+++ /dev/null
-Revision history for Perl extension DBD::SQLite.
-
-0.33
- - Set HAVE_USLEEP appropriately. This massively improves
- concurrent access to your SQLite DB.
-
-0.32
- - Renamed to DBD::SQLite2 to allow backwards compatibility
- - Implemented busy_timeout API
- - Add internal line number to error reporting
-
-0.31
- - Fixed a free() bug on Win32
- - Silence warnings in test suite
- - Updated to sqlite 2.8.12
-
-0.30
- - Updated to sqlite 2.8.11
- - A few minor bugs fixed
-
-0.29
- - Updated to sqlite 2.8.7
- - A number of bugs fixed
-
-0.28
- - Perl 5.8.0 removed long deprecated SvOK_off()
- - Aliases for perl_call_*
- - Updated to sqlite 2.8.6
- - use sqlite_freemem everywhere
-
-0.27
- - Changed API to use sqlite streaming API. This makes things slightly
- slower for large result sets, at the benefit of being more "sane"
- internally.
-
-0.26
- - Update to sqlite 2.8.5
- - Automatic binary encoding added (via a flag)
- - Better getsqlite.pl - now deals with new files
- - Extension functions and aggregates can be created in
- perl space now.
-
-0.25
- - Fixed Makefile.PL to no longer try creating a .c file to determine
- the OS ptrsize - use Config.pm directly in the DEFINE
- - Major updates from Tim Bunce to bring DBD::SQLite in line with
- the DBI spec and other drivers, including:
- - Support for table_info_all() and primary_key_info()
- - $sth->{NAME} updates
- - execute() returns number of rows updated
- - $dbh->{sqlite_version} returns the SQLite version in use
- - $dbh->{sqlite_encoding} returns the SQLite encoding in use
- - Improved trace debugging
- - Improved error handling
- (many MANY thanks to Tim for all these patches!)
- - Updated to sqlite 2.8.0
-
-0.24
- - Fixed major crash bug affecting Mac OS X
- - Removed test.pl from distribution
- - Upgraded to sqlite 2.7.6
-
-0.23
- - Fixed unicode tests
-
-0.22
- - Merge with sqlite 2.7.4
-
-0.21
- - Ooops - forgot new opcodes files from MANIFEST
-
-0.20
- - Port to SQLite 2.7.2
- - Fixed bug in not freeing memory if you re-execute a $sth
-
-0.19
- - Upgrade to SQLite 2.6.3 - this now allows databases to work across
- different endian architectures.
-
-0.18
- - Upgraded to SQLite 2.5.6 - All users are advised to upgrade
- due to a corruption bug in SQLite 2.4.0 - 2.5.6
-
-0.17
- - Upgraded to SQLite 2.5.3
- - Fixed getsqlite.pl
-
-0.16
- - Upgraded to SQLite 2.5.0
-
-0.15
- - Upgraded to SQLite 2.4.5
-
-0.14
- - Added NoUTF8Flag option, so that returned strings don't get flagged
- with SvUTF8_on() - needed when you're storing non-unicode in the database
-
-0.13
- - Upgraded to SQLite 2.4.3
- - Added script to download sqlite core library when it's upgraded
-
-0.12
- - Upgraded to SQLite 2.4.2
-
-0.11
- - Upgraded to SQLite 2.4.0, which adds views, subqueries, new builtin
- functions, performance, and even sheds some weight
- - Changed transaction support to only BEGIN TRAN when you execute some
- SQL, which should improve locking problems.
-
-0.10
- - Fixed missing SQLiteXS.h from 0.09
-
-0.09
- - Updated to SQLite 2.3.3, and some file cleanups to make that easier
- next time.
-
-0.08
- - Last of the mem leaks fixed
- - Doc fix on last_insert_rowid
-
-0.07
- - Memory leak fixes (though still leaks some, beware)
- - Some API cleanups and test cleanups
- - Added last_insert_rowid() method and docs
-
-0.06
- - Win32 and 5.00404 build fixes
- - Added some more performance tests to test.pl
- - Make sure to set $sth->{Active} only on selects
-
-0.05
- - Added all DBD::CSV tests (ported, of course)
- - Fixed bugs that the above revealed.
-
-0.04
- - Fix multiple placeholders bug
-
-0.03
- - Fixed multiple execute on single $sth
-
-0.02
- - Fixed transactions
-
-0.01 Sat Feb 16 16:10:42 2002
- - original version; created by h2xs 1.20 with options
- -A -X -n DBD::SQLite
-
+++ /dev/null
-Changes
-MANIFEST
-MANIFEST.SKIP
-Makefile.PL
-README
-SQLite2.xs
-SQLiteXS.h
-attach.c
-auth.c
-btree.c
-btree.h
-btree_rb.c
-build.c
-copy.c
-date.c
-dbdimp.c
-dbdimp.h
-delete.c
-encode.c
-expr.c
-func.c
-getsqlite.pl
-hash.c
-hash.h
-insert.c
-lib/DBD/SQLite2.pm
-main.c
-opcodes.c
-opcodes.h
-os.c
-os.h
-pager.c
-pager.h
-parse.c
-parse.h
-pragma.c
-printf.c
-random.c
-select.c
-sqlite.h
-sqliteInt.h
-t/00basic.t
-t/01logon.t
-t/02cr_table.t
-t/03insert.t
-t/04select.t
-t/05tran.t
-t/06error.t
-t/08create_function.t
-t/09create_aggregate.t
-t/10dsnlist.t
-t/20createdrop.t
-t/30insertfetch.t
-t/40bindparam.t
-t/40blobs.t
-t/40listfields.t
-t/40nulls.t
-t/40numrows.t
-t/50chopblanks.t
-t/50commit.t
-t/60metadata.t
-t/90cppcomments.t
-t/99cleanup.t
-t/SQLite2.dbtest
-t/ak-dbd.t
-t/dbdadmin.t
-t/lib.pl
-table.c
-tokenize.c
-trigger.c
-update.c
-util.c
-vacuum.c
-vdbe.c
-vdbe.h
-vdbeaux.c
-vdbeInt.h
-where.c
-META.yml Module meta-data (added by MakeMaker)
+++ /dev/null
-CVS/.*
-\.bak$
-\.sw[a-z]$
-\.tar$
-\.tgz$
-\.tar\.gz$
-\.o$
-\.xsi$
-\.bs$
-output/.*
-^.#
-^mess/
-^sqlite/
-^output/
-^tmp/
-^blib/
-^Makefile$
-^Makefile\.[a-z]+$
-^pm_to_blib$
-~$
+++ /dev/null
-# http://module-build.sourceforge.net/META-spec.html
-#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
-name: DBD-SQLite2
-version: 0.33
-version_from: lib/DBD/SQLite2.pm
-installdirs: site
-requires:
- DBI: 1.21
-
-distribution_type: module
-generated_by: ExtUtils::MakeMaker version 6.21
+++ /dev/null
-{
- "abstract" : "unknown",
- "author" : [
- "unknown"
- ],
- "dynamic_config" : 0,
- "generated_by" : "ExtUtils::MakeMaker version 7.0401, CPAN::Meta::Converter version 2.150001",
- "license" : [
- "unknown"
- ],
- "meta-spec" : {
- "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
- "version" : "2"
- },
- "name" : "DBD-SQLite2",
- "no_index" : {
- "directory" : [
- "t",
- "inc"
- ]
- },
- "prereqs" : {
- "build" : {
- "requires" : {
- "ExtUtils::MakeMaker" : "0"
- }
- },
- "configure" : {
- "requires" : {
- "ExtUtils::MakeMaker" : "0"
- }
- },
- "runtime" : {
- "requires" : {
- "DBI" : "1.21"
- }
- }
- },
- "release_status" : "stable",
- "version" : "0.33"
-}
+++ /dev/null
----
-abstract: unknown
-author:
- - unknown
-build_requires:
- ExtUtils::MakeMaker: '0'
-configure_requires:
- ExtUtils::MakeMaker: '0'
-dynamic_config: 0
-generated_by: 'ExtUtils::MakeMaker version 7.0401, CPAN::Meta::Converter version 2.150001'
-license: unknown
-meta-spec:
- url: http://module-build.sourceforge.net/META-spec-v1.4.html
- version: '1.4'
-name: DBD-SQLite2
-no_index:
- directory:
- - t
- - inc
-requires:
- DBI: '1.21'
-version: '0.33'
+++ /dev/null
-# This Makefile is for the DBD::SQLite2 extension to perl.
-#
-# It was generated automatically by MakeMaker version
-# 7.0401 (Revision: 70401) 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:
-
-# BUILD_REQUIRES => { }
-# CONFIGURE_REQUIRES => { }
-# DEFINE => q[-DNDEBUG=1 -DSQLITE_PTR_SZ=8 -DHAVE_USLEEP=1]
-# INC => q[-I$(DBI_INSTARCH_DIR)]
-# NAME => q[DBD::SQLite2]
-# OBJECT => q[$(O_FILES)]
-# OPTIMIZE => q[-O2]
-# PREREQ_PM => { DBI=>q[1.21] }
-# TEST_REQUIRES => { }
-# VERSION_FROM => q[lib/DBD/SQLite2.pm]
-# clean => { FILES=>q[SQLite2.xsi config.h] }
-
-# --- MakeMaker post_initialize section:
-
-
-# --- MakeMaker const_config section:
-
-# These definitions are from config.sh (via /usr/lib/x86_64-linux-gnu/perl/5.22/Config.pm).
-# They may have been overridden via Makefile.PL or on the command line.
-AR = ar
-CC = x86_64-linux-gnu-gcc
-CCCDLFLAGS = -fPIC
-CCDLFLAGS = -Wl,-E
-DLEXT = so
-DLSRC = dl_dlopen.xs
-EXE_EXT =
-FULL_AR = /usr/bin/ar
-LD = x86_64-linux-gnu-gcc
-LDDLFLAGS = -shared -L/usr/local/lib -fstack-protector-strong
-LDFLAGS = -fstack-protector-strong -L/usr/local/lib
-LIBC = libc-2.23.so
-LIB_EXT = .a
-OBJ_EXT = .o
-OSNAME = linux
-OSVERS = 3.16.0
-RANLIB = :
-SITELIBEXP = /usr/local/share/perl/5.22.1
-SITEARCHEXP = /usr/local/lib/x86_64-linux-gnu/perl/5.22.1
-SO = so
-VENDORARCHEXP = /usr/lib/x86_64-linux-gnu/perl5/5.22
-VENDORLIBEXP = /usr/share/perl5
-
-
-# --- MakeMaker constants section:
-AR_STATIC_ARGS = cr
-DIRFILESEP = /
-DFSEP = $(DIRFILESEP)
-NAME = DBD::SQLite2
-NAME_SYM = DBD_SQLite2
-VERSION = 0.33
-VERSION_MACRO = VERSION
-VERSION_SYM = 0_33
-DEFINE_VERSION = -D$(VERSION_MACRO)=\"$(VERSION)\"
-XS_VERSION = 0.33
-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 = 1p
-MAN3EXT = 3pm
-INSTALLDIRS = site
-DESTDIR =
-PREFIX = $(SITEPREFIX)
-PERLPREFIX = /usr
-SITEPREFIX = /usr/local
-VENDORPREFIX = /usr
-INSTALLPRIVLIB = /usr/share/perl/5.22
-DESTINSTALLPRIVLIB = $(DESTDIR)$(INSTALLPRIVLIB)
-INSTALLSITELIB = /usr/local/share/perl/5.22.1
-DESTINSTALLSITELIB = $(DESTDIR)$(INSTALLSITELIB)
-INSTALLVENDORLIB = /usr/share/perl5
-DESTINSTALLVENDORLIB = $(DESTDIR)$(INSTALLVENDORLIB)
-INSTALLARCHLIB = /usr/lib/x86_64-linux-gnu/perl/5.22
-DESTINSTALLARCHLIB = $(DESTDIR)$(INSTALLARCHLIB)
-INSTALLSITEARCH = /usr/local/lib/x86_64-linux-gnu/perl/5.22.1
-DESTINSTALLSITEARCH = $(DESTDIR)$(INSTALLSITEARCH)
-INSTALLVENDORARCH = /usr/lib/x86_64-linux-gnu/perl5/5.22
-DESTINSTALLVENDORARCH = $(DESTDIR)$(INSTALLVENDORARCH)
-INSTALLBIN = /usr/bin
-DESTINSTALLBIN = $(DESTDIR)$(INSTALLBIN)
-INSTALLSITEBIN = /usr/local/bin
-DESTINSTALLSITEBIN = $(DESTDIR)$(INSTALLSITEBIN)
-INSTALLVENDORBIN = /usr/bin
-DESTINSTALLVENDORBIN = $(DESTDIR)$(INSTALLVENDORBIN)
-INSTALLSCRIPT = /usr/bin
-DESTINSTALLSCRIPT = $(DESTDIR)$(INSTALLSCRIPT)
-INSTALLSITESCRIPT = /usr/local/bin
-DESTINSTALLSITESCRIPT = $(DESTDIR)$(INSTALLSITESCRIPT)
-INSTALLVENDORSCRIPT = /usr/bin
-DESTINSTALLVENDORSCRIPT = $(DESTDIR)$(INSTALLVENDORSCRIPT)
-INSTALLMAN1DIR = /usr/share/man/man1
-DESTINSTALLMAN1DIR = $(DESTDIR)$(INSTALLMAN1DIR)
-INSTALLSITEMAN1DIR = /usr/local/man/man1
-DESTINSTALLSITEMAN1DIR = $(DESTDIR)$(INSTALLSITEMAN1DIR)
-INSTALLVENDORMAN1DIR = /usr/share/man/man1
-DESTINSTALLVENDORMAN1DIR = $(DESTDIR)$(INSTALLVENDORMAN1DIR)
-INSTALLMAN3DIR = /usr/share/man/man3
-DESTINSTALLMAN3DIR = $(DESTDIR)$(INSTALLMAN3DIR)
-INSTALLSITEMAN3DIR = /usr/local/man/man3
-DESTINSTALLSITEMAN3DIR = $(DESTDIR)$(INSTALLSITEMAN3DIR)
-INSTALLVENDORMAN3DIR = /usr/share/man/man3
-DESTINSTALLVENDORMAN3DIR = $(DESTDIR)$(INSTALLVENDORMAN3DIR)
-PERL_LIB = /usr/share/perl/5.22
-PERL_ARCHLIB = /usr/lib/x86_64-linux-gnu/perl/5.22
-PERL_ARCHLIBDEP = /usr/lib/x86_64-linux-gnu/perl/5.22
-LIBPERL_A = libperl.a
-FIRST_MAKEFILE = Makefile
-MAKEFILE_OLD = Makefile.old
-MAKE_APERL_FILE = Makefile.aperl
-PERLMAINCC = $(CC)
-PERL_INC = /usr/lib/x86_64-linux-gnu/perl/5.22/CORE
-PERL_INCDEP = /usr/lib/x86_64-linux-gnu/perl/5.22/CORE
-PERL = "/usr/bin/perl"
-FULLPERL = "/usr/bin/perl"
-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_DIR = 755
-PERM_RW = 644
-PERM_RWX = 755
-
-MAKEMAKER = /usr/share/perl/5.22/ExtUtils/MakeMaker.pm
-MM_VERSION = 7.0401
-MM_REVISION = 70401
-
-# 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 = make
-FULLEXT = DBD/SQLite2
-BASEEXT = SQLite2
-PARENT_NAME = DBD
-DLBASE = $(BASEEXT)
-VERSION_FROM = lib/DBD/SQLite2.pm
-INC = -I$(DBI_INSTARCH_DIR)
-DEFINE = -DNDEBUG=1 -DSQLITE_PTR_SZ=8 -DHAVE_USLEEP=1
-OBJECT = $(O_FILES)
-LDFROM = $(OBJECT)
-LINKTYPE = dynamic
-BOOTDEP =
-
-# Handy lists of source code files:
-XS_FILES = SQLite2.xs
-C_FILES = SQLite2.c \
- attach.c \
- auth.c \
- btree.c \
- btree_rb.c \
- build.c \
- copy.c \
- date.c \
- dbdimp.c \
- delete.c \
- encode.c \
- expr.c \
- func.c \
- hash.c \
- insert.c \
- main.c \
- opcodes.c \
- os.c \
- pager.c \
- parse.c \
- pragma.c \
- printf.c \
- random.c \
- select.c \
- table.c \
- tokenize.c \
- trigger.c \
- update.c \
- util.c \
- vacuum.c \
- vdbe.c \
- vdbeaux.c \
- where.c
-O_FILES = SQLite2.o \
- attach.o \
- auth.o \
- btree.o \
- btree_rb.o \
- build.o \
- copy.o \
- date.o \
- dbdimp.o \
- delete.o \
- encode.o \
- expr.o \
- func.o \
- hash.o \
- insert.o \
- main.o \
- opcodes.o \
- os.o \
- pager.o \
- parse.o \
- pragma.o \
- printf.o \
- random.o \
- select.o \
- table.o \
- tokenize.o \
- trigger.o \
- update.o \
- util.o \
- vacuum.o \
- vdbe.o \
- vdbeaux.o \
- where.o
-H_FILES = SQLiteXS.h \
- btree.h \
- dbdimp.h \
- hash.h \
- opcodes.h \
- os.h \
- pager.h \
- parse.h \
- sqlite.h \
- sqliteInt.h \
- vdbe.h \
- vdbeInt.h
-MAN1PODS =
-MAN3PODS = lib/DBD/SQLite2.pm
-
-# Where is the Config information that we are using/depend on
-CONFIGDEP = $(PERL_ARCHLIBDEP)$(DFSEP)Config.pm $(PERL_INCDEP)$(DFSEP)config.h
-
-# Where to build things
-INST_LIBDIR = $(INST_LIB)/DBD
-INST_ARCHLIBDIR = $(INST_ARCHLIB)/DBD
-
-INST_AUTODIR = $(INST_LIB)/auto/$(FULLEXT)
-INST_ARCHAUTODIR = $(INST_ARCHLIB)/auto/$(FULLEXT)
-
-INST_STATIC = $(INST_ARCHAUTODIR)/$(BASEEXT)$(LIB_EXT)
-INST_DYNAMIC = $(INST_ARCHAUTODIR)/$(DLBASE).$(DLEXT)
-INST_BOOT = $(INST_ARCHAUTODIR)/$(BASEEXT).bs
-
-# Extra linker info
-EXPORT_LIST =
-PERL_ARCHIVE =
-PERL_ARCHIVEDEP =
-PERL_ARCHIVE_AFTER =
-
-
-TO_INST_PM = getsqlite.pl \
- lib/DBD/SQLite2.pm
-
-PM_TO_BLIB = getsqlite.pl \
- $(INST_LIB)/DBD/getsqlite.pl \
- lib/DBD/SQLite2.pm \
- blib/lib/DBD/SQLite2.pm
-
-
-# --- MakeMaker platform_constants section:
-MM_Unix_VERSION = 7.0401
-PERL_MALLOC_DEF = -DPERL_EXTMALLOC_DEF -Dmalloc=Perl_malloc -Dfree=Perl_mfree -Drealloc=Perl_realloc -Dcalloc=Perl_calloc
-
-
-# --- 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:
-
-XSUBPPDIR = /usr/share/perl/5.22/ExtUtils
-XSUBPP = "$(XSUBPPDIR)$(DFSEP)xsubpp"
-XSUBPPRUN = $(PERLRUN) $(XSUBPP)
-XSPROTOARG =
-XSUBPPDEPS = /usr/share/perl/5.22/ExtUtils/typemap /usr/share/perl/5.22/ExtUtils$(DFSEP)xsubpp
-XSUBPPARGS = -typemap "/usr/share/perl/5.22/ExtUtils/typemap"
-XSUBPP_EXTRA_ARGS =
-
-
-# --- MakeMaker tools_other section:
-SHELL = /bin/sh
-CHMOD = chmod
-CP = cp
-MV = mv
-NOOP = $(TRUE)
-NOECHO = @
-RM_F = rm -f
-RM_RF = rm -rf
-TEST_F = test -f
-TOUCH = touch
-UMASK_NULL = umask 0
-DEV_NULL = > /dev/null 2>&1
-MKPATH = $(ABSPERLRUN) -MExtUtils::Command -e 'mkpath' --
-EQUALIZE_TIMESTAMP = $(ABSPERLRUN) -MExtUtils::Command -e 'eqtime' --
-FALSE = false
-TRUE = true
-ECHO = echo
-ECHO_N = echo -n
-UNINST = 0
-VERBINST = 0
-MOD_INSTALL = $(ABSPERLRUN) -MExtUtils::Install -e 'install([ from_to => {@ARGV}, verbose => '\''$(VERBINST)'\'', uninstall_shadows => '\''$(UNINST)'\'', dir_mode => '\''$(PERM_DIR)'\'' ]);' --
-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 = $(ABSPERLRUN) -MExtUtils::MY -e 'MY->fixin(shift)' --
-CP_NONEMPTY = $(ABSPERLRUN) -MExtUtils::Command::MM -e 'cp_nonempty' --
-
-
-# --- 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 = DBD-SQLite2
-DISTVNAME = DBD-SQLite2-0.33
-
-
-# --- MakeMaker macro section:
-
-
-# --- MakeMaker depend section:
-
-
-# --- MakeMaker cflags section:
-
-CCFLAGS = -D_REENTRANT -D_GNU_SOURCE -DDEBIAN -fwrapv -fno-strict-aliasing -pipe -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64
-OPTIMIZE = -O2
-PERLTYPE =
-MPOLLUTE =
-
-
-# --- MakeMaker const_loadlibs section:
-
-# DBD::SQLite2 might depend on some other libraries:
-# See ExtUtils::Liblist for details
-#
-
-
-# --- MakeMaker const_cccmd section:
-CCCMD = $(CC) -c $(PASTHRU_INC) $(INC) \
- $(CCFLAGS) $(OPTIMIZE) \
- $(PERLTYPE) $(MPOLLUTE) $(DEFINE_VERSION) \
- $(XS_DEFINE_VERSION)
-
-# --- MakeMaker post_constants section:
-
-
-# --- MakeMaker pasthru section:
-
-PASTHRU = LIBPERL_A="$(LIBPERL_A)"\
- LINKTYPE="$(LINKTYPE)"\
- OPTIMIZE="$(OPTIMIZE)"\
- LD="$(LD)"\
- PREFIX="$(PREFIX)"\
- PASTHRU_DEFINE="$(PASTHRU_DEFINE)"\
- PASTHRU_INC="$(PASTHRU_INC)"
-
-
-# --- 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:
-
-.c.i:
- x86_64-linux-gnu-gcc -E -c $(PASTHRU_INC) $(INC) \
- $(CCFLAGS) $(OPTIMIZE) \
- $(PERLTYPE) $(MPOLLUTE) $(DEFINE_VERSION) \
- $(XS_DEFINE_VERSION) $(CCCDLFLAGS) "-I$(PERL_INC)" $(PASTHRU_DEFINE) $(DEFINE) $*.c > $*.i
-
-.c.s:
- $(CCCMD) -S $(CCCDLFLAGS) "-I$(PERL_INC)" $(PASTHRU_DEFINE) $(DEFINE) $*.c
-
-.c$(OBJ_EXT):
- $(CCCMD) $(CCCDLFLAGS) "-I$(PERL_INC)" $(PASTHRU_DEFINE) $(DEFINE) $*.c
-
-.cpp$(OBJ_EXT):
- $(CCCMD) $(CCCDLFLAGS) "-I$(PERL_INC)" $(PASTHRU_DEFINE) $(DEFINE) $*.cpp
-
-.cxx$(OBJ_EXT):
- $(CCCMD) $(CCCDLFLAGS) "-I$(PERL_INC)" $(PASTHRU_DEFINE) $(DEFINE) $*.cxx
-
-.cc$(OBJ_EXT):
- $(CCCMD) $(CCCDLFLAGS) "-I$(PERL_INC)" $(PASTHRU_DEFINE) $(DEFINE) $*.cc
-
-.C$(OBJ_EXT):
- $(CCCMD) $(CCCDLFLAGS) "-I$(PERL_INC)" $(PASTHRU_DEFINE) $(DEFINE) $*.C
-
-
-# --- MakeMaker xs_c section:
-
-.xs.c:
- $(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $(XSUBPP_EXTRA_ARGS) $*.xs > $*.xsc && $(MV) $*.xsc $*.c
-
-
-# --- MakeMaker xs_o section:
-
-.xs$(OBJ_EXT):
- $(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $*.xs > $*.xsc && $(MV) $*.xsc $*.c
- $(CCCMD) $(CCCDLFLAGS) "-I$(PERL_INC)" $(PASTHRU_DEFINE) $(DEFINE) $*.c
-
-
-# --- MakeMaker top_targets section:
-all :: pure_all manifypods
- $(NOECHO) $(NOOP)
-
-
-pure_all :: config pm_to_blib subdirs linkext
- $(NOECHO) $(NOOP)
-
-subdirs :: $(MYEXTLIB)
- $(NOECHO) $(NOOP)
-
-config :: $(FIRST_MAKEFILE) blibdirs
- $(NOECHO) $(NOOP)
-
-$(O_FILES): $(H_FILES)
-
-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) $(PERM_DIR) $(INST_LIBDIR)
- $(NOECHO) $(TOUCH) $(INST_LIBDIR)$(DFSEP).exists
-
-$(INST_ARCHLIB)$(DFSEP).exists :: Makefile.PL
- $(NOECHO) $(MKPATH) $(INST_ARCHLIB)
- $(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_ARCHLIB)
- $(NOECHO) $(TOUCH) $(INST_ARCHLIB)$(DFSEP).exists
-
-$(INST_AUTODIR)$(DFSEP).exists :: Makefile.PL
- $(NOECHO) $(MKPATH) $(INST_AUTODIR)
- $(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_AUTODIR)
- $(NOECHO) $(TOUCH) $(INST_AUTODIR)$(DFSEP).exists
-
-$(INST_ARCHAUTODIR)$(DFSEP).exists :: Makefile.PL
- $(NOECHO) $(MKPATH) $(INST_ARCHAUTODIR)
- $(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_ARCHAUTODIR)
- $(NOECHO) $(TOUCH) $(INST_ARCHAUTODIR)$(DFSEP).exists
-
-$(INST_BIN)$(DFSEP).exists :: Makefile.PL
- $(NOECHO) $(MKPATH) $(INST_BIN)
- $(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_BIN)
- $(NOECHO) $(TOUCH) $(INST_BIN)$(DFSEP).exists
-
-$(INST_SCRIPT)$(DFSEP).exists :: Makefile.PL
- $(NOECHO) $(MKPATH) $(INST_SCRIPT)
- $(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_SCRIPT)
- $(NOECHO) $(TOUCH) $(INST_SCRIPT)$(DFSEP).exists
-
-$(INST_MAN1DIR)$(DFSEP).exists :: Makefile.PL
- $(NOECHO) $(MKPATH) $(INST_MAN1DIR)
- $(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_MAN1DIR)
- $(NOECHO) $(TOUCH) $(INST_MAN1DIR)$(DFSEP).exists
-
-$(INST_MAN3DIR)$(DFSEP).exists :: Makefile.PL
- $(NOECHO) $(MKPATH) $(INST_MAN3DIR)
- $(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_MAN3DIR)
- $(NOECHO) $(TOUCH) $(INST_MAN3DIR)$(DFSEP).exists
-
-
-
-# --- MakeMaker linkext section:
-
-linkext :: $(LINKTYPE)
- $(NOECHO) $(NOOP)
-
-
-# --- MakeMaker dlsyms section:
-
-
-# --- MakeMaker dynamic_bs section:
-BOOTSTRAP = $(BASEEXT).bs
-
-# As Mkbootstrap might not write a file (if none is required)
-# we use touch to prevent make continually trying to remake it.
-# The DynaLoader only reads a non-empty file.
-$(BOOTSTRAP) : $(FIRST_MAKEFILE) $(BOOTDEP) $(INST_ARCHAUTODIR)$(DFSEP).exists
- $(NOECHO) $(ECHO) "Running Mkbootstrap for $(NAME) ($(BSLOADLIBS))"
- $(NOECHO) $(PERLRUN) \
- "-MExtUtils::Mkbootstrap" \
- -e "Mkbootstrap('$(BASEEXT)','$(BSLOADLIBS)');"
- $(NOECHO) $(TOUCH) "$@"
- $(CHMOD) $(PERM_RW) "$@"
-
-
-# --- MakeMaker dynamic section:
-
-dynamic :: $(FIRST_MAKEFILE) $(BOOTSTRAP) $(INST_DYNAMIC)
- $(NOECHO) $(NOOP)
-
-
-# --- MakeMaker dynamic_lib section:
-
-# This section creates the dynamically loadable $(INST_DYNAMIC)
-# from $(OBJECT) and possibly $(MYEXTLIB).
-ARMAYBE = :
-OTHERLDFLAGS =
-INST_DYNAMIC_DEP =
-INST_DYNAMIC_FIX =
-
-$(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(INST_ARCHAUTODIR)$(DFSEP).exists $(EXPORT_LIST) $(PERL_ARCHIVEDEP) $(PERL_ARCHIVE_AFTER) $(INST_DYNAMIC_DEP)
- $(RM_F) $@
- $(LD) $(LDDLFLAGS) $(LDFROM) $(OTHERLDFLAGS) -o $@ $(MYEXTLIB) \
- $(PERL_ARCHIVE) $(LDLOADLIBS) $(PERL_ARCHIVE_AFTER) $(EXPORT_LIST) \
- $(INST_DYNAMIC_FIX)
- $(CHMOD) $(PERM_RWX) $@
- $(NOECHO) $(RM_RF) $(BOOTSTRAP)
- - $(CP_NONEMPTY) $(BOOTSTRAP) $(INST_BOOT) $(PERM_RW)
-
-
-# --- 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:
-
-$(INST_STATIC) : $(OBJECT) $(MYEXTLIB) $(INST_ARCHAUTODIR)$(DFSEP).exists
- $(RM_RF) $@
- $(FULL_AR) $(AR_STATIC_ARGS) $@ $(OBJECT) && $(RANLIB) $@
- $(CHMOD) $(PERM_RWX) $@
- $(NOECHO) $(ECHO) "$(EXTRALIBS)" > "$(INST_ARCHAUTODIR)/extralibs.ld"
-
-
-# --- MakeMaker manifypods section:
-
-POD2MAN_EXE = $(PERLRUN) "-MExtUtils::Command::MM" -e pod2man "--"
-POD2MAN = $(POD2MAN_EXE)
-
-
-manifypods : pure_all \
- lib/DBD/SQLite2.pm
- $(NOECHO) $(POD2MAN) --section=$(MAN3EXT) --perm_rw=$(PERM_RW) -u \
- lib/DBD/SQLite2.pm $(INST_MAN3DIR)/DBD::SQLite2.$(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) \
- $(BASEEXT).bso $(BASEEXT).def \
- $(BASEEXT).exp $(BASEEXT).x \
- $(BOOTSTRAP) $(INST_ARCHAUTODIR)/extralibs.all \
- $(INST_ARCHAUTODIR)/extralibs.ld $(MAKE_APERL_FILE) \
- *$(LIB_EXT) *$(OBJ_EXT) \
- *perl.core MYMETA.json \
- MYMETA.yml SQLite2.c \
- blibdirs.ts core \
- core.*perl.*.? core.[0-9] \
- core.[0-9][0-9] core.[0-9][0-9][0-9] \
- core.[0-9][0-9][0-9][0-9] core.[0-9][0-9][0-9][0-9][0-9] \
- lib$(BASEEXT).def mon.out \
- perl perl$(EXE_EXT) \
- perl.exe perlmain.c \
- pm_to_blib pm_to_blib.ts \
- so_locations tmon.out
- - $(RM_RF) \
- SQLite2.xsi blib \
- config.h
- $(NOECHO) $(RM_F) $(MAKEFILE_OLD)
- - $(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) \
- $(OBJECT)
- - $(RM_RF) \
- $(DISTVNAME)
-
-
-# --- MakeMaker metafile section:
-metafile : create_distdir
- $(NOECHO) $(ECHO) Generating META.yml
- $(NOECHO) $(ECHO) '---' > META_new.yml
- $(NOECHO) $(ECHO) 'abstract: unknown' >> META_new.yml
- $(NOECHO) $(ECHO) 'author:' >> META_new.yml
- $(NOECHO) $(ECHO) ' - unknown' >> META_new.yml
- $(NOECHO) $(ECHO) 'build_requires:' >> META_new.yml
- $(NOECHO) $(ECHO) ' ExtUtils::MakeMaker: '\''0'\''' >> META_new.yml
- $(NOECHO) $(ECHO) 'configure_requires:' >> META_new.yml
- $(NOECHO) $(ECHO) ' ExtUtils::MakeMaker: '\''0'\''' >> META_new.yml
- $(NOECHO) $(ECHO) 'dynamic_config: 1' >> META_new.yml
- $(NOECHO) $(ECHO) 'generated_by: '\''ExtUtils::MakeMaker version 7.0401, CPAN::Meta::Converter version 2.150001'\''' >> META_new.yml
- $(NOECHO) $(ECHO) 'license: unknown' >> META_new.yml
- $(NOECHO) $(ECHO) 'meta-spec:' >> META_new.yml
- $(NOECHO) $(ECHO) ' url: http://module-build.sourceforge.net/META-spec-v1.4.html' >> META_new.yml
- $(NOECHO) $(ECHO) ' version: '\''1.4'\''' >> META_new.yml
- $(NOECHO) $(ECHO) 'name: DBD-SQLite2' >> META_new.yml
- $(NOECHO) $(ECHO) 'no_index:' >> META_new.yml
- $(NOECHO) $(ECHO) ' directory:' >> META_new.yml
- $(NOECHO) $(ECHO) ' - t' >> META_new.yml
- $(NOECHO) $(ECHO) ' - inc' >> META_new.yml
- $(NOECHO) $(ECHO) 'requires:' >> META_new.yml
- $(NOECHO) $(ECHO) ' DBI: '\''1.21'\''' >> META_new.yml
- $(NOECHO) $(ECHO) 'version: '\''0.33'\''' >> META_new.yml
- -$(NOECHO) $(MV) META_new.yml $(DISTVNAME)/META.yml
- $(NOECHO) $(ECHO) Generating META.json
- $(NOECHO) $(ECHO) '{' > META_new.json
- $(NOECHO) $(ECHO) ' "abstract" : "unknown",' >> META_new.json
- $(NOECHO) $(ECHO) ' "author" : [' >> META_new.json
- $(NOECHO) $(ECHO) ' "unknown"' >> META_new.json
- $(NOECHO) $(ECHO) ' ],' >> META_new.json
- $(NOECHO) $(ECHO) ' "dynamic_config" : 1,' >> META_new.json
- $(NOECHO) $(ECHO) ' "generated_by" : "ExtUtils::MakeMaker version 7.0401, CPAN::Meta::Converter version 2.150001",' >> META_new.json
- $(NOECHO) $(ECHO) ' "license" : [' >> META_new.json
- $(NOECHO) $(ECHO) ' "unknown"' >> META_new.json
- $(NOECHO) $(ECHO) ' ],' >> META_new.json
- $(NOECHO) $(ECHO) ' "meta-spec" : {' >> META_new.json
- $(NOECHO) $(ECHO) ' "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",' >> META_new.json
- $(NOECHO) $(ECHO) ' "version" : "2"' >> META_new.json
- $(NOECHO) $(ECHO) ' },' >> META_new.json
- $(NOECHO) $(ECHO) ' "name" : "DBD-SQLite2",' >> META_new.json
- $(NOECHO) $(ECHO) ' "no_index" : {' >> META_new.json
- $(NOECHO) $(ECHO) ' "directory" : [' >> META_new.json
- $(NOECHO) $(ECHO) ' "t",' >> META_new.json
- $(NOECHO) $(ECHO) ' "inc"' >> META_new.json
- $(NOECHO) $(ECHO) ' ]' >> META_new.json
- $(NOECHO) $(ECHO) ' },' >> META_new.json
- $(NOECHO) $(ECHO) ' "prereqs" : {' >> META_new.json
- $(NOECHO) $(ECHO) ' "build" : {' >> META_new.json
- $(NOECHO) $(ECHO) ' "requires" : {' >> META_new.json
- $(NOECHO) $(ECHO) ' "ExtUtils::MakeMaker" : "0"' >> META_new.json
- $(NOECHO) $(ECHO) ' }' >> META_new.json
- $(NOECHO) $(ECHO) ' },' >> META_new.json
- $(NOECHO) $(ECHO) ' "configure" : {' >> META_new.json
- $(NOECHO) $(ECHO) ' "requires" : {' >> META_new.json
- $(NOECHO) $(ECHO) ' "ExtUtils::MakeMaker" : "0"' >> META_new.json
- $(NOECHO) $(ECHO) ' }' >> META_new.json
- $(NOECHO) $(ECHO) ' },' >> META_new.json
- $(NOECHO) $(ECHO) ' "runtime" : {' >> META_new.json
- $(NOECHO) $(ECHO) ' "requires" : {' >> META_new.json
- $(NOECHO) $(ECHO) ' "DBI" : "1.21"' >> META_new.json
- $(NOECHO) $(ECHO) ' }' >> META_new.json
- $(NOECHO) $(ECHO) ' }' >> META_new.json
- $(NOECHO) $(ECHO) ' },' >> META_new.json
- $(NOECHO) $(ECHO) ' "release_status" : "stable",' >> META_new.json
- $(NOECHO) $(ECHO) ' "version" : "0.33"' >> META_new.json
- $(NOECHO) $(ECHO) '}' >> META_new.json
- -$(NOECHO) $(MV) META_new.json $(DISTVNAME)/META.json
-
-
-# --- 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)'\''' \
- -e ' 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
- $(NOECHO) $(ECHO) 'Created $(DISTVNAME).tar$(SUFFIX)_uu'
-
-$(DISTVNAME).tar$(SUFFIX) : distdir
- $(PREOP)
- $(TO_UNIX)
- $(TAR) $(TARFLAGS) $(DISTVNAME).tar $(DISTVNAME)
- $(RM_RF) $(DISTVNAME)
- $(COMPRESS) $(DISTVNAME).tar
- $(NOECHO) $(ECHO) 'Created $(DISTVNAME).tar$(SUFFIX)'
- $(POSTOP)
-
-zipdist : $(DISTVNAME).zip
- $(NOECHO) $(NOOP)
-
-$(DISTVNAME).zip : distdir
- $(PREOP)
- $(ZIP) $(ZIPFLAGS) $(DISTVNAME).zip $(DISTVNAME)
- $(RM_RF) $(DISTVNAME)
- $(NOECHO) $(ECHO) 'Created $(DISTVNAME).zip'
- $(POSTOP)
-
-shdist : distdir
- $(PREOP)
- $(SHAR) $(DISTVNAME) > $(DISTVNAME).shar
- $(RM_RF) $(DISTVNAME)
- $(NOECHO) $(ECHO) 'Created $(DISTVNAME).shar'
- $(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
- cd $(DISTVNAME) && $(MAKE) $(PASTHRU)
- cd $(DISTVNAME) && $(MAKE) test $(PASTHRU)
-
-
-
-# --- 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 'exit unless -e q{META.yml};' \
- -e 'eval { maniadd({q{META.yml} => q{Module YAML meta-data (added by MakeMaker)}}) }' \
- -e ' or print "Could not add META.yml to MANIFEST: $$$${'\''@'\''}\n"' --
- $(NOECHO) cd $(DISTVNAME) && $(ABSPERLRUN) -MExtUtils::Manifest=maniadd -e 'exit unless -f q{META.json};' \
- -e 'eval { maniadd({q{META.json} => q{Module JSON meta-data (added by MakeMaker)}}) }' \
- -e ' or print "Could not add META.json to MANIFEST: $$$${'\''@'\''}\n"' --
-
-
-
-# --- 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)}}) }' \
- -e ' or print "Could not add SIGNATURE to MANIFEST: $$$${'\''@'\''}\n"' --
- $(NOECHO) cd $(DISTVNAME) && $(TOUCH) SIGNATURE
- cd $(DISTVNAME) && cpansign -s
-
-
-
-# --- MakeMaker install section:
-
-install :: pure_install doc_install
- $(NOECHO) $(NOOP)
-
-install_perl :: pure_perl_install doc_perl_install
- $(NOECHO) $(NOOP)
-
-install_site :: pure_site_install doc_site_install
- $(NOECHO) $(NOOP)
-
-install_vendor :: 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 :: all
- $(NOECHO) umask 022; $(MOD_INSTALL) \
- "$(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 :: all
- $(NOECHO) umask 02; $(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 :: all
- $(NOECHO) umask 022; $(MOD_INSTALL) \
- "$(INST_LIB)" "$(DESTINSTALLVENDORLIB)" \
- "$(INST_ARCHLIB)" "$(DESTINSTALLVENDORARCH)" \
- "$(INST_BIN)" "$(DESTINSTALLVENDORBIN)" \
- "$(INST_SCRIPT)" "$(DESTINSTALLVENDORSCRIPT)" \
- "$(INST_MAN1DIR)" "$(DESTINSTALLVENDORMAN1DIR)" \
- "$(INST_MAN3DIR)" "$(DESTINSTALLVENDORMAN3DIR)"
-
-
-doc_perl_install :: all
-
-doc_site_install :: all
- $(NOECHO) $(ECHO) Appending installation info to "$(DESTINSTALLSITEARCH)/perllocal.pod"
- -$(NOECHO) umask 02; $(MKPATH) "$(DESTINSTALLSITEARCH)"
- -$(NOECHO) umask 02; $(DOC_INSTALL) \
- "Module" "$(NAME)" \
- "installed into" $(INSTALLSITELIB) \
- LINKTYPE "$(LINKTYPE)" \
- VERSION "$(VERSION)" \
- EXE_FILES "$(EXE_FILES)" \
- >> "$(DESTINSTALLSITEARCH)/perllocal.pod"
-
-doc_vendor_install :: all
-
-
-uninstall :: uninstall_from_$(INSTALLDIRS)dirs
- $(NOECHO) $(NOOP)
-
-uninstall_from_perldirs ::
-
-uninstall_from_sitedirs ::
- $(NOECHO) $(UNINSTALL) "$(SITEARCHEXP)/auto/$(FULLEXT)/.packlist"
-
-uninstall_from_vendordirs ::
-
-
-# --- MakeMaker force section:
-# Phony target to force checking subdirectories.
-FORCE :
- $(NOECHO) $(NOOP)
-
-
-# --- MakeMaker perldepend section:
-PERL_HDRS = \
- $(PERL_INCDEP)/EXTERN.h \
- $(PERL_INCDEP)/INTERN.h \
- $(PERL_INCDEP)/XSUB.h \
- $(PERL_INCDEP)/av.h \
- $(PERL_INCDEP)/bitcount.h \
- $(PERL_INCDEP)/charclass_invlists.h \
- $(PERL_INCDEP)/config.h \
- $(PERL_INCDEP)/cop.h \
- $(PERL_INCDEP)/cv.h \
- $(PERL_INCDEP)/dosish.h \
- $(PERL_INCDEP)/ebcdic_tables.h \
- $(PERL_INCDEP)/embed.h \
- $(PERL_INCDEP)/embedvar.h \
- $(PERL_INCDEP)/fakesdio.h \
- $(PERL_INCDEP)/feature.h \
- $(PERL_INCDEP)/form.h \
- $(PERL_INCDEP)/git_version.h \
- $(PERL_INCDEP)/gv.h \
- $(PERL_INCDEP)/handy.h \
- $(PERL_INCDEP)/hv.h \
- $(PERL_INCDEP)/hv_func.h \
- $(PERL_INCDEP)/inline.h \
- $(PERL_INCDEP)/intrpvar.h \
- $(PERL_INCDEP)/iperlsys.h \
- $(PERL_INCDEP)/keywords.h \
- $(PERL_INCDEP)/l1_char_class_tab.h \
- $(PERL_INCDEP)/malloc_ctl.h \
- $(PERL_INCDEP)/metaconfig.h \
- $(PERL_INCDEP)/mg.h \
- $(PERL_INCDEP)/mg_data.h \
- $(PERL_INCDEP)/mg_raw.h \
- $(PERL_INCDEP)/mg_vtable.h \
- $(PERL_INCDEP)/mydtrace.h \
- $(PERL_INCDEP)/nostdio.h \
- $(PERL_INCDEP)/op.h \
- $(PERL_INCDEP)/op_reg_common.h \
- $(PERL_INCDEP)/opcode.h \
- $(PERL_INCDEP)/opnames.h \
- $(PERL_INCDEP)/overload.h \
- $(PERL_INCDEP)/pad.h \
- $(PERL_INCDEP)/parser.h \
- $(PERL_INCDEP)/patchlevel-debian.h \
- $(PERL_INCDEP)/patchlevel.h \
- $(PERL_INCDEP)/perl.h \
- $(PERL_INCDEP)/perlapi.h \
- $(PERL_INCDEP)/perlio.h \
- $(PERL_INCDEP)/perliol.h \
- $(PERL_INCDEP)/perlsdio.h \
- $(PERL_INCDEP)/perlvars.h \
- $(PERL_INCDEP)/perly.h \
- $(PERL_INCDEP)/pp.h \
- $(PERL_INCDEP)/pp_proto.h \
- $(PERL_INCDEP)/proto.h \
- $(PERL_INCDEP)/reentr.h \
- $(PERL_INCDEP)/regcharclass.h \
- $(PERL_INCDEP)/regcomp.h \
- $(PERL_INCDEP)/regexp.h \
- $(PERL_INCDEP)/regnodes.h \
- $(PERL_INCDEP)/scope.h \
- $(PERL_INCDEP)/sv.h \
- $(PERL_INCDEP)/thread.h \
- $(PERL_INCDEP)/time64.h \
- $(PERL_INCDEP)/time64_config.h \
- $(PERL_INCDEP)/uconfig.h \
- $(PERL_INCDEP)/unicode_constants.h \
- $(PERL_INCDEP)/unixish.h \
- $(PERL_INCDEP)/utf8.h \
- $(PERL_INCDEP)/utfebcdic.h \
- $(PERL_INCDEP)/util.h \
- $(PERL_INCDEP)/uudmap.h \
- $(PERL_INCDEP)/vutil.h \
- $(PERL_INCDEP)/warnings.h
-
-$(OBJECT) : $(PERL_HDRS)
-
-SQLite2.c : $(XSUBPPDEPS)
-
-
-# --- MakeMaker makefile section:
-
-$(OBJECT) : $(FIRST_MAKEFILE)
-
-# 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 = "/usr/bin/perl"
-
-$(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
- PERL_DL_NONLAZY=1 $(FULLPERLRUN) "-MExtUtils::Command::MM" "-MTest::Harness" "-e" "undef *Test::Harness::Switches; test_harness($(TEST_VERBOSE), '$(INST_LIB)', '$(INST_ARCHLIB)')" $(TEST_FILES)
-
-testdb_dynamic :: pure_all
- PERL_DL_NONLAZY=1 $(FULLPERLRUN) $(TESTDB_SW) "-I$(INST_LIB)" "-I$(INST_ARCHLIB)" $(TEST_FILE)
-
-test_ : test_dynamic
-
-test_static :: pure_all $(MAP_TARGET)
- PERL_DL_NONLAZY=1 ./$(MAP_TARGET) "-MExtUtils::Command::MM" "-MTest::Harness" "-e" "undef *Test::Harness::Switches; test_harness($(TEST_VERBOSE), '$(INST_LIB)', '$(INST_ARCHLIB)')" $(TEST_FILES)
-
-testdb_static :: pure_all $(MAP_TARGET)
- PERL_DL_NONLAZY=1 ./$(MAP_TARGET) $(TESTDB_SW) "-I$(INST_LIB)" "-I$(INST_ARCHLIB)" $(TEST_FILE)
-
-
-
-# --- MakeMaker ppd section:
-# Creates a PPD (Perl Package Description) for a binary distribution.
-ppd :
- $(NOECHO) $(ECHO) '<SOFTPKG NAME="$(DISTNAME)" VERSION="$(VERSION)">' > $(DISTNAME).ppd
- $(NOECHO) $(ECHO) ' <ABSTRACT></ABSTRACT>' >> $(DISTNAME).ppd
- $(NOECHO) $(ECHO) ' <AUTHOR></AUTHOR>' >> $(DISTNAME).ppd
- $(NOECHO) $(ECHO) ' <IMPLEMENTATION>' >> $(DISTNAME).ppd
- $(NOECHO) $(ECHO) ' <REQUIRE NAME="DBI::" VERSION="1.21" />' >> $(DISTNAME).ppd
- $(NOECHO) $(ECHO) ' <ARCHITECTURE NAME="x86_64-linux-gnu-thread-multi-5.22" />' >> $(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 : $(FIRST_MAKEFILE) $(TO_INST_PM)
- $(NOECHO) $(ABSPERLRUN) -MExtUtils::Install -e 'pm_to_blib({@ARGV}, '\''$(INST_LIB)/auto'\'', q[$(PM_FILTER)], '\''$(PERM_DIR)'\'')' -- \
- getsqlite.pl $(INST_LIB)/DBD/getsqlite.pl \
- lib/DBD/SQLite2.pm blib/lib/DBD/SQLite2.pm
- $(NOECHO) $(TOUCH) pm_to_blib
-
-
-# --- MakeMaker selfdocument section:
-
-
-# --- MakeMaker postamble section:
-
-# --- This section was generated by DBI::DBD::dbd_postamble()
-DBI_INSTARCH_DIR=/usr/local/lib/x86_64-linux-gnu/perl/5.22.1/auto/DBI
-DBI_DRIVER_XST=/usr/local/lib/x86_64-linux-gnu/perl/5.22.1/auto/DBI/Driver.xst
-
-# The main dependency (technically correct but probably not used)
-$(BASEEXT).c: $(BASEEXT).xsi
-
-# This dependency is needed since MakeMaker uses the .xs.o rule
-$(BASEEXT)$(OBJ_EXT): $(BASEEXT).xsi
-
-$(BASEEXT).xsi: $(DBI_DRIVER_XST) /usr/local/lib/x86_64-linux-gnu/perl/5.22.1/auto/DBI/Driver_xst.h
- $(PERL) -p -e "s/~DRIVER~/$(BASEEXT)/g" $(DBI_DRIVER_XST) > $(BASEEXT).xsi
-
-# ---
-
-
-# End.
+++ /dev/null
-eval {
- require DBI;
- require DBI::DBD;
- die "Too old" unless $DBI::VERSION >= 1.03;
-};
-use ExtUtils::MakeMaker;
-use Config;
-use strict;
-
-WriteMakefile(
- 'NAME' => 'DBD::SQLite2',
- 'VERSION_FROM' => 'lib/DBD/SQLite2.pm', # finds $VERSION
- 'PREREQ_PM' => {DBI => 1.21}, # e.g., Module::Name => 1.1
- 'OBJECT' => '$(O_FILES)',
- 'INC' => '-I$(DBI_INSTARCH_DIR)',
- 'OPTIMIZE' => "-O2",
- 'DEFINE' => "-DNDEBUG=1 -DSQLITE_PTR_SZ=$Config{ptrsize}" .
- ($Config{d_usleep} ? " -DHAVE_USLEEP=1" : ""),
- 'clean' => { FILES => 'SQLite2.xsi config.h' },
-);
-
-package MY;
-sub postamble {
- DBI::DBD::dbd_postamble(@_);
-}
-sub libscan {
- my ($self, $path) = @_;
- ($path =~ m/\~$/) ? undef : $path;
-}
+++ /dev/null
-DBD::SQLite2
-============
-
-SQLite is a small fast embedded SQL database engine.
-
-DBD::SQLite2 embeds that database engine into a DBD driver, so
-if you want a relational database for your project, but don't
-want to install a large RDBMS system like MySQL or PostgreSQL,
-then DBD::SQLite2 may be just what you need.
-
-Note: DBD::SQLite2 is the old version of DBD::SQLite, and embeds
-version 2.x.x of the sqlite library. The current version of
-DBD::SQLite embeds version 3 (or possibly later if I forget to
-update this file). This release is designed to allow you to have
-both versions installed on the same system.
-
-SQLite supports quite a lot of features, such as transactions (atomic
-commit and rollback), indexes, DBA-free operation, a large subset
-of SQL92 supported, and more.
-
-Installation requires a compiler.
-
-The engine is very fast, but for updates/inserts/dml it does
-perform a global lock on the entire database. This, obviously,
-might not be good for multiple user systems. So beware. The
-database also appears to be significantly faster if your
-transactions are coarse. One performance benchmark I did was
-inserting 100_000 rows into the database - with AutoCommit
-on it was doing about 50 rows per second. When I turned AutoCommit
-off it went up to 1000 rows per second.
-
-This module is distributed under the same terms as Perl itself, and
-is copyright Matt Sergeant, 2002.
-
-The underlying SQLite database engine is copyright free.
-
+++ /dev/null
-/*
- * This file was generated automatically by ExtUtils::ParseXS version 3.28 from the
- * contents of SQLite2.xs. Do not edit this file, edit SQLite2.xs instead.
- *
- * ANY CHANGES MADE HERE WILL BE LOST!
- *
- */
-
-#line 1 "SQLite2.xs"
-/* $Id: SQLite2.xs,v 1.2 2004/08/09 13:23:55 matt Exp $ */
-
-#include "SQLiteXS.h"
-
-DBISTATE_DECLARE;
-
-#line 17 "SQLite2.c"
-#ifndef PERL_UNUSED_VAR
-# define PERL_UNUSED_VAR(var) if (0) var = var
-#endif
-
-#ifndef dVAR
-# define dVAR dNOOP
-#endif
-
-
-/* This stuff is not part of the API! You have been warned. */
-#ifndef PERL_VERSION_DECIMAL
-# define PERL_VERSION_DECIMAL(r,v,s) (r*1000000 + v*1000 + s)
-#endif
-#ifndef PERL_DECIMAL_VERSION
-# define PERL_DECIMAL_VERSION \
- PERL_VERSION_DECIMAL(PERL_REVISION,PERL_VERSION,PERL_SUBVERSION)
-#endif
-#ifndef PERL_VERSION_GE
-# define PERL_VERSION_GE(r,v,s) \
- (PERL_DECIMAL_VERSION >= PERL_VERSION_DECIMAL(r,v,s))
-#endif
-#ifndef PERL_VERSION_LE
-# define PERL_VERSION_LE(r,v,s) \
- (PERL_DECIMAL_VERSION <= PERL_VERSION_DECIMAL(r,v,s))
-#endif
-
-/* XS_INTERNAL is the explicit static-linkage variant of the default
- * XS macro.
- *
- * XS_EXTERNAL is the same as XS_INTERNAL except it does not include
- * "STATIC", ie. it exports XSUB symbols. You probably don't want that
- * for anything but the BOOT XSUB.
- *
- * See XSUB.h in core!
- */
-
-
-/* TODO: This might be compatible further back than 5.10.0. */
-#if PERL_VERSION_GE(5, 10, 0) && PERL_VERSION_LE(5, 15, 1)
-# undef XS_EXTERNAL
-# undef XS_INTERNAL
-# if defined(__CYGWIN__) && defined(USE_DYNAMIC_LOADING)
-# define XS_EXTERNAL(name) __declspec(dllexport) XSPROTO(name)
-# define XS_INTERNAL(name) STATIC XSPROTO(name)
-# endif
-# if defined(__SYMBIAN32__)
-# define XS_EXTERNAL(name) EXPORT_C XSPROTO(name)
-# define XS_INTERNAL(name) EXPORT_C STATIC XSPROTO(name)
-# endif
-# ifndef XS_EXTERNAL
-# if defined(HASATTRIBUTE_UNUSED) && !defined(__cplusplus)
-# define XS_EXTERNAL(name) void name(pTHX_ CV* cv __attribute__unused__)
-# define XS_INTERNAL(name) STATIC void name(pTHX_ CV* cv __attribute__unused__)
-# else
-# ifdef __cplusplus
-# define XS_EXTERNAL(name) extern "C" XSPROTO(name)
-# define XS_INTERNAL(name) static XSPROTO(name)
-# else
-# define XS_EXTERNAL(name) XSPROTO(name)
-# define XS_INTERNAL(name) STATIC XSPROTO(name)
-# endif
-# endif
-# endif
-#endif
-
-/* perl >= 5.10.0 && perl <= 5.15.1 */
-
-
-/* The XS_EXTERNAL macro is used for functions that must not be static
- * like the boot XSUB of a module. If perl didn't have an XS_EXTERNAL
- * macro defined, the best we can do is assume XS is the same.
- * Dito for XS_INTERNAL.
- */
-#ifndef XS_EXTERNAL
-# define XS_EXTERNAL(name) XS(name)
-#endif
-#ifndef XS_INTERNAL
-# define XS_INTERNAL(name) XS(name)
-#endif
-
-/* Now, finally, after all this mess, we want an ExtUtils::ParseXS
- * internal macro that we're free to redefine for varying linkage due
- * to the EXPORT_XSUB_SYMBOLS XS keyword. This is internal, use
- * XS_EXTERNAL(name) or XS_INTERNAL(name) in your code if you need to!
- */
-
-#undef XS_EUPXS
-#if defined(PERL_EUPXS_ALWAYS_EXPORT)
-# define XS_EUPXS(name) XS_EXTERNAL(name)
-#else
- /* default to internal */
-# define XS_EUPXS(name) XS_INTERNAL(name)
-#endif
-
-#ifndef PERL_ARGS_ASSERT_CROAK_XS_USAGE
-#define PERL_ARGS_ASSERT_CROAK_XS_USAGE assert(cv); assert(params)
-
-/* prototype to pass -Wmissing-prototypes */
-STATIC void
-S_croak_xs_usage(const CV *const cv, const char *const params);
-
-STATIC void
-S_croak_xs_usage(const CV *const cv, const char *const params)
-{
- const GV *const gv = CvGV(cv);
-
- PERL_ARGS_ASSERT_CROAK_XS_USAGE;
-
- if (gv) {
- const char *const gvname = GvNAME(gv);
- const HV *const stash = GvSTASH(gv);
- const char *const hvname = stash ? HvNAME(stash) : NULL;
-
- if (hvname)
- Perl_croak_nocontext("Usage: %s::%s(%s)", hvname, gvname, params);
- else
- Perl_croak_nocontext("Usage: %s(%s)", gvname, params);
- } else {
- /* Pants. I don't think that it should be possible to get here. */
- Perl_croak_nocontext("Usage: CODE(0x%"UVxf")(%s)", PTR2UV(cv), params);
- }
-}
-#undef PERL_ARGS_ASSERT_CROAK_XS_USAGE
-
-#define croak_xs_usage S_croak_xs_usage
-
-#endif
-
-/* NOTE: the prototype of newXSproto() is different in versions of perls,
- * so we define a portable version of newXSproto()
- */
-#ifdef newXS_flags
-#define newXSproto_portable(name, c_impl, file, proto) newXS_flags(name, c_impl, file, proto, 0)
-#else
-#define newXSproto_portable(name, c_impl, file, proto) (PL_Sv=(SV*)newXS(name, c_impl, file), sv_setpv(PL_Sv, proto), (CV*)PL_Sv)
-#endif /* !defined(newXS_flags) */
-
-#if PERL_VERSION_LE(5, 21, 5)
-# define newXS_deffile(a,b) Perl_newXS(aTHX_ a,b,file)
-#else
-# define newXS_deffile(a,b) Perl_newXS_deffile(aTHX_ a,b)
-#endif
-
-#line 161 "SQLite2.c"
-
-XS_EUPXS(XS_DBD__SQLite2__db_list_tables); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD__SQLite2__db_list_tables)
-{
- dVAR; dXSARGS;
- if (items != 1)
- croak_xs_usage(cv, "dbh");
- {
- SV * dbh = ST(0)
-;
- AV * RETVAL;
-#line 15 "SQLite2.xs"
- {
- RETVAL = newAV();
- }
-#line 177 "SQLite2.c"
- {
- SV * RETVALSV;
- RETVALSV = newRV((SV*)RETVAL);
- RETVALSV = sv_2mortal(RETVALSV);
- ST(0) = RETVALSV;
- }
- }
- XSRETURN(1);
-}
-
-
-XS_EUPXS(XS_DBD__SQLite2__db_last_insert_rowid); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD__SQLite2__db_last_insert_rowid)
-{
- dVAR; dXSARGS;
- if (items != 1)
- croak_xs_usage(cv, "dbh");
- {
- SV * dbh = ST(0)
-;
- int RETVAL;
- dXSTARG;
-#line 25 "SQLite2.xs"
- {
- D_imp_dbh(dbh);
- RETVAL = sqlite_last_insert_rowid(imp_dbh->db);
- }
-#line 205 "SQLite2.c"
- XSprePUSH; PUSHi((IV)RETVAL);
- }
- XSRETURN(1);
-}
-
-
-XS_EUPXS(XS_DBD__SQLite2__db_create_function); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD__SQLite2__db_create_function)
-{
- dVAR; dXSARGS;
- if (items != 4)
- croak_xs_usage(cv, "dbh, name, argc, func");
- {
- SV * dbh = ST(0)
-;
- char * name = (char *)SvPV_nolen(ST(1))
-;
- int argc = (int)SvIV(ST(2))
-;
- SV * func = ST(3)
-;
-#line 39 "SQLite2.xs"
- {
- sqlite2_db_create_function( dbh, name, argc, func );
- }
-#line 231 "SQLite2.c"
- }
- XSRETURN_EMPTY;
-}
-
-
-XS_EUPXS(XS_DBD__SQLite2__db_create_aggregate); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD__SQLite2__db_create_aggregate)
-{
- dVAR; dXSARGS;
- if (items != 4)
- croak_xs_usage(cv, "dbh, name, argc, aggr");
- {
- SV * dbh = ST(0)
-;
- char * name = (char *)SvPV_nolen(ST(1))
-;
- int argc = (int)SvIV(ST(2))
-;
- SV * aggr = ST(3)
-;
-#line 50 "SQLite2.xs"
- {
- sqlite2_db_create_aggregate( dbh, name, argc, aggr );
- }
-#line 256 "SQLite2.c"
- }
- XSRETURN_EMPTY;
-}
-
-
-XS_EUPXS(XS_DBD__SQLite2__db_busy_timeout); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD__SQLite2__db_busy_timeout)
-{
- dVAR; dXSARGS;
- if (items < 1 || items > 2)
- croak_xs_usage(cv, "dbh, timeout=0");
- {
- SV * dbh = ST(0)
-;
- int timeout;
- int RETVAL;
- dXSTARG;
-
- if (items < 2)
- timeout = 0;
- else {
- timeout = (int)SvIV(ST(1))
-;
- }
-#line 59 "SQLite2.xs"
- RETVAL = sqlite2_busy_timeout( dbh, timeout );
-#line 283 "SQLite2.c"
- XSprePUSH; PUSHi((IV)RETVAL);
- }
- XSRETURN(1);
-}
-
-
-/* INCLUDE: Including 'SQLite2.xsi' from 'SQLite2.xs' */
-
-#include "Driver_xst.h"
-#if defined(dbd_st_execute_iv)
-#undef dbd_st_execute
-#define dbd_st_execute dbd_st_execute_iv
-#endif
-#if defined(dbd_st_rows_iv)
-#undef dbd_st_rows
-#define dbd_st_rows dbd_st_rows_iv
-#endif
-#if defined(dbd_db_do4_iv)
-#undef dbd_db_do4
-#define dbd_db_do4 dbd_db_do4_iv
-#endif
-
-XS_EUPXS(XS_DBD__SQLite2__dr_dbixs_revision); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD__SQLite2__dr_dbixs_revision)
-{
- dVAR; dXSARGS;
- PERL_UNUSED_VAR(cv); /* -W */
- PERL_UNUSED_VAR(ax); /* -Wall */
- SP -= items;
- {
-#line 57 "./SQLite2.xsi"
- ST(0) = sv_2mortal(newSViv(DBIXS_REVISION));
-#line 316 "SQLite2.c"
- PUTBACK;
- return;
- }
-}
-
-#ifdef dbd_discon_all
-#define XSubPPtmpAAAA 1
-
-
-XS_EUPXS(XS_DBD__SQLite2__dr_discon_all_); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD__SQLite2__dr_discon_all_)
-{
- dVAR; dXSARGS;
- dXSI32;
- if (items != 1)
- croak_xs_usage(cv, "drh");
- {
- SV * drh = ST(0)
-;
-#line 69 "./SQLite2.xsi"
- D_imp_drh(drh);
- PERL_UNUSED_VAR(ix);
- ST(0) = dbd_discon_all(drh, imp_drh) ? &PL_sv_yes : &PL_sv_no;
-#line 340 "SQLite2.c"
- }
- XSRETURN(1);
-}
-
-#endif /* dbd_discon_all */
-#ifdef dbd_dr_data_sources
-#define XSubPPtmpAAAB 1
-
-
-XS_EUPXS(XS_DBD__SQLite2__dr_data_sources); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD__SQLite2__dr_data_sources)
-{
- dVAR; dXSARGS;
- if (items < 1 || items > 2)
- croak_xs_usage(cv, "drh, attr = Nullsv");
- PERL_UNUSED_VAR(ax); /* -Wall */
- SP -= items;
- {
- SV * drh = ST(0)
-;
- SV * attr;
-
- if (items < 2)
- attr = Nullsv;
- else {
- attr = ST(1)
-;
- }
-#line 83 "./SQLite2.xsi"
- {
- D_imp_drh(drh);
- AV *av = dbd_dr_data_sources(drh, imp_drh, attr);
- if (av) {
- int i;
- int n = AvFILL(av)+1;
- EXTEND(sp, n);
- for (i = 0; i < n; ++i) {
- PUSHs(AvARRAY(av)[i]);
- }
- }
- }
-#line 382 "SQLite2.c"
- PUTBACK;
- return;
- }
-}
-
-#endif
-
-XS_EUPXS(XS_DBD__SQLite2__db__login); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD__SQLite2__db__login)
-{
- dVAR; dXSARGS;
- if (items < 4 || items > 5)
- croak_xs_usage(cv, "dbh, dbname, username, password, attribs=Nullsv");
- {
- SV * dbh = ST(0)
-;
- SV * dbname = ST(1)
-;
- SV * username = ST(2)
-;
- SV * password = ST(3)
-;
- SV * attribs;
-
- if (items < 5)
- attribs = Nullsv;
- else {
- attribs = ST(4)
-;
- }
-#line 113 "./SQLite2.xsi"
- {
- D_imp_dbh(dbh);
-#if !defined(dbd_db_login6_sv)
- STRLEN lna;
- char *u = (SvOK(username)) ? SvPV(username,lna) : (char*)"";
- char *p = (SvOK(password)) ? SvPV(password,lna) : (char*)"";
-#endif
-#ifdef dbd_db_login6_sv
- ST(0) = dbd_db_login6_sv(dbh, imp_dbh, dbname, username, password, attribs) ? &PL_sv_yes : &PL_sv_no;
-#elif defined(dbd_db_login6)
- ST(0) = dbd_db_login6(dbh, imp_dbh, SvPV_nolen(dbname), u, p, attribs) ? &PL_sv_yes : &PL_sv_no;
-#else
- PERL_UNUSED_ARG(attribs);
- ST(0) = dbd_db_login( dbh, imp_dbh, SvPV_nolen(dbname), u, p) ? &PL_sv_yes : &PL_sv_no;
-#endif
- }
-#line 430 "SQLite2.c"
- }
- XSRETURN(1);
-}
-
-
-XS_EUPXS(XS_DBD__SQLite2__db_selectall_arrayref); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD__SQLite2__db_selectall_arrayref)
-{
- dVAR; dXSARGS;
- PERL_UNUSED_VAR(cv); /* -W */
- {
-#line 134 "./SQLite2.xsi"
- SV *sth;
- SV **maxrows_svp;
- SV **tmp_svp;
- SV *tmp_sv;
- SV *attr = &PL_sv_undef;
- imp_sth_t *imp_sth;
-#line 449 "SQLite2.c"
-#line 141 "./SQLite2.xsi"
- if (items > 2) {
- attr = ST(2);
- if (SvROK(attr) &&
- (DBD_ATTRIB_TRUE(attr,"Slice",5,tmp_svp) || DBD_ATTRIB_TRUE(attr,"Columns",7,tmp_svp))
- ) {
- /* fallback to perl implementation */
- SV *tmp =dbixst_bounce_method("DBD::SQLite2::db::SUPER::selectall_arrayref", items);
- SPAGAIN;
- ST(0) = tmp;
- XSRETURN(1);
- }
- }
- /* --- prepare --- */
- if (SvROK(ST(1))) {
- MAGIC *mg;
- sth = ST(1);
- /* switch to inner handle if not already */
- if ( (mg = mg_find(SvRV(sth),'P')) )
- sth = mg->mg_obj;
- }
- else {
- sth = dbixst_bounce_method("prepare", 3);
- SPAGAIN; SP -= items; /* because stack might have been realloc'd */
- if (!SvROK(sth))
- XSRETURN_UNDEF;
- /* switch to inner handle */
- sth = mg_find(SvRV(sth),'P')->mg_obj;
- }
- imp_sth = (imp_sth_t*)(DBIh_COM(sth));
- /* --- bind_param --- */
- if (items > 3) { /* need to bind params before execute */
- if (!dbdxst_bind_params(sth, imp_sth, items-2, ax+2) ) {
- XSRETURN_UNDEF;
- }
- }
- /* --- execute --- */
- DBIc_ROW_COUNT(imp_sth) = 0;
- if ( dbd_st_execute(sth, imp_sth) <= -2 ) { /* -2 == error */
- XSRETURN_UNDEF;
- }
- /* --- fetchall --- */
- maxrows_svp = DBD_ATTRIB_GET_SVP(attr, "MaxRows", 7);
- tmp_sv = dbdxst_fetchall_arrayref(sth, &PL_sv_undef, (maxrows_svp) ? *maxrows_svp : &PL_sv_undef);
- SPAGAIN;
- ST(0) = tmp_sv;
-#line 496 "SQLite2.c"
- }
- XSRETURN(1);
-}
-
-
-XS_EUPXS(XS_DBD__SQLite2__db_selectrow_arrayref); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD__SQLite2__db_selectrow_arrayref)
-{
- dVAR; dXSARGS;
- dXSI32;
- PERL_UNUSED_VAR(cv); /* -W */
- PERL_UNUSED_VAR(ax); /* -Wall */
- SP -= items;
- {
-#line 193 "./SQLite2.xsi"
- int is_selectrow_array = (ix == 1);
- imp_sth_t *imp_sth;
- SV *sth;
- AV *row_av;
-#line 516 "SQLite2.c"
-#line 198 "./SQLite2.xsi"
- if (SvROK(ST(1))) {
- MAGIC *mg;
- sth = ST(1);
- /* switch to inner handle if not already */
- if ( (mg = mg_find(SvRV(sth),'P')) )
- sth = mg->mg_obj;
- }
- else {
- /* --- prepare --- */
- sth = dbixst_bounce_method("prepare", 3);
- SPAGAIN; SP -= items; /* because stack might have been realloc'd */
- if (!SvROK(sth)) {
- if (is_selectrow_array) { XSRETURN_EMPTY; } else { XSRETURN_UNDEF; }
- }
- /* switch to inner handle */
- sth = mg_find(SvRV(sth),'P')->mg_obj;
- }
- imp_sth = (imp_sth_t*)(DBIh_COM(sth));
- /* --- bind_param --- */
- if (items > 3) { /* need to bind params before execute */
- if (!dbdxst_bind_params(sth, imp_sth, items-2, ax+2) ) {
- if (is_selectrow_array) { XSRETURN_EMPTY; } else { XSRETURN_UNDEF; }
- }
- }
- /* --- execute --- */
- DBIc_ROW_COUNT(imp_sth) = 0;
- if ( dbd_st_execute(sth, imp_sth) <= -2 ) { /* -2 == error */
- if (is_selectrow_array) { XSRETURN_EMPTY; } else { XSRETURN_UNDEF; }
- }
- /* --- fetchrow_arrayref --- */
- row_av = dbd_st_fetch(sth, imp_sth);
- if (!row_av) {
- if (GIMME == G_SCALAR)
- PUSHs(&PL_sv_undef);
- }
- else if (is_selectrow_array) {
- int i;
- int num_fields = AvFILL(row_av)+1;
- if (GIMME == G_SCALAR)
- num_fields = 1; /* return just first field */
- EXTEND(sp, num_fields);
- for(i=0; i < num_fields; ++i) {
- PUSHs(AvARRAY(row_av)[i]);
- }
- }
- else {
- PUSHs( sv_2mortal(newRV((SV *)row_av)) );
- }
- /* --- finish --- */
-#ifdef dbd_st_finish3
- dbd_st_finish3(sth, imp_sth, 0);
-#else
- dbd_st_finish(sth, imp_sth);
-#endif
-#line 572 "SQLite2.c"
- PUTBACK;
- return;
- }
-}
-
-#ifdef dbd_db_do4 /* deebeedee-deebee-doo, deebee-doobee-dah? */
-#define XSubPPtmpAAAC 1
-
-
-XS_EUPXS(XS_DBD__SQLite2__db_do); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD__SQLite2__db_do)
-{
- dVAR; dXSARGS;
- if (items < 2 || items > 3)
- croak_xs_usage(cv, "dbh, statement, params = Nullsv");
- {
- SV * dbh = ST(0)
-;
- char * statement = (char *)SvPV_nolen(ST(1))
-;
- SV * params;
-
- if (items < 3)
- params = Nullsv;
- else {
- params = ST(2)
-;
- }
-#line 262 "./SQLite2.xsi"
- {
- D_imp_dbh(dbh);
- IV retval;
- retval = dbd_db_do4(dbh, imp_dbh, statement, params); /* might be dbd_db_do4_iv via macro */
- /* remember that dbd_db_do4 must return <= -2 for error */
- if (retval == 0) /* ok with no rows affected */
- XST_mPV(0, "0E0"); /* (true but zero) */
- else if (retval < -1) /* -1 == unknown number of rows */
- XST_mUNDEF(0); /* <= -2 means error */
- else
- XST_mIV(0, retval); /* typically 1, rowcount or -1 */
- }
-#line 614 "SQLite2.c"
- }
- XSRETURN(1);
-}
-
-#endif
-#ifdef dbd_db_last_insert_id
-#define XSubPPtmpAAAD 1
-
-
-XS_EUPXS(XS_DBD__SQLite2__db_last_insert_id); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD__SQLite2__db_last_insert_id)
-{
- dVAR; dXSARGS;
- if (items < 5 || items > 6)
- croak_xs_usage(cv, "dbh, catalog, schema, table, field, attr=Nullsv");
- {
- SV * dbh = ST(0)
-;
- SV * catalog = ST(1)
-;
- SV * schema = ST(2)
-;
- SV * table = ST(3)
-;
- SV * field = ST(4)
-;
- SV * attr;
-
- if (items < 6)
- attr = Nullsv;
- else {
- attr = ST(5)
-;
- }
-#line 289 "./SQLite2.xsi"
- {
- D_imp_dbh(dbh);
- ST(0) = dbd_db_last_insert_id(dbh, imp_dbh, catalog, schema, table, field, attr);
- }
-#line 654 "SQLite2.c"
- }
- XSRETURN(1);
-}
-
-#endif
-
-XS_EUPXS(XS_DBD__SQLite2__db_commit); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD__SQLite2__db_commit)
-{
- dVAR; dXSARGS;
- if (items != 1)
- croak_xs_usage(cv, "dbh");
- {
- SV * dbh = ST(0)
-;
-#line 301 "./SQLite2.xsi"
- D_imp_dbh(dbh);
- if (DBIc_has(imp_dbh,DBIcf_AutoCommit) && DBIc_WARN(imp_dbh))
- warn("commit ineffective with AutoCommit enabled");
- ST(0) = dbd_db_commit(dbh, imp_dbh) ? &PL_sv_yes : &PL_sv_no;
-#line 675 "SQLite2.c"
- }
- XSRETURN(1);
-}
-
-
-XS_EUPXS(XS_DBD__SQLite2__db_rollback); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD__SQLite2__db_rollback)
-{
- dVAR; dXSARGS;
- if (items != 1)
- croak_xs_usage(cv, "dbh");
- {
- SV * dbh = ST(0)
-;
-#line 311 "./SQLite2.xsi"
- D_imp_dbh(dbh);
- if (DBIc_has(imp_dbh,DBIcf_AutoCommit) && DBIc_WARN(imp_dbh))
- warn("rollback ineffective with AutoCommit enabled");
- ST(0) = dbd_db_rollback(dbh, imp_dbh) ? &PL_sv_yes : &PL_sv_no;
-#line 695 "SQLite2.c"
- }
- XSRETURN(1);
-}
-
-
-XS_EUPXS(XS_DBD__SQLite2__db_disconnect); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD__SQLite2__db_disconnect)
-{
- dVAR; dXSARGS;
- if (items != 1)
- croak_xs_usage(cv, "dbh");
- {
- SV * dbh = ST(0)
-;
-#line 321 "./SQLite2.xsi"
- D_imp_dbh(dbh);
- if ( !DBIc_ACTIVE(imp_dbh) ) {
- XSRETURN_YES;
- }
- /* Check for disconnect() being called whilst refs to cursors */
- /* still exists. This possibly needs some more thought. */
- if (DBIc_ACTIVE_KIDS(imp_dbh) && DBIc_WARN(imp_dbh) && !PL_dirty) {
- STRLEN lna;
- char *plural = (DBIc_ACTIVE_KIDS(imp_dbh)==1) ? (char*)"" : (char*)"s";
- warn("%s->disconnect invalidates %d active statement handle%s %s",
- SvPV(dbh,lna), (int)DBIc_ACTIVE_KIDS(imp_dbh), plural,
- "(either destroy statement handles or call finish on them before disconnecting)");
- }
- ST(0) = dbd_db_disconnect(dbh, imp_dbh) ? &PL_sv_yes : &PL_sv_no;
- DBIc_ACTIVE_off(imp_dbh); /* ensure it's off, regardless */
-#line 726 "SQLite2.c"
- }
- XSRETURN(1);
-}
-
-
-XS_EUPXS(XS_DBD__SQLite2__db_STORE); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD__SQLite2__db_STORE)
-{
- dVAR; dXSARGS;
- if (items != 3)
- croak_xs_usage(cv, "dbh, keysv, valuesv");
- {
- SV * dbh = ST(0)
-;
- SV * keysv = ST(1)
-;
- SV * valuesv = ST(2)
-;
-#line 344 "./SQLite2.xsi"
- D_imp_dbh(dbh);
- if (SvGMAGICAL(valuesv))
- mg_get(valuesv);
- ST(0) = &PL_sv_yes;
- if (!dbd_db_STORE_attrib(dbh, imp_dbh, keysv, valuesv))
- if (!DBIc_DBISTATE(imp_dbh)->set_attr(dbh, keysv, valuesv))
- ST(0) = &PL_sv_no;
-#line 753 "SQLite2.c"
- }
- XSRETURN(1);
-}
-
-
-XS_EUPXS(XS_DBD__SQLite2__db_FETCH); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD__SQLite2__db_FETCH)
-{
- dVAR; dXSARGS;
- if (items != 2)
- croak_xs_usage(cv, "dbh, keysv");
- {
- SV * dbh = ST(0)
-;
- SV * keysv = ST(1)
-;
-#line 358 "./SQLite2.xsi"
- D_imp_dbh(dbh);
- SV *valuesv = dbd_db_FETCH_attrib(dbh, imp_dbh, keysv);
- if (!valuesv)
- valuesv = DBIc_DBISTATE(imp_dbh)->get_attr(dbh, keysv);
- ST(0) = valuesv; /* dbd_db_FETCH_attrib did sv_2mortal */
-#line 776 "SQLite2.c"
- }
- XSRETURN(1);
-}
-
-
-XS_EUPXS(XS_DBD__SQLite2__db_DESTROY); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD__SQLite2__db_DESTROY)
-{
- dVAR; dXSARGS;
- if (items != 1)
- croak_xs_usage(cv, "dbh");
- PERL_UNUSED_VAR(ax); /* -Wall */
- SP -= items;
- {
- SV * dbh = ST(0)
-;
-#line 369 "./SQLite2.xsi"
- /* keep in sync with default DESTROY in DBI.xs */
- D_imp_dbh(dbh);
- ST(0) = &PL_sv_yes;
- if (!DBIc_IMPSET(imp_dbh)) { /* was never fully set up */
- STRLEN lna;
- if (DBIc_WARN(imp_dbh) && !PL_dirty && DBIc_DBISTATE(imp_dbh)->debug >= 2)
- PerlIO_printf(DBIc_LOGPIO(imp_dbh),
- " DESTROY for %s ignored - handle not initialised\n",
- SvPV(dbh,lna));
- }
- else {
- if (DBIc_IADESTROY(imp_dbh)) { /* wants ineffective destroy */
- DBIc_ACTIVE_off(imp_dbh);
- if (DBIc_DBISTATE(imp_dbh)->debug)
- PerlIO_printf(DBIc_LOGPIO(imp_dbh), " DESTROY %s skipped due to InactiveDestroy\n", SvPV_nolen(dbh));
- }
- if (DBIc_ACTIVE(imp_dbh)) {
- if (!DBIc_has(imp_dbh,DBIcf_AutoCommit)) {
- /* Application is using transactions and hasn't explicitly disconnected.
- Some databases will automatically commit on graceful disconnect.
- Since we're about to gracefully disconnect as part of the DESTROY
- we want to be sure we're not about to implicitly commit changes
- that are incomplete and should be rolled back. (The DESTROY may
- be due to a RaiseError, for example.) So we rollback here.
- This will be harmless if the application has issued a commit,
- XXX Could add an attribute flag to indicate that the driver
- doesn't have this problem. Patches welcome.
- */
- if (DBIc_WARN(imp_dbh) /* only warn if likely to be useful... */
- && DBIc_is(imp_dbh, DBIcf_Executed) /* has not just called commit/rollback */
- /* && !DBIc_is(imp_dbh, DBIcf_ReadOnly) -- is not read only */
- && (!PL_dirty || DBIc_DBISTATE(imp_dbh)->debug >= 3)
- ) {
- warn("Issuing rollback() due to DESTROY without explicit disconnect() of %s handle %s",
- SvPV_nolen(*hv_fetch((HV*)SvRV(dbh), "ImplementorClass", 16, 1)),
- SvPV_nolen(*hv_fetch((HV*)SvRV(dbh), "Name", 4, 1))
- );
- }
- dbd_db_rollback(dbh, imp_dbh); /* ROLLBACK! */
- }
- dbd_db_disconnect(dbh, imp_dbh);
- DBIc_ACTIVE_off(imp_dbh); /* ensure it's off, regardless */
- }
- dbd_db_destroy(dbh, imp_dbh);
- }
-#line 839 "SQLite2.c"
- PUTBACK;
- return;
- }
-}
-
-#ifdef dbd_take_imp_data
-#define XSubPPtmpAAAE 1
-
-
-XS_EUPXS(XS_DBD__SQLite2__db_take_imp_data); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD__SQLite2__db_take_imp_data)
-{
- dVAR; dXSARGS;
- if (items != 1)
- croak_xs_usage(cv, "h");
- {
- SV * h = ST(0)
-;
-#line 422 "./SQLite2.xsi"
- D_imp_xxh(h);
- /* dbd_take_imp_data() returns &sv_no (or other defined but false value)
- * to indicate "preparations complete, now call SUPER::take_imp_data" for me.
- * Anything else is returned to the caller via sv_2mortal(sv), typically that
- * would be &sv_undef for error or an SV holding the imp_data.
- */
- SV *sv = dbd_take_imp_data(h, imp_xxh, NULL);
- if (SvOK(sv) && !SvTRUE(sv)) {
- SV *tmp = dbixst_bounce_method("DBD::SQLite2::db::SUPER::take_imp_data", items);
- SPAGAIN;
- ST(0) = tmp;
- } else {
- ST(0) = sv_2mortal(sv);
- }
-#line 873 "SQLite2.c"
- }
- XSRETURN(1);
-}
-
-#endif
-#ifdef dbd_db_data_sources
-#define XSubPPtmpAAAF 1
-
-
-XS_EUPXS(XS_DBD__SQLite2__db_data_sources); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD__SQLite2__db_data_sources)
-{
- dVAR; dXSARGS;
- if (items < 1 || items > 2)
- croak_xs_usage(cv, "dbh, attr = Nullsv");
- PERL_UNUSED_VAR(ax); /* -Wall */
- SP -= items;
- {
- SV * dbh = ST(0)
-;
- SV * attr;
-
- if (items < 2)
- attr = Nullsv;
- else {
- attr = ST(1)
-;
- }
-#line 446 "./SQLite2.xsi"
- {
- D_imp_dbh(dbh);
- AV *av = dbd_db_data_sources(dbh, imp_dbh, attr);
- if (av) {
- int i;
- int n = AvFILL(av)+1;
- EXTEND(sp, n);
- for (i = 0; i < n; ++i) {
- PUSHs(AvARRAY(av)[i]);
- }
- }
- }
-#line 915 "SQLite2.c"
- PUTBACK;
- return;
- }
-}
-
-#endif
-
-XS_EUPXS(XS_DBD__SQLite2__st__prepare); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD__SQLite2__st__prepare)
-{
- dVAR; dXSARGS;
- if (items < 2 || items > 3)
- croak_xs_usage(cv, "sth, statement, attribs=Nullsv");
- {
- SV * sth = ST(0)
-;
- SV * statement = ST(1)
-;
- SV * attribs;
-
- if (items < 3)
- attribs = Nullsv;
- else {
- attribs = ST(2)
-;
- }
-#line 475 "./SQLite2.xsi"
- {
- D_imp_sth(sth);
- DBD_ATTRIBS_CHECK("_prepare", sth, attribs);
-#ifdef dbd_st_prepare_sv
- ST(0) = dbd_st_prepare_sv(sth, imp_sth, statement, attribs) ? &PL_sv_yes : &PL_sv_no;
-#else
- ST(0) = dbd_st_prepare(sth, imp_sth, SvPV_nolen(statement), attribs) ? &PL_sv_yes : &PL_sv_no;
-#endif
- }
-#line 952 "SQLite2.c"
- }
- XSRETURN(1);
-}
-
-#ifdef dbd_st_rows
-#define XSubPPtmpAAAG 1
-
-
-XS_EUPXS(XS_DBD__SQLite2__st_rows); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD__SQLite2__st_rows)
-{
- dVAR; dXSARGS;
- if (items != 1)
- croak_xs_usage(cv, "sth");
- {
- SV * sth = ST(0)
-;
-#line 492 "./SQLite2.xsi"
- D_imp_sth(sth);
- XST_mIV(0, dbd_st_rows(sth, imp_sth));
-#line 973 "SQLite2.c"
- }
- XSRETURN(1);
-}
-
-#endif /* dbd_st_rows */
-#ifdef dbd_st_bind_col
-#define XSubPPtmpAAAH 1
-
-
-XS_EUPXS(XS_DBD__SQLite2__st_bind_col); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD__SQLite2__st_bind_col)
-{
- dVAR; dXSARGS;
- if (items < 3 || items > 4)
- croak_xs_usage(cv, "sth, col, ref, attribs=Nullsv");
- {
- SV * sth = ST(0)
-;
- SV * col = ST(1)
-;
- SV * ref = ST(2)
-;
- SV * attribs;
-
- if (items < 4)
- attribs = Nullsv;
- else {
- attribs = ST(3)
-;
- }
-#line 507 "./SQLite2.xsi"
- {
- IV sql_type = 0;
- D_imp_sth(sth);
- if (SvGMAGICAL(ref))
- mg_get(ref);
- if (attribs) {
- if (SvNIOK(attribs)) {
- sql_type = SvIV(attribs);
- attribs = Nullsv;
- }
- else {
- SV **svp;
- DBD_ATTRIBS_CHECK("bind_col", sth, attribs);
- /* XXX we should perhaps complain if TYPE is not SvNIOK */
- DBD_ATTRIB_GET_IV(attribs, "TYPE",4, svp, sql_type);
- }
- }
- switch(dbd_st_bind_col(sth, imp_sth, col, ref, sql_type, attribs)) {
- case 2: ST(0) = &PL_sv_yes; /* job done completely */
- break;
- case 1: /* fallback to DBI default */
- ST(0) = (DBIc_DBISTATE(imp_sth)->bind_col(sth, col, ref, attribs))
- ? &PL_sv_yes : &PL_sv_no;
- break;
- default: ST(0) = &PL_sv_no; /* dbd_st_bind_col has called set_err */
- break;
- }
- }
-#line 1033 "SQLite2.c"
- }
- XSRETURN(1);
-}
-
-#endif /* dbd_st_bind_col */
-
-XS_EUPXS(XS_DBD__SQLite2__st_bind_param); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD__SQLite2__st_bind_param)
-{
- dVAR; dXSARGS;
- if (items < 3 || items > 4)
- croak_xs_usage(cv, "sth, param, value, attribs=Nullsv");
- {
- SV * sth = ST(0)
-;
- SV * param = ST(1)
-;
- SV * value = ST(2)
-;
- SV * attribs;
-
- if (items < 4)
- attribs = Nullsv;
- else {
- attribs = ST(3)
-;
- }
-#line 545 "./SQLite2.xsi"
- {
- IV sql_type = 0;
- D_imp_sth(sth);
- if (SvGMAGICAL(value))
- mg_get(value);
- if (attribs) {
- if (SvNIOK(attribs)) {
- sql_type = SvIV(attribs);
- attribs = Nullsv;
- }
- else {
- SV **svp;
- DBD_ATTRIBS_CHECK("bind_param", sth, attribs);
- /* XXX we should perhaps complain if TYPE is not SvNIOK */
- DBD_ATTRIB_GET_IV(attribs, "TYPE",4, svp, sql_type);
- }
- }
- ST(0) = dbd_bind_ph(sth, imp_sth, param, value, sql_type, attribs, FALSE, 0)
- ? &PL_sv_yes : &PL_sv_no;
- }
-#line 1082 "SQLite2.c"
- }
- XSRETURN(1);
-}
-
-
-XS_EUPXS(XS_DBD__SQLite2__st_bind_param_inout); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD__SQLite2__st_bind_param_inout)
-{
- dVAR; dXSARGS;
- if (items < 4 || items > 5)
- croak_xs_usage(cv, "sth, param, value_ref, maxlen, attribs=Nullsv");
- {
- SV * sth = ST(0)
-;
- SV * param = ST(1)
-;
- SV * value_ref = ST(2)
-;
- IV maxlen = (IV)SvIV(ST(3))
-;
- SV * attribs;
-
- if (items < 5)
- attribs = Nullsv;
- else {
- attribs = ST(4)
-;
- }
-#line 575 "./SQLite2.xsi"
- {
- IV sql_type = 0;
- D_imp_sth(sth);
- SV *value;
- if (!SvROK(value_ref) || SvTYPE(SvRV(value_ref)) > SVt_PVMG)
- croak("bind_param_inout needs a reference to a scalar value");
- value = SvRV(value_ref);
- if (SvREADONLY(value))
- croak("Modification of a read-only value attempted");
- if (SvGMAGICAL(value))
- mg_get(value);
- if (attribs) {
- if (SvNIOK(attribs)) {
- sql_type = SvIV(attribs);
- attribs = Nullsv;
- }
- else {
- SV **svp;
- DBD_ATTRIBS_CHECK("bind_param", sth, attribs);
- DBD_ATTRIB_GET_IV(attribs, "TYPE",4, svp, sql_type);
- }
- }
- ST(0) = dbd_bind_ph(sth, imp_sth, param, value, sql_type, attribs, TRUE, maxlen)
- ? &PL_sv_yes : &PL_sv_no;
- }
-#line 1137 "SQLite2.c"
- }
- XSRETURN(1);
-}
-
-
-XS_EUPXS(XS_DBD__SQLite2__st_execute); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD__SQLite2__st_execute)
-{
- dVAR; dXSARGS;
- if (items < 1)
- croak_xs_usage(cv, "sth, ...");
- {
- SV * sth = ST(0)
-;
-#line 606 "./SQLite2.xsi"
- D_imp_sth(sth);
- IV retval;
- if (items > 1) { /* need to bind params */
- if (!dbdxst_bind_params(sth, imp_sth, items, ax) ) {
- XSRETURN_UNDEF;
- }
- }
- /* XXX this code is duplicated in selectrow_arrayref above */
- DBIc_ROW_COUNT(imp_sth) = 0;
- retval = dbd_st_execute(sth, imp_sth); /* might be dbd_st_execute_iv via macro */
- /* remember that dbd_st_execute must return <= -2 for error */
- if (retval == 0) /* ok with no rows affected */
- XST_mPV(0, "0E0"); /* (true but zero) */
- else if (retval < -1) /* -1 == unknown number of rows */
- XST_mUNDEF(0); /* <= -2 means error */
- else
- XST_mIV(0, retval); /* typically 1, rowcount or -1 */
-#line 1170 "SQLite2.c"
- }
- XSRETURN(1);
-}
-
-#ifdef dbd_st_execute_for_fetch
-#define XSubPPtmpAAAI 1
-
-
-XS_EUPXS(XS_DBD__SQLite2__st_execute_for_fetch); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD__SQLite2__st_execute_for_fetch)
-{
- dVAR; dXSARGS;
- if (items < 2 || items > 3)
- croak_xs_usage(cv, "sth, fetch_tuple_sub, tuple_status = Nullsv");
- {
- SV * sth = ST(0)
-;
- SV * fetch_tuple_sub = ST(1)
-;
- SV * tuple_status;
-
- if (items < 3)
- tuple_status = Nullsv;
- else {
- tuple_status = ST(2)
-;
- }
-#line 633 "./SQLite2.xsi"
- {
- D_imp_sth(sth);
- ST(0) = dbd_st_execute_for_fetch(sth, imp_sth, fetch_tuple_sub, tuple_status);
- }
-#line 1203 "SQLite2.c"
- }
- XSRETURN(1);
-}
-
-#endif
-
-XS_EUPXS(XS_DBD__SQLite2__st_fetchrow_arrayref); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD__SQLite2__st_fetchrow_arrayref)
-{
- dVAR; dXSARGS;
- dXSI32;
- if (items != 1)
- croak_xs_usage(cv, "sth");
- {
- SV * sth = ST(0)
-;
-#line 648 "./SQLite2.xsi"
- D_imp_sth(sth);
- AV *av;
- PERL_UNUSED_VAR(ix);
- av = dbd_st_fetch(sth, imp_sth);
- ST(0) = (av) ? sv_2mortal(newRV((SV *)av)) : &PL_sv_undef;
-#line 1226 "SQLite2.c"
- }
- XSRETURN(1);
-}
-
-
-XS_EUPXS(XS_DBD__SQLite2__st_fetchrow_array); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD__SQLite2__st_fetchrow_array)
-{
- dVAR; dXSARGS;
- dXSI32;
- if (items != 1)
- croak_xs_usage(cv, "sth");
- PERL_UNUSED_VAR(ax); /* -Wall */
- SP -= items;
- {
- SV * sth = ST(0)
-;
-#line 661 "./SQLite2.xsi"
- D_imp_sth(sth);
- AV *av;
- av = dbd_st_fetch(sth, imp_sth);
- if (av) {
- int i;
- int num_fields = AvFILL(av)+1;
- EXTEND(sp, num_fields);
- for(i=0; i < num_fields; ++i) {
- PUSHs(AvARRAY(av)[i]);
- }
- PERL_UNUSED_VAR(ix);
- }
-#line 1257 "SQLite2.c"
- PUTBACK;
- return;
- }
-}
-
-
-XS_EUPXS(XS_DBD__SQLite2__st_fetchall_arrayref); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD__SQLite2__st_fetchall_arrayref)
-{
- dVAR; dXSARGS;
- if (items < 1 || items > 3)
- croak_xs_usage(cv, "sth, slice=&PL_sv_undef, batch_row_count=&PL_sv_undef");
- {
- SV * sth = ST(0)
-;
- SV * slice;
- SV * batch_row_count;
-
- if (items < 2)
- slice = &PL_sv_undef;
- else {
- slice = ST(1)
-;
- }
-
- if (items < 3)
- batch_row_count = &PL_sv_undef;
- else {
- batch_row_count = ST(2)
-;
- }
-#line 681 "./SQLite2.xsi"
- if (SvOK(slice)) { /* fallback to perl implementation */
- SV *tmp = dbixst_bounce_method("DBD::SQLite2::st::SUPER::fetchall_arrayref", 3);
- SPAGAIN;
- ST(0) = tmp;
- }
- else {
- SV *tmp = dbdxst_fetchall_arrayref(sth, slice, batch_row_count);
- SPAGAIN;
- ST(0) = tmp;
- }
-#line 1300 "SQLite2.c"
- }
- XSRETURN(1);
-}
-
-
-XS_EUPXS(XS_DBD__SQLite2__st_finish); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD__SQLite2__st_finish)
-{
- dVAR; dXSARGS;
- if (items != 1)
- croak_xs_usage(cv, "sth");
- {
- SV * sth = ST(0)
-;
-#line 697 "./SQLite2.xsi"
- D_imp_sth(sth);
- D_imp_dbh_from_sth;
- if (!DBIc_ACTIVE(imp_sth)) {
- /* No active statement to finish */
- XSRETURN_YES;
- }
- if (!DBIc_ACTIVE(imp_dbh)) {
- /* Either an explicit disconnect() or global destruction */
- /* has disconnected us from the database. Finish is meaningless */
- DBIc_ACTIVE_off(imp_sth);
- XSRETURN_YES;
- }
-#ifdef dbd_st_finish3
- ST(0) = dbd_st_finish3(sth, imp_sth, 0) ? &PL_sv_yes : &PL_sv_no;
-#else
- ST(0) = dbd_st_finish(sth, imp_sth) ? &PL_sv_yes : &PL_sv_no;
-#endif
-#line 1333 "SQLite2.c"
- }
- XSRETURN(1);
-}
-
-
-XS_EUPXS(XS_DBD__SQLite2__st_blob_read); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD__SQLite2__st_blob_read)
-{
- dVAR; dXSARGS;
- if (items < 4 || items > 6)
- croak_xs_usage(cv, "sth, field, offset, len, destrv=Nullsv, destoffset=0");
- {
- SV * sth = ST(0)
-;
- int field = (int)SvIV(ST(1))
-;
- long offset = (long)SvIV(ST(2))
-;
- long len = (long)SvIV(ST(3))
-;
- SV * destrv;
- long destoffset;
-
- if (items < 5)
- destrv = Nullsv;
- else {
- destrv = ST(4)
-;
- }
-
- if (items < 6)
- destoffset = 0;
- else {
- destoffset = (long)SvIV(ST(5))
-;
- }
-#line 725 "./SQLite2.xsi"
- {
- D_imp_sth(sth);
- if (!destrv)
- destrv = sv_2mortal(newRV(sv_2mortal(newSV(0))));
- if (dbd_st_blob_read(sth, imp_sth, field, offset, len, destrv, destoffset))
- ST(0) = SvRV(destrv);
- else ST(0) = &PL_sv_undef;
- }
-#line 1379 "SQLite2.c"
- }
- XSRETURN(1);
-}
-
-
-XS_EUPXS(XS_DBD__SQLite2__st_STORE); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD__SQLite2__st_STORE)
-{
- dVAR; dXSARGS;
- if (items != 3)
- croak_xs_usage(cv, "sth, keysv, valuesv");
- {
- SV * sth = ST(0)
-;
- SV * keysv = ST(1)
-;
- SV * valuesv = ST(2)
-;
-#line 741 "./SQLite2.xsi"
- D_imp_sth(sth);
- if (SvGMAGICAL(valuesv))
- mg_get(valuesv);
- ST(0) = &PL_sv_yes;
- if (!dbd_st_STORE_attrib(sth, imp_sth, keysv, valuesv))
- if (!DBIc_DBISTATE(imp_sth)->set_attr(sth, keysv, valuesv))
- ST(0) = &PL_sv_no;
-#line 1406 "SQLite2.c"
- }
- XSRETURN(1);
-}
-
-
-XS_EUPXS(XS_DBD__SQLite2__st_FETCH_attrib); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD__SQLite2__st_FETCH_attrib)
-{
- dVAR; dXSARGS;
- dXSI32;
- if (items != 2)
- croak_xs_usage(cv, "sth, keysv");
- {
- SV * sth = ST(0)
-;
- SV * keysv = ST(1)
-;
-#line 758 "./SQLite2.xsi"
- D_imp_sth(sth);
- SV *valuesv;
- PERL_UNUSED_VAR(ix);
- valuesv = dbd_st_FETCH_attrib(sth, imp_sth, keysv);
- if (!valuesv)
- valuesv = DBIc_DBISTATE(imp_sth)->get_attr(sth, keysv);
- ST(0) = valuesv; /* dbd_st_FETCH_attrib did sv_2mortal */
-#line 1432 "SQLite2.c"
- }
- XSRETURN(1);
-}
-
-
-XS_EUPXS(XS_DBD__SQLite2__st_DESTROY); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD__SQLite2__st_DESTROY)
-{
- dVAR; dXSARGS;
- if (items != 1)
- croak_xs_usage(cv, "sth");
- PERL_UNUSED_VAR(ax); /* -Wall */
- SP -= items;
- {
- SV * sth = ST(0)
-;
-#line 771 "./SQLite2.xsi"
- /* keep in sync with default DESTROY in DBI.xs */
- D_imp_sth(sth);
- ST(0) = &PL_sv_yes;
- if (!DBIc_IMPSET(imp_sth)) { /* was never fully set up */
- STRLEN lna;
- if (DBIc_WARN(imp_sth) && !PL_dirty && DBIc_DBISTATE(imp_sth)->debug >= 2)
- PerlIO_printf(DBIc_LOGPIO(imp_sth),
- " DESTROY for %s ignored - handle not initialised\n",
- SvPV(sth,lna));
- }
- else {
- if (DBIc_IADESTROY(imp_sth)) { /* wants ineffective destroy */
- DBIc_ACTIVE_off(imp_sth);
- if (DBIc_DBISTATE(imp_sth)->debug)
- PerlIO_printf(DBIc_LOGPIO(imp_sth), " DESTROY %s skipped due to InactiveDestroy\n", SvPV_nolen(sth));
- }
- if (DBIc_ACTIVE(imp_sth)) {
- D_imp_dbh_from_sth;
- if (!PL_dirty && DBIc_ACTIVE(imp_dbh)) {
-#ifdef dbd_st_finish3
- dbd_st_finish3(sth, imp_sth, 1);
-#else
- dbd_st_finish(sth, imp_sth);
-#endif
- }
- else {
- DBIc_ACTIVE_off(imp_sth);
- }
- }
- dbd_st_destroy(sth, imp_sth);
- }
-#line 1481 "SQLite2.c"
- PUTBACK;
- return;
- }
-}
-
-
-/* INCLUDE: Returning to 'SQLite2.xs' from 'SQLite2.xsi' */
-
-#ifdef __cplusplus
-extern "C"
-#endif
-XS_EXTERNAL(boot_DBD__SQLite2); /* prototype to pass -Wmissing-prototypes */
-XS_EXTERNAL(boot_DBD__SQLite2)
-{
-#if PERL_VERSION_LE(5, 21, 5)
- dVAR; dXSARGS;
-#else
- dVAR; dXSBOOTARGSXSAPIVERCHK;
-#endif
-#if (PERL_REVISION == 5 && PERL_VERSION < 9)
- char* file = __FILE__;
-#else
- const char* file = __FILE__;
-#endif
-
- PERL_UNUSED_VAR(file);
-
- PERL_UNUSED_VAR(cv); /* -W */
- PERL_UNUSED_VAR(items); /* -W */
-#if PERL_VERSION_LE(5, 21, 5)
- XS_VERSION_BOOTCHECK;
-# ifdef XS_APIVERSION_BOOTCHECK
- XS_APIVERSION_BOOTCHECK;
-# endif
-#endif
-
- newXS_deffile("DBD::SQLite2::db::list_tables", XS_DBD__SQLite2__db_list_tables);
- newXS_deffile("DBD::SQLite2::db::last_insert_rowid", XS_DBD__SQLite2__db_last_insert_rowid);
- newXS_deffile("DBD::SQLite2::db::create_function", XS_DBD__SQLite2__db_create_function);
- newXS_deffile("DBD::SQLite2::db::create_aggregate", XS_DBD__SQLite2__db_create_aggregate);
- newXS_deffile("DBD::SQLite2::db::busy_timeout", XS_DBD__SQLite2__db_busy_timeout);
- newXS_deffile("DBD::SQLite2::dr::dbixs_revision", XS_DBD__SQLite2__dr_dbixs_revision);
-#if XSubPPtmpAAAA
- cv = newXS_deffile("DBD::SQLite2::dr::discon_all_", XS_DBD__SQLite2__dr_discon_all_);
- XSANY.any_i32 = 0;
- cv = newXS_deffile("DBD::SQLite2::dr::disconnect_all", XS_DBD__SQLite2__dr_discon_all_);
- XSANY.any_i32 = 1;
-#endif
-#if XSubPPtmpAAAB
- newXS_deffile("DBD::SQLite2::dr::data_sources", XS_DBD__SQLite2__dr_data_sources);
-#endif
- newXS_deffile("DBD::SQLite2::db::_login", XS_DBD__SQLite2__db__login);
- newXS_deffile("DBD::SQLite2::db::selectall_arrayref", XS_DBD__SQLite2__db_selectall_arrayref);
- cv = newXS_deffile("DBD::SQLite2::db::selectrow_array", XS_DBD__SQLite2__db_selectrow_arrayref);
- XSANY.any_i32 = 1;
- cv = newXS_deffile("DBD::SQLite2::db::selectrow_arrayref", XS_DBD__SQLite2__db_selectrow_arrayref);
- XSANY.any_i32 = 0;
-#if XSubPPtmpAAAC
- newXS_deffile("DBD::SQLite2::db::do", XS_DBD__SQLite2__db_do);
-#endif
-#if XSubPPtmpAAAD
- newXS_deffile("DBD::SQLite2::db::last_insert_id", XS_DBD__SQLite2__db_last_insert_id);
-#endif
- newXS_deffile("DBD::SQLite2::db::commit", XS_DBD__SQLite2__db_commit);
- newXS_deffile("DBD::SQLite2::db::rollback", XS_DBD__SQLite2__db_rollback);
- newXS_deffile("DBD::SQLite2::db::disconnect", XS_DBD__SQLite2__db_disconnect);
- newXS_deffile("DBD::SQLite2::db::STORE", XS_DBD__SQLite2__db_STORE);
- newXS_deffile("DBD::SQLite2::db::FETCH", XS_DBD__SQLite2__db_FETCH);
- newXS_deffile("DBD::SQLite2::db::DESTROY", XS_DBD__SQLite2__db_DESTROY);
-#if XSubPPtmpAAAE
- newXS_deffile("DBD::SQLite2::db::take_imp_data", XS_DBD__SQLite2__db_take_imp_data);
-#endif
-#if XSubPPtmpAAAF
- newXS_deffile("DBD::SQLite2::db::data_sources", XS_DBD__SQLite2__db_data_sources);
-#endif
- newXS_deffile("DBD::SQLite2::st::_prepare", XS_DBD__SQLite2__st__prepare);
-#if XSubPPtmpAAAG
- newXS_deffile("DBD::SQLite2::st::rows", XS_DBD__SQLite2__st_rows);
-#endif
-#if XSubPPtmpAAAH
- newXS_deffile("DBD::SQLite2::st::bind_col", XS_DBD__SQLite2__st_bind_col);
-#endif
- newXS_deffile("DBD::SQLite2::st::bind_param", XS_DBD__SQLite2__st_bind_param);
- newXS_deffile("DBD::SQLite2::st::bind_param_inout", XS_DBD__SQLite2__st_bind_param_inout);
- newXS_deffile("DBD::SQLite2::st::execute", XS_DBD__SQLite2__st_execute);
-#if XSubPPtmpAAAI
- newXS_deffile("DBD::SQLite2::st::execute_for_fetch", XS_DBD__SQLite2__st_execute_for_fetch);
-#endif
- cv = newXS_deffile("DBD::SQLite2::st::fetch", XS_DBD__SQLite2__st_fetchrow_arrayref);
- XSANY.any_i32 = 1;
- cv = newXS_deffile("DBD::SQLite2::st::fetchrow_arrayref", XS_DBD__SQLite2__st_fetchrow_arrayref);
- XSANY.any_i32 = 0;
- cv = newXS_deffile("DBD::SQLite2::st::fetchrow", XS_DBD__SQLite2__st_fetchrow_array);
- XSANY.any_i32 = 1;
- cv = newXS_deffile("DBD::SQLite2::st::fetchrow_array", XS_DBD__SQLite2__st_fetchrow_array);
- XSANY.any_i32 = 0;
- newXS_deffile("DBD::SQLite2::st::fetchall_arrayref", XS_DBD__SQLite2__st_fetchall_arrayref);
- newXS_deffile("DBD::SQLite2::st::finish", XS_DBD__SQLite2__st_finish);
- newXS_deffile("DBD::SQLite2::st::blob_read", XS_DBD__SQLite2__st_blob_read);
- newXS_deffile("DBD::SQLite2::st::STORE", XS_DBD__SQLite2__st_STORE);
- cv = newXS_deffile("DBD::SQLite2::st::FETCH", XS_DBD__SQLite2__st_FETCH_attrib);
- XSANY.any_i32 = 1;
- cv = newXS_deffile("DBD::SQLite2::st::FETCH_attrib", XS_DBD__SQLite2__st_FETCH_attrib);
- XSANY.any_i32 = 0;
- newXS_deffile("DBD::SQLite2::st::DESTROY", XS_DBD__SQLite2__st_DESTROY);
-
- /* Initialisation Section */
-
-#line 39 "./SQLite2.xsi"
- PERL_UNUSED_VAR(items);
- DBISTATE_INIT;
- /* XXX this interface will change: */
- DBI_IMP_SIZE("DBD::SQLite2::dr::imp_data_size", sizeof(imp_drh_t));
- DBI_IMP_SIZE("DBD::SQLite2::db::imp_data_size", sizeof(imp_dbh_t));
- DBI_IMP_SIZE("DBD::SQLite2::st::imp_data_size", sizeof(imp_sth_t));
- dbd_init(DBIS);
-
-#if XSubPPtmpAAAA
-#endif
-#if XSubPPtmpAAAB
-#endif
-#if XSubPPtmpAAAC
-#endif
-#if XSubPPtmpAAAD
-#endif
-#if XSubPPtmpAAAE
-#endif
-#if XSubPPtmpAAAF
-#endif
-#if XSubPPtmpAAAG
-#endif
-#if XSubPPtmpAAAH
-#endif
-#if XSubPPtmpAAAI
-#endif
-#line 1617 "SQLite2.c"
-
- /* End of Initialisation Section */
-
-#if PERL_VERSION_LE(5, 21, 5)
-# if PERL_VERSION_GE(5, 9, 0)
- if (PL_unitcheckav)
- call_list(PL_scopestack_ix, PL_unitcheckav);
-# endif
- XSRETURN_YES;
-#else
- Perl_xs_boot_epilog(aTHX_ ax);
-#endif
-}
-
+++ /dev/null
-/* $Id: SQLite2.xs,v 1.2 2004/08/09 13:23:55 matt Exp $ */
-
-#include "SQLiteXS.h"
-
-DBISTATE_DECLARE;
-
-MODULE = DBD::SQLite2 PACKAGE = DBD::SQLite2::db
-
-PROTOTYPES: DISABLE
-
-AV *
-list_tables(dbh)
- SV *dbh
- CODE:
- {
- RETVAL = newAV();
- }
- OUTPUT:
- RETVAL
-
-int
-last_insert_rowid(dbh)
- SV *dbh
- CODE:
- {
- D_imp_dbh(dbh);
- RETVAL = sqlite_last_insert_rowid(imp_dbh->db);
- }
- OUTPUT:
- RETVAL
-
-void
-create_function(dbh, name, argc, func)
- SV *dbh
- char *name
- int argc
- SV *func
- CODE:
- {
- sqlite2_db_create_function( dbh, name, argc, func );
- }
-
-void
-create_aggregate(dbh, name, argc, aggr)
- SV *dbh
- char *name
- int argc
- SV *aggr
- CODE:
- {
- sqlite2_db_create_aggregate( dbh, name, argc, aggr );
- }
-
-int
-busy_timeout(dbh, timeout=0)
- SV *dbh
- int timeout
- CODE:
- RETVAL = sqlite2_busy_timeout( dbh, timeout );
- OUTPUT:
- RETVAL
-
-MODULE = DBD::SQLite2 PACKAGE = DBD::SQLite2::st
-
-PROTOTYPES: DISABLE
-
-MODULE = DBD::SQLite2 PACKAGE = DBD::SQLite2
-
-INCLUDE: SQLite2.xsi
+++ /dev/null
-# $Id$
-# Copyright (c) 1997-2002 Tim Bunce Ireland
-# Copyright (c) 2002 Jonathan Leffler
-#
-# You may distribute under the terms of either the GNU General Public
-# License or the Artistic License, as specified in the Perl README file.
-
-
-#include "Driver_xst.h"
-
-# Historically dbd_db_do4, dbd_st_execute, and dbd_st_rows returned an 'int' type.
-# That's only 32 bits (31+sign) so isn't sufficient for very large row counts
-# So now instead of defining those macros, drivers can define dbd_db_do4_iv,
-# dbd_st_execute_iv, and dbd_st_rows_iv to be the names of functions that
-# return an 'IV' type. They could also set DBIc_ROW_COUNT(imp_sth).
-#
-# To save a mess of #ifdef's we arrange for dbd_st_execute (etc) to work
-# as dbd_st_execute_iv if that's defined
-#
-#if defined(dbd_st_execute_iv)
-#undef dbd_st_execute
-#define dbd_st_execute dbd_st_execute_iv
-#endif
-#if defined(dbd_st_rows_iv)
-#undef dbd_st_rows
-#define dbd_st_rows dbd_st_rows_iv
-#endif
-#if defined(dbd_db_do4_iv)
-#undef dbd_db_do4
-#define dbd_db_do4 dbd_db_do4_iv
-#endif
-
-MODULE = DBD::SQLite2 PACKAGE = DBD::SQLite2
-
-REQUIRE: 1.929
-PROTOTYPES: DISABLE
-
-BOOT:
- PERL_UNUSED_VAR(items);
- DBISTATE_INIT;
- /* XXX this interface will change: */
- DBI_IMP_SIZE("DBD::SQLite2::dr::imp_data_size", sizeof(imp_drh_t));
- DBI_IMP_SIZE("DBD::SQLite2::db::imp_data_size", sizeof(imp_dbh_t));
- DBI_IMP_SIZE("DBD::SQLite2::st::imp_data_size", sizeof(imp_sth_t));
- dbd_init(DBIS);
-
-
-# ------------------------------------------------------------
-# driver level interface
-# ------------------------------------------------------------
-MODULE = DBD::SQLite2 PACKAGE = DBD::SQLite2::dr
-
-
-void
-dbixs_revision(...)
- PPCODE:
- ST(0) = sv_2mortal(newSViv(DBIXS_REVISION));
-
-
-#ifdef dbd_discon_all
-
-# disconnect_all renamed and ALIAS'd to avoid length clash on VMS :-(
-void
-discon_all_(drh)
- SV * drh
- ALIAS:
- disconnect_all = 1
- CODE:
- D_imp_drh(drh);
- PERL_UNUSED_VAR(ix);
- ST(0) = dbd_discon_all(drh, imp_drh) ? &PL_sv_yes : &PL_sv_no;
-
-#endif /* dbd_discon_all */
-
-
-#ifdef dbd_dr_data_sources
-
-void
-data_sources(drh, attr = Nullsv)
- SV *drh
- SV *attr
- PPCODE:
- {
- D_imp_drh(drh);
- AV *av = dbd_dr_data_sources(drh, imp_drh, attr);
- if (av) {
- int i;
- int n = AvFILL(av)+1;
- EXTEND(sp, n);
- for (i = 0; i < n; ++i) {
- PUSHs(AvARRAY(av)[i]);
- }
- }
- }
-
-#endif
-
-
-# ------------------------------------------------------------
-# database level interface
-# ------------------------------------------------------------
-MODULE = DBD::SQLite2 PACKAGE = DBD::SQLite2::db
-
-
-void
-_login(dbh, dbname, username, password, attribs=Nullsv)
- SV * dbh
- SV * dbname
- SV * username
- SV * password
- SV * attribs
- CODE:
- {
- D_imp_dbh(dbh);
-#if !defined(dbd_db_login6_sv)
- STRLEN lna;
- char *u = (SvOK(username)) ? SvPV(username,lna) : (char*)"";
- char *p = (SvOK(password)) ? SvPV(password,lna) : (char*)"";
-#endif
-#ifdef dbd_db_login6_sv
- ST(0) = dbd_db_login6_sv(dbh, imp_dbh, dbname, username, password, attribs) ? &PL_sv_yes : &PL_sv_no;
-#elif defined(dbd_db_login6)
- ST(0) = dbd_db_login6(dbh, imp_dbh, SvPV_nolen(dbname), u, p, attribs) ? &PL_sv_yes : &PL_sv_no;
-#else
- PERL_UNUSED_ARG(attribs);
- ST(0) = dbd_db_login( dbh, imp_dbh, SvPV_nolen(dbname), u, p) ? &PL_sv_yes : &PL_sv_no;
-#endif
- }
-
-
-void
-selectall_arrayref(...)
- PREINIT:
- SV *sth;
- SV **maxrows_svp;
- SV **tmp_svp;
- SV *tmp_sv;
- SV *attr = &PL_sv_undef;
- imp_sth_t *imp_sth;
- CODE:
- if (items > 2) {
- attr = ST(2);
- if (SvROK(attr) &&
- (DBD_ATTRIB_TRUE(attr,"Slice",5,tmp_svp) || DBD_ATTRIB_TRUE(attr,"Columns",7,tmp_svp))
- ) {
- /* fallback to perl implementation */
- SV *tmp =dbixst_bounce_method("DBD::SQLite2::db::SUPER::selectall_arrayref", items);
- SPAGAIN;
- ST(0) = tmp;
- XSRETURN(1);
- }
- }
- /* --- prepare --- */
- if (SvROK(ST(1))) {
- MAGIC *mg;
- sth = ST(1);
- /* switch to inner handle if not already */
- if ( (mg = mg_find(SvRV(sth),'P')) )
- sth = mg->mg_obj;
- }
- else {
- sth = dbixst_bounce_method("prepare", 3);
- SPAGAIN; SP -= items; /* because stack might have been realloc'd */
- if (!SvROK(sth))
- XSRETURN_UNDEF;
- /* switch to inner handle */
- sth = mg_find(SvRV(sth),'P')->mg_obj;
- }
- imp_sth = (imp_sth_t*)(DBIh_COM(sth));
- /* --- bind_param --- */
- if (items > 3) { /* need to bind params before execute */
- if (!dbdxst_bind_params(sth, imp_sth, items-2, ax+2) ) {
- XSRETURN_UNDEF;
- }
- }
- /* --- execute --- */
- DBIc_ROW_COUNT(imp_sth) = 0;
- if ( dbd_st_execute(sth, imp_sth) <= -2 ) { /* -2 == error */
- XSRETURN_UNDEF;
- }
- /* --- fetchall --- */
- maxrows_svp = DBD_ATTRIB_GET_SVP(attr, "MaxRows", 7);
- tmp_sv = dbdxst_fetchall_arrayref(sth, &PL_sv_undef, (maxrows_svp) ? *maxrows_svp : &PL_sv_undef);
- SPAGAIN;
- ST(0) = tmp_sv;
-
-
-void
-selectrow_arrayref(...)
- ALIAS:
- selectrow_array = 1
- PREINIT:
- int is_selectrow_array = (ix == 1);
- imp_sth_t *imp_sth;
- SV *sth;
- AV *row_av;
- PPCODE:
- if (SvROK(ST(1))) {
- MAGIC *mg;
- sth = ST(1);
- /* switch to inner handle if not already */
- if ( (mg = mg_find(SvRV(sth),'P')) )
- sth = mg->mg_obj;
- }
- else {
- /* --- prepare --- */
- sth = dbixst_bounce_method("prepare", 3);
- SPAGAIN; SP -= items; /* because stack might have been realloc'd */
- if (!SvROK(sth)) {
- if (is_selectrow_array) { XSRETURN_EMPTY; } else { XSRETURN_UNDEF; }
- }
- /* switch to inner handle */
- sth = mg_find(SvRV(sth),'P')->mg_obj;
- }
- imp_sth = (imp_sth_t*)(DBIh_COM(sth));
- /* --- bind_param --- */
- if (items > 3) { /* need to bind params before execute */
- if (!dbdxst_bind_params(sth, imp_sth, items-2, ax+2) ) {
- if (is_selectrow_array) { XSRETURN_EMPTY; } else { XSRETURN_UNDEF; }
- }
- }
- /* --- execute --- */
- DBIc_ROW_COUNT(imp_sth) = 0;
- if ( dbd_st_execute(sth, imp_sth) <= -2 ) { /* -2 == error */
- if (is_selectrow_array) { XSRETURN_EMPTY; } else { XSRETURN_UNDEF; }
- }
- /* --- fetchrow_arrayref --- */
- row_av = dbd_st_fetch(sth, imp_sth);
- if (!row_av) {
- if (GIMME == G_SCALAR)
- PUSHs(&PL_sv_undef);
- }
- else if (is_selectrow_array) {
- int i;
- int num_fields = AvFILL(row_av)+1;
- if (GIMME == G_SCALAR)
- num_fields = 1; /* return just first field */
- EXTEND(sp, num_fields);
- for(i=0; i < num_fields; ++i) {
- PUSHs(AvARRAY(row_av)[i]);
- }
- }
- else {
- PUSHs( sv_2mortal(newRV((SV *)row_av)) );
- }
- /* --- finish --- */
-#ifdef dbd_st_finish3
- dbd_st_finish3(sth, imp_sth, 0);
-#else
- dbd_st_finish(sth, imp_sth);
-#endif
-
-
-#ifdef dbd_db_do4 /* deebeedee-deebee-doo, deebee-doobee-dah? */
-
-void
-do(dbh, statement, params = Nullsv)
- SV * dbh
- char * statement
- SV * params
- CODE:
- {
- D_imp_dbh(dbh);
- IV retval;
- retval = dbd_db_do4(dbh, imp_dbh, statement, params); /* might be dbd_db_do4_iv via macro */
- /* remember that dbd_db_do4 must return <= -2 for error */
- if (retval == 0) /* ok with no rows affected */
- XST_mPV(0, "0E0"); /* (true but zero) */
- else if (retval < -1) /* -1 == unknown number of rows */
- XST_mUNDEF(0); /* <= -2 means error */
- else
- XST_mIV(0, retval); /* typically 1, rowcount or -1 */
- }
-
-#endif
-
-
-#ifdef dbd_db_last_insert_id
-
-void
-last_insert_id(dbh, catalog, schema, table, field, attr=Nullsv)
- SV * dbh
- SV * catalog
- SV * schema
- SV * table
- SV * field
- SV * attr
- CODE:
- {
- D_imp_dbh(dbh);
- ST(0) = dbd_db_last_insert_id(dbh, imp_dbh, catalog, schema, table, field, attr);
- }
-
-#endif
-
-
-void
-commit(dbh)
- SV * dbh
- CODE:
- D_imp_dbh(dbh);
- if (DBIc_has(imp_dbh,DBIcf_AutoCommit) && DBIc_WARN(imp_dbh))
- warn("commit ineffective with AutoCommit enabled");
- ST(0) = dbd_db_commit(dbh, imp_dbh) ? &PL_sv_yes : &PL_sv_no;
-
-
-void
-rollback(dbh)
- SV * dbh
- CODE:
- D_imp_dbh(dbh);
- if (DBIc_has(imp_dbh,DBIcf_AutoCommit) && DBIc_WARN(imp_dbh))
- warn("rollback ineffective with AutoCommit enabled");
- ST(0) = dbd_db_rollback(dbh, imp_dbh) ? &PL_sv_yes : &PL_sv_no;
-
-
-void
-disconnect(dbh)
- SV * dbh
- CODE:
- D_imp_dbh(dbh);
- if ( !DBIc_ACTIVE(imp_dbh) ) {
- XSRETURN_YES;
- }
- /* Check for disconnect() being called whilst refs to cursors */
- /* still exists. This possibly needs some more thought. */
- if (DBIc_ACTIVE_KIDS(imp_dbh) && DBIc_WARN(imp_dbh) && !PL_dirty) {
- STRLEN lna;
- char *plural = (DBIc_ACTIVE_KIDS(imp_dbh)==1) ? (char*)"" : (char*)"s";
- warn("%s->disconnect invalidates %d active statement handle%s %s",
- SvPV(dbh,lna), (int)DBIc_ACTIVE_KIDS(imp_dbh), plural,
- "(either destroy statement handles or call finish on them before disconnecting)");
- }
- ST(0) = dbd_db_disconnect(dbh, imp_dbh) ? &PL_sv_yes : &PL_sv_no;
- DBIc_ACTIVE_off(imp_dbh); /* ensure it's off, regardless */
-
-
-void
-STORE(dbh, keysv, valuesv)
- SV * dbh
- SV * keysv
- SV * valuesv
- CODE:
- D_imp_dbh(dbh);
- if (SvGMAGICAL(valuesv))
- mg_get(valuesv);
- ST(0) = &PL_sv_yes;
- if (!dbd_db_STORE_attrib(dbh, imp_dbh, keysv, valuesv))
- if (!DBIc_DBISTATE(imp_dbh)->set_attr(dbh, keysv, valuesv))
- ST(0) = &PL_sv_no;
-
-
-void
-FETCH(dbh, keysv)
- SV * dbh
- SV * keysv
- CODE:
- D_imp_dbh(dbh);
- SV *valuesv = dbd_db_FETCH_attrib(dbh, imp_dbh, keysv);
- if (!valuesv)
- valuesv = DBIc_DBISTATE(imp_dbh)->get_attr(dbh, keysv);
- ST(0) = valuesv; /* dbd_db_FETCH_attrib did sv_2mortal */
-
-
-void
-DESTROY(dbh)
- SV * dbh
- PPCODE:
- /* keep in sync with default DESTROY in DBI.xs */
- D_imp_dbh(dbh);
- ST(0) = &PL_sv_yes;
- if (!DBIc_IMPSET(imp_dbh)) { /* was never fully set up */
- STRLEN lna;
- if (DBIc_WARN(imp_dbh) && !PL_dirty && DBIc_DBISTATE(imp_dbh)->debug >= 2)
- PerlIO_printf(DBIc_LOGPIO(imp_dbh),
- " DESTROY for %s ignored - handle not initialised\n",
- SvPV(dbh,lna));
- }
- else {
- if (DBIc_IADESTROY(imp_dbh)) { /* wants ineffective destroy */
- DBIc_ACTIVE_off(imp_dbh);
- if (DBIc_DBISTATE(imp_dbh)->debug)
- PerlIO_printf(DBIc_LOGPIO(imp_dbh), " DESTROY %s skipped due to InactiveDestroy\n", SvPV_nolen(dbh));
- }
- if (DBIc_ACTIVE(imp_dbh)) {
- if (!DBIc_has(imp_dbh,DBIcf_AutoCommit)) {
- /* Application is using transactions and hasn't explicitly disconnected.
- Some databases will automatically commit on graceful disconnect.
- Since we're about to gracefully disconnect as part of the DESTROY
- we want to be sure we're not about to implicitly commit changes
- that are incomplete and should be rolled back. (The DESTROY may
- be due to a RaiseError, for example.) So we rollback here.
- This will be harmless if the application has issued a commit,
- XXX Could add an attribute flag to indicate that the driver
- doesn't have this problem. Patches welcome.
- */
- if (DBIc_WARN(imp_dbh) /* only warn if likely to be useful... */
- && DBIc_is(imp_dbh, DBIcf_Executed) /* has not just called commit/rollback */
- /* && !DBIc_is(imp_dbh, DBIcf_ReadOnly) -- is not read only */
- && (!PL_dirty || DBIc_DBISTATE(imp_dbh)->debug >= 3)
- ) {
- warn("Issuing rollback() due to DESTROY without explicit disconnect() of %s handle %s",
- SvPV_nolen(*hv_fetch((HV*)SvRV(dbh), "ImplementorClass", 16, 1)),
- SvPV_nolen(*hv_fetch((HV*)SvRV(dbh), "Name", 4, 1))
- );
- }
- dbd_db_rollback(dbh, imp_dbh); /* ROLLBACK! */
- }
- dbd_db_disconnect(dbh, imp_dbh);
- DBIc_ACTIVE_off(imp_dbh); /* ensure it's off, regardless */
- }
- dbd_db_destroy(dbh, imp_dbh);
- }
-
-
-#ifdef dbd_take_imp_data
-
-void
-take_imp_data(h)
- SV * h
- CODE:
- D_imp_xxh(h);
- /* dbd_take_imp_data() returns &sv_no (or other defined but false value)
- * to indicate "preparations complete, now call SUPER::take_imp_data" for me.
- * Anything else is returned to the caller via sv_2mortal(sv), typically that
- * would be &sv_undef for error or an SV holding the imp_data.
- */
- SV *sv = dbd_take_imp_data(h, imp_xxh, NULL);
- if (SvOK(sv) && !SvTRUE(sv)) {
- SV *tmp = dbixst_bounce_method("DBD::SQLite2::db::SUPER::take_imp_data", items);
- SPAGAIN;
- ST(0) = tmp;
- } else {
- ST(0) = sv_2mortal(sv);
- }
-
-#endif
-
-#ifdef dbd_db_data_sources
-
-void
-data_sources(dbh, attr = Nullsv)
- SV *dbh
- SV *attr
- PPCODE:
- {
- D_imp_dbh(dbh);
- AV *av = dbd_db_data_sources(dbh, imp_dbh, attr);
- if (av) {
- int i;
- int n = AvFILL(av)+1;
- EXTEND(sp, n);
- for (i = 0; i < n; ++i) {
- PUSHs(AvARRAY(av)[i]);
- }
- }
- }
-
-#endif
-
-# -- end of DBD::SQLite2::db
-
-# ------------------------------------------------------------
-# statement interface
-# ------------------------------------------------------------
-MODULE = DBD::SQLite2 PACKAGE = DBD::SQLite2::st
-
-
-void
-_prepare(sth, statement, attribs=Nullsv)
- SV * sth
- SV * statement
- SV * attribs
- CODE:
- {
- D_imp_sth(sth);
- DBD_ATTRIBS_CHECK("_prepare", sth, attribs);
-#ifdef dbd_st_prepare_sv
- ST(0) = dbd_st_prepare_sv(sth, imp_sth, statement, attribs) ? &PL_sv_yes : &PL_sv_no;
-#else
- ST(0) = dbd_st_prepare(sth, imp_sth, SvPV_nolen(statement), attribs) ? &PL_sv_yes : &PL_sv_no;
-#endif
- }
-
-
-#ifdef dbd_st_rows
-
-void
-rows(sth)
- SV * sth
- CODE:
- D_imp_sth(sth);
- XST_mIV(0, dbd_st_rows(sth, imp_sth));
-
-#endif /* dbd_st_rows */
-
-
-#ifdef dbd_st_bind_col
-
-void
-bind_col(sth, col, ref, attribs=Nullsv)
- SV * sth
- SV * col
- SV * ref
- SV * attribs
- CODE:
- {
- IV sql_type = 0;
- D_imp_sth(sth);
- if (SvGMAGICAL(ref))
- mg_get(ref);
- if (attribs) {
- if (SvNIOK(attribs)) {
- sql_type = SvIV(attribs);
- attribs = Nullsv;
- }
- else {
- SV **svp;
- DBD_ATTRIBS_CHECK("bind_col", sth, attribs);
- /* XXX we should perhaps complain if TYPE is not SvNIOK */
- DBD_ATTRIB_GET_IV(attribs, "TYPE",4, svp, sql_type);
- }
- }
- switch(dbd_st_bind_col(sth, imp_sth, col, ref, sql_type, attribs)) {
- case 2: ST(0) = &PL_sv_yes; /* job done completely */
- break;
- case 1: /* fallback to DBI default */
- ST(0) = (DBIc_DBISTATE(imp_sth)->bind_col(sth, col, ref, attribs))
- ? &PL_sv_yes : &PL_sv_no;
- break;
- default: ST(0) = &PL_sv_no; /* dbd_st_bind_col has called set_err */
- break;
- }
- }
-
-#endif /* dbd_st_bind_col */
-
-void
-bind_param(sth, param, value, attribs=Nullsv)
- SV * sth
- SV * param
- SV * value
- SV * attribs
- CODE:
- {
- IV sql_type = 0;
- D_imp_sth(sth);
- if (SvGMAGICAL(value))
- mg_get(value);
- if (attribs) {
- if (SvNIOK(attribs)) {
- sql_type = SvIV(attribs);
- attribs = Nullsv;
- }
- else {
- SV **svp;
- DBD_ATTRIBS_CHECK("bind_param", sth, attribs);
- /* XXX we should perhaps complain if TYPE is not SvNIOK */
- DBD_ATTRIB_GET_IV(attribs, "TYPE",4, svp, sql_type);
- }
- }
- ST(0) = dbd_bind_ph(sth, imp_sth, param, value, sql_type, attribs, FALSE, 0)
- ? &PL_sv_yes : &PL_sv_no;
- }
-
-
-void
-bind_param_inout(sth, param, value_ref, maxlen, attribs=Nullsv)
- SV * sth
- SV * param
- SV * value_ref
- IV maxlen
- SV * attribs
- CODE:
- {
- IV sql_type = 0;
- D_imp_sth(sth);
- SV *value;
- if (!SvROK(value_ref) || SvTYPE(SvRV(value_ref)) > SVt_PVMG)
- croak("bind_param_inout needs a reference to a scalar value");
- value = SvRV(value_ref);
- if (SvREADONLY(value))
- croak("Modification of a read-only value attempted");
- if (SvGMAGICAL(value))
- mg_get(value);
- if (attribs) {
- if (SvNIOK(attribs)) {
- sql_type = SvIV(attribs);
- attribs = Nullsv;
- }
- else {
- SV **svp;
- DBD_ATTRIBS_CHECK("bind_param", sth, attribs);
- DBD_ATTRIB_GET_IV(attribs, "TYPE",4, svp, sql_type);
- }
- }
- ST(0) = dbd_bind_ph(sth, imp_sth, param, value, sql_type, attribs, TRUE, maxlen)
- ? &PL_sv_yes : &PL_sv_no;
- }
-
-
-void
-execute(sth, ...)
- SV * sth
- CODE:
- D_imp_sth(sth);
- IV retval;
- if (items > 1) { /* need to bind params */
- if (!dbdxst_bind_params(sth, imp_sth, items, ax) ) {
- XSRETURN_UNDEF;
- }
- }
- /* XXX this code is duplicated in selectrow_arrayref above */
- DBIc_ROW_COUNT(imp_sth) = 0;
- retval = dbd_st_execute(sth, imp_sth); /* might be dbd_st_execute_iv via macro */
- /* remember that dbd_st_execute must return <= -2 for error */
- if (retval == 0) /* ok with no rows affected */
- XST_mPV(0, "0E0"); /* (true but zero) */
- else if (retval < -1) /* -1 == unknown number of rows */
- XST_mUNDEF(0); /* <= -2 means error */
- else
- XST_mIV(0, retval); /* typically 1, rowcount or -1 */
-
-
-#ifdef dbd_st_execute_for_fetch
-
-void
-execute_for_fetch(sth, fetch_tuple_sub, tuple_status = Nullsv)
- SV * sth
- SV * fetch_tuple_sub
- SV * tuple_status
- CODE:
- {
- D_imp_sth(sth);
- ST(0) = dbd_st_execute_for_fetch(sth, imp_sth, fetch_tuple_sub, tuple_status);
- }
-
-#endif
-
-
-
-void
-fetchrow_arrayref(sth)
- SV * sth
- ALIAS:
- fetch = 1
- CODE:
- D_imp_sth(sth);
- AV *av;
- PERL_UNUSED_VAR(ix);
- av = dbd_st_fetch(sth, imp_sth);
- ST(0) = (av) ? sv_2mortal(newRV((SV *)av)) : &PL_sv_undef;
-
-
-void
-fetchrow_array(sth)
- SV * sth
- ALIAS:
- fetchrow = 1
- PPCODE:
- D_imp_sth(sth);
- AV *av;
- av = dbd_st_fetch(sth, imp_sth);
- if (av) {
- int i;
- int num_fields = AvFILL(av)+1;
- EXTEND(sp, num_fields);
- for(i=0; i < num_fields; ++i) {
- PUSHs(AvARRAY(av)[i]);
- }
- PERL_UNUSED_VAR(ix);
- }
-
-
-void
-fetchall_arrayref(sth, slice=&PL_sv_undef, batch_row_count=&PL_sv_undef)
- SV * sth
- SV * slice
- SV * batch_row_count
- CODE:
- if (SvOK(slice)) { /* fallback to perl implementation */
- SV *tmp = dbixst_bounce_method("DBD::SQLite2::st::SUPER::fetchall_arrayref", 3);
- SPAGAIN;
- ST(0) = tmp;
- }
- else {
- SV *tmp = dbdxst_fetchall_arrayref(sth, slice, batch_row_count);
- SPAGAIN;
- ST(0) = tmp;
- }
-
-
-void
-finish(sth)
- SV * sth
- CODE:
- D_imp_sth(sth);
- D_imp_dbh_from_sth;
- if (!DBIc_ACTIVE(imp_sth)) {
- /* No active statement to finish */
- XSRETURN_YES;
- }
- if (!DBIc_ACTIVE(imp_dbh)) {
- /* Either an explicit disconnect() or global destruction */
- /* has disconnected us from the database. Finish is meaningless */
- DBIc_ACTIVE_off(imp_sth);
- XSRETURN_YES;
- }
-#ifdef dbd_st_finish3
- ST(0) = dbd_st_finish3(sth, imp_sth, 0) ? &PL_sv_yes : &PL_sv_no;
-#else
- ST(0) = dbd_st_finish(sth, imp_sth) ? &PL_sv_yes : &PL_sv_no;
-#endif
-
-
-void
-blob_read(sth, field, offset, len, destrv=Nullsv, destoffset=0)
- SV * sth
- int field
- long offset
- long len
- SV * destrv
- long destoffset
- CODE:
- {
- D_imp_sth(sth);
- if (!destrv)
- destrv = sv_2mortal(newRV(sv_2mortal(newSV(0))));
- if (dbd_st_blob_read(sth, imp_sth, field, offset, len, destrv, destoffset))
- ST(0) = SvRV(destrv);
- else ST(0) = &PL_sv_undef;
- }
-
-
-void
-STORE(sth, keysv, valuesv)
- SV * sth
- SV * keysv
- SV * valuesv
- CODE:
- D_imp_sth(sth);
- if (SvGMAGICAL(valuesv))
- mg_get(valuesv);
- ST(0) = &PL_sv_yes;
- if (!dbd_st_STORE_attrib(sth, imp_sth, keysv, valuesv))
- if (!DBIc_DBISTATE(imp_sth)->set_attr(sth, keysv, valuesv))
- ST(0) = &PL_sv_no;
-
-
-# FETCH renamed and ALIAS'd to avoid case clash on VMS :-(
-void
-FETCH_attrib(sth, keysv)
- SV * sth
- SV * keysv
- ALIAS:
- FETCH = 1
- CODE:
- D_imp_sth(sth);
- SV *valuesv;
- PERL_UNUSED_VAR(ix);
- valuesv = dbd_st_FETCH_attrib(sth, imp_sth, keysv);
- if (!valuesv)
- valuesv = DBIc_DBISTATE(imp_sth)->get_attr(sth, keysv);
- ST(0) = valuesv; /* dbd_st_FETCH_attrib did sv_2mortal */
-
-
-void
-DESTROY(sth)
- SV * sth
- PPCODE:
- /* keep in sync with default DESTROY in DBI.xs */
- D_imp_sth(sth);
- ST(0) = &PL_sv_yes;
- if (!DBIc_IMPSET(imp_sth)) { /* was never fully set up */
- STRLEN lna;
- if (DBIc_WARN(imp_sth) && !PL_dirty && DBIc_DBISTATE(imp_sth)->debug >= 2)
- PerlIO_printf(DBIc_LOGPIO(imp_sth),
- " DESTROY for %s ignored - handle not initialised\n",
- SvPV(sth,lna));
- }
- else {
- if (DBIc_IADESTROY(imp_sth)) { /* wants ineffective destroy */
- DBIc_ACTIVE_off(imp_sth);
- if (DBIc_DBISTATE(imp_sth)->debug)
- PerlIO_printf(DBIc_LOGPIO(imp_sth), " DESTROY %s skipped due to InactiveDestroy\n", SvPV_nolen(sth));
- }
- if (DBIc_ACTIVE(imp_sth)) {
- D_imp_dbh_from_sth;
- if (!PL_dirty && DBIc_ACTIVE(imp_dbh)) {
-#ifdef dbd_st_finish3
- dbd_st_finish3(sth, imp_sth, 1);
-#else
- dbd_st_finish(sth, imp_sth);
-#endif
- }
- else {
- DBIc_ACTIVE_off(imp_sth);
- }
- }
- dbd_st_destroy(sth, imp_sth);
- }
-
-# end of SQLite2.xst
-# vim:ts=8:sw=4:et
+++ /dev/null
-
-#ifndef _SQLITEXS_H
-#define _SQLITEXS_H 1
-
-/************************************************************************
- DBI Specific Stuff - Added by Matt Sergeant
- ************************************************************************/
-#define NEED_DBIXS_VERSION 93
-#include <DBIXS.h>
-#include "dbdimp.h"
-#include <dbd_xsh.h>
-
-#include "sqlite.h"
-
-#endif
+++ /dev/null
-/*
-** 2003 April 6
-**
-** The author disclaims copyright to this source code. In place of
-** a legal notice, here is a blessing:
-**
-** May you do good and not evil.
-** May you find forgiveness for yourself and forgive others.
-** May you share freely, never taking more than you give.
-**
-*************************************************************************
-** This file contains code used to implement the ATTACH and DETACH commands.
-**
-** $Id: attach.c,v 1.1.1.1 2004/08/08 15:03:56 matt Exp $
-*/
-#include "sqliteInt.h"
-
-/*
-** This routine is called by the parser to process an ATTACH statement:
-**
-** ATTACH DATABASE filename AS dbname
-**
-** The pFilename and pDbname arguments are the tokens that define the
-** filename and dbname in the ATTACH statement.
-*/
-void sqliteAttach(Parse *pParse, Token *pFilename, Token *pDbname, Token *pKey){
- Db *aNew;
- int rc, i;
- char *zFile, *zName;
- sqlite *db;
- Vdbe *v;
-
- v = sqliteGetVdbe(pParse);
- sqliteVdbeAddOp(v, OP_Halt, 0, 0);
- if( pParse->explain ) return;
- db = pParse->db;
- if( db->file_format<4 ){
- sqliteErrorMsg(pParse, "cannot attach auxiliary databases to an "
- "older format master database", 0);
- pParse->rc = SQLITE_ERROR;
- return;
- }
- if( db->nDb>=MAX_ATTACHED+2 ){
- sqliteErrorMsg(pParse, "too many attached databases - max %d",
- MAX_ATTACHED);
- pParse->rc = SQLITE_ERROR;
- return;
- }
-
- zFile = 0;
- sqliteSetNString(&zFile, pFilename->z, pFilename->n, 0);
- if( zFile==0 ) return;
- sqliteDequote(zFile);
-#ifndef SQLITE_OMIT_AUTHORIZATION
- if( sqliteAuthCheck(pParse, SQLITE_ATTACH, zFile, 0, 0)!=SQLITE_OK ){
- sqliteFree(zFile);
- return;
- }
-#endif /* SQLITE_OMIT_AUTHORIZATION */
-
- zName = 0;
- sqliteSetNString(&zName, pDbname->z, pDbname->n, 0);
- if( zName==0 ) return;
- sqliteDequote(zName);
- for(i=0; i<db->nDb; i++){
- if( db->aDb[i].zName && sqliteStrICmp(db->aDb[i].zName, zName)==0 ){
- sqliteErrorMsg(pParse, "database %z is already in use", zName);
- pParse->rc = SQLITE_ERROR;
- sqliteFree(zFile);
- return;
- }
- }
-
- if( db->aDb==db->aDbStatic ){
- aNew = sqliteMalloc( sizeof(db->aDb[0])*3 );
- if( aNew==0 ) return;
- memcpy(aNew, db->aDb, sizeof(db->aDb[0])*2);
- }else{
- aNew = sqliteRealloc(db->aDb, sizeof(db->aDb[0])*(db->nDb+1) );
- if( aNew==0 ) return;
- }
- db->aDb = aNew;
- aNew = &db->aDb[db->nDb++];
- memset(aNew, 0, sizeof(*aNew));
- sqliteHashInit(&aNew->tblHash, SQLITE_HASH_STRING, 0);
- sqliteHashInit(&aNew->idxHash, SQLITE_HASH_STRING, 0);
- sqliteHashInit(&aNew->trigHash, SQLITE_HASH_STRING, 0);
- sqliteHashInit(&aNew->aFKey, SQLITE_HASH_STRING, 1);
- aNew->zName = zName;
- rc = sqliteBtreeFactory(db, zFile, 0, MAX_PAGES, &aNew->pBt);
- if( rc ){
- sqliteErrorMsg(pParse, "unable to open database: %s", zFile);
- }
-#if SQLITE_HAS_CODEC
- {
- extern int sqliteCodecAttach(sqlite*, int, void*, int);
- char *zKey = 0;
- int nKey;
- if( pKey && pKey->z && pKey->n ){
- sqliteSetNString(&zKey, pKey->z, pKey->n, 0);
- sqliteDequote(zKey);
- nKey = strlen(zKey);
- }else{
- zKey = 0;
- nKey = 0;
- }
- sqliteCodecAttach(db, db->nDb-1, zKey, nKey);
- }
-#endif
- sqliteFree(zFile);
- db->flags &= ~SQLITE_Initialized;
- if( pParse->nErr ) return;
- if( rc==SQLITE_OK ){
- rc = sqliteInit(pParse->db, &pParse->zErrMsg);
- }
- if( rc ){
- int i = db->nDb - 1;
- assert( i>=2 );
- if( db->aDb[i].pBt ){
- sqliteBtreeClose(db->aDb[i].pBt);
- db->aDb[i].pBt = 0;
- }
- sqliteResetInternalSchema(db, 0);
- pParse->nErr++;
- pParse->rc = SQLITE_ERROR;
- }
-}
-
-/*
-** This routine is called by the parser to process a DETACH statement:
-**
-** DETACH DATABASE dbname
-**
-** The pDbname argument is the name of the database in the DETACH statement.
-*/
-void sqliteDetach(Parse *pParse, Token *pDbname){
- int i;
- sqlite *db;
- Vdbe *v;
- Db *pDb;
-
- v = sqliteGetVdbe(pParse);
- sqliteVdbeAddOp(v, OP_Halt, 0, 0);
- if( pParse->explain ) return;
- db = pParse->db;
- for(i=0; i<db->nDb; i++){
- pDb = &db->aDb[i];
- if( pDb->pBt==0 || pDb->zName==0 ) continue;
- if( strlen(pDb->zName)!=pDbname->n ) continue;
- if( sqliteStrNICmp(pDb->zName, pDbname->z, pDbname->n)==0 ) break;
- }
- if( i>=db->nDb ){
- sqliteErrorMsg(pParse, "no such database: %T", pDbname);
- return;
- }
- if( i<2 ){
- sqliteErrorMsg(pParse, "cannot detach database %T", pDbname);
- return;
- }
-#ifndef SQLITE_OMIT_AUTHORIZATION
- if( sqliteAuthCheck(pParse,SQLITE_DETACH,db->aDb[i].zName,0,0)!=SQLITE_OK ){
- return;
- }
-#endif /* SQLITE_OMIT_AUTHORIZATION */
- sqliteBtreeClose(pDb->pBt);
- pDb->pBt = 0;
- sqliteFree(pDb->zName);
- sqliteResetInternalSchema(db, i);
- if( pDb->pAux && pDb->xFreeAux ) pDb->xFreeAux(pDb->pAux);
- db->nDb--;
- if( i<db->nDb ){
- db->aDb[i] = db->aDb[db->nDb];
- memset(&db->aDb[db->nDb], 0, sizeof(db->aDb[0]));
- sqliteResetInternalSchema(db, i);
- }
-}
-
-/*
-** Initialize a DbFixer structure. This routine must be called prior
-** to passing the structure to one of the sqliteFixAAAA() routines below.
-**
-** The return value indicates whether or not fixation is required. TRUE
-** means we do need to fix the database references, FALSE means we do not.
-*/
-int sqliteFixInit(
- DbFixer *pFix, /* The fixer to be initialized */
- Parse *pParse, /* Error messages will be written here */
- int iDb, /* This is the database that must must be used */
- const char *zType, /* "view", "trigger", or "index" */
- const Token *pName /* Name of the view, trigger, or index */
-){
- sqlite *db;
-
- if( iDb<0 || iDb==1 ) return 0;
- db = pParse->db;
- assert( db->nDb>iDb );
- pFix->pParse = pParse;
- pFix->zDb = db->aDb[iDb].zName;
- pFix->zType = zType;
- pFix->pName = pName;
- return 1;
-}
-
-/*
-** The following set of routines walk through the parse tree and assign
-** a specific database to all table references where the database name
-** was left unspecified in the original SQL statement. The pFix structure
-** must have been initialized by a prior call to sqliteFixInit().
-**
-** These routines are used to make sure that an index, trigger, or
-** view in one database does not refer to objects in a different database.
-** (Exception: indices, triggers, and views in the TEMP database are
-** allowed to refer to anything.) If a reference is explicitly made
-** to an object in a different database, an error message is added to
-** pParse->zErrMsg and these routines return non-zero. If everything
-** checks out, these routines return 0.
-*/
-int sqliteFixSrcList(
- DbFixer *pFix, /* Context of the fixation */
- SrcList *pList /* The Source list to check and modify */
-){
- int i;
- const char *zDb;
-
- if( pList==0 ) return 0;
- zDb = pFix->zDb;
- for(i=0; i<pList->nSrc; i++){
- if( pList->a[i].zDatabase==0 ){
- pList->a[i].zDatabase = sqliteStrDup(zDb);
- }else if( sqliteStrICmp(pList->a[i].zDatabase,zDb)!=0 ){
- sqliteErrorMsg(pFix->pParse,
- "%s %z cannot reference objects in database %s",
- pFix->zType, sqliteStrNDup(pFix->pName->z, pFix->pName->n),
- pList->a[i].zDatabase);
- return 1;
- }
- if( sqliteFixSelect(pFix, pList->a[i].pSelect) ) return 1;
- if( sqliteFixExpr(pFix, pList->a[i].pOn) ) return 1;
- }
- return 0;
-}
-int sqliteFixSelect(
- DbFixer *pFix, /* Context of the fixation */
- Select *pSelect /* The SELECT statement to be fixed to one database */
-){
- while( pSelect ){
- if( sqliteFixExprList(pFix, pSelect->pEList) ){
- return 1;
- }
- if( sqliteFixSrcList(pFix, pSelect->pSrc) ){
- return 1;
- }
- if( sqliteFixExpr(pFix, pSelect->pWhere) ){
- return 1;
- }
- if( sqliteFixExpr(pFix, pSelect->pHaving) ){
- return 1;
- }
- pSelect = pSelect->pPrior;
- }
- return 0;
-}
-int sqliteFixExpr(
- DbFixer *pFix, /* Context of the fixation */
- Expr *pExpr /* The expression to be fixed to one database */
-){
- while( pExpr ){
- if( sqliteFixSelect(pFix, pExpr->pSelect) ){
- return 1;
- }
- if( sqliteFixExprList(pFix, pExpr->pList) ){
- return 1;
- }
- if( sqliteFixExpr(pFix, pExpr->pRight) ){
- return 1;
- }
- pExpr = pExpr->pLeft;
- }
- return 0;
-}
-int sqliteFixExprList(
- DbFixer *pFix, /* Context of the fixation */
- ExprList *pList /* The expression to be fixed to one database */
-){
- int i;
- if( pList==0 ) return 0;
- for(i=0; i<pList->nExpr; i++){
- if( sqliteFixExpr(pFix, pList->a[i].pExpr) ){
- return 1;
- }
- }
- return 0;
-}
-int sqliteFixTriggerStep(
- DbFixer *pFix, /* Context of the fixation */
- TriggerStep *pStep /* The trigger step be fixed to one database */
-){
- while( pStep ){
- if( sqliteFixSelect(pFix, pStep->pSelect) ){
- return 1;
- }
- if( sqliteFixExpr(pFix, pStep->pWhere) ){
- return 1;
- }
- if( sqliteFixExprList(pFix, pStep->pExprList) ){
- return 1;
- }
- pStep = pStep->pNext;
- }
- return 0;
-}
+++ /dev/null
-/*
-** 2003 January 11
-**
-** The author disclaims copyright to this source code. In place of
-** a legal notice, here is a blessing:
-**
-** May you do good and not evil.
-** May you find forgiveness for yourself and forgive others.
-** May you share freely, never taking more than you give.
-**
-*************************************************************************
-** This file contains code used to implement the sqlite_set_authorizer()
-** API. This facility is an optional feature of the library. Embedded
-** systems that do not need this facility may omit it by recompiling
-** the library with -DSQLITE_OMIT_AUTHORIZATION=1
-**
-** $Id: auth.c,v 1.1.1.1 2004/08/08 15:03:56 matt Exp $
-*/
-#include "sqliteInt.h"
-
-/*
-** All of the code in this file may be omitted by defining a single
-** macro.
-*/
-#ifndef SQLITE_OMIT_AUTHORIZATION
-
-/*
-** Set or clear the access authorization function.
-**
-** The access authorization function is be called during the compilation
-** phase to verify that the user has read and/or write access permission on
-** various fields of the database. The first argument to the auth function
-** is a copy of the 3rd argument to this routine. The second argument
-** to the auth function is one of these constants:
-**
-** SQLITE_COPY
-** SQLITE_CREATE_INDEX
-** SQLITE_CREATE_TABLE
-** SQLITE_CREATE_TEMP_INDEX
-** SQLITE_CREATE_TEMP_TABLE
-** SQLITE_CREATE_TEMP_TRIGGER
-** SQLITE_CREATE_TEMP_VIEW
-** SQLITE_CREATE_TRIGGER
-** SQLITE_CREATE_VIEW
-** SQLITE_DELETE
-** SQLITE_DROP_INDEX
-** SQLITE_DROP_TABLE
-** SQLITE_DROP_TEMP_INDEX
-** SQLITE_DROP_TEMP_TABLE
-** SQLITE_DROP_TEMP_TRIGGER
-** SQLITE_DROP_TEMP_VIEW
-** SQLITE_DROP_TRIGGER
-** SQLITE_DROP_VIEW
-** SQLITE_INSERT
-** SQLITE_PRAGMA
-** SQLITE_READ
-** SQLITE_SELECT
-** SQLITE_TRANSACTION
-** SQLITE_UPDATE
-**
-** The third and fourth arguments to the auth function are the name of
-** the table and the column that are being accessed. The auth function
-** should return either SQLITE_OK, SQLITE_DENY, or SQLITE_IGNORE. If
-** SQLITE_OK is returned, it means that access is allowed. SQLITE_DENY
-** means that the SQL statement will never-run - the sqlite_exec() call
-** will return with an error. SQLITE_IGNORE means that the SQL statement
-** should run but attempts to read the specified column will return NULL
-** and attempts to write the column will be ignored.
-**
-** Setting the auth function to NULL disables this hook. The default
-** setting of the auth function is NULL.
-*/
-int sqlite_set_authorizer(
- sqlite *db,
- int (*xAuth)(void*,int,const char*,const char*,const char*,const char*),
- void *pArg
-){
- db->xAuth = xAuth;
- db->pAuthArg = pArg;
- return SQLITE_OK;
-}
-
-/*
-** Write an error message into pParse->zErrMsg that explains that the
-** user-supplied authorization function returned an illegal value.
-*/
-static void sqliteAuthBadReturnCode(Parse *pParse, int rc){
- sqliteErrorMsg(pParse, "illegal return value (%d) from the "
- "authorization function - should be SQLITE_OK, SQLITE_IGNORE, "
- "or SQLITE_DENY", rc);
- pParse->rc = SQLITE_MISUSE;
-}
-
-/*
-** The pExpr should be a TK_COLUMN expression. The table referred to
-** is in pTabList or else it is the NEW or OLD table of a trigger.
-** Check to see if it is OK to read this particular column.
-**
-** If the auth function returns SQLITE_IGNORE, change the TK_COLUMN
-** instruction into a TK_NULL. If the auth function returns SQLITE_DENY,
-** then generate an error.
-*/
-void sqliteAuthRead(
- Parse *pParse, /* The parser context */
- Expr *pExpr, /* The expression to check authorization on */
- SrcList *pTabList /* All table that pExpr might refer to */
-){
- sqlite *db = pParse->db;
- int rc;
- Table *pTab; /* The table being read */
- const char *zCol; /* Name of the column of the table */
- int iSrc; /* Index in pTabList->a[] of table being read */
- const char *zDBase; /* Name of database being accessed */
-
- if( db->xAuth==0 ) return;
- assert( pExpr->op==TK_COLUMN );
- for(iSrc=0; iSrc<pTabList->nSrc; iSrc++){
- if( pExpr->iTable==pTabList->a[iSrc].iCursor ) break;
- }
- if( iSrc>=0 && iSrc<pTabList->nSrc ){
- pTab = pTabList->a[iSrc].pTab;
- }else{
- /* This must be an attempt to read the NEW or OLD pseudo-tables
- ** of a trigger.
- */
- TriggerStack *pStack; /* The stack of current triggers */
- pStack = pParse->trigStack;
- assert( pStack!=0 );
- assert( pExpr->iTable==pStack->newIdx || pExpr->iTable==pStack->oldIdx );
- pTab = pStack->pTab;
- }
- if( pTab==0 ) return;
- if( pExpr->iColumn>=0 ){
- assert( pExpr->iColumn<pTab->nCol );
- zCol = pTab->aCol[pExpr->iColumn].zName;
- }else if( pTab->iPKey>=0 ){
- assert( pTab->iPKey<pTab->nCol );
- zCol = pTab->aCol[pTab->iPKey].zName;
- }else{
- zCol = "ROWID";
- }
- assert( pExpr->iDb<db->nDb );
- zDBase = db->aDb[pExpr->iDb].zName;
- rc = db->xAuth(db->pAuthArg, SQLITE_READ, pTab->zName, zCol, zDBase,
- pParse->zAuthContext);
- if( rc==SQLITE_IGNORE ){
- pExpr->op = TK_NULL;
- }else if( rc==SQLITE_DENY ){
- if( db->nDb>2 || pExpr->iDb!=0 ){
- sqliteErrorMsg(pParse, "access to %s.%s.%s is prohibited",
- zDBase, pTab->zName, zCol);
- }else{
- sqliteErrorMsg(pParse, "access to %s.%s is prohibited", pTab->zName,zCol);
- }
- pParse->rc = SQLITE_AUTH;
- }else if( rc!=SQLITE_OK ){
- sqliteAuthBadReturnCode(pParse, rc);
- }
-}
-
-/*
-** Do an authorization check using the code and arguments given. Return
-** either SQLITE_OK (zero) or SQLITE_IGNORE or SQLITE_DENY. If SQLITE_DENY
-** is returned, then the error count and error message in pParse are
-** modified appropriately.
-*/
-int sqliteAuthCheck(
- Parse *pParse,
- int code,
- const char *zArg1,
- const char *zArg2,
- const char *zArg3
-){
- sqlite *db = pParse->db;
- int rc;
-
- if( db->init.busy || db->xAuth==0 ){
- return SQLITE_OK;
- }
- rc = db->xAuth(db->pAuthArg, code, zArg1, zArg2, zArg3, pParse->zAuthContext);
- if( rc==SQLITE_DENY ){
- sqliteErrorMsg(pParse, "not authorized");
- pParse->rc = SQLITE_AUTH;
- }else if( rc!=SQLITE_OK && rc!=SQLITE_IGNORE ){
- rc = SQLITE_DENY;
- sqliteAuthBadReturnCode(pParse, rc);
- }
- return rc;
-}
-
-/*
-** Push an authorization context. After this routine is called, the
-** zArg3 argument to authorization callbacks will be zContext until
-** popped. Or if pParse==0, this routine is a no-op.
-*/
-void sqliteAuthContextPush(
- Parse *pParse,
- AuthContext *pContext,
- const char *zContext
-){
- pContext->pParse = pParse;
- if( pParse ){
- pContext->zAuthContext = pParse->zAuthContext;
- pParse->zAuthContext = zContext;
- }
-}
-
-/*
-** Pop an authorization context that was previously pushed
-** by sqliteAuthContextPush
-*/
-void sqliteAuthContextPop(AuthContext *pContext){
- if( pContext->pParse ){
- pContext->pParse->zAuthContext = pContext->zAuthContext;
- pContext->pParse = 0;
- }
-}
-
-#endif /* SQLITE_OMIT_AUTHORIZATION */
+++ /dev/null
-# $Id: SQLite2.pm,v 1.2 2004/09/10 15:43:39 matt Exp $
-
-package DBD::SQLite2;
-use strict;
-
-use DBI;
-use vars qw($err $errstr $state $drh $VERSION @ISA);
-$VERSION = '0.33';
-
-use DynaLoader();
-@ISA = ('DynaLoader');
-
-__PACKAGE__->bootstrap($VERSION);
-
-$drh = undef;
-
-sub driver {
- return $drh if $drh;
- my ($class, $attr) = @_;
-
- $class .= "::dr";
-
- $drh = DBI::_new_drh($class, {
- Name => 'SQLite2',
- Version => $VERSION,
- Attribution => 'DBD::SQLite2 by Matt Sergeant',
- });
-
- return $drh;
-}
-
-sub CLONE {
- undef $drh;
-}
-
-package DBD::SQLite2::dr;
-
-sub connect {
- my ($drh, $dbname, $user, $auth, $attr) = @_;
-
- my $dbh = DBI::_new_dbh($drh, {
- Name => $dbname,
- });
-
- my $real_dbname = $dbname;
- if ($dbname =~ /=/) {
- foreach my $attrib (split(/;/, $dbname)) {
- my ($k, $v) = split(/=/, $attrib, 2);
- if ($k eq 'dbname') {
- $real_dbname = $v;
- }
- else {
- # TODO: add to attribs
- }
- }
- }
- DBD::SQLite2::db::_login($dbh, $real_dbname, $user, $auth)
- or return undef;
-
- return $dbh;
-}
-
-package DBD::SQLite2::db;
-
-sub prepare {
- my ($dbh, $statement, @attribs) = @_;
-
- my $sth = DBI::_new_sth($dbh, {
- Statement => $statement,
- });
-
- DBD::SQLite2::st::_prepare($sth, $statement, @attribs)
- or return undef;
-
- return $sth;
-}
-
-
-sub table_info {
- my ($dbh, $CatVal, $SchVal, $TblVal, $TypVal) = @_;
- # SQL/CLI (ISO/IEC JTC 1/SC 32 N 0595), 6.63 Tables
- # Based on DBD::Oracle's
- # See also http://www.ch-werner.de/sqliteodbc/html/sqliteodbc_8c.html#a117
-
- my @Where = ();
- my $Sql;
- if ( defined($CatVal) && $CatVal eq '%'
- && defined($SchVal) && $SchVal eq ''
- && defined($TblVal) && $TblVal eq '') { # Rule 19a
- $Sql = <<'SQL';
-SELECT NULL TABLE_CAT
- , NULL TABLE_SCHEM
- , NULL TABLE_NAME
- , NULL TABLE_TYPE
- , NULL REMARKS
-SQL
- }
- elsif ( defined($SchVal) && $SchVal eq '%'
- && defined($CatVal) && $CatVal eq ''
- && defined($TblVal) && $TblVal eq '') { # Rule 19b
- $Sql = <<'SQL';
-SELECT NULL TABLE_CAT
- , NULL TABLE_SCHEM
- , NULL TABLE_NAME
- , NULL TABLE_TYPE
- , NULL REMARKS
-SQL
- }
- elsif ( defined($TypVal) && $TypVal eq '%'
- && defined($CatVal) && $CatVal eq ''
- && defined($SchVal) && $SchVal eq ''
- && defined($TblVal) && $TblVal eq '') { # Rule 19c
- $Sql = <<'SQL';
-SELECT NULL TABLE_CAT
- , NULL TABLE_SCHEM
- , NULL TABLE_NAME
- , t.tt TABLE_TYPE
- , NULL REMARKS
-FROM (
- SELECT 'TABLE' tt UNION
- SELECT 'VIEW' tt UNION
- SELECT 'LOCAL TEMPORARY' tt
-) t
-ORDER BY TABLE_TYPE
-SQL
- }
- else {
- $Sql = <<'SQL';
-SELECT *
-FROM
-(
-SELECT NULL TABLE_CAT
- , NULL TABLE_SCHEM
- , tbl_name TABLE_NAME
- , TABLE_TYPE
- , NULL REMARKS
- , sql sqlite_sql
-FROM (
- SELECT tbl_name, upper(type) TABLE_TYPE, sql
- FROM sqlite_master
- WHERE type IN ( 'table','view')
-UNION ALL
- SELECT tbl_name, 'LOCAL TEMPORARY' TABLE_TYPE, sql
- FROM sqlite_temp_master
- WHERE type IN ( 'table','view')
-UNION ALL
- SELECT 'sqlite_master' tbl_name, 'SYSTEM TABLE' TABLE_TYPE, NULL sql
-UNION ALL
- SELECT 'sqlite_temp_master' tbl_name, 'SYSTEM TABLE' TABLE_TYPE, NULL sql
-)
-)
-SQL
- if ( defined $TblVal ) {
- push @Where, "TABLE_NAME LIKE '$TblVal'";
- }
- if ( defined $TypVal ) {
- my $table_type_list;
- $TypVal =~ s/^\s+//;
- $TypVal =~ s/\s+$//;
- my @ttype_list = split (/\s*,\s*/, $TypVal);
- foreach my $table_type (@ttype_list) {
- if ($table_type !~ /^'.*'$/) {
- $table_type = "'" . $table_type . "'";
- }
- $table_type_list = join(", ", @ttype_list);
- }
- push @Where, "TABLE_TYPE IN (\U$table_type_list)"
- if $table_type_list;
- }
- $Sql .= ' WHERE ' . join("\n AND ", @Where ) . "\n" if @Where;
- $Sql .= " ORDER BY TABLE_TYPE, TABLE_SCHEM, TABLE_NAME\n";
- }
- my $sth = $dbh->prepare($Sql) or return undef;
- $sth->execute or return undef;
- $sth;
-}
-
-
-sub primary_key_info {
- my($dbh, $catalog, $schema, $table) = @_;
-
- my @pk_info;
-
- my $sth_tables = $dbh->table_info($catalog, $schema, $table, '');
-
- # this is a hack but much simpler than using pragma index_list etc
- # also the pragma doesn't list 'INTEGER PRIMARK KEY' autoinc PKs!
- while ( my $row = $sth_tables->fetchrow_hashref ) {
- my $sql = $row->{sqlite_sql} or next;
- next unless $sql =~ /(.*?)\s*PRIMARY\s+KEY\s*(?:\(\s*(.*?)\s*\))?/si;
- my @pk = split /\s*,\s*/, $2 || '';
- unless (@pk) {
- my $prefix = $1;
- $prefix =~ s/.*create\s+table\s+.*?\(//i;
- $prefix = (split /\s*,\s*/, $prefix)[-1];
- @pk = (split /\s+/, $prefix)[0]; # take first word as name
- }
- #warn "GOT PK $row->{TABLE_NAME} (@pk)\n";
- my $key_seq = 0;
- for my $pk_field (@pk) {
- push @pk_info, {
- TABLE_SCHEM => $row->{TABLE_SCHEM},
- TABLE_NAME => $row->{TABLE_NAME},
- COLUMN_NAME => $pk_field,
- KEY_SEQ => ++$key_seq,
- PK_NAME => 'PRIMARY KEY',
- };
- }
- }
-
- my $sponge = DBI->connect("DBI:Sponge:", '','')
- or return $dbh->DBI::set_err($DBI::err, "DBI::Sponge: $DBI::errstr");
- my @names = qw(TABLE_CAT TABLE_SCHEM TABLE_NAME COLUMN_NAME KEY_SEQ PK_NAME);
- my $sth = $sponge->prepare("column_info $table", {
- rows => [ map { [ @{$_}{@names} ] } @pk_info ],
- NUM_OF_FIELDS => scalar @names,
- NAME => \@names,
- }) or return $dbh->DBI::set_err($sponge->err(), $sponge->errstr());
- return $sth;
-}
-
-sub type_info_all {
- my ($dbh) = @_;
-return; # XXX code just copied from DBD::Oracle, not yet thought about
- my $names = {
- TYPE_NAME => 0,
- DATA_TYPE => 1,
- COLUMN_SIZE => 2,
- LITERAL_PREFIX => 3,
- LITERAL_SUFFIX => 4,
- CREATE_PARAMS => 5,
- NULLABLE => 6,
- CASE_SENSITIVE => 7,
- SEARCHABLE => 8,
- UNSIGNED_ATTRIBUTE => 9,
- FIXED_PREC_SCALE =>10,
- AUTO_UNIQUE_VALUE =>11,
- LOCAL_TYPE_NAME =>12,
- MINIMUM_SCALE =>13,
- MAXIMUM_SCALE =>14,
- SQL_DATA_TYPE =>15,
- SQL_DATETIME_SUB=>16,
- NUM_PREC_RADIX =>17,
- };
- my $ti = [
- $names,
- [ 'CHAR', 1, 255, '\'', '\'', 'max length', 1, 1, 3,
- undef, '0', '0', undef, undef, undef, 1, undef, undef
- ],
- [ 'NUMBER', 3, 38, undef, undef, 'precision,scale', 1, '0', 3,
- '0', '0', '0', undef, '0', 38, 3, undef, 10
- ],
- [ 'DOUBLE', 8, 15, undef, undef, undef, 1, '0', 3,
- '0', '0', '0', undef, undef, undef, 8, undef, 10
- ],
- [ 'DATE', 9, 19, '\'', '\'', undef, 1, '0', 3,
- undef, '0', '0', undef, '0', '0', 11, undef, undef
- ],
- [ 'VARCHAR', 12, 1024*1024, '\'', '\'', 'max length', 1, 1, 3,
- undef, '0', '0', undef, undef, undef, 12, undef, undef
- ]
- ];
- return $ti;
-}
-
-
-1;
-__END__
-
-=head1 NAME
-
-DBD::SQLite2 - Self Contained RDBMS in a DBI Driver (sqlite 2.x)
-
-=head1 SYNOPSIS
-
- use DBI;
- my $dbh = DBI->connect("dbi:SQLite2:dbname=dbfile","","");
-
-=head1 DESCRIPTION
-
-SQLite is a public domain RDBMS database engine that you can find
-at http://www.hwaci.com/sw/sqlite/.
-
-Rather than ask you to install SQLite first, because SQLite is public
-domain, DBD::SQLite2 includes the entire thing in the distribution. So
-in order to get a fast transaction capable RDBMS working for your
-perl project you simply have to install this module, and B<nothing>
-else.
-
-SQLite supports the following features:
-
-=over 4
-
-=item Implements a large subset of SQL92
-
-See http://www.hwaci.com/sw/sqlite/lang.html for details.
-
-=item A complete DB in a single disk file
-
-Everything for your database is stored in a single disk file, making it
-easier to move things around than with DBD::CSV.
-
-=item Atomic commit and rollback
-
-Yes, DBD::SQLite2 is small and light, but it supports full transactions!
-
-=item Extensible
-
-User-defined aggregate or regular functions can be registered with the
-SQL parser.
-
-=back
-
-There's lots more to it, so please refer to the docs on the SQLite web
-page, listed above, for SQL details. Also refer to L<DBI> for details
-on how to use DBI itself.
-
-=head1 CONFORMANCE WITH DBI SPECIFICATION
-
-The API works like every DBI module does. Please see L<DBI> for more
-details about core features.
-
-Currently many statement attributes are not implemented or are
-limited by the typeless nature of the SQLite database.
-
-=head1 DRIVER PRIVATE ATTRIBUTES
-
-=head2 Database Handle Attributes
-
-=over 4
-
-=item sqlite_version
-
-Returns the version of the SQLite library which DBD::SQLite2 is using, e.g., "2.8.0".
-
-=item sqlite_encoding
-
-Returns either "UTF-8" or "iso8859" to indicate how the SQLite library was compiled.
-
-=item sqlite_handle_binary_nulls
-
-Set this attribute to 1 to transparently handle binary nulls in quoted
-and returned data.
-
-B<NOTE:> This will cause all backslash characters (C<\>) to be doubled
-up in all columns regardless of whether or not they contain binary
-data or not. This may break your database if you use it from another
-application. This does not use the built in sqlite_encode_binary
-and sqlite_decode_binary functions, which may be considered a bug.
-
-=back
-
-=head1 DRIVER PRIVATE METHODS
-
-=head2 $dbh->func('last_insert_rowid')
-
-This method returns the last inserted rowid. If you specify an INTEGER PRIMARY
-KEY as the first column in your table, that is the column that is returned.
-Otherwise, it is the hidden ROWID column. See the sqlite docs for details.
-
-=head2 $dbh->func( $name, $argc, $func_ref, "create_function" )
-
-This method will register a new function which will be useable in SQL
-query. The method's parameters are:
-
-=over
-
-=item $name
-
-The name of the function. This is the name of the function as it will
-be used from SQL.
-
-=item $argc
-
-The number of arguments taken by the function. If this number is -1,
-the function can take any number of arguments.
-
-=item $func_ref
-
-This should be a reference to the function's implementation.
-
-=back
-
-For example, here is how to define a now() function which returns the
-current number of seconds since the epoch:
-
- $dbh->func( 'now', 0, sub { return time }, 'create_function' );
-
-After this, it could be use from SQL as:
-
- INSERT INTO mytable ( now() );
-
-=head2 $dbh->func( $name, $argc, $pkg, 'create_aggregate' )
-
-This method will register a new aggregate function which can then used
-from SQL. The method's parameters are:
-
-=over
-
-=item $name
-
-The name of the aggregate function, this is the name under which the
-function will be available from SQL.
-
-=item $argc
-
-This is an integer which tells the SQL parser how many arguments the
-function takes. If that number is -1, the function can take any number
-of arguments.
-
-=item $pkg
-
-This is the package which implements the aggregator interface.
-
-=back
-
-The aggregator interface consists of defining three methods:
-
-=over
-
-=item new()
-
-This method will be called once to create an object which should
-be used to aggregate the rows in a particular group. The step() and
-finalize() methods will be called upon the reference return by
-the method.
-
-=item step(@_)
-
-This method will be called once for each rows in the aggregate.
-
-=item finalize()
-
-This method will be called once all rows in the aggregate were
-processed and it should return the aggregate function's result. When
-there is no rows in the aggregate, finalize() will be called right
-after new().
-
-=back
-
-Here is a simple aggregate function which returns the variance
-(example adapted from pysqlite):
-
- package variance;
-
- sub new { bless [], shift; }
-
- sub step {
- my ( $self, $value ) = @_;
-
- push @$self, $value;
- }
-
- sub finalize {
- my $self = $_[0];
-
- my $n = @$self;
-
- # Variance is NULL unless there is more than one row
- return undef unless $n || $n == 1;
-
- my $mu = 0;
- foreach my $v ( @$self ) {
- $mu += $v;
- }
- $mu /= $n;
-
- my $sigma = 0;
- foreach my $v ( @$self ) {
- $sigma += ($x - $mu)**2;
- }
- $sigma = $sigma / ($n - 1);
-
- return $sigma;
- }
-
- $dbh->func( "variance", 1, 'variance', "create_aggregate" );
-
-The aggregate function can then be used as:
-
- SELECT group_name, variance(score) FROM results
- GROUP BY group_name;
-
-=head1 NOTES
-
-To access the database from the command line, try using dbish which comes with
-the DBI module. Just type:
-
- dbish dbi:SQLite:foo.db
-
-On the command line to access the file F<foo.db>.
-
-Alternatively you can install SQLite from the link above without conflicting
-with DBD::SQLite2 and use the supplied C<sqlite> command line tool.
-
-=head1 PERFORMANCE
-
-SQLite is fast, very fast. I recently processed my 72MB log file with it,
-inserting the data (400,000+ rows) by using transactions and only committing
-every 1000 rows (otherwise the insertion is quite slow), and then performing
-queries on the data.
-
-Queries like count(*) and avg(bytes) took fractions of a second to return,
-but what surprised me most of all was:
-
- SELECT url, count(*) as count FROM access_log
- GROUP BY url
- ORDER BY count desc
- LIMIT 20
-
-To discover the top 20 hit URLs on the site (http://axkit.org), and it
-returned within 2 seconds. I'm seriously considering switching my log
-analysis code to use this little speed demon!
-
-Oh yeah, and that was with no indexes on the table, on a 400MHz PIII.
-
-For best performance be sure to tune your hdparm settings if you are
-using linux. Also you might want to set:
-
- PRAGMA default_synchronous = OFF
-
-Which will prevent sqlite from doing fsync's when writing (which
-slows down non-transactional writes significantly) at the expense of some
-peace of mind. Also try playing with the cache_size pragma.
-
-=head1 BUGS
-
-Likely to be many, please use http://rt.cpan.org/ for reporting bugs.
-
-=head1 AUTHOR
-
-Matt Sergeant, matt@sergeant.org
-
-Perl extension functions contributed by Francis J. Lacoste
-<flacoste@logreport.org> and Wolfgang Sourdeau
-<wolfgang@logreport.org>
-
-=head1 SEE ALSO
-
-L<DBI>.
-
-=cut
+++ /dev/null
-use strict;
-use LWP::Simple qw(getstore);
-use Fatal qw(chdir);
-use ExtUtils::Command;
-
-my $version = shift || die "Usage: getsqlite.pl <version>\n";
-
-print("downloading http://www.sqlite.org/sqlite-$version.tar.gz\n");
-if (getstore(
- "http://www.sqlite.org/sqlite-$version.tar.gz",
- "sqlite.tar.gz") != 200) {
- die "Failed to download";
-}
-print("done\n");
-
-rm_rf('sqlite');
-xsystem("tar zxvf sqlite.tar.gz");
-chdir("sqlite");
-xsystem("sh configure --enable-utf8");
-xsystem("make parse.c sqlite.h opcodes.h opcodes.c");
-
-my %skip = map { $_ => 1 } map { chomp; $_ } <DATA>;
-warn("Skip: $_\n") for keys %skip;
-
-foreach (<*.[ch]>, `find src -name \\*.[ch]`) {
- chomp;
- next if $skip{$_};
- xsystem("cp $_ ../");
-}
-
-exit(0);
-
-sub xsystem {
- local $, = ", ";
- print("@_\n");
- my $ret = system(@_);
- if ($ret != 0) {
- die "system(@_) failed: $?";
- }
-}
-
-__DATA__
-lempar.c
-src/threadtest.c
-src/test1.c
-src/test2.c
-src/test3.c
-src/tclsqlite.c
-src/shell.c
-src/lemon.c
-src/md5.c
-
+++ /dev/null
-.\" Automatically generated by Pod::Man 2.28 (Pod::Simple 3.29)
-.\"
-.\" Standard preamble:
-.\" ========================================================================
-.de Sp \" Vertical space (when we can't use .PP)
-.if t .sp .5v
-.if n .sp
-..
-.de Vb \" Begin verbatim text
-.ft CW
-.nf
-.ne \\$1
-..
-.de Ve \" End verbatim text
-.ft R
-.fi
-..
-.\" Set up some character translations and predefined strings. \*(-- will
-.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
-.\" double quote, and \*(R" will give a right double quote. \*(C+ will
-.\" give a nicer C++. Capital omega is used to do unbreakable dashes and
-.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff,
-.\" nothing in troff, for use with C<>.
-.tr \(*W-
-.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
-.ie n \{\
-. ds -- \(*W-
-. ds PI pi
-. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
-. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch
-. ds L" ""
-. ds R" ""
-. ds C` ""
-. ds C' ""
-'br\}
-.el\{\
-. ds -- \|\(em\|
-. ds PI \(*p
-. ds L" ``
-. ds R" ''
-. ds C`
-. ds C'
-'br\}
-.\"
-.\" Escape single quotes in literal strings from groff's Unicode transform.
-.ie \n(.g .ds Aq \(aq
-.el .ds Aq '
-.\"
-.\" If the F register is turned on, we'll generate index entries on stderr for
-.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
-.\" entries marked with X<> in POD. Of course, you'll have to process the
-.\" output yourself in some meaningful fashion.
-.\"
-.\" Avoid warning from groff about undefined register 'F'.
-.de IX
-..
-.nr rF 0
-.if \n(.g .if rF .nr rF 1
-.if (\n(rF:(\n(.g==0)) \{
-. if \nF \{
-. de IX
-. tm Index:\\$1\t\\n%\t"\\$2"
-..
-. if !\nF==2 \{
-. nr % 0
-. nr F 2
-. \}
-. \}
-.\}
-.rr rF
-.\" ========================================================================
-.\"
-.IX Title "DBD::SQLite2 3pm"
-.TH DBD::SQLite2 3pm "2004-09-10" "perl v5.22.1" "User Contributed Perl Documentation"
-.\" For nroff, turn off justification. Always turn off hyphenation; it makes
-.\" way too many mistakes in technical documents.
-.if n .ad l
-.nh
-.SH "NAME"
-DBD::SQLite2 \- Self Contained RDBMS in a DBI Driver (sqlite 2.x)
-.SH "SYNOPSIS"
-.IX Header "SYNOPSIS"
-.Vb 2
-\& use DBI;
-\& my $dbh = DBI\->connect("dbi:SQLite2:dbname=dbfile","","");
-.Ve
-.SH "DESCRIPTION"
-.IX Header "DESCRIPTION"
-SQLite is a public domain \s-1RDBMS\s0 database engine that you can find
-at http://www.hwaci.com/sw/sqlite/.
-.PP
-Rather than ask you to install SQLite first, because SQLite is public
-domain, DBD::SQLite2 includes the entire thing in the distribution. So
-in order to get a fast transaction capable \s-1RDBMS\s0 working for your
-perl project you simply have to install this module, and \fBnothing\fR
-else.
-.PP
-SQLite supports the following features:
-.IP "Implements a large subset of \s-1SQL92\s0" 4
-.IX Item "Implements a large subset of SQL92"
-See http://www.hwaci.com/sw/sqlite/lang.html for details.
-.IP "A complete \s-1DB\s0 in a single disk file" 4
-.IX Item "A complete DB in a single disk file"
-Everything for your database is stored in a single disk file, making it
-easier to move things around than with \s-1DBD::CSV.\s0
-.IP "Atomic commit and rollback" 4
-.IX Item "Atomic commit and rollback"
-Yes, DBD::SQLite2 is small and light, but it supports full transactions!
-.IP "Extensible" 4
-.IX Item "Extensible"
-User-defined aggregate or regular functions can be registered with the
-\&\s-1SQL\s0 parser.
-.PP
-There's lots more to it, so please refer to the docs on the SQLite web
-page, listed above, for \s-1SQL\s0 details. Also refer to \s-1DBI\s0 for details
-on how to use \s-1DBI\s0 itself.
-.SH "CONFORMANCE WITH DBI SPECIFICATION"
-.IX Header "CONFORMANCE WITH DBI SPECIFICATION"
-The \s-1API\s0 works like every \s-1DBI\s0 module does. Please see \s-1DBI\s0 for more
-details about core features.
-.PP
-Currently many statement attributes are not implemented or are
-limited by the typeless nature of the SQLite database.
-.SH "DRIVER PRIVATE ATTRIBUTES"
-.IX Header "DRIVER PRIVATE ATTRIBUTES"
-.SS "Database Handle Attributes"
-.IX Subsection "Database Handle Attributes"
-.IP "sqlite_version" 4
-.IX Item "sqlite_version"
-Returns the version of the SQLite library which DBD::SQLite2 is using, e.g., \*(L"2.8.0\*(R".
-.IP "sqlite_encoding" 4
-.IX Item "sqlite_encoding"
-Returns either \*(L"\s-1UTF\-8\*(R"\s0 or \*(L"iso8859\*(R" to indicate how the SQLite library was compiled.
-.IP "sqlite_handle_binary_nulls" 4
-.IX Item "sqlite_handle_binary_nulls"
-Set this attribute to 1 to transparently handle binary nulls in quoted
-and returned data.
-.Sp
-\&\fB\s-1NOTE:\s0\fR This will cause all backslash characters (\f(CW\*(C`\e\*(C'\fR) to be doubled
-up in all columns regardless of whether or not they contain binary
-data or not. This may break your database if you use it from another
-application. This does not use the built in sqlite_encode_binary
-and sqlite_decode_binary functions, which may be considered a bug.
-.SH "DRIVER PRIVATE METHODS"
-.IX Header "DRIVER PRIVATE METHODS"
-.ie n .SS "$dbh\->func('last_insert_rowid')"
-.el .SS "\f(CW$dbh\fP\->func('last_insert_rowid')"
-.IX Subsection "$dbh->func('last_insert_rowid')"
-This method returns the last inserted rowid. If you specify an \s-1INTEGER PRIMARY
-KEY\s0 as the first column in your table, that is the column that is returned.
-Otherwise, it is the hidden \s-1ROWID\s0 column. See the sqlite docs for details.
-.ie n .SS "$dbh\->func( $name, $argc, $func_ref, ""create_function"" )"
-.el .SS "\f(CW$dbh\fP\->func( \f(CW$name\fP, \f(CW$argc\fP, \f(CW$func_ref\fP, ``create_function'' )"
-.IX Subsection "$dbh->func( $name, $argc, $func_ref, create_function )"
-This method will register a new function which will be useable in \s-1SQL\s0
-query. The method's parameters are:
-.ie n .IP "$name" 4
-.el .IP "\f(CW$name\fR" 4
-.IX Item "$name"
-The name of the function. This is the name of the function as it will
-be used from \s-1SQL.\s0
-.ie n .IP "$argc" 4
-.el .IP "\f(CW$argc\fR" 4
-.IX Item "$argc"
-The number of arguments taken by the function. If this number is \-1,
-the function can take any number of arguments.
-.ie n .IP "$func_ref" 4
-.el .IP "\f(CW$func_ref\fR" 4
-.IX Item "$func_ref"
-This should be a reference to the function's implementation.
-.PP
-For example, here is how to define a \fInow()\fR function which returns the
-current number of seconds since the epoch:
-.PP
-.Vb 1
-\& $dbh\->func( \*(Aqnow\*(Aq, 0, sub { return time }, \*(Aqcreate_function\*(Aq );
-.Ve
-.PP
-After this, it could be use from \s-1SQL\s0 as:
-.PP
-.Vb 1
-\& INSERT INTO mytable ( now() );
-.Ve
-.ie n .SS "$dbh\->func( $name, $argc, $pkg, 'create_aggregate' )"
-.el .SS "\f(CW$dbh\fP\->func( \f(CW$name\fP, \f(CW$argc\fP, \f(CW$pkg\fP, 'create_aggregate' )"
-.IX Subsection "$dbh->func( $name, $argc, $pkg, 'create_aggregate' )"
-This method will register a new aggregate function which can then used
-from \s-1SQL.\s0 The method's parameters are:
-.ie n .IP "$name" 4
-.el .IP "\f(CW$name\fR" 4
-.IX Item "$name"
-The name of the aggregate function, this is the name under which the
-function will be available from \s-1SQL.\s0
-.ie n .IP "$argc" 4
-.el .IP "\f(CW$argc\fR" 4
-.IX Item "$argc"
-This is an integer which tells the \s-1SQL\s0 parser how many arguments the
-function takes. If that number is \-1, the function can take any number
-of arguments.
-.ie n .IP "$pkg" 4
-.el .IP "\f(CW$pkg\fR" 4
-.IX Item "$pkg"
-This is the package which implements the aggregator interface.
-.PP
-The aggregator interface consists of defining three methods:
-.IP "\fInew()\fR" 4
-.IX Item "new()"
-This method will be called once to create an object which should
-be used to aggregate the rows in a particular group. The \fIstep()\fR and
-\&\fIfinalize()\fR methods will be called upon the reference return by
-the method.
-.IP "step(@_)" 4
-.IX Item "step(@_)"
-This method will be called once for each rows in the aggregate.
-.IP "\fIfinalize()\fR" 4
-.IX Item "finalize()"
-This method will be called once all rows in the aggregate were
-processed and it should return the aggregate function's result. When
-there is no rows in the aggregate, \fIfinalize()\fR will be called right
-after \fInew()\fR.
-.PP
-Here is a simple aggregate function which returns the variance
-(example adapted from pysqlite):
-.PP
-.Vb 1
-\& package variance;
-\&
-\& sub new { bless [], shift; }
-\&
-\& sub step {
-\& my ( $self, $value ) = @_;
-\&
-\& push @$self, $value;
-\& }
-\&
-\& sub finalize {
-\& my $self = $_[0];
-\&
-\& my $n = @$self;
-\&
-\& # Variance is NULL unless there is more than one row
-\& return undef unless $n || $n == 1;
-\&
-\& my $mu = 0;
-\& foreach my $v ( @$self ) {
-\& $mu += $v;
-\& }
-\& $mu /= $n;
-\&
-\& my $sigma = 0;
-\& foreach my $v ( @$self ) {
-\& $sigma += ($x \- $mu)**2;
-\& }
-\& $sigma = $sigma / ($n \- 1);
-\&
-\& return $sigma;
-\& }
-\&
-\& $dbh\->func( "variance", 1, \*(Aqvariance\*(Aq, "create_aggregate" );
-.Ve
-.PP
-The aggregate function can then be used as:
-.PP
-.Vb 2
-\& SELECT group_name, variance(score) FROM results
-\& GROUP BY group_name;
-.Ve
-.SH "NOTES"
-.IX Header "NOTES"
-To access the database from the command line, try using dbish which comes with
-the \s-1DBI\s0 module. Just type:
-.PP
-.Vb 1
-\& dbish dbi:SQLite:foo.db
-.Ve
-.PP
-On the command line to access the file \fIfoo.db\fR.
-.PP
-Alternatively you can install SQLite from the link above without conflicting
-with DBD::SQLite2 and use the supplied \f(CW\*(C`sqlite\*(C'\fR command line tool.
-.SH "PERFORMANCE"
-.IX Header "PERFORMANCE"
-SQLite is fast, very fast. I recently processed my 72MB log file with it,
-inserting the data (400,000+ rows) by using transactions and only committing
-every 1000 rows (otherwise the insertion is quite slow), and then performing
-queries on the data.
-.PP
-Queries like count(*) and avg(bytes) took fractions of a second to return,
-but what surprised me most of all was:
-.PP
-.Vb 4
-\& SELECT url, count(*) as count FROM access_log
-\& GROUP BY url
-\& ORDER BY count desc
-\& LIMIT 20
-.Ve
-.PP
-To discover the top 20 hit URLs on the site (http://axkit.org), and it
-returned within 2 seconds. I'm seriously considering switching my log
-analysis code to use this little speed demon!
-.PP
-Oh yeah, and that was with no indexes on the table, on a 400MHz \s-1PIII.\s0
-.PP
-For best performance be sure to tune your hdparm settings if you are
-using linux. Also you might want to set:
-.PP
-.Vb 1
-\& PRAGMA default_synchronous = OFF
-.Ve
-.PP
-Which will prevent sqlite from doing fsync's when writing (which
-slows down non-transactional writes significantly) at the expense of some
-peace of mind. Also try playing with the cache_size pragma.
-.SH "BUGS"
-.IX Header "BUGS"
-Likely to be many, please use http://rt.cpan.org/ for reporting bugs.
-.SH "AUTHOR"
-.IX Header "AUTHOR"
-Matt Sergeant, matt@sergeant.org
-.PP
-Perl extension functions contributed by Francis J. Lacoste
-<flacoste@logreport.org> and Wolfgang Sourdeau
-<wolfgang@logreport.org>
-.SH "SEE ALSO"
-.IX Header "SEE ALSO"
-\&\s-1DBI\s0.
+++ /dev/null
-/*
-** 2001 September 15
-**
-** The author disclaims copyright to this source code. In place of
-** a legal notice, here is a blessing:
-**
-** May you do good and not evil.
-** May you find forgiveness for yourself and forgive others.
-** May you share freely, never taking more than you give.
-**
-*************************************************************************
-** $Id: btree.c,v 1.1.1.1 2004/08/08 15:03:57 matt Exp $
-**
-** This file implements a external (disk-based) database using BTrees.
-** For a detailed discussion of BTrees, refer to
-**
-** Donald E. Knuth, THE ART OF COMPUTER PROGRAMMING, Volume 3:
-** "Sorting And Searching", pages 473-480. Addison-Wesley
-** Publishing Company, Reading, Massachusetts.
-**
-** The basic idea is that each page of the file contains N database
-** entries and N+1 pointers to subpages.
-**
-** ----------------------------------------------------------------
-** | Ptr(0) | Key(0) | Ptr(1) | Key(1) | ... | Key(N) | Ptr(N+1) |
-** ----------------------------------------------------------------
-**
-** All of the keys on the page that Ptr(0) points to have values less
-** than Key(0). All of the keys on page Ptr(1) and its subpages have
-** values greater than Key(0) and less than Key(1). All of the keys
-** on Ptr(N+1) and its subpages have values greater than Key(N). And
-** so forth.
-**
-** Finding a particular key requires reading O(log(M)) pages from the
-** disk where M is the number of entries in the tree.
-**
-** In this implementation, a single file can hold one or more separate
-** BTrees. Each BTree is identified by the index of its root page. The
-** key and data for any entry are combined to form the "payload". Up to
-** MX_LOCAL_PAYLOAD bytes of payload can be carried directly on the
-** database page. If the payload is larger than MX_LOCAL_PAYLOAD bytes
-** then surplus bytes are stored on overflow pages. The payload for an
-** entry and the preceding pointer are combined to form a "Cell". Each
-** page has a small header which contains the Ptr(N+1) pointer.
-**
-** The first page of the file contains a magic string used to verify that
-** the file really is a valid BTree database, a pointer to a list of unused
-** pages in the file, and some meta information. The root of the first
-** BTree begins on page 2 of the file. (Pages are numbered beginning with
-** 1, not 0.) Thus a minimum database contains 2 pages.
-*/
-#include "sqliteInt.h"
-#include "pager.h"
-#include "btree.h"
-#include <assert.h>
-
-/* Forward declarations */
-static BtOps sqliteBtreeOps;
-static BtCursorOps sqliteBtreeCursorOps;
-
-/*
-** Macros used for byteswapping. B is a pointer to the Btree
-** structure. This is needed to access the Btree.needSwab boolean
-** in order to tell if byte swapping is needed or not.
-** X is an unsigned integer. SWAB16 byte swaps a 16-bit integer.
-** SWAB32 byteswaps a 32-bit integer.
-*/
-#define SWAB16(B,X) ((B)->needSwab? swab16((u16)X) : ((u16)X))
-#define SWAB32(B,X) ((B)->needSwab? swab32(X) : (X))
-#define SWAB_ADD(B,X,A) \
- if((B)->needSwab){ X=swab32(swab32(X)+A); }else{ X += (A); }
-
-/*
-** The following global variable - available only if SQLITE_TEST is
-** defined - is used to determine whether new databases are created in
-** native byte order or in non-native byte order. Non-native byte order
-** databases are created for testing purposes only. Under normal operation,
-** only native byte-order databases should be created, but we should be
-** able to read or write existing databases regardless of the byteorder.
-*/
-#ifdef SQLITE_TEST
-int btree_native_byte_order = 1;
-#else
-# define btree_native_byte_order 1
-#endif
-
-/*
-** Forward declarations of structures used only in this file.
-*/
-typedef struct PageOne PageOne;
-typedef struct MemPage MemPage;
-typedef struct PageHdr PageHdr;
-typedef struct Cell Cell;
-typedef struct CellHdr CellHdr;
-typedef struct FreeBlk FreeBlk;
-typedef struct OverflowPage OverflowPage;
-typedef struct FreelistInfo FreelistInfo;
-
-/*
-** All structures on a database page are aligned to 4-byte boundries.
-** This routine rounds up a number of bytes to the next multiple of 4.
-**
-** This might need to change for computer architectures that require
-** and 8-byte alignment boundry for structures.
-*/
-#define ROUNDUP(X) ((X+3) & ~3)
-
-/*
-** This is a magic string that appears at the beginning of every
-** SQLite database in order to identify the file as a real database.
-*/
-static const char zMagicHeader[] =
- "** This file contains an SQLite 2.1 database **";
-#define MAGIC_SIZE (sizeof(zMagicHeader))
-
-/*
-** This is a magic integer also used to test the integrity of the database
-** file. This integer is used in addition to the string above so that
-** if the file is written on a little-endian architecture and read
-** on a big-endian architectures (or vice versa) we can detect the
-** problem.
-**
-** The number used was obtained at random and has no special
-** significance other than the fact that it represents a different
-** integer on little-endian and big-endian machines.
-*/
-#define MAGIC 0xdae37528
-
-/*
-** The first page of the database file contains a magic header string
-** to identify the file as an SQLite database file. It also contains
-** a pointer to the first free page of the file. Page 2 contains the
-** root of the principle BTree. The file might contain other BTrees
-** rooted on pages above 2.
-**
-** The first page also contains SQLITE_N_BTREE_META integers that
-** can be used by higher-level routines.
-**
-** Remember that pages are numbered beginning with 1. (See pager.c
-** for additional information.) Page 0 does not exist and a page
-** number of 0 is used to mean "no such page".
-*/
-struct PageOne {
- char zMagic[MAGIC_SIZE]; /* String that identifies the file as a database */
- int iMagic; /* Integer to verify correct byte order */
- Pgno freeList; /* First free page in a list of all free pages */
- int nFree; /* Number of pages on the free list */
- int aMeta[SQLITE_N_BTREE_META-1]; /* User defined integers */
-};
-
-/*
-** Each database page has a header that is an instance of this
-** structure.
-**
-** PageHdr.firstFree is 0 if there is no free space on this page.
-** Otherwise, PageHdr.firstFree is the index in MemPage.u.aDisk[] of a
-** FreeBlk structure that describes the first block of free space.
-** All free space is defined by a linked list of FreeBlk structures.
-**
-** Data is stored in a linked list of Cell structures. PageHdr.firstCell
-** is the index into MemPage.u.aDisk[] of the first cell on the page. The
-** Cells are kept in sorted order.
-**
-** A Cell contains all information about a database entry and a pointer
-** to a child page that contains other entries less than itself. In
-** other words, the i-th Cell contains both Ptr(i) and Key(i). The
-** right-most pointer of the page is contained in PageHdr.rightChild.
-*/
-struct PageHdr {
- Pgno rightChild; /* Child page that comes after all cells on this page */
- u16 firstCell; /* Index in MemPage.u.aDisk[] of the first cell */
- u16 firstFree; /* Index in MemPage.u.aDisk[] of the first free block */
-};
-
-/*
-** Entries on a page of the database are called "Cells". Each Cell
-** has a header and data. This structure defines the header. The
-** key and data (collectively the "payload") follow this header on
-** the database page.
-**
-** A definition of the complete Cell structure is given below. The
-** header for the cell must be defined first in order to do some
-** of the sizing #defines that follow.
-*/
-struct CellHdr {
- Pgno leftChild; /* Child page that comes before this cell */
- u16 nKey; /* Number of bytes in the key */
- u16 iNext; /* Index in MemPage.u.aDisk[] of next cell in sorted order */
- u8 nKeyHi; /* Upper 8 bits of key size for keys larger than 64K bytes */
- u8 nDataHi; /* Upper 8 bits of data size when the size is more than 64K */
- u16 nData; /* Number of bytes of data */
-};
-
-/*
-** The key and data size are split into a lower 16-bit segment and an
-** upper 8-bit segment in order to pack them together into a smaller
-** space. The following macros reassembly a key or data size back
-** into an integer.
-*/
-#define NKEY(b,h) (SWAB16(b,h.nKey) + h.nKeyHi*65536)
-#define NDATA(b,h) (SWAB16(b,h.nData) + h.nDataHi*65536)
-
-/*
-** The minimum size of a complete Cell. The Cell must contain a header
-** and at least 4 bytes of payload.
-*/
-#define MIN_CELL_SIZE (sizeof(CellHdr)+4)
-
-/*
-** The maximum number of database entries that can be held in a single
-** page of the database.
-*/
-#define MX_CELL ((SQLITE_USABLE_SIZE-sizeof(PageHdr))/MIN_CELL_SIZE)
-
-/*
-** The amount of usable space on a single page of the BTree. This is the
-** page size minus the overhead of the page header.
-*/
-#define USABLE_SPACE (SQLITE_USABLE_SIZE - sizeof(PageHdr))
-
-/*
-** The maximum amount of payload (in bytes) that can be stored locally for
-** a database entry. If the entry contains more data than this, the
-** extra goes onto overflow pages.
-**
-** This number is chosen so that at least 4 cells will fit on every page.
-*/
-#define MX_LOCAL_PAYLOAD ((USABLE_SPACE/4-(sizeof(CellHdr)+sizeof(Pgno)))&~3)
-
-/*
-** Data on a database page is stored as a linked list of Cell structures.
-** Both the key and the data are stored in aPayload[]. The key always comes
-** first. The aPayload[] field grows as necessary to hold the key and data,
-** up to a maximum of MX_LOCAL_PAYLOAD bytes. If the size of the key and
-** data combined exceeds MX_LOCAL_PAYLOAD bytes, then Cell.ovfl is the
-** page number of the first overflow page.
-**
-** Though this structure is fixed in size, the Cell on the database
-** page varies in size. Every cell has a CellHdr and at least 4 bytes
-** of payload space. Additional payload bytes (up to the maximum of
-** MX_LOCAL_PAYLOAD) and the Cell.ovfl value are allocated only as
-** needed.
-*/
-struct Cell {
- CellHdr h; /* The cell header */
- char aPayload[MX_LOCAL_PAYLOAD]; /* Key and data */
- Pgno ovfl; /* The first overflow page */
-};
-
-/*
-** Free space on a page is remembered using a linked list of the FreeBlk
-** structures. Space on a database page is allocated in increments of
-** at least 4 bytes and is always aligned to a 4-byte boundry. The
-** linked list of FreeBlks is always kept in order by address.
-*/
-struct FreeBlk {
- u16 iSize; /* Number of bytes in this block of free space */
- u16 iNext; /* Index in MemPage.u.aDisk[] of the next free block */
-};
-
-/*
-** The number of bytes of payload that will fit on a single overflow page.
-*/
-#define OVERFLOW_SIZE (SQLITE_USABLE_SIZE-sizeof(Pgno))
-
-/*
-** When the key and data for a single entry in the BTree will not fit in
-** the MX_LOCAL_PAYLOAD bytes of space available on the database page,
-** then all extra bytes are written to a linked list of overflow pages.
-** Each overflow page is an instance of the following structure.
-**
-** Unused pages in the database are also represented by instances of
-** the OverflowPage structure. The PageOne.freeList field is the
-** page number of the first page in a linked list of unused database
-** pages.
-*/
-struct OverflowPage {
- Pgno iNext;
- char aPayload[OVERFLOW_SIZE];
-};
-
-/*
-** The PageOne.freeList field points to a linked list of overflow pages
-** hold information about free pages. The aPayload section of each
-** overflow page contains an instance of the following structure. The
-** aFree[] array holds the page number of nFree unused pages in the disk
-** file.
-*/
-struct FreelistInfo {
- int nFree;
- Pgno aFree[(OVERFLOW_SIZE-sizeof(int))/sizeof(Pgno)];
-};
-
-/*
-** For every page in the database file, an instance of the following structure
-** is stored in memory. The u.aDisk[] array contains the raw bits read from
-** the disk. The rest is auxiliary information held in memory only. The
-** auxiliary info is only valid for regular database pages - it is not
-** used for overflow pages and pages on the freelist.
-**
-** Of particular interest in the auxiliary info is the apCell[] entry. Each
-** apCell[] entry is a pointer to a Cell structure in u.aDisk[]. The cells are
-** put in this array so that they can be accessed in constant time, rather
-** than in linear time which would be needed if we had to walk the linked
-** list on every access.
-**
-** Note that apCell[] contains enough space to hold up to two more Cells
-** than can possibly fit on one page. In the steady state, every apCell[]
-** points to memory inside u.aDisk[]. But in the middle of an insert
-** operation, some apCell[] entries may temporarily point to data space
-** outside of u.aDisk[]. This is a transient situation that is quickly
-** resolved. But while it is happening, it is possible for a database
-** page to hold as many as two more cells than it might otherwise hold.
-** The extra two entries in apCell[] are an allowance for this situation.
-**
-** The pParent field points back to the parent page. This allows us to
-** walk up the BTree from any leaf to the root. Care must be taken to
-** unref() the parent page pointer when this page is no longer referenced.
-** The pageDestructor() routine handles that chore.
-*/
-struct MemPage {
- union u_page_data {
- char aDisk[SQLITE_PAGE_SIZE]; /* Page data stored on disk */
- PageHdr hdr; /* Overlay page header */
- } u;
- u8 isInit; /* True if auxiliary data is initialized */
- u8 idxShift; /* True if apCell[] indices have changed */
- u8 isOverfull; /* Some apCell[] points outside u.aDisk[] */
- MemPage *pParent; /* The parent of this page. NULL for root */
- int idxParent; /* Index in pParent->apCell[] of this node */
- int nFree; /* Number of free bytes in u.aDisk[] */
- int nCell; /* Number of entries on this page */
- Cell *apCell[MX_CELL+2]; /* All data entires in sorted order */
-};
-
-/*
-** The in-memory image of a disk page has the auxiliary information appended
-** to the end. EXTRA_SIZE is the number of bytes of space needed to hold
-** that extra information.
-*/
-#define EXTRA_SIZE (sizeof(MemPage)-sizeof(union u_page_data))
-
-/*
-** Everything we need to know about an open database
-*/
-struct Btree {
- BtOps *pOps; /* Function table */
- Pager *pPager; /* The page cache */
- BtCursor *pCursor; /* A list of all open cursors */
- PageOne *page1; /* First page of the database */
- u8 inTrans; /* True if a transaction is in progress */
- u8 inCkpt; /* True if there is a checkpoint on the transaction */
- u8 readOnly; /* True if the underlying file is readonly */
- u8 needSwab; /* Need to byte-swapping */
-};
-typedef Btree Bt;
-
-/*
-** A cursor is a pointer to a particular entry in the BTree.
-** The entry is identified by its MemPage and the index in
-** MemPage.apCell[] of the entry.
-*/
-struct BtCursor {
- BtCursorOps *pOps; /* Function table */
- Btree *pBt; /* The Btree to which this cursor belongs */
- BtCursor *pNext, *pPrev; /* Forms a linked list of all cursors */
- BtCursor *pShared; /* Loop of cursors with the same root page */
- Pgno pgnoRoot; /* The root page of this tree */
- MemPage *pPage; /* Page that contains the entry */
- int idx; /* Index of the entry in pPage->apCell[] */
- u8 wrFlag; /* True if writable */
- u8 eSkip; /* Determines if next step operation is a no-op */
- u8 iMatch; /* compare result from last sqliteBtreeMoveto() */
-};
-
-/*
-** Legal values for BtCursor.eSkip.
-*/
-#define SKIP_NONE 0 /* Always step the cursor */
-#define SKIP_NEXT 1 /* The next sqliteBtreeNext() is a no-op */
-#define SKIP_PREV 2 /* The next sqliteBtreePrevious() is a no-op */
-#define SKIP_INVALID 3 /* Calls to Next() and Previous() are invalid */
-
-/* Forward declarations */
-static int fileBtreeCloseCursor(BtCursor *pCur);
-
-/*
-** Routines for byte swapping.
-*/
-u16 swab16(u16 x){
- return ((x & 0xff)<<8) | ((x>>8)&0xff);
-}
-u32 swab32(u32 x){
- return ((x & 0xff)<<24) | ((x & 0xff00)<<8) |
- ((x>>8) & 0xff00) | ((x>>24)&0xff);
-}
-
-/*
-** Compute the total number of bytes that a Cell needs on the main
-** database page. The number returned includes the Cell header,
-** local payload storage, and the pointer to overflow pages (if
-** applicable). Additional space allocated on overflow pages
-** is NOT included in the value returned from this routine.
-*/
-static int cellSize(Btree *pBt, Cell *pCell){
- int n = NKEY(pBt, pCell->h) + NDATA(pBt, pCell->h);
- if( n>MX_LOCAL_PAYLOAD ){
- n = MX_LOCAL_PAYLOAD + sizeof(Pgno);
- }else{
- n = ROUNDUP(n);
- }
- n += sizeof(CellHdr);
- return n;
-}
-
-/*
-** Defragment the page given. All Cells are moved to the
-** beginning of the page and all free space is collected
-** into one big FreeBlk at the end of the page.
-*/
-static void defragmentPage(Btree *pBt, MemPage *pPage){
- int pc, i, n;
- FreeBlk *pFBlk;
- char newPage[SQLITE_USABLE_SIZE];
-
- assert( sqlitepager_iswriteable(pPage) );
- assert( pPage->isInit );
- pc = sizeof(PageHdr);
- pPage->u.hdr.firstCell = SWAB16(pBt, pc);
- memcpy(newPage, pPage->u.aDisk, pc);
- for(i=0; i<pPage->nCell; i++){
- Cell *pCell = pPage->apCell[i];
-
- /* This routine should never be called on an overfull page. The
- ** following asserts verify that constraint. */
- assert( Addr(pCell) > Addr(pPage) );
- assert( Addr(pCell) < Addr(pPage) + SQLITE_USABLE_SIZE );
-
- n = cellSize(pBt, pCell);
- pCell->h.iNext = SWAB16(pBt, pc + n);
- memcpy(&newPage[pc], pCell, n);
- pPage->apCell[i] = (Cell*)&pPage->u.aDisk[pc];
- pc += n;
- }
- assert( pPage->nFree==SQLITE_USABLE_SIZE-pc );
- memcpy(pPage->u.aDisk, newPage, pc);
- if( pPage->nCell>0 ){
- pPage->apCell[pPage->nCell-1]->h.iNext = 0;
- }
- pFBlk = (FreeBlk*)&pPage->u.aDisk[pc];
- pFBlk->iSize = SWAB16(pBt, SQLITE_USABLE_SIZE - pc);
- pFBlk->iNext = 0;
- pPage->u.hdr.firstFree = SWAB16(pBt, pc);
- memset(&pFBlk[1], 0, SQLITE_USABLE_SIZE - pc - sizeof(FreeBlk));
-}
-
-/*
-** Allocate nByte bytes of space on a page. nByte must be a
-** multiple of 4.
-**
-** Return the index into pPage->u.aDisk[] of the first byte of
-** the new allocation. Or return 0 if there is not enough free
-** space on the page to satisfy the allocation request.
-**
-** If the page contains nBytes of free space but does not contain
-** nBytes of contiguous free space, then this routine automatically
-** calls defragementPage() to consolidate all free space before
-** allocating the new chunk.
-*/
-static int allocateSpace(Btree *pBt, MemPage *pPage, int nByte){
- FreeBlk *p;
- u16 *pIdx;
- int start;
- int iSize;
-#ifndef NDEBUG
- int cnt = 0;
-#endif
-
- assert( sqlitepager_iswriteable(pPage) );
- assert( nByte==ROUNDUP(nByte) );
- assert( pPage->isInit );
- if( pPage->nFree<nByte || pPage->isOverfull ) return 0;
- pIdx = &pPage->u.hdr.firstFree;
- p = (FreeBlk*)&pPage->u.aDisk[SWAB16(pBt, *pIdx)];
- while( (iSize = SWAB16(pBt, p->iSize))<nByte ){
- assert( cnt++ < SQLITE_USABLE_SIZE/4 );
- if( p->iNext==0 ){
- defragmentPage(pBt, pPage);
- pIdx = &pPage->u.hdr.firstFree;
- }else{
- pIdx = &p->iNext;
- }
- p = (FreeBlk*)&pPage->u.aDisk[SWAB16(pBt, *pIdx)];
- }
- if( iSize==nByte ){
- start = SWAB16(pBt, *pIdx);
- *pIdx = p->iNext;
- }else{
- FreeBlk *pNew;
- start = SWAB16(pBt, *pIdx);
- pNew = (FreeBlk*)&pPage->u.aDisk[start + nByte];
- pNew->iNext = p->iNext;
- pNew->iSize = SWAB16(pBt, iSize - nByte);
- *pIdx = SWAB16(pBt, start + nByte);
- }
- pPage->nFree -= nByte;
- return start;
-}
-
-/*
-** Return a section of the MemPage.u.aDisk[] to the freelist.
-** The first byte of the new free block is pPage->u.aDisk[start]
-** and the size of the block is "size" bytes. Size must be
-** a multiple of 4.
-**
-** Most of the effort here is involved in coalesing adjacent
-** free blocks into a single big free block.
-*/
-static void freeSpace(Btree *pBt, MemPage *pPage, int start, int size){
- int end = start + size;
- u16 *pIdx, idx;
- FreeBlk *pFBlk;
- FreeBlk *pNew;
- FreeBlk *pNext;
- int iSize;
-
- assert( sqlitepager_iswriteable(pPage) );
- assert( size == ROUNDUP(size) );
- assert( start == ROUNDUP(start) );
- assert( pPage->isInit );
- pIdx = &pPage->u.hdr.firstFree;
- idx = SWAB16(pBt, *pIdx);
- while( idx!=0 && idx<start ){
- pFBlk = (FreeBlk*)&pPage->u.aDisk[idx];
- iSize = SWAB16(pBt, pFBlk->iSize);
- if( idx + iSize == start ){
- pFBlk->iSize = SWAB16(pBt, iSize + size);
- if( idx + iSize + size == SWAB16(pBt, pFBlk->iNext) ){
- pNext = (FreeBlk*)&pPage->u.aDisk[idx + iSize + size];
- if( pBt->needSwab ){
- pFBlk->iSize = swab16((u16)swab16(pNext->iSize)+iSize+size);
- }else{
- pFBlk->iSize += pNext->iSize;
- }
- pFBlk->iNext = pNext->iNext;
- }
- pPage->nFree += size;
- return;
- }
- pIdx = &pFBlk->iNext;
- idx = SWAB16(pBt, *pIdx);
- }
- pNew = (FreeBlk*)&pPage->u.aDisk[start];
- if( idx != end ){
- pNew->iSize = SWAB16(pBt, size);
- pNew->iNext = SWAB16(pBt, idx);
- }else{
- pNext = (FreeBlk*)&pPage->u.aDisk[idx];
- pNew->iSize = SWAB16(pBt, size + SWAB16(pBt, pNext->iSize));
- pNew->iNext = pNext->iNext;
- }
- *pIdx = SWAB16(pBt, start);
- pPage->nFree += size;
-}
-
-/*
-** Initialize the auxiliary information for a disk block.
-**
-** The pParent parameter must be a pointer to the MemPage which
-** is the parent of the page being initialized. The root of the
-** BTree (usually page 2) has no parent and so for that page,
-** pParent==NULL.
-**
-** Return SQLITE_OK on success. If we see that the page does
-** not contain a well-formed database page, then return
-** SQLITE_CORRUPT. Note that a return of SQLITE_OK does not
-** guarantee that the page is well-formed. It only shows that
-** we failed to detect any corruption.
-*/
-static int initPage(Bt *pBt, MemPage *pPage, Pgno pgnoThis, MemPage *pParent){
- int idx; /* An index into pPage->u.aDisk[] */
- Cell *pCell; /* A pointer to a Cell in pPage->u.aDisk[] */
- FreeBlk *pFBlk; /* A pointer to a free block in pPage->u.aDisk[] */
- int sz; /* The size of a Cell in bytes */
- int freeSpace; /* Amount of free space on the page */
-
- if( pPage->pParent ){
- assert( pPage->pParent==pParent );
- return SQLITE_OK;
- }
- if( pParent ){
- pPage->pParent = pParent;
- sqlitepager_ref(pParent);
- }
- if( pPage->isInit ) return SQLITE_OK;
- pPage->isInit = 1;
- pPage->nCell = 0;
- freeSpace = USABLE_SPACE;
- idx = SWAB16(pBt, pPage->u.hdr.firstCell);
- while( idx!=0 ){
- if( idx>SQLITE_USABLE_SIZE-MIN_CELL_SIZE ) goto page_format_error;
- if( idx<sizeof(PageHdr) ) goto page_format_error;
- if( idx!=ROUNDUP(idx) ) goto page_format_error;
- pCell = (Cell*)&pPage->u.aDisk[idx];
- sz = cellSize(pBt, pCell);
- if( idx+sz > SQLITE_USABLE_SIZE ) goto page_format_error;
- freeSpace -= sz;
- pPage->apCell[pPage->nCell++] = pCell;
- idx = SWAB16(pBt, pCell->h.iNext);
- }
- pPage->nFree = 0;
- idx = SWAB16(pBt, pPage->u.hdr.firstFree);
- while( idx!=0 ){
- int iNext;
- if( idx>SQLITE_USABLE_SIZE-sizeof(FreeBlk) ) goto page_format_error;
- if( idx<sizeof(PageHdr) ) goto page_format_error;
- pFBlk = (FreeBlk*)&pPage->u.aDisk[idx];
- pPage->nFree += SWAB16(pBt, pFBlk->iSize);
- iNext = SWAB16(pBt, pFBlk->iNext);
- if( iNext>0 && iNext <= idx ) goto page_format_error;
- idx = iNext;
- }
- if( pPage->nCell==0 && pPage->nFree==0 ){
- /* As a special case, an uninitialized root page appears to be
- ** an empty database */
- return SQLITE_OK;
- }
- if( pPage->nFree!=freeSpace ) goto page_format_error;
- return SQLITE_OK;
-
-page_format_error:
- return SQLITE_CORRUPT;
-}
-
-/*
-** Set up a raw page so that it looks like a database page holding
-** no entries.
-*/
-static void zeroPage(Btree *pBt, MemPage *pPage){
- PageHdr *pHdr;
- FreeBlk *pFBlk;
- assert( sqlitepager_iswriteable(pPage) );
- memset(pPage, 0, SQLITE_USABLE_SIZE);
- pHdr = &pPage->u.hdr;
- pHdr->firstCell = 0;
- pHdr->firstFree = SWAB16(pBt, sizeof(*pHdr));
- pFBlk = (FreeBlk*)&pHdr[1];
- pFBlk->iNext = 0;
- pPage->nFree = SQLITE_USABLE_SIZE - sizeof(*pHdr);
- pFBlk->iSize = SWAB16(pBt, pPage->nFree);
- pPage->nCell = 0;
- pPage->isOverfull = 0;
-}
-
-/*
-** This routine is called when the reference count for a page
-** reaches zero. We need to unref the pParent pointer when that
-** happens.
-*/
-static void pageDestructor(void *pData){
- MemPage *pPage = (MemPage*)pData;
- if( pPage->pParent ){
- MemPage *pParent = pPage->pParent;
- pPage->pParent = 0;
- sqlitepager_unref(pParent);
- }
-}
-
-/*
-** Open a new database.
-**
-** Actually, this routine just sets up the internal data structures
-** for accessing the database. We do not open the database file
-** until the first page is loaded.
-**
-** zFilename is the name of the database file. If zFilename is NULL
-** a new database with a random name is created. This randomly named
-** database file will be deleted when sqliteBtreeClose() is called.
-*/
-int sqliteBtreeOpen(
- const char *zFilename, /* Name of the file containing the BTree database */
- int omitJournal, /* if TRUE then do not journal this file */
- int nCache, /* How many pages in the page cache */
- Btree **ppBtree /* Pointer to new Btree object written here */
-){
- Btree *pBt;
- int rc;
-
- /*
- ** The following asserts make sure that structures used by the btree are
- ** the right size. This is to guard against size changes that result
- ** when compiling on a different architecture.
- */
- assert( sizeof(u32)==4 );
- assert( sizeof(u16)==2 );
- assert( sizeof(Pgno)==4 );
- assert( sizeof(PageHdr)==8 );
- assert( sizeof(CellHdr)==12 );
- assert( sizeof(FreeBlk)==4 );
- assert( sizeof(OverflowPage)==SQLITE_USABLE_SIZE );
- assert( sizeof(FreelistInfo)==OVERFLOW_SIZE );
- assert( sizeof(ptr)==sizeof(char*) );
- assert( sizeof(uptr)==sizeof(ptr) );
-
- pBt = sqliteMalloc( sizeof(*pBt) );
- if( pBt==0 ){
- *ppBtree = 0;
- return SQLITE_NOMEM;
- }
- if( nCache<10 ) nCache = 10;
- rc = sqlitepager_open(&pBt->pPager, zFilename, nCache, EXTRA_SIZE,
- !omitJournal);
- if( rc!=SQLITE_OK ){
- if( pBt->pPager ) sqlitepager_close(pBt->pPager);
- sqliteFree(pBt);
- *ppBtree = 0;
- return rc;
- }
- sqlitepager_set_destructor(pBt->pPager, pageDestructor);
- pBt->pCursor = 0;
- pBt->page1 = 0;
- pBt->readOnly = sqlitepager_isreadonly(pBt->pPager);
- pBt->pOps = &sqliteBtreeOps;
- *ppBtree = pBt;
- return SQLITE_OK;
-}
-
-/*
-** Close an open database and invalidate all cursors.
-*/
-static int fileBtreeClose(Btree *pBt){
- while( pBt->pCursor ){
- fileBtreeCloseCursor(pBt->pCursor);
- }
- sqlitepager_close(pBt->pPager);
- sqliteFree(pBt);
- return SQLITE_OK;
-}
-
-/*
-** Change the limit on the number of pages allowed in the cache.
-**
-** The maximum number of cache pages is set to the absolute
-** value of mxPage. If mxPage is negative, the pager will
-** operate asynchronously - it will not stop to do fsync()s
-** to insure data is written to the disk surface before
-** continuing. Transactions still work if synchronous is off,
-** and the database cannot be corrupted if this program
-** crashes. But if the operating system crashes or there is
-** an abrupt power failure when synchronous is off, the database
-** could be left in an inconsistent and unrecoverable state.
-** Synchronous is on by default so database corruption is not
-** normally a worry.
-*/
-static int fileBtreeSetCacheSize(Btree *pBt, int mxPage){
- sqlitepager_set_cachesize(pBt->pPager, mxPage);
- return SQLITE_OK;
-}
-
-/*
-** Change the way data is synced to disk in order to increase or decrease
-** how well the database resists damage due to OS crashes and power
-** failures. Level 1 is the same as asynchronous (no syncs() occur and
-** there is a high probability of damage) Level 2 is the default. There
-** is a very low but non-zero probability of damage. Level 3 reduces the
-** probability of damage to near zero but with a write performance reduction.
-*/
-static int fileBtreeSetSafetyLevel(Btree *pBt, int level){
- sqlitepager_set_safety_level(pBt->pPager, level);
- return SQLITE_OK;
-}
-
-/*
-** Get a reference to page1 of the database file. This will
-** also acquire a readlock on that file.
-**
-** SQLITE_OK is returned on success. If the file is not a
-** well-formed database file, then SQLITE_CORRUPT is returned.
-** SQLITE_BUSY is returned if the database is locked. SQLITE_NOMEM
-** is returned if we run out of memory. SQLITE_PROTOCOL is returned
-** if there is a locking protocol violation.
-*/
-static int lockBtree(Btree *pBt){
- int rc;
- if( pBt->page1 ) return SQLITE_OK;
- rc = sqlitepager_get(pBt->pPager, 1, (void**)&pBt->page1);
- if( rc!=SQLITE_OK ) return rc;
-
- /* Do some checking to help insure the file we opened really is
- ** a valid database file.
- */
- if( sqlitepager_pagecount(pBt->pPager)>0 ){
- PageOne *pP1 = pBt->page1;
- if( strcmp(pP1->zMagic,zMagicHeader)!=0 ||
- (pP1->iMagic!=MAGIC && swab32(pP1->iMagic)!=MAGIC) ){
- rc = SQLITE_NOTADB;
- goto page1_init_failed;
- }
- pBt->needSwab = pP1->iMagic!=MAGIC;
- }
- return rc;
-
-page1_init_failed:
- sqlitepager_unref(pBt->page1);
- pBt->page1 = 0;
- return rc;
-}
-
-/*
-** If there are no outstanding cursors and we are not in the middle
-** of a transaction but there is a read lock on the database, then
-** this routine unrefs the first page of the database file which
-** has the effect of releasing the read lock.
-**
-** If there are any outstanding cursors, this routine is a no-op.
-**
-** If there is a transaction in progress, this routine is a no-op.
-*/
-static void unlockBtreeIfUnused(Btree *pBt){
- if( pBt->inTrans==0 && pBt->pCursor==0 && pBt->page1!=0 ){
- sqlitepager_unref(pBt->page1);
- pBt->page1 = 0;
- pBt->inTrans = 0;
- pBt->inCkpt = 0;
- }
-}
-
-/*
-** Create a new database by initializing the first two pages of the
-** file.
-*/
-static int newDatabase(Btree *pBt){
- MemPage *pRoot;
- PageOne *pP1;
- int rc;
- if( sqlitepager_pagecount(pBt->pPager)>1 ) return SQLITE_OK;
- pP1 = pBt->page1;
- rc = sqlitepager_write(pBt->page1);
- if( rc ) return rc;
- rc = sqlitepager_get(pBt->pPager, 2, (void**)&pRoot);
- if( rc ) return rc;
- rc = sqlitepager_write(pRoot);
- if( rc ){
- sqlitepager_unref(pRoot);
- return rc;
- }
- strcpy(pP1->zMagic, zMagicHeader);
- if( btree_native_byte_order ){
- pP1->iMagic = MAGIC;
- pBt->needSwab = 0;
- }else{
- pP1->iMagic = swab32(MAGIC);
- pBt->needSwab = 1;
- }
- zeroPage(pBt, pRoot);
- sqlitepager_unref(pRoot);
- return SQLITE_OK;
-}
-
-/*
-** Attempt to start a new transaction.
-**
-** A transaction must be started before attempting any changes
-** to the database. None of the following routines will work
-** unless a transaction is started first:
-**
-** sqliteBtreeCreateTable()
-** sqliteBtreeCreateIndex()
-** sqliteBtreeClearTable()
-** sqliteBtreeDropTable()
-** sqliteBtreeInsert()
-** sqliteBtreeDelete()
-** sqliteBtreeUpdateMeta()
-*/
-static int fileBtreeBeginTrans(Btree *pBt){
- int rc;
- if( pBt->inTrans ) return SQLITE_ERROR;
- if( pBt->readOnly ) return SQLITE_READONLY;
- if( pBt->page1==0 ){
- rc = lockBtree(pBt);
- if( rc!=SQLITE_OK ){
- return rc;
- }
- }
- rc = sqlitepager_begin(pBt->page1);
- if( rc==SQLITE_OK ){
- rc = newDatabase(pBt);
- }
- if( rc==SQLITE_OK ){
- pBt->inTrans = 1;
- pBt->inCkpt = 0;
- }else{
- unlockBtreeIfUnused(pBt);
- }
- return rc;
-}
-
-/*
-** Commit the transaction currently in progress.
-**
-** This will release the write lock on the database file. If there
-** are no active cursors, it also releases the read lock.
-*/
-static int fileBtreeCommit(Btree *pBt){
- int rc;
- rc = pBt->readOnly ? SQLITE_OK : sqlitepager_commit(pBt->pPager);
- pBt->inTrans = 0;
- pBt->inCkpt = 0;
- unlockBtreeIfUnused(pBt);
- return rc;
-}
-
-/*
-** Rollback the transaction in progress. All cursors will be
-** invalided by this operation. Any attempt to use a cursor
-** that was open at the beginning of this operation will result
-** in an error.
-**
-** This will release the write lock on the database file. If there
-** are no active cursors, it also releases the read lock.
-*/
-static int fileBtreeRollback(Btree *pBt){
- int rc;
- BtCursor *pCur;
- if( pBt->inTrans==0 ) return SQLITE_OK;
- pBt->inTrans = 0;
- pBt->inCkpt = 0;
- rc = pBt->readOnly ? SQLITE_OK : sqlitepager_rollback(pBt->pPager);
- for(pCur=pBt->pCursor; pCur; pCur=pCur->pNext){
- if( pCur->pPage && pCur->pPage->isInit==0 ){
- sqlitepager_unref(pCur->pPage);
- pCur->pPage = 0;
- }
- }
- unlockBtreeIfUnused(pBt);
- return rc;
-}
-
-/*
-** Set the checkpoint for the current transaction. The checkpoint serves
-** as a sub-transaction that can be rolled back independently of the
-** main transaction. You must start a transaction before starting a
-** checkpoint. The checkpoint is ended automatically if the transaction
-** commits or rolls back.
-**
-** Only one checkpoint may be active at a time. It is an error to try
-** to start a new checkpoint if another checkpoint is already active.
-*/
-static int fileBtreeBeginCkpt(Btree *pBt){
- int rc;
- if( !pBt->inTrans || pBt->inCkpt ){
- return pBt->readOnly ? SQLITE_READONLY : SQLITE_ERROR;
- }
- rc = pBt->readOnly ? SQLITE_OK : sqlitepager_ckpt_begin(pBt->pPager);
- pBt->inCkpt = 1;
- return rc;
-}
-
-
-/*
-** Commit a checkpoint to transaction currently in progress. If no
-** checkpoint is active, this is a no-op.
-*/
-static int fileBtreeCommitCkpt(Btree *pBt){
- int rc;
- if( pBt->inCkpt && !pBt->readOnly ){
- rc = sqlitepager_ckpt_commit(pBt->pPager);
- }else{
- rc = SQLITE_OK;
- }
- pBt->inCkpt = 0;
- return rc;
-}
-
-/*
-** Rollback the checkpoint to the current transaction. If there
-** is no active checkpoint or transaction, this routine is a no-op.
-**
-** All cursors will be invalided by this operation. Any attempt
-** to use a cursor that was open at the beginning of this operation
-** will result in an error.
-*/
-static int fileBtreeRollbackCkpt(Btree *pBt){
- int rc;
- BtCursor *pCur;
- if( pBt->inCkpt==0 || pBt->readOnly ) return SQLITE_OK;
- rc = sqlitepager_ckpt_rollback(pBt->pPager);
- for(pCur=pBt->pCursor; pCur; pCur=pCur->pNext){
- if( pCur->pPage && pCur->pPage->isInit==0 ){
- sqlitepager_unref(pCur->pPage);
- pCur->pPage = 0;
- }
- }
- pBt->inCkpt = 0;
- return rc;
-}
-
-/*
-** Create a new cursor for the BTree whose root is on the page
-** iTable. The act of acquiring a cursor gets a read lock on
-** the database file.
-**
-** If wrFlag==0, then the cursor can only be used for reading.
-** If wrFlag==1, then the cursor can be used for reading or for
-** writing if other conditions for writing are also met. These
-** are the conditions that must be met in order for writing to
-** be allowed:
-**
-** 1: The cursor must have been opened with wrFlag==1
-**
-** 2: No other cursors may be open with wrFlag==0 on the same table
-**
-** 3: The database must be writable (not on read-only media)
-**
-** 4: There must be an active transaction.
-**
-** Condition 2 warrants further discussion. If any cursor is opened
-** on a table with wrFlag==0, that prevents all other cursors from
-** writing to that table. This is a kind of "read-lock". When a cursor
-** is opened with wrFlag==0 it is guaranteed that the table will not
-** change as long as the cursor is open. This allows the cursor to
-** do a sequential scan of the table without having to worry about
-** entries being inserted or deleted during the scan. Cursors should
-** be opened with wrFlag==0 only if this read-lock property is needed.
-** That is to say, cursors should be opened with wrFlag==0 only if they
-** intend to use the sqliteBtreeNext() system call. All other cursors
-** should be opened with wrFlag==1 even if they never really intend
-** to write.
-**
-** No checking is done to make sure that page iTable really is the
-** root page of a b-tree. If it is not, then the cursor acquired
-** will not work correctly.
-*/
-static
-int fileBtreeCursor(Btree *pBt, int iTable, int wrFlag, BtCursor **ppCur){
- int rc;
- BtCursor *pCur, *pRing;
-
- if( pBt->readOnly && wrFlag ){
- *ppCur = 0;
- return SQLITE_READONLY;
- }
- if( pBt->page1==0 ){
- rc = lockBtree(pBt);
- if( rc!=SQLITE_OK ){
- *ppCur = 0;
- return rc;
- }
- }
- pCur = sqliteMalloc( sizeof(*pCur) );
- if( pCur==0 ){
- rc = SQLITE_NOMEM;
- goto create_cursor_exception;
- }
- pCur->pgnoRoot = (Pgno)iTable;
- rc = sqlitepager_get(pBt->pPager, pCur->pgnoRoot, (void**)&pCur->pPage);
- if( rc!=SQLITE_OK ){
- goto create_cursor_exception;
- }
- rc = initPage(pBt, pCur->pPage, pCur->pgnoRoot, 0);
- if( rc!=SQLITE_OK ){
- goto create_cursor_exception;
- }
- pCur->pOps = &sqliteBtreeCursorOps;
- pCur->pBt = pBt;
- pCur->wrFlag = wrFlag;
- pCur->idx = 0;
- pCur->eSkip = SKIP_INVALID;
- pCur->pNext = pBt->pCursor;
- if( pCur->pNext ){
- pCur->pNext->pPrev = pCur;
- }
- pCur->pPrev = 0;
- pRing = pBt->pCursor;
- while( pRing && pRing->pgnoRoot!=pCur->pgnoRoot ){ pRing = pRing->pNext; }
- if( pRing ){
- pCur->pShared = pRing->pShared;
- pRing->pShared = pCur;
- }else{
- pCur->pShared = pCur;
- }
- pBt->pCursor = pCur;
- *ppCur = pCur;
- return SQLITE_OK;
-
-create_cursor_exception:
- *ppCur = 0;
- if( pCur ){
- if( pCur->pPage ) sqlitepager_unref(pCur->pPage);
- sqliteFree(pCur);
- }
- unlockBtreeIfUnused(pBt);
- return rc;
-}
-
-/*
-** Close a cursor. The read lock on the database file is released
-** when the last cursor is closed.
-*/
-static int fileBtreeCloseCursor(BtCursor *pCur){
- Btree *pBt = pCur->pBt;
- if( pCur->pPrev ){
- pCur->pPrev->pNext = pCur->pNext;
- }else{
- pBt->pCursor = pCur->pNext;
- }
- if( pCur->pNext ){
- pCur->pNext->pPrev = pCur->pPrev;
- }
- if( pCur->pPage ){
- sqlitepager_unref(pCur->pPage);
- }
- if( pCur->pShared!=pCur ){
- BtCursor *pRing = pCur->pShared;
- while( pRing->pShared!=pCur ){ pRing = pRing->pShared; }
- pRing->pShared = pCur->pShared;
- }
- unlockBtreeIfUnused(pBt);
- sqliteFree(pCur);
- return SQLITE_OK;
-}
-
-/*
-** Make a temporary cursor by filling in the fields of pTempCur.
-** The temporary cursor is not on the cursor list for the Btree.
-*/
-static void getTempCursor(BtCursor *pCur, BtCursor *pTempCur){
- memcpy(pTempCur, pCur, sizeof(*pCur));
- pTempCur->pNext = 0;
- pTempCur->pPrev = 0;
- if( pTempCur->pPage ){
- sqlitepager_ref(pTempCur->pPage);
- }
-}
-
-/*
-** Delete a temporary cursor such as was made by the CreateTemporaryCursor()
-** function above.
-*/
-static void releaseTempCursor(BtCursor *pCur){
- if( pCur->pPage ){
- sqlitepager_unref(pCur->pPage);
- }
-}
-
-/*
-** Set *pSize to the number of bytes of key in the entry the
-** cursor currently points to. Always return SQLITE_OK.
-** Failure is not possible. If the cursor is not currently
-** pointing to an entry (which can happen, for example, if
-** the database is empty) then *pSize is set to 0.
-*/
-static int fileBtreeKeySize(BtCursor *pCur, int *pSize){
- Cell *pCell;
- MemPage *pPage;
-
- pPage = pCur->pPage;
- assert( pPage!=0 );
- if( pCur->idx >= pPage->nCell ){
- *pSize = 0;
- }else{
- pCell = pPage->apCell[pCur->idx];
- *pSize = NKEY(pCur->pBt, pCell->h);
- }
- return SQLITE_OK;
-}
-
-/*
-** Read payload information from the entry that the pCur cursor is
-** pointing to. Begin reading the payload at "offset" and read
-** a total of "amt" bytes. Put the result in zBuf.
-**
-** This routine does not make a distinction between key and data.
-** It just reads bytes from the payload area.
-*/
-static int getPayload(BtCursor *pCur, int offset, int amt, char *zBuf){
- char *aPayload;
- Pgno nextPage;
- int rc;
- Btree *pBt = pCur->pBt;
- assert( pCur!=0 && pCur->pPage!=0 );
- assert( pCur->idx>=0 && pCur->idx<pCur->pPage->nCell );
- aPayload = pCur->pPage->apCell[pCur->idx]->aPayload;
- if( offset<MX_LOCAL_PAYLOAD ){
- int a = amt;
- if( a+offset>MX_LOCAL_PAYLOAD ){
- a = MX_LOCAL_PAYLOAD - offset;
- }
- memcpy(zBuf, &aPayload[offset], a);
- if( a==amt ){
- return SQLITE_OK;
- }
- offset = 0;
- zBuf += a;
- amt -= a;
- }else{
- offset -= MX_LOCAL_PAYLOAD;
- }
- if( amt>0 ){
- nextPage = SWAB32(pBt, pCur->pPage->apCell[pCur->idx]->ovfl);
- }
- while( amt>0 && nextPage ){
- OverflowPage *pOvfl;
- rc = sqlitepager_get(pBt->pPager, nextPage, (void**)&pOvfl);
- if( rc!=0 ){
- return rc;
- }
- nextPage = SWAB32(pBt, pOvfl->iNext);
- if( offset<OVERFLOW_SIZE ){
- int a = amt;
- if( a + offset > OVERFLOW_SIZE ){
- a = OVERFLOW_SIZE - offset;
- }
- memcpy(zBuf, &pOvfl->aPayload[offset], a);
- offset = 0;
- amt -= a;
- zBuf += a;
- }else{
- offset -= OVERFLOW_SIZE;
- }
- sqlitepager_unref(pOvfl);
- }
- if( amt>0 ){
- return SQLITE_CORRUPT;
- }
- return SQLITE_OK;
-}
-
-/*
-** Read part of the key associated with cursor pCur. A maximum
-** of "amt" bytes will be transfered into zBuf[]. The transfer
-** begins at "offset". The number of bytes actually read is
-** returned.
-**
-** Change: It used to be that the amount returned will be smaller
-** than the amount requested if there are not enough bytes in the key
-** to satisfy the request. But now, it must be the case that there
-** is enough data available to satisfy the request. If not, an exception
-** is raised. The change was made in an effort to boost performance
-** by eliminating unneeded tests.
-*/
-static int fileBtreeKey(BtCursor *pCur, int offset, int amt, char *zBuf){
- MemPage *pPage;
-
- assert( amt>=0 );
- assert( offset>=0 );
- assert( pCur->pPage!=0 );
- pPage = pCur->pPage;
- if( pCur->idx >= pPage->nCell ){
- return 0;
- }
- assert( amt+offset <= NKEY(pCur->pBt, pPage->apCell[pCur->idx]->h) );
- getPayload(pCur, offset, amt, zBuf);
- return amt;
-}
-
-/*
-** Set *pSize to the number of bytes of data in the entry the
-** cursor currently points to. Always return SQLITE_OK.
-** Failure is not possible. If the cursor is not currently
-** pointing to an entry (which can happen, for example, if
-** the database is empty) then *pSize is set to 0.
-*/
-static int fileBtreeDataSize(BtCursor *pCur, int *pSize){
- Cell *pCell;
- MemPage *pPage;
-
- pPage = pCur->pPage;
- assert( pPage!=0 );
- if( pCur->idx >= pPage->nCell ){
- *pSize = 0;
- }else{
- pCell = pPage->apCell[pCur->idx];
- *pSize = NDATA(pCur->pBt, pCell->h);
- }
- return SQLITE_OK;
-}
-
-/*
-** Read part of the data associated with cursor pCur. A maximum
-** of "amt" bytes will be transfered into zBuf[]. The transfer
-** begins at "offset". The number of bytes actually read is
-** returned. The amount returned will be smaller than the
-** amount requested if there are not enough bytes in the data
-** to satisfy the request.
-*/
-static int fileBtreeData(BtCursor *pCur, int offset, int amt, char *zBuf){
- Cell *pCell;
- MemPage *pPage;
-
- assert( amt>=0 );
- assert( offset>=0 );
- assert( pCur->pPage!=0 );
- pPage = pCur->pPage;
- if( pCur->idx >= pPage->nCell ){
- return 0;
- }
- pCell = pPage->apCell[pCur->idx];
- assert( amt+offset <= NDATA(pCur->pBt, pCell->h) );
- getPayload(pCur, offset + NKEY(pCur->pBt, pCell->h), amt, zBuf);
- return amt;
-}
-
-/*
-** Compare an external key against the key on the entry that pCur points to.
-**
-** The external key is pKey and is nKey bytes long. The last nIgnore bytes
-** of the key associated with pCur are ignored, as if they do not exist.
-** (The normal case is for nIgnore to be zero in which case the entire
-** internal key is used in the comparison.)
-**
-** The comparison result is written to *pRes as follows:
-**
-** *pRes<0 This means pCur<pKey
-**
-** *pRes==0 This means pCur==pKey for all nKey bytes
-**
-** *pRes>0 This means pCur>pKey
-**
-** When one key is an exact prefix of the other, the shorter key is
-** considered less than the longer one. In order to be equal the
-** keys must be exactly the same length. (The length of the pCur key
-** is the actual key length minus nIgnore bytes.)
-*/
-static int fileBtreeKeyCompare(
- BtCursor *pCur, /* Pointer to entry to compare against */
- const void *pKey, /* Key to compare against entry that pCur points to */
- int nKey, /* Number of bytes in pKey */
- int nIgnore, /* Ignore this many bytes at the end of pCur */
- int *pResult /* Write the result here */
-){
- Pgno nextPage;
- int n, c, rc, nLocal;
- Cell *pCell;
- Btree *pBt = pCur->pBt;
- const char *zKey = (const char*)pKey;
-
- assert( pCur->pPage );
- assert( pCur->idx>=0 && pCur->idx<pCur->pPage->nCell );
- pCell = pCur->pPage->apCell[pCur->idx];
- nLocal = NKEY(pBt, pCell->h) - nIgnore;
- if( nLocal<0 ) nLocal = 0;
- n = nKey<nLocal ? nKey : nLocal;
- if( n>MX_LOCAL_PAYLOAD ){
- n = MX_LOCAL_PAYLOAD;
- }
- c = memcmp(pCell->aPayload, zKey, n);
- if( c!=0 ){
- *pResult = c;
- return SQLITE_OK;
- }
- zKey += n;
- nKey -= n;
- nLocal -= n;
- nextPage = SWAB32(pBt, pCell->ovfl);
- while( nKey>0 && nLocal>0 ){
- OverflowPage *pOvfl;
- if( nextPage==0 ){
- return SQLITE_CORRUPT;
- }
- rc = sqlitepager_get(pBt->pPager, nextPage, (void**)&pOvfl);
- if( rc ){
- return rc;
- }
- nextPage = SWAB32(pBt, pOvfl->iNext);
- n = nKey<nLocal ? nKey : nLocal;
- if( n>OVERFLOW_SIZE ){
- n = OVERFLOW_SIZE;
- }
- c = memcmp(pOvfl->aPayload, zKey, n);
- sqlitepager_unref(pOvfl);
- if( c!=0 ){
- *pResult = c;
- return SQLITE_OK;
- }
- nKey -= n;
- nLocal -= n;
- zKey += n;
- }
- if( c==0 ){
- c = nLocal - nKey;
- }
- *pResult = c;
- return SQLITE_OK;
-}
-
-/*
-** Move the cursor down to a new child page. The newPgno argument is the
-** page number of the child page in the byte order of the disk image.
-*/
-static int moveToChild(BtCursor *pCur, int newPgno){
- int rc;
- MemPage *pNewPage;
- Btree *pBt = pCur->pBt;
-
- newPgno = SWAB32(pBt, newPgno);
- rc = sqlitepager_get(pBt->pPager, newPgno, (void**)&pNewPage);
- if( rc ) return rc;
- rc = initPage(pBt, pNewPage, newPgno, pCur->pPage);
- if( rc ) return rc;
- assert( pCur->idx>=pCur->pPage->nCell
- || pCur->pPage->apCell[pCur->idx]->h.leftChild==SWAB32(pBt,newPgno) );
- assert( pCur->idx<pCur->pPage->nCell
- || pCur->pPage->u.hdr.rightChild==SWAB32(pBt,newPgno) );
- pNewPage->idxParent = pCur->idx;
- pCur->pPage->idxShift = 0;
- sqlitepager_unref(pCur->pPage);
- pCur->pPage = pNewPage;
- pCur->idx = 0;
- if( pNewPage->nCell<1 ){
- return SQLITE_CORRUPT;
- }
- return SQLITE_OK;
-}
-
-/*
-** Move the cursor up to the parent page.
-**
-** pCur->idx is set to the cell index that contains the pointer
-** to the page we are coming from. If we are coming from the
-** right-most child page then pCur->idx is set to one more than
-** the largest cell index.
-*/
-static void moveToParent(BtCursor *pCur){
- Pgno oldPgno;
- MemPage *pParent;
- MemPage *pPage;
- int idxParent;
- pPage = pCur->pPage;
- assert( pPage!=0 );
- pParent = pPage->pParent;
- assert( pParent!=0 );
- idxParent = pPage->idxParent;
- sqlitepager_ref(pParent);
- sqlitepager_unref(pPage);
- pCur->pPage = pParent;
- assert( pParent->idxShift==0 );
- if( pParent->idxShift==0 ){
- pCur->idx = idxParent;
-#ifndef NDEBUG
- /* Verify that pCur->idx is the correct index to point back to the child
- ** page we just came from
- */
- oldPgno = SWAB32(pCur->pBt, sqlitepager_pagenumber(pPage));
- if( pCur->idx<pParent->nCell ){
- assert( pParent->apCell[idxParent]->h.leftChild==oldPgno );
- }else{
- assert( pParent->u.hdr.rightChild==oldPgno );
- }
-#endif
- }else{
- /* The MemPage.idxShift flag indicates that cell indices might have
- ** changed since idxParent was set and hence idxParent might be out
- ** of date. So recompute the parent cell index by scanning all cells
- ** and locating the one that points to the child we just came from.
- */
- int i;
- pCur->idx = pParent->nCell;
- oldPgno = SWAB32(pCur->pBt, sqlitepager_pagenumber(pPage));
- for(i=0; i<pParent->nCell; i++){
- if( pParent->apCell[i]->h.leftChild==oldPgno ){
- pCur->idx = i;
- break;
- }
- }
- }
-}
-
-/*
-** Move the cursor to the root page
-*/
-static int moveToRoot(BtCursor *pCur){
- MemPage *pNew;
- int rc;
- Btree *pBt = pCur->pBt;
-
- rc = sqlitepager_get(pBt->pPager, pCur->pgnoRoot, (void**)&pNew);
- if( rc ) return rc;
- rc = initPage(pBt, pNew, pCur->pgnoRoot, 0);
- if( rc ) return rc;
- sqlitepager_unref(pCur->pPage);
- pCur->pPage = pNew;
- pCur->idx = 0;
- return SQLITE_OK;
-}
-
-/*
-** Move the cursor down to the left-most leaf entry beneath the
-** entry to which it is currently pointing.
-*/
-static int moveToLeftmost(BtCursor *pCur){
- Pgno pgno;
- int rc;
-
- while( (pgno = pCur->pPage->apCell[pCur->idx]->h.leftChild)!=0 ){
- rc = moveToChild(pCur, pgno);
- if( rc ) return rc;
- }
- return SQLITE_OK;
-}
-
-/*
-** Move the cursor down to the right-most leaf entry beneath the
-** page to which it is currently pointing. Notice the difference
-** between moveToLeftmost() and moveToRightmost(). moveToLeftmost()
-** finds the left-most entry beneath the *entry* whereas moveToRightmost()
-** finds the right-most entry beneath the *page*.
-*/
-static int moveToRightmost(BtCursor *pCur){
- Pgno pgno;
- int rc;
-
- while( (pgno = pCur->pPage->u.hdr.rightChild)!=0 ){
- pCur->idx = pCur->pPage->nCell;
- rc = moveToChild(pCur, pgno);
- if( rc ) return rc;
- }
- pCur->idx = pCur->pPage->nCell - 1;
- return SQLITE_OK;
-}
-
-/* Move the cursor to the first entry in the table. Return SQLITE_OK
-** on success. Set *pRes to 0 if the cursor actually points to something
-** or set *pRes to 1 if the table is empty.
-*/
-static int fileBtreeFirst(BtCursor *pCur, int *pRes){
- int rc;
- if( pCur->pPage==0 ) return SQLITE_ABORT;
- rc = moveToRoot(pCur);
- if( rc ) return rc;
- if( pCur->pPage->nCell==0 ){
- *pRes = 1;
- return SQLITE_OK;
- }
- *pRes = 0;
- rc = moveToLeftmost(pCur);
- pCur->eSkip = SKIP_NONE;
- return rc;
-}
-
-/* Move the cursor to the last entry in the table. Return SQLITE_OK
-** on success. Set *pRes to 0 if the cursor actually points to something
-** or set *pRes to 1 if the table is empty.
-*/
-static int fileBtreeLast(BtCursor *pCur, int *pRes){
- int rc;
- if( pCur->pPage==0 ) return SQLITE_ABORT;
- rc = moveToRoot(pCur);
- if( rc ) return rc;
- assert( pCur->pPage->isInit );
- if( pCur->pPage->nCell==0 ){
- *pRes = 1;
- return SQLITE_OK;
- }
- *pRes = 0;
- rc = moveToRightmost(pCur);
- pCur->eSkip = SKIP_NONE;
- return rc;
-}
-
-/* Move the cursor so that it points to an entry near pKey.
-** Return a success code.
-**
-** If an exact match is not found, then the cursor is always
-** left pointing at a leaf page which would hold the entry if it
-** were present. The cursor might point to an entry that comes
-** before or after the key.
-**
-** The result of comparing the key with the entry to which the
-** cursor is left pointing is stored in pCur->iMatch. The same
-** value is also written to *pRes if pRes!=NULL. The meaning of
-** this value is as follows:
-**
-** *pRes<0 The cursor is left pointing at an entry that
-** is smaller than pKey or if the table is empty
-** and the cursor is therefore left point to nothing.
-**
-** *pRes==0 The cursor is left pointing at an entry that
-** exactly matches pKey.
-**
-** *pRes>0 The cursor is left pointing at an entry that
-** is larger than pKey.
-*/
-static
-int fileBtreeMoveto(BtCursor *pCur, const void *pKey, int nKey, int *pRes){
- int rc;
- if( pCur->pPage==0 ) return SQLITE_ABORT;
- pCur->eSkip = SKIP_NONE;
- rc = moveToRoot(pCur);
- if( rc ) return rc;
- for(;;){
- int lwr, upr;
- Pgno chldPg;
- MemPage *pPage = pCur->pPage;
- int c = -1; /* pRes return if table is empty must be -1 */
- lwr = 0;
- upr = pPage->nCell-1;
- while( lwr<=upr ){
- pCur->idx = (lwr+upr)/2;
- rc = fileBtreeKeyCompare(pCur, pKey, nKey, 0, &c);
- if( rc ) return rc;
- if( c==0 ){
- pCur->iMatch = c;
- if( pRes ) *pRes = 0;
- return SQLITE_OK;
- }
- if( c<0 ){
- lwr = pCur->idx+1;
- }else{
- upr = pCur->idx-1;
- }
- }
- assert( lwr==upr+1 );
- assert( pPage->isInit );
- if( lwr>=pPage->nCell ){
- chldPg = pPage->u.hdr.rightChild;
- }else{
- chldPg = pPage->apCell[lwr]->h.leftChild;
- }
- if( chldPg==0 ){
- pCur->iMatch = c;
- if( pRes ) *pRes = c;
- return SQLITE_OK;
- }
- pCur->idx = lwr;
- rc = moveToChild(pCur, chldPg);
- if( rc ) return rc;
- }
- /* NOT REACHED */
-}
-
-/*
-** Advance the cursor to the next entry in the database. If
-** successful then set *pRes=0. If the cursor
-** was already pointing to the last entry in the database before
-** this routine was called, then set *pRes=1.
-*/
-static int fileBtreeNext(BtCursor *pCur, int *pRes){
- int rc;
- MemPage *pPage = pCur->pPage;
- assert( pRes!=0 );
- if( pPage==0 ){
- *pRes = 1;
- return SQLITE_ABORT;
- }
- assert( pPage->isInit );
- assert( pCur->eSkip!=SKIP_INVALID );
- if( pPage->nCell==0 ){
- *pRes = 1;
- return SQLITE_OK;
- }
- assert( pCur->idx<pPage->nCell );
- if( pCur->eSkip==SKIP_NEXT ){
- pCur->eSkip = SKIP_NONE;
- *pRes = 0;
- return SQLITE_OK;
- }
- pCur->eSkip = SKIP_NONE;
- pCur->idx++;
- if( pCur->idx>=pPage->nCell ){
- if( pPage->u.hdr.rightChild ){
- rc = moveToChild(pCur, pPage->u.hdr.rightChild);
- if( rc ) return rc;
- rc = moveToLeftmost(pCur);
- *pRes = 0;
- return rc;
- }
- do{
- if( pPage->pParent==0 ){
- *pRes = 1;
- return SQLITE_OK;
- }
- moveToParent(pCur);
- pPage = pCur->pPage;
- }while( pCur->idx>=pPage->nCell );
- *pRes = 0;
- return SQLITE_OK;
- }
- *pRes = 0;
- if( pPage->u.hdr.rightChild==0 ){
- return SQLITE_OK;
- }
- rc = moveToLeftmost(pCur);
- return rc;
-}
-
-/*
-** Step the cursor to the back to the previous entry in the database. If
-** successful then set *pRes=0. If the cursor
-** was already pointing to the first entry in the database before
-** this routine was called, then set *pRes=1.
-*/
-static int fileBtreePrevious(BtCursor *pCur, int *pRes){
- int rc;
- Pgno pgno;
- MemPage *pPage;
- pPage = pCur->pPage;
- if( pPage==0 ){
- *pRes = 1;
- return SQLITE_ABORT;
- }
- assert( pPage->isInit );
- assert( pCur->eSkip!=SKIP_INVALID );
- if( pPage->nCell==0 ){
- *pRes = 1;
- return SQLITE_OK;
- }
- if( pCur->eSkip==SKIP_PREV ){
- pCur->eSkip = SKIP_NONE;
- *pRes = 0;
- return SQLITE_OK;
- }
- pCur->eSkip = SKIP_NONE;
- assert( pCur->idx>=0 );
- if( (pgno = pPage->apCell[pCur->idx]->h.leftChild)!=0 ){
- rc = moveToChild(pCur, pgno);
- if( rc ) return rc;
- rc = moveToRightmost(pCur);
- }else{
- while( pCur->idx==0 ){
- if( pPage->pParent==0 ){
- if( pRes ) *pRes = 1;
- return SQLITE_OK;
- }
- moveToParent(pCur);
- pPage = pCur->pPage;
- }
- pCur->idx--;
- rc = SQLITE_OK;
- }
- *pRes = 0;
- return rc;
-}
-
-/*
-** Allocate a new page from the database file.
-**
-** The new page is marked as dirty. (In other words, sqlitepager_write()
-** has already been called on the new page.) The new page has also
-** been referenced and the calling routine is responsible for calling
-** sqlitepager_unref() on the new page when it is done.
-**
-** SQLITE_OK is returned on success. Any other return value indicates
-** an error. *ppPage and *pPgno are undefined in the event of an error.
-** Do not invoke sqlitepager_unref() on *ppPage if an error is returned.
-**
-** If the "nearby" parameter is not 0, then a (feeble) effort is made to
-** locate a page close to the page number "nearby". This can be used in an
-** attempt to keep related pages close to each other in the database file,
-** which in turn can make database access faster.
-*/
-static int allocatePage(Btree *pBt, MemPage **ppPage, Pgno *pPgno, Pgno nearby){
- PageOne *pPage1 = pBt->page1;
- int rc;
- if( pPage1->freeList ){
- OverflowPage *pOvfl;
- FreelistInfo *pInfo;
-
- rc = sqlitepager_write(pPage1);
- if( rc ) return rc;
- SWAB_ADD(pBt, pPage1->nFree, -1);
- rc = sqlitepager_get(pBt->pPager, SWAB32(pBt, pPage1->freeList),
- (void**)&pOvfl);
- if( rc ) return rc;
- rc = sqlitepager_write(pOvfl);
- if( rc ){
- sqlitepager_unref(pOvfl);
- return rc;
- }
- pInfo = (FreelistInfo*)pOvfl->aPayload;
- if( pInfo->nFree==0 ){
- *pPgno = SWAB32(pBt, pPage1->freeList);
- pPage1->freeList = pOvfl->iNext;
- *ppPage = (MemPage*)pOvfl;
- }else{
- int closest, n;
- n = SWAB32(pBt, pInfo->nFree);
- if( n>1 && nearby>0 ){
- int i, dist;
- closest = 0;
- dist = SWAB32(pBt, pInfo->aFree[0]) - nearby;
- if( dist<0 ) dist = -dist;
- for(i=1; i<n; i++){
- int d2 = SWAB32(pBt, pInfo->aFree[i]) - nearby;
- if( d2<0 ) d2 = -d2;
- if( d2<dist ) closest = i;
- }
- }else{
- closest = 0;
- }
- SWAB_ADD(pBt, pInfo->nFree, -1);
- *pPgno = SWAB32(pBt, pInfo->aFree[closest]);
- pInfo->aFree[closest] = pInfo->aFree[n-1];
- rc = sqlitepager_get(pBt->pPager, *pPgno, (void**)ppPage);
- sqlitepager_unref(pOvfl);
- if( rc==SQLITE_OK ){
- sqlitepager_dont_rollback(*ppPage);
- rc = sqlitepager_write(*ppPage);
- }
- }
- }else{
- *pPgno = sqlitepager_pagecount(pBt->pPager) + 1;
- rc = sqlitepager_get(pBt->pPager, *pPgno, (void**)ppPage);
- if( rc ) return rc;
- rc = sqlitepager_write(*ppPage);
- }
- return rc;
-}
-
-/*
-** Add a page of the database file to the freelist. Either pgno or
-** pPage but not both may be 0.
-**
-** sqlitepager_unref() is NOT called for pPage.
-*/
-static int freePage(Btree *pBt, void *pPage, Pgno pgno){
- PageOne *pPage1 = pBt->page1;
- OverflowPage *pOvfl = (OverflowPage*)pPage;
- int rc;
- int needUnref = 0;
- MemPage *pMemPage;
-
- if( pgno==0 ){
- assert( pOvfl!=0 );
- pgno = sqlitepager_pagenumber(pOvfl);
- }
- assert( pgno>2 );
- assert( sqlitepager_pagenumber(pOvfl)==pgno );
- pMemPage = (MemPage*)pPage;
- pMemPage->isInit = 0;
- if( pMemPage->pParent ){
- sqlitepager_unref(pMemPage->pParent);
- pMemPage->pParent = 0;
- }
- rc = sqlitepager_write(pPage1);
- if( rc ){
- return rc;
- }
- SWAB_ADD(pBt, pPage1->nFree, 1);
- if( pPage1->nFree!=0 && pPage1->freeList!=0 ){
- OverflowPage *pFreeIdx;
- rc = sqlitepager_get(pBt->pPager, SWAB32(pBt, pPage1->freeList),
- (void**)&pFreeIdx);
- if( rc==SQLITE_OK ){
- FreelistInfo *pInfo = (FreelistInfo*)pFreeIdx->aPayload;
- int n = SWAB32(pBt, pInfo->nFree);
- if( n<(sizeof(pInfo->aFree)/sizeof(pInfo->aFree[0])) ){
- rc = sqlitepager_write(pFreeIdx);
- if( rc==SQLITE_OK ){
- pInfo->aFree[n] = SWAB32(pBt, pgno);
- SWAB_ADD(pBt, pInfo->nFree, 1);
- sqlitepager_unref(pFreeIdx);
- sqlitepager_dont_write(pBt->pPager, pgno);
- return rc;
- }
- }
- sqlitepager_unref(pFreeIdx);
- }
- }
- if( pOvfl==0 ){
- assert( pgno>0 );
- rc = sqlitepager_get(pBt->pPager, pgno, (void**)&pOvfl);
- if( rc ) return rc;
- needUnref = 1;
- }
- rc = sqlitepager_write(pOvfl);
- if( rc ){
- if( needUnref ) sqlitepager_unref(pOvfl);
- return rc;
- }
- pOvfl->iNext = pPage1->freeList;
- pPage1->freeList = SWAB32(pBt, pgno);
- memset(pOvfl->aPayload, 0, OVERFLOW_SIZE);
- if( needUnref ) rc = sqlitepager_unref(pOvfl);
- return rc;
-}
-
-/*
-** Erase all the data out of a cell. This involves returning overflow
-** pages back the freelist.
-*/
-static int clearCell(Btree *pBt, Cell *pCell){
- Pager *pPager = pBt->pPager;
- OverflowPage *pOvfl;
- Pgno ovfl, nextOvfl;
- int rc;
-
- if( NKEY(pBt, pCell->h) + NDATA(pBt, pCell->h) <= MX_LOCAL_PAYLOAD ){
- return SQLITE_OK;
- }
- ovfl = SWAB32(pBt, pCell->ovfl);
- pCell->ovfl = 0;
- while( ovfl ){
- rc = sqlitepager_get(pPager, ovfl, (void**)&pOvfl);
- if( rc ) return rc;
- nextOvfl = SWAB32(pBt, pOvfl->iNext);
- rc = freePage(pBt, pOvfl, ovfl);
- if( rc ) return rc;
- sqlitepager_unref(pOvfl);
- ovfl = nextOvfl;
- }
- return SQLITE_OK;
-}
-
-/*
-** Create a new cell from key and data. Overflow pages are allocated as
-** necessary and linked to this cell.
-*/
-static int fillInCell(
- Btree *pBt, /* The whole Btree. Needed to allocate pages */
- Cell *pCell, /* Populate this Cell structure */
- const void *pKey, int nKey, /* The key */
- const void *pData,int nData /* The data */
-){
- OverflowPage *pOvfl, *pPrior;
- Pgno *pNext;
- int spaceLeft;
- int n, rc;
- int nPayload;
- const char *pPayload;
- char *pSpace;
- Pgno nearby = 0;
-
- pCell->h.leftChild = 0;
- pCell->h.nKey = SWAB16(pBt, nKey & 0xffff);
- pCell->h.nKeyHi = nKey >> 16;
- pCell->h.nData = SWAB16(pBt, nData & 0xffff);
- pCell->h.nDataHi = nData >> 16;
- pCell->h.iNext = 0;
-
- pNext = &pCell->ovfl;
- pSpace = pCell->aPayload;
- spaceLeft = MX_LOCAL_PAYLOAD;
- pPayload = pKey;
- pKey = 0;
- nPayload = nKey;
- pPrior = 0;
- while( nPayload>0 ){
- if( spaceLeft==0 ){
- rc = allocatePage(pBt, (MemPage**)&pOvfl, pNext, nearby);
- if( rc ){
- *pNext = 0;
- }else{
- nearby = *pNext;
- }
- if( pPrior ) sqlitepager_unref(pPrior);
- if( rc ){
- clearCell(pBt, pCell);
- return rc;
- }
- if( pBt->needSwab ) *pNext = swab32(*pNext);
- pPrior = pOvfl;
- spaceLeft = OVERFLOW_SIZE;
- pSpace = pOvfl->aPayload;
- pNext = &pOvfl->iNext;
- }
- n = nPayload;
- if( n>spaceLeft ) n = spaceLeft;
- memcpy(pSpace, pPayload, n);
- nPayload -= n;
- if( nPayload==0 && pData ){
- pPayload = pData;
- nPayload = nData;
- pData = 0;
- }else{
- pPayload += n;
- }
- spaceLeft -= n;
- pSpace += n;
- }
- *pNext = 0;
- if( pPrior ){
- sqlitepager_unref(pPrior);
- }
- return SQLITE_OK;
-}
-
-/*
-** Change the MemPage.pParent pointer on the page whose number is
-** given in the second argument so that MemPage.pParent holds the
-** pointer in the third argument.
-*/
-static void reparentPage(Pager *pPager, Pgno pgno, MemPage *pNewParent,int idx){
- MemPage *pThis;
-
- if( pgno==0 ) return;
- assert( pPager!=0 );
- pThis = sqlitepager_lookup(pPager, pgno);
- if( pThis && pThis->isInit ){
- if( pThis->pParent!=pNewParent ){
- if( pThis->pParent ) sqlitepager_unref(pThis->pParent);
- pThis->pParent = pNewParent;
- if( pNewParent ) sqlitepager_ref(pNewParent);
- }
- pThis->idxParent = idx;
- sqlitepager_unref(pThis);
- }
-}
-
-/*
-** Reparent all children of the given page to be the given page.
-** In other words, for every child of pPage, invoke reparentPage()
-** to make sure that each child knows that pPage is its parent.
-**
-** This routine gets called after you memcpy() one page into
-** another.
-*/
-static void reparentChildPages(Btree *pBt, MemPage *pPage){
- int i;
- Pager *pPager = pBt->pPager;
- for(i=0; i<pPage->nCell; i++){
- reparentPage(pPager, SWAB32(pBt, pPage->apCell[i]->h.leftChild), pPage, i);
- }
- reparentPage(pPager, SWAB32(pBt, pPage->u.hdr.rightChild), pPage, i);
- pPage->idxShift = 0;
-}
-
-/*
-** Remove the i-th cell from pPage. This routine effects pPage only.
-** The cell content is not freed or deallocated. It is assumed that
-** the cell content has been copied someplace else. This routine just
-** removes the reference to the cell from pPage.
-**
-** "sz" must be the number of bytes in the cell.
-**
-** Do not bother maintaining the integrity of the linked list of Cells.
-** Only the pPage->apCell[] array is important. The relinkCellList()
-** routine will be called soon after this routine in order to rebuild
-** the linked list.
-*/
-static void dropCell(Btree *pBt, MemPage *pPage, int idx, int sz){
- int j;
- assert( idx>=0 && idx<pPage->nCell );
- assert( sz==cellSize(pBt, pPage->apCell[idx]) );
- assert( sqlitepager_iswriteable(pPage) );
- freeSpace(pBt, pPage, Addr(pPage->apCell[idx]) - Addr(pPage), sz);
- for(j=idx; j<pPage->nCell-1; j++){
- pPage->apCell[j] = pPage->apCell[j+1];
- }
- pPage->nCell--;
- pPage->idxShift = 1;
-}
-
-/*
-** Insert a new cell on pPage at cell index "i". pCell points to the
-** content of the cell.
-**
-** If the cell content will fit on the page, then put it there. If it
-** will not fit, then just make pPage->apCell[i] point to the content
-** and set pPage->isOverfull.
-**
-** Do not bother maintaining the integrity of the linked list of Cells.
-** Only the pPage->apCell[] array is important. The relinkCellList()
-** routine will be called soon after this routine in order to rebuild
-** the linked list.
-*/
-static void insertCell(Btree *pBt, MemPage *pPage, int i, Cell *pCell, int sz){
- int idx, j;
- assert( i>=0 && i<=pPage->nCell );
- assert( sz==cellSize(pBt, pCell) );
- assert( sqlitepager_iswriteable(pPage) );
- idx = allocateSpace(pBt, pPage, sz);
- for(j=pPage->nCell; j>i; j--){
- pPage->apCell[j] = pPage->apCell[j-1];
- }
- pPage->nCell++;
- if( idx<=0 ){
- pPage->isOverfull = 1;
- pPage->apCell[i] = pCell;
- }else{
- memcpy(&pPage->u.aDisk[idx], pCell, sz);
- pPage->apCell[i] = (Cell*)&pPage->u.aDisk[idx];
- }
- pPage->idxShift = 1;
-}
-
-/*
-** Rebuild the linked list of cells on a page so that the cells
-** occur in the order specified by the pPage->apCell[] array.
-** Invoke this routine once to repair damage after one or more
-** invocations of either insertCell() or dropCell().
-*/
-static void relinkCellList(Btree *pBt, MemPage *pPage){
- int i;
- u16 *pIdx;
- assert( sqlitepager_iswriteable(pPage) );
- pIdx = &pPage->u.hdr.firstCell;
- for(i=0; i<pPage->nCell; i++){
- int idx = Addr(pPage->apCell[i]) - Addr(pPage);
- assert( idx>0 && idx<SQLITE_USABLE_SIZE );
- *pIdx = SWAB16(pBt, idx);
- pIdx = &pPage->apCell[i]->h.iNext;
- }
- *pIdx = 0;
-}
-
-/*
-** Make a copy of the contents of pFrom into pTo. The pFrom->apCell[]
-** pointers that point into pFrom->u.aDisk[] must be adjusted to point
-** into pTo->u.aDisk[] instead. But some pFrom->apCell[] entries might
-** not point to pFrom->u.aDisk[]. Those are unchanged.
-*/
-static void copyPage(MemPage *pTo, MemPage *pFrom){
- uptr from, to;
- int i;
- memcpy(pTo->u.aDisk, pFrom->u.aDisk, SQLITE_USABLE_SIZE);
- pTo->pParent = 0;
- pTo->isInit = 1;
- pTo->nCell = pFrom->nCell;
- pTo->nFree = pFrom->nFree;
- pTo->isOverfull = pFrom->isOverfull;
- to = Addr(pTo);
- from = Addr(pFrom);
- for(i=0; i<pTo->nCell; i++){
- uptr x = Addr(pFrom->apCell[i]);
- if( x>from && x<from+SQLITE_USABLE_SIZE ){
- *((uptr*)&pTo->apCell[i]) = x + to - from;
- }else{
- pTo->apCell[i] = pFrom->apCell[i];
- }
- }
-}
-
-/*
-** The following parameters determine how many adjacent pages get involved
-** in a balancing operation. NN is the number of neighbors on either side
-** of the page that participate in the balancing operation. NB is the
-** total number of pages that participate, including the target page and
-** NN neighbors on either side.
-**
-** The minimum value of NN is 1 (of course). Increasing NN above 1
-** (to 2 or 3) gives a modest improvement in SELECT and DELETE performance
-** in exchange for a larger degradation in INSERT and UPDATE performance.
-** The value of NN appears to give the best results overall.
-*/
-#define NN 1 /* Number of neighbors on either side of pPage */
-#define NB (NN*2+1) /* Total pages involved in the balance */
-
-/*
-** This routine redistributes Cells on pPage and up to two siblings
-** of pPage so that all pages have about the same amount of free space.
-** Usually one sibling on either side of pPage is used in the balancing,
-** though both siblings might come from one side if pPage is the first
-** or last child of its parent. If pPage has fewer than two siblings
-** (something which can only happen if pPage is the root page or a
-** child of root) then all available siblings participate in the balancing.
-**
-** The number of siblings of pPage might be increased or decreased by
-** one in an effort to keep pages between 66% and 100% full. The root page
-** is special and is allowed to be less than 66% full. If pPage is
-** the root page, then the depth of the tree might be increased
-** or decreased by one, as necessary, to keep the root page from being
-** overfull or empty.
-**
-** This routine calls relinkCellList() on its input page regardless of
-** whether or not it does any real balancing. Client routines will typically
-** invoke insertCell() or dropCell() before calling this routine, so we
-** need to call relinkCellList() to clean up the mess that those other
-** routines left behind.
-**
-** pCur is left pointing to the same cell as when this routine was called
-** even if that cell gets moved to a different page. pCur may be NULL.
-** Set the pCur parameter to NULL if you do not care about keeping track
-** of a cell as that will save this routine the work of keeping track of it.
-**
-** Note that when this routine is called, some of the Cells on pPage
-** might not actually be stored in pPage->u.aDisk[]. This can happen
-** if the page is overfull. Part of the job of this routine is to
-** make sure all Cells for pPage once again fit in pPage->u.aDisk[].
-**
-** In the course of balancing the siblings of pPage, the parent of pPage
-** might become overfull or underfull. If that happens, then this routine
-** is called recursively on the parent.
-**
-** If this routine fails for any reason, it might leave the database
-** in a corrupted state. So if this routine fails, the database should
-** be rolled back.
-*/
-static int balance(Btree *pBt, MemPage *pPage, BtCursor *pCur){
- MemPage *pParent; /* The parent of pPage */
- int nCell; /* Number of cells in apCell[] */
- int nOld; /* Number of pages in apOld[] */
- int nNew; /* Number of pages in apNew[] */
- int nDiv; /* Number of cells in apDiv[] */
- int i, j, k; /* Loop counters */
- int idx; /* Index of pPage in pParent->apCell[] */
- int nxDiv; /* Next divider slot in pParent->apCell[] */
- int rc; /* The return code */
- int iCur; /* apCell[iCur] is the cell of the cursor */
- MemPage *pOldCurPage; /* The cursor originally points to this page */
- int subtotal; /* Subtotal of bytes in cells on one page */
- MemPage *extraUnref = 0; /* A page that needs to be unref-ed */
- MemPage *apOld[NB]; /* pPage and up to two siblings */
- Pgno pgnoOld[NB]; /* Page numbers for each page in apOld[] */
- MemPage *apNew[NB+1]; /* pPage and up to NB siblings after balancing */
- Pgno pgnoNew[NB+1]; /* Page numbers for each page in apNew[] */
- int idxDiv[NB]; /* Indices of divider cells in pParent */
- Cell *apDiv[NB]; /* Divider cells in pParent */
- Cell aTemp[NB]; /* Temporary holding area for apDiv[] */
- int cntNew[NB+1]; /* Index in apCell[] of cell after i-th page */
- int szNew[NB+1]; /* Combined size of cells place on i-th page */
- MemPage aOld[NB]; /* Temporary copies of pPage and its siblings */
- Cell *apCell[(MX_CELL+2)*NB]; /* All cells from pages being balanced */
- int szCell[(MX_CELL+2)*NB]; /* Local size of all cells */
-
- /*
- ** Return without doing any work if pPage is neither overfull nor
- ** underfull.
- */
- assert( sqlitepager_iswriteable(pPage) );
- if( !pPage->isOverfull && pPage->nFree<SQLITE_USABLE_SIZE/2
- && pPage->nCell>=2){
- relinkCellList(pBt, pPage);
- return SQLITE_OK;
- }
-
- /*
- ** Find the parent of the page to be balanceed.
- ** If there is no parent, it means this page is the root page and
- ** special rules apply.
- */
- pParent = pPage->pParent;
- if( pParent==0 ){
- Pgno pgnoChild;
- MemPage *pChild;
- assert( pPage->isInit );
- if( pPage->nCell==0 ){
- if( pPage->u.hdr.rightChild ){
- /*
- ** The root page is empty. Copy the one child page
- ** into the root page and return. This reduces the depth
- ** of the BTree by one.
- */
- pgnoChild = SWAB32(pBt, pPage->u.hdr.rightChild);
- rc = sqlitepager_get(pBt->pPager, pgnoChild, (void**)&pChild);
- if( rc ) return rc;
- memcpy(pPage, pChild, SQLITE_USABLE_SIZE);
- pPage->isInit = 0;
- rc = initPage(pBt, pPage, sqlitepager_pagenumber(pPage), 0);
- assert( rc==SQLITE_OK );
- reparentChildPages(pBt, pPage);
- if( pCur && pCur->pPage==pChild ){
- sqlitepager_unref(pChild);
- pCur->pPage = pPage;
- sqlitepager_ref(pPage);
- }
- freePage(pBt, pChild, pgnoChild);
- sqlitepager_unref(pChild);
- }else{
- relinkCellList(pBt, pPage);
- }
- return SQLITE_OK;
- }
- if( !pPage->isOverfull ){
- /* It is OK for the root page to be less than half full.
- */
- relinkCellList(pBt, pPage);
- return SQLITE_OK;
- }
- /*
- ** If we get to here, it means the root page is overfull.
- ** When this happens, Create a new child page and copy the
- ** contents of the root into the child. Then make the root
- ** page an empty page with rightChild pointing to the new
- ** child. Then fall thru to the code below which will cause
- ** the overfull child page to be split.
- */
- rc = sqlitepager_write(pPage);
- if( rc ) return rc;
- rc = allocatePage(pBt, &pChild, &pgnoChild, sqlitepager_pagenumber(pPage));
- if( rc ) return rc;
- assert( sqlitepager_iswriteable(pChild) );
- copyPage(pChild, pPage);
- pChild->pParent = pPage;
- pChild->idxParent = 0;
- sqlitepager_ref(pPage);
- pChild->isOverfull = 1;
- if( pCur && pCur->pPage==pPage ){
- sqlitepager_unref(pPage);
- pCur->pPage = pChild;
- }else{
- extraUnref = pChild;
- }
- zeroPage(pBt, pPage);
- pPage->u.hdr.rightChild = SWAB32(pBt, pgnoChild);
- pParent = pPage;
- pPage = pChild;
- }
- rc = sqlitepager_write(pParent);
- if( rc ) return rc;
- assert( pParent->isInit );
-
- /*
- ** Find the Cell in the parent page whose h.leftChild points back
- ** to pPage. The "idx" variable is the index of that cell. If pPage
- ** is the rightmost child of pParent then set idx to pParent->nCell
- */
- if( pParent->idxShift ){
- Pgno pgno, swabPgno;
- pgno = sqlitepager_pagenumber(pPage);
- swabPgno = SWAB32(pBt, pgno);
- for(idx=0; idx<pParent->nCell; idx++){
- if( pParent->apCell[idx]->h.leftChild==swabPgno ){
- break;
- }
- }
- assert( idx<pParent->nCell || pParent->u.hdr.rightChild==swabPgno );
- }else{
- idx = pPage->idxParent;
- }
-
- /*
- ** Initialize variables so that it will be safe to jump
- ** directly to balance_cleanup at any moment.
- */
- nOld = nNew = 0;
- sqlitepager_ref(pParent);
-
- /*
- ** Find sibling pages to pPage and the Cells in pParent that divide
- ** the siblings. An attempt is made to find NN siblings on either
- ** side of pPage. More siblings are taken from one side, however, if
- ** pPage there are fewer than NN siblings on the other side. If pParent
- ** has NB or fewer children then all children of pParent are taken.
- */
- nxDiv = idx - NN;
- if( nxDiv + NB > pParent->nCell ){
- nxDiv = pParent->nCell - NB + 1;
- }
- if( nxDiv<0 ){
- nxDiv = 0;
- }
- nDiv = 0;
- for(i=0, k=nxDiv; i<NB; i++, k++){
- if( k<pParent->nCell ){
- idxDiv[i] = k;
- apDiv[i] = pParent->apCell[k];
- nDiv++;
- pgnoOld[i] = SWAB32(pBt, apDiv[i]->h.leftChild);
- }else if( k==pParent->nCell ){
- pgnoOld[i] = SWAB32(pBt, pParent->u.hdr.rightChild);
- }else{
- break;
- }
- rc = sqlitepager_get(pBt->pPager, pgnoOld[i], (void**)&apOld[i]);
- if( rc ) goto balance_cleanup;
- rc = initPage(pBt, apOld[i], pgnoOld[i], pParent);
- if( rc ) goto balance_cleanup;
- apOld[i]->idxParent = k;
- nOld++;
- }
-
- /*
- ** Set iCur to be the index in apCell[] of the cell that the cursor
- ** is pointing to. We will need this later on in order to keep the
- ** cursor pointing at the same cell. If pCur points to a page that
- ** has no involvement with this rebalancing, then set iCur to a large
- ** number so that the iCur==j tests always fail in the main cell
- ** distribution loop below.
- */
- if( pCur ){
- iCur = 0;
- for(i=0; i<nOld; i++){
- if( pCur->pPage==apOld[i] ){
- iCur += pCur->idx;
- break;
- }
- iCur += apOld[i]->nCell;
- if( i<nOld-1 && pCur->pPage==pParent && pCur->idx==idxDiv[i] ){
- break;
- }
- iCur++;
- }
- pOldCurPage = pCur->pPage;
- }
-
- /*
- ** Make copies of the content of pPage and its siblings into aOld[].
- ** The rest of this function will use data from the copies rather
- ** that the original pages since the original pages will be in the
- ** process of being overwritten.
- */
- for(i=0; i<nOld; i++){
- copyPage(&aOld[i], apOld[i]);
- }
-
- /*
- ** Load pointers to all cells on sibling pages and the divider cells
- ** into the local apCell[] array. Make copies of the divider cells
- ** into aTemp[] and remove the the divider Cells from pParent.
- */
- nCell = 0;
- for(i=0; i<nOld; i++){
- MemPage *pOld = &aOld[i];
- for(j=0; j<pOld->nCell; j++){
- apCell[nCell] = pOld->apCell[j];
- szCell[nCell] = cellSize(pBt, apCell[nCell]);
- nCell++;
- }
- if( i<nOld-1 ){
- szCell[nCell] = cellSize(pBt, apDiv[i]);
- memcpy(&aTemp[i], apDiv[i], szCell[nCell]);
- apCell[nCell] = &aTemp[i];
- dropCell(pBt, pParent, nxDiv, szCell[nCell]);
- assert( SWAB32(pBt, apCell[nCell]->h.leftChild)==pgnoOld[i] );
- apCell[nCell]->h.leftChild = pOld->u.hdr.rightChild;
- nCell++;
- }
- }
-
- /*
- ** Figure out the number of pages needed to hold all nCell cells.
- ** Store this number in "k". Also compute szNew[] which is the total
- ** size of all cells on the i-th page and cntNew[] which is the index
- ** in apCell[] of the cell that divides path i from path i+1.
- ** cntNew[k] should equal nCell.
- **
- ** This little patch of code is critical for keeping the tree
- ** balanced.
- */
- for(subtotal=k=i=0; i<nCell; i++){
- subtotal += szCell[i];
- if( subtotal > USABLE_SPACE ){
- szNew[k] = subtotal - szCell[i];
- cntNew[k] = i;
- subtotal = 0;
- k++;
- }
- }
- szNew[k] = subtotal;
- cntNew[k] = nCell;
- k++;
- for(i=k-1; i>0; i--){
- while( szNew[i]<USABLE_SPACE/2 ){
- cntNew[i-1]--;
- assert( cntNew[i-1]>0 );
- szNew[i] += szCell[cntNew[i-1]];
- szNew[i-1] -= szCell[cntNew[i-1]-1];
- }
- }
- assert( cntNew[0]>0 );
-
- /*
- ** Allocate k new pages. Reuse old pages where possible.
- */
- for(i=0; i<k; i++){
- if( i<nOld ){
- apNew[i] = apOld[i];
- pgnoNew[i] = pgnoOld[i];
- apOld[i] = 0;
- sqlitepager_write(apNew[i]);
- }else{
- rc = allocatePage(pBt, &apNew[i], &pgnoNew[i], pgnoNew[i-1]);
- if( rc ) goto balance_cleanup;
- }
- nNew++;
- zeroPage(pBt, apNew[i]);
- apNew[i]->isInit = 1;
- }
-
- /* Free any old pages that were not reused as new pages.
- */
- while( i<nOld ){
- rc = freePage(pBt, apOld[i], pgnoOld[i]);
- if( rc ) goto balance_cleanup;
- sqlitepager_unref(apOld[i]);
- apOld[i] = 0;
- i++;
- }
-
- /*
- ** Put the new pages in accending order. This helps to
- ** keep entries in the disk file in order so that a scan
- ** of the table is a linear scan through the file. That
- ** in turn helps the operating system to deliver pages
- ** from the disk more rapidly.
- **
- ** An O(n^2) insertion sort algorithm is used, but since
- ** n is never more than NB (a small constant), that should
- ** not be a problem.
- **
- ** When NB==3, this one optimization makes the database
- ** about 25% faster for large insertions and deletions.
- */
- for(i=0; i<k-1; i++){
- int minV = pgnoNew[i];
- int minI = i;
- for(j=i+1; j<k; j++){
- if( pgnoNew[j]<(unsigned)minV ){
- minI = j;
- minV = pgnoNew[j];
- }
- }
- if( minI>i ){
- int t;
- MemPage *pT;
- t = pgnoNew[i];
- pT = apNew[i];
- pgnoNew[i] = pgnoNew[minI];
- apNew[i] = apNew[minI];
- pgnoNew[minI] = t;
- apNew[minI] = pT;
- }
- }
-
- /*
- ** Evenly distribute the data in apCell[] across the new pages.
- ** Insert divider cells into pParent as necessary.
- */
- j = 0;
- for(i=0; i<nNew; i++){
- MemPage *pNew = apNew[i];
- while( j<cntNew[i] ){
- assert( pNew->nFree>=szCell[j] );
- if( pCur && iCur==j ){ pCur->pPage = pNew; pCur->idx = pNew->nCell; }
- insertCell(pBt, pNew, pNew->nCell, apCell[j], szCell[j]);
- j++;
- }
- assert( pNew->nCell>0 );
- assert( !pNew->isOverfull );
- relinkCellList(pBt, pNew);
- if( i<nNew-1 && j<nCell ){
- pNew->u.hdr.rightChild = apCell[j]->h.leftChild;
- apCell[j]->h.leftChild = SWAB32(pBt, pgnoNew[i]);
- if( pCur && iCur==j ){ pCur->pPage = pParent; pCur->idx = nxDiv; }
- insertCell(pBt, pParent, nxDiv, apCell[j], szCell[j]);
- j++;
- nxDiv++;
- }
- }
- assert( j==nCell );
- apNew[nNew-1]->u.hdr.rightChild = aOld[nOld-1].u.hdr.rightChild;
- if( nxDiv==pParent->nCell ){
- pParent->u.hdr.rightChild = SWAB32(pBt, pgnoNew[nNew-1]);
- }else{
- pParent->apCell[nxDiv]->h.leftChild = SWAB32(pBt, pgnoNew[nNew-1]);
- }
- if( pCur ){
- if( j<=iCur && pCur->pPage==pParent && pCur->idx>idxDiv[nOld-1] ){
- assert( pCur->pPage==pOldCurPage );
- pCur->idx += nNew - nOld;
- }else{
- assert( pOldCurPage!=0 );
- sqlitepager_ref(pCur->pPage);
- sqlitepager_unref(pOldCurPage);
- }
- }
-
- /*
- ** Reparent children of all cells.
- */
- for(i=0; i<nNew; i++){
- reparentChildPages(pBt, apNew[i]);
- }
- reparentChildPages(pBt, pParent);
-
- /*
- ** balance the parent page.
- */
- rc = balance(pBt, pParent, pCur);
-
- /*
- ** Cleanup before returning.
- */
-balance_cleanup:
- if( extraUnref ){
- sqlitepager_unref(extraUnref);
- }
- for(i=0; i<nOld; i++){
- if( apOld[i]!=0 && apOld[i]!=&aOld[i] ) sqlitepager_unref(apOld[i]);
- }
- for(i=0; i<nNew; i++){
- sqlitepager_unref(apNew[i]);
- }
- if( pCur && pCur->pPage==0 ){
- pCur->pPage = pParent;
- pCur->idx = 0;
- }else{
- sqlitepager_unref(pParent);
- }
- return rc;
-}
-
-/*
-** This routine checks all cursors that point to the same table
-** as pCur points to. If any of those cursors were opened with
-** wrFlag==0 then this routine returns SQLITE_LOCKED. If all
-** cursors point to the same table were opened with wrFlag==1
-** then this routine returns SQLITE_OK.
-**
-** In addition to checking for read-locks (where a read-lock
-** means a cursor opened with wrFlag==0) this routine also moves
-** all cursors other than pCur so that they are pointing to the
-** first Cell on root page. This is necessary because an insert
-** or delete might change the number of cells on a page or delete
-** a page entirely and we do not want to leave any cursors
-** pointing to non-existant pages or cells.
-*/
-static int checkReadLocks(BtCursor *pCur){
- BtCursor *p;
- assert( pCur->wrFlag );
- for(p=pCur->pShared; p!=pCur; p=p->pShared){
- assert( p );
- assert( p->pgnoRoot==pCur->pgnoRoot );
- if( p->wrFlag==0 ) return SQLITE_LOCKED;
- if( sqlitepager_pagenumber(p->pPage)!=p->pgnoRoot ){
- moveToRoot(p);
- }
- }
- return SQLITE_OK;
-}
-
-/*
-** Insert a new record into the BTree. The key is given by (pKey,nKey)
-** and the data is given by (pData,nData). The cursor is used only to
-** define what database the record should be inserted into. The cursor
-** is left pointing at the new record.
-*/
-static int fileBtreeInsert(
- BtCursor *pCur, /* Insert data into the table of this cursor */
- const void *pKey, int nKey, /* The key of the new record */
- const void *pData, int nData /* The data of the new record */
-){
- Cell newCell;
- int rc;
- int loc;
- int szNew;
- MemPage *pPage;
- Btree *pBt = pCur->pBt;
-
- if( pCur->pPage==0 ){
- return SQLITE_ABORT; /* A rollback destroyed this cursor */
- }
- if( !pBt->inTrans || nKey+nData==0 ){
- /* Must start a transaction before doing an insert */
- return pBt->readOnly ? SQLITE_READONLY : SQLITE_ERROR;
- }
- assert( !pBt->readOnly );
- if( !pCur->wrFlag ){
- return SQLITE_PERM; /* Cursor not open for writing */
- }
- if( checkReadLocks(pCur) ){
- return SQLITE_LOCKED; /* The table pCur points to has a read lock */
- }
- rc = fileBtreeMoveto(pCur, pKey, nKey, &loc);
- if( rc ) return rc;
- pPage = pCur->pPage;
- assert( pPage->isInit );
- rc = sqlitepager_write(pPage);
- if( rc ) return rc;
- rc = fillInCell(pBt, &newCell, pKey, nKey, pData, nData);
- if( rc ) return rc;
- szNew = cellSize(pBt, &newCell);
- if( loc==0 ){
- newCell.h.leftChild = pPage->apCell[pCur->idx]->h.leftChild;
- rc = clearCell(pBt, pPage->apCell[pCur->idx]);
- if( rc ) return rc;
- dropCell(pBt, pPage, pCur->idx, cellSize(pBt, pPage->apCell[pCur->idx]));
- }else if( loc<0 && pPage->nCell>0 ){
- assert( pPage->u.hdr.rightChild==0 ); /* Must be a leaf page */
- pCur->idx++;
- }else{
- assert( pPage->u.hdr.rightChild==0 ); /* Must be a leaf page */
- }
- insertCell(pBt, pPage, pCur->idx, &newCell, szNew);
- rc = balance(pCur->pBt, pPage, pCur);
- /* sqliteBtreePageDump(pCur->pBt, pCur->pgnoRoot, 1); */
- /* fflush(stdout); */
- pCur->eSkip = SKIP_INVALID;
- return rc;
-}
-
-/*
-** Delete the entry that the cursor is pointing to.
-**
-** The cursor is left pointing at either the next or the previous
-** entry. If the cursor is left pointing to the next entry, then
-** the pCur->eSkip flag is set to SKIP_NEXT which forces the next call to
-** sqliteBtreeNext() to be a no-op. That way, you can always call
-** sqliteBtreeNext() after a delete and the cursor will be left
-** pointing to the first entry after the deleted entry. Similarly,
-** pCur->eSkip is set to SKIP_PREV is the cursor is left pointing to
-** the entry prior to the deleted entry so that a subsequent call to
-** sqliteBtreePrevious() will always leave the cursor pointing at the
-** entry immediately before the one that was deleted.
-*/
-static int fileBtreeDelete(BtCursor *pCur){
- MemPage *pPage = pCur->pPage;
- Cell *pCell;
- int rc;
- Pgno pgnoChild;
- Btree *pBt = pCur->pBt;
-
- assert( pPage->isInit );
- if( pCur->pPage==0 ){
- return SQLITE_ABORT; /* A rollback destroyed this cursor */
- }
- if( !pBt->inTrans ){
- /* Must start a transaction before doing a delete */
- return pBt->readOnly ? SQLITE_READONLY : SQLITE_ERROR;
- }
- assert( !pBt->readOnly );
- if( pCur->idx >= pPage->nCell ){
- return SQLITE_ERROR; /* The cursor is not pointing to anything */
- }
- if( !pCur->wrFlag ){
- return SQLITE_PERM; /* Did not open this cursor for writing */
- }
- if( checkReadLocks(pCur) ){
- return SQLITE_LOCKED; /* The table pCur points to has a read lock */
- }
- rc = sqlitepager_write(pPage);
- if( rc ) return rc;
- pCell = pPage->apCell[pCur->idx];
- pgnoChild = SWAB32(pBt, pCell->h.leftChild);
- clearCell(pBt, pCell);
- if( pgnoChild ){
- /*
- ** The entry we are about to delete is not a leaf so if we do not
- ** do something we will leave a hole on an internal page.
- ** We have to fill the hole by moving in a cell from a leaf. The
- ** next Cell after the one to be deleted is guaranteed to exist and
- ** to be a leaf so we can use it.
- */
- BtCursor leafCur;
- Cell *pNext;
- int szNext;
- int notUsed;
- getTempCursor(pCur, &leafCur);
- rc = fileBtreeNext(&leafCur, ¬Used);
- if( rc!=SQLITE_OK ){
- if( rc!=SQLITE_NOMEM ) rc = SQLITE_CORRUPT;
- return rc;
- }
- rc = sqlitepager_write(leafCur.pPage);
- if( rc ) return rc;
- dropCell(pBt, pPage, pCur->idx, cellSize(pBt, pCell));
- pNext = leafCur.pPage->apCell[leafCur.idx];
- szNext = cellSize(pBt, pNext);
- pNext->h.leftChild = SWAB32(pBt, pgnoChild);
- insertCell(pBt, pPage, pCur->idx, pNext, szNext);
- rc = balance(pBt, pPage, pCur);
- if( rc ) return rc;
- pCur->eSkip = SKIP_NEXT;
- dropCell(pBt, leafCur.pPage, leafCur.idx, szNext);
- rc = balance(pBt, leafCur.pPage, pCur);
- releaseTempCursor(&leafCur);
- }else{
- dropCell(pBt, pPage, pCur->idx, cellSize(pBt, pCell));
- if( pCur->idx>=pPage->nCell ){
- pCur->idx = pPage->nCell-1;
- if( pCur->idx<0 ){
- pCur->idx = 0;
- pCur->eSkip = SKIP_NEXT;
- }else{
- pCur->eSkip = SKIP_PREV;
- }
- }else{
- pCur->eSkip = SKIP_NEXT;
- }
- rc = balance(pBt, pPage, pCur);
- }
- return rc;
-}
-
-/*
-** Create a new BTree table. Write into *piTable the page
-** number for the root page of the new table.
-**
-** In the current implementation, BTree tables and BTree indices are the
-** the same. In the future, we may change this so that BTree tables
-** are restricted to having a 4-byte integer key and arbitrary data and
-** BTree indices are restricted to having an arbitrary key and no data.
-** But for now, this routine also serves to create indices.
-*/
-static int fileBtreeCreateTable(Btree *pBt, int *piTable){
- MemPage *pRoot;
- Pgno pgnoRoot;
- int rc;
- if( !pBt->inTrans ){
- /* Must start a transaction first */
- return pBt->readOnly ? SQLITE_READONLY : SQLITE_ERROR;
- }
- if( pBt->readOnly ){
- return SQLITE_READONLY;
- }
- rc = allocatePage(pBt, &pRoot, &pgnoRoot, 0);
- if( rc ) return rc;
- assert( sqlitepager_iswriteable(pRoot) );
- zeroPage(pBt, pRoot);
- sqlitepager_unref(pRoot);
- *piTable = (int)pgnoRoot;
- return SQLITE_OK;
-}
-
-/*
-** Erase the given database page and all its children. Return
-** the page to the freelist.
-*/
-static int clearDatabasePage(Btree *pBt, Pgno pgno, int freePageFlag){
- MemPage *pPage;
- int rc;
- Cell *pCell;
- int idx;
-
- rc = sqlitepager_get(pBt->pPager, pgno, (void**)&pPage);
- if( rc ) return rc;
- rc = sqlitepager_write(pPage);
- if( rc ) return rc;
- rc = initPage(pBt, pPage, pgno, 0);
- if( rc ) return rc;
- idx = SWAB16(pBt, pPage->u.hdr.firstCell);
- while( idx>0 ){
- pCell = (Cell*)&pPage->u.aDisk[idx];
- idx = SWAB16(pBt, pCell->h.iNext);
- if( pCell->h.leftChild ){
- rc = clearDatabasePage(pBt, SWAB32(pBt, pCell->h.leftChild), 1);
- if( rc ) return rc;
- }
- rc = clearCell(pBt, pCell);
- if( rc ) return rc;
- }
- if( pPage->u.hdr.rightChild ){
- rc = clearDatabasePage(pBt, SWAB32(pBt, pPage->u.hdr.rightChild), 1);
- if( rc ) return rc;
- }
- if( freePageFlag ){
- rc = freePage(pBt, pPage, pgno);
- }else{
- zeroPage(pBt, pPage);
- }
- sqlitepager_unref(pPage);
- return rc;
-}
-
-/*
-** Delete all information from a single table in the database.
-*/
-static int fileBtreeClearTable(Btree *pBt, int iTable){
- int rc;
- BtCursor *pCur;
- if( !pBt->inTrans ){
- return pBt->readOnly ? SQLITE_READONLY : SQLITE_ERROR;
- }
- for(pCur=pBt->pCursor; pCur; pCur=pCur->pNext){
- if( pCur->pgnoRoot==(Pgno)iTable ){
- if( pCur->wrFlag==0 ) return SQLITE_LOCKED;
- moveToRoot(pCur);
- }
- }
- rc = clearDatabasePage(pBt, (Pgno)iTable, 0);
- if( rc ){
- fileBtreeRollback(pBt);
- }
- return rc;
-}
-
-/*
-** Erase all information in a table and add the root of the table to
-** the freelist. Except, the root of the principle table (the one on
-** page 2) is never added to the freelist.
-*/
-static int fileBtreeDropTable(Btree *pBt, int iTable){
- int rc;
- MemPage *pPage;
- BtCursor *pCur;
- if( !pBt->inTrans ){
- return pBt->readOnly ? SQLITE_READONLY : SQLITE_ERROR;
- }
- for(pCur=pBt->pCursor; pCur; pCur=pCur->pNext){
- if( pCur->pgnoRoot==(Pgno)iTable ){
- return SQLITE_LOCKED; /* Cannot drop a table that has a cursor */
- }
- }
- rc = sqlitepager_get(pBt->pPager, (Pgno)iTable, (void**)&pPage);
- if( rc ) return rc;
- rc = fileBtreeClearTable(pBt, iTable);
- if( rc ) return rc;
- if( iTable>2 ){
- rc = freePage(pBt, pPage, iTable);
- }else{
- zeroPage(pBt, pPage);
- }
- sqlitepager_unref(pPage);
- return rc;
-}
-
-#if 0 /* UNTESTED */
-/*
-** Copy all cell data from one database file into another.
-** pages back the freelist.
-*/
-static int copyCell(Btree *pBtFrom, BTree *pBtTo, Cell *pCell){
- Pager *pFromPager = pBtFrom->pPager;
- OverflowPage *pOvfl;
- Pgno ovfl, nextOvfl;
- Pgno *pPrev;
- int rc = SQLITE_OK;
- MemPage *pNew, *pPrevPg;
- Pgno new;
-
- if( NKEY(pBtTo, pCell->h) + NDATA(pBtTo, pCell->h) <= MX_LOCAL_PAYLOAD ){
- return SQLITE_OK;
- }
- pPrev = &pCell->ovfl;
- pPrevPg = 0;
- ovfl = SWAB32(pBtTo, pCell->ovfl);
- while( ovfl && rc==SQLITE_OK ){
- rc = sqlitepager_get(pFromPager, ovfl, (void**)&pOvfl);
- if( rc ) return rc;
- nextOvfl = SWAB32(pBtFrom, pOvfl->iNext);
- rc = allocatePage(pBtTo, &pNew, &new, 0);
- if( rc==SQLITE_OK ){
- rc = sqlitepager_write(pNew);
- if( rc==SQLITE_OK ){
- memcpy(pNew, pOvfl, SQLITE_USABLE_SIZE);
- *pPrev = SWAB32(pBtTo, new);
- if( pPrevPg ){
- sqlitepager_unref(pPrevPg);
- }
- pPrev = &pOvfl->iNext;
- pPrevPg = pNew;
- }
- }
- sqlitepager_unref(pOvfl);
- ovfl = nextOvfl;
- }
- if( pPrevPg ){
- sqlitepager_unref(pPrevPg);
- }
- return rc;
-}
-#endif
-
-
-#if 0 /* UNTESTED */
-/*
-** Copy a page of data from one database over to another.
-*/
-static int copyDatabasePage(
- Btree *pBtFrom,
- Pgno pgnoFrom,
- Btree *pBtTo,
- Pgno *pTo
-){
- MemPage *pPageFrom, *pPage;
- Pgno to;
- int rc;
- Cell *pCell;
- int idx;
-
- rc = sqlitepager_get(pBtFrom->pPager, pgno, (void**)&pPageFrom);
- if( rc ) return rc;
- rc = allocatePage(pBt, &pPage, pTo, 0);
- if( rc==SQLITE_OK ){
- rc = sqlitepager_write(pPage);
- }
- if( rc==SQLITE_OK ){
- memcpy(pPage, pPageFrom, SQLITE_USABLE_SIZE);
- idx = SWAB16(pBt, pPage->u.hdr.firstCell);
- while( idx>0 ){
- pCell = (Cell*)&pPage->u.aDisk[idx];
- idx = SWAB16(pBt, pCell->h.iNext);
- if( pCell->h.leftChild ){
- Pgno newChld;
- rc = copyDatabasePage(pBtFrom, SWAB32(pBtFrom, pCell->h.leftChild),
- pBtTo, &newChld);
- if( rc ) return rc;
- pCell->h.leftChild = SWAB32(pBtFrom, newChld);
- }
- rc = copyCell(pBtFrom, pBtTo, pCell);
- if( rc ) return rc;
- }
- if( pPage->u.hdr.rightChild ){
- Pgno newChld;
- rc = copyDatabasePage(pBtFrom, SWAB32(pBtFrom, pPage->u.hdr.rightChild),
- pBtTo, &newChld);
- if( rc ) return rc;
- pPage->u.hdr.rightChild = SWAB32(pBtTo, newChild);
- }
- }
- sqlitepager_unref(pPage);
- return rc;
-}
-#endif
-
-/*
-** Read the meta-information out of a database file.
-*/
-static int fileBtreeGetMeta(Btree *pBt, int *aMeta){
- PageOne *pP1;
- int rc;
- int i;
-
- rc = sqlitepager_get(pBt->pPager, 1, (void**)&pP1);
- if( rc ) return rc;
- aMeta[0] = SWAB32(pBt, pP1->nFree);
- for(i=0; i<sizeof(pP1->aMeta)/sizeof(pP1->aMeta[0]); i++){
- aMeta[i+1] = SWAB32(pBt, pP1->aMeta[i]);
- }
- sqlitepager_unref(pP1);
- return SQLITE_OK;
-}
-
-/*
-** Write meta-information back into the database.
-*/
-static int fileBtreeUpdateMeta(Btree *pBt, int *aMeta){
- PageOne *pP1;
- int rc, i;
- if( !pBt->inTrans ){
- return pBt->readOnly ? SQLITE_READONLY : SQLITE_ERROR;
- }
- pP1 = pBt->page1;
- rc = sqlitepager_write(pP1);
- if( rc ) return rc;
- for(i=0; i<sizeof(pP1->aMeta)/sizeof(pP1->aMeta[0]); i++){
- pP1->aMeta[i] = SWAB32(pBt, aMeta[i+1]);
- }
- return SQLITE_OK;
-}
-
-/******************************************************************************
-** The complete implementation of the BTree subsystem is above this line.
-** All the code the follows is for testing and troubleshooting the BTree
-** subsystem. None of the code that follows is used during normal operation.
-******************************************************************************/
-
-/*
-** Print a disassembly of the given page on standard output. This routine
-** is used for debugging and testing only.
-*/
-#ifdef SQLITE_TEST
-static int fileBtreePageDump(Btree *pBt, int pgno, int recursive){
- int rc;
- MemPage *pPage;
- int i, j;
- int nFree;
- u16 idx;
- char range[20];
- unsigned char payload[20];
- rc = sqlitepager_get(pBt->pPager, (Pgno)pgno, (void**)&pPage);
- if( rc ){
- return rc;
- }
- if( recursive ) printf("PAGE %d:\n", pgno);
- i = 0;
- idx = SWAB16(pBt, pPage->u.hdr.firstCell);
- while( idx>0 && idx<=SQLITE_USABLE_SIZE-MIN_CELL_SIZE ){
- Cell *pCell = (Cell*)&pPage->u.aDisk[idx];
- int sz = cellSize(pBt, pCell);
- sprintf(range,"%d..%d", idx, idx+sz-1);
- sz = NKEY(pBt, pCell->h) + NDATA(pBt, pCell->h);
- if( sz>sizeof(payload)-1 ) sz = sizeof(payload)-1;
- memcpy(payload, pCell->aPayload, sz);
- for(j=0; j<sz; j++){
- if( payload[j]<0x20 || payload[j]>0x7f ) payload[j] = '.';
- }
- payload[sz] = 0;
- printf(
- "cell %2d: i=%-10s chld=%-4d nk=%-4d nd=%-4d payload=%s\n",
- i, range, (int)pCell->h.leftChild,
- NKEY(pBt, pCell->h), NDATA(pBt, pCell->h),
- payload
- );
- if( pPage->isInit && pPage->apCell[i]!=pCell ){
- printf("**** apCell[%d] does not match on prior entry ****\n", i);
- }
- i++;
- idx = SWAB16(pBt, pCell->h.iNext);
- }
- if( idx!=0 ){
- printf("ERROR: next cell index out of range: %d\n", idx);
- }
- printf("right_child: %d\n", SWAB32(pBt, pPage->u.hdr.rightChild));
- nFree = 0;
- i = 0;
- idx = SWAB16(pBt, pPage->u.hdr.firstFree);
- while( idx>0 && idx<SQLITE_USABLE_SIZE ){
- FreeBlk *p = (FreeBlk*)&pPage->u.aDisk[idx];
- sprintf(range,"%d..%d", idx, idx+p->iSize-1);
- nFree += SWAB16(pBt, p->iSize);
- printf("freeblock %2d: i=%-10s size=%-4d total=%d\n",
- i, range, SWAB16(pBt, p->iSize), nFree);
- idx = SWAB16(pBt, p->iNext);
- i++;
- }
- if( idx!=0 ){
- printf("ERROR: next freeblock index out of range: %d\n", idx);
- }
- if( recursive && pPage->u.hdr.rightChild!=0 ){
- idx = SWAB16(pBt, pPage->u.hdr.firstCell);
- while( idx>0 && idx<SQLITE_USABLE_SIZE-MIN_CELL_SIZE ){
- Cell *pCell = (Cell*)&pPage->u.aDisk[idx];
- fileBtreePageDump(pBt, SWAB32(pBt, pCell->h.leftChild), 1);
- idx = SWAB16(pBt, pCell->h.iNext);
- }
- fileBtreePageDump(pBt, SWAB32(pBt, pPage->u.hdr.rightChild), 1);
- }
- sqlitepager_unref(pPage);
- return SQLITE_OK;
-}
-#endif
-
-#ifdef SQLITE_TEST
-/*
-** Fill aResult[] with information about the entry and page that the
-** cursor is pointing to.
-**
-** aResult[0] = The page number
-** aResult[1] = The entry number
-** aResult[2] = Total number of entries on this page
-** aResult[3] = Size of this entry
-** aResult[4] = Number of free bytes on this page
-** aResult[5] = Number of free blocks on the page
-** aResult[6] = Page number of the left child of this entry
-** aResult[7] = Page number of the right child for the whole page
-**
-** This routine is used for testing and debugging only.
-*/
-static int fileBtreeCursorDump(BtCursor *pCur, int *aResult){
- int cnt, idx;
- MemPage *pPage = pCur->pPage;
- Btree *pBt = pCur->pBt;
- aResult[0] = sqlitepager_pagenumber(pPage);
- aResult[1] = pCur->idx;
- aResult[2] = pPage->nCell;
- if( pCur->idx>=0 && pCur->idx<pPage->nCell ){
- aResult[3] = cellSize(pBt, pPage->apCell[pCur->idx]);
- aResult[6] = SWAB32(pBt, pPage->apCell[pCur->idx]->h.leftChild);
- }else{
- aResult[3] = 0;
- aResult[6] = 0;
- }
- aResult[4] = pPage->nFree;
- cnt = 0;
- idx = SWAB16(pBt, pPage->u.hdr.firstFree);
- while( idx>0 && idx<SQLITE_USABLE_SIZE ){
- cnt++;
- idx = SWAB16(pBt, ((FreeBlk*)&pPage->u.aDisk[idx])->iNext);
- }
- aResult[5] = cnt;
- aResult[7] = SWAB32(pBt, pPage->u.hdr.rightChild);
- return SQLITE_OK;
-}
-#endif
-
-/*
-** Return the pager associated with a BTree. This routine is used for
-** testing and debugging only.
-*/
-static Pager *fileBtreePager(Btree *pBt){
- return pBt->pPager;
-}
-
-/*
-** This structure is passed around through all the sanity checking routines
-** in order to keep track of some global state information.
-*/
-typedef struct IntegrityCk IntegrityCk;
-struct IntegrityCk {
- Btree *pBt; /* The tree being checked out */
- Pager *pPager; /* The associated pager. Also accessible by pBt->pPager */
- int nPage; /* Number of pages in the database */
- int *anRef; /* Number of times each page is referenced */
- char *zErrMsg; /* An error message. NULL of no errors seen. */
-};
-
-/*
-** Append a message to the error message string.
-*/
-static void checkAppendMsg(IntegrityCk *pCheck, char *zMsg1, char *zMsg2){
- if( pCheck->zErrMsg ){
- char *zOld = pCheck->zErrMsg;
- pCheck->zErrMsg = 0;
- sqliteSetString(&pCheck->zErrMsg, zOld, "\n", zMsg1, zMsg2, (char*)0);
- sqliteFree(zOld);
- }else{
- sqliteSetString(&pCheck->zErrMsg, zMsg1, zMsg2, (char*)0);
- }
-}
-
-/*
-** Add 1 to the reference count for page iPage. If this is the second
-** reference to the page, add an error message to pCheck->zErrMsg.
-** Return 1 if there are 2 ore more references to the page and 0 if
-** if this is the first reference to the page.
-**
-** Also check that the page number is in bounds.
-*/
-static int checkRef(IntegrityCk *pCheck, int iPage, char *zContext){
- if( iPage==0 ) return 1;
- if( iPage>pCheck->nPage || iPage<0 ){
- char zBuf[100];
- sprintf(zBuf, "invalid page number %d", iPage);
- checkAppendMsg(pCheck, zContext, zBuf);
- return 1;
- }
- if( pCheck->anRef[iPage]==1 ){
- char zBuf[100];
- sprintf(zBuf, "2nd reference to page %d", iPage);
- checkAppendMsg(pCheck, zContext, zBuf);
- return 1;
- }
- return (pCheck->anRef[iPage]++)>1;
-}
-
-/*
-** Check the integrity of the freelist or of an overflow page list.
-** Verify that the number of pages on the list is N.
-*/
-static void checkList(
- IntegrityCk *pCheck, /* Integrity checking context */
- int isFreeList, /* True for a freelist. False for overflow page list */
- int iPage, /* Page number for first page in the list */
- int N, /* Expected number of pages in the list */
- char *zContext /* Context for error messages */
-){
- int i;
- char zMsg[100];
- while( N-- > 0 ){
- OverflowPage *pOvfl;
- if( iPage<1 ){
- sprintf(zMsg, "%d pages missing from overflow list", N+1);
- checkAppendMsg(pCheck, zContext, zMsg);
- break;
- }
- if( checkRef(pCheck, iPage, zContext) ) break;
- if( sqlitepager_get(pCheck->pPager, (Pgno)iPage, (void**)&pOvfl) ){
- sprintf(zMsg, "failed to get page %d", iPage);
- checkAppendMsg(pCheck, zContext, zMsg);
- break;
- }
- if( isFreeList ){
- FreelistInfo *pInfo = (FreelistInfo*)pOvfl->aPayload;
- int n = SWAB32(pCheck->pBt, pInfo->nFree);
- for(i=0; i<n; i++){
- checkRef(pCheck, SWAB32(pCheck->pBt, pInfo->aFree[i]), zContext);
- }
- N -= n;
- }
- iPage = SWAB32(pCheck->pBt, pOvfl->iNext);
- sqlitepager_unref(pOvfl);
- }
-}
-
-/*
-** Return negative if zKey1<zKey2.
-** Return zero if zKey1==zKey2.
-** Return positive if zKey1>zKey2.
-*/
-static int keyCompare(
- const char *zKey1, int nKey1,
- const char *zKey2, int nKey2
-){
- int min = nKey1>nKey2 ? nKey2 : nKey1;
- int c = memcmp(zKey1, zKey2, min);
- if( c==0 ){
- c = nKey1 - nKey2;
- }
- return c;
-}
-
-/*
-** Do various sanity checks on a single page of a tree. Return
-** the tree depth. Root pages return 0. Parents of root pages
-** return 1, and so forth.
-**
-** These checks are done:
-**
-** 1. Make sure that cells and freeblocks do not overlap
-** but combine to completely cover the page.
-** 2. Make sure cell keys are in order.
-** 3. Make sure no key is less than or equal to zLowerBound.
-** 4. Make sure no key is greater than or equal to zUpperBound.
-** 5. Check the integrity of overflow pages.
-** 6. Recursively call checkTreePage on all children.
-** 7. Verify that the depth of all children is the same.
-** 8. Make sure this page is at least 33% full or else it is
-** the root of the tree.
-*/
-static int checkTreePage(
- IntegrityCk *pCheck, /* Context for the sanity check */
- int iPage, /* Page number of the page to check */
- MemPage *pParent, /* Parent page */
- char *zParentContext, /* Parent context */
- char *zLowerBound, /* All keys should be greater than this, if not NULL */
- int nLower, /* Number of characters in zLowerBound */
- char *zUpperBound, /* All keys should be less than this, if not NULL */
- int nUpper /* Number of characters in zUpperBound */
-){
- MemPage *pPage;
- int i, rc, depth, d2, pgno;
- char *zKey1, *zKey2;
- int nKey1, nKey2;
- BtCursor cur;
- Btree *pBt;
- char zMsg[100];
- char zContext[100];
- char hit[SQLITE_USABLE_SIZE];
-
- /* Check that the page exists
- */
- cur.pBt = pBt = pCheck->pBt;
- if( iPage==0 ) return 0;
- if( checkRef(pCheck, iPage, zParentContext) ) return 0;
- sprintf(zContext, "On tree page %d: ", iPage);
- if( (rc = sqlitepager_get(pCheck->pPager, (Pgno)iPage, (void**)&pPage))!=0 ){
- sprintf(zMsg, "unable to get the page. error code=%d", rc);
- checkAppendMsg(pCheck, zContext, zMsg);
- return 0;
- }
- if( (rc = initPage(pBt, pPage, (Pgno)iPage, pParent))!=0 ){
- sprintf(zMsg, "initPage() returns error code %d", rc);
- checkAppendMsg(pCheck, zContext, zMsg);
- sqlitepager_unref(pPage);
- return 0;
- }
-
- /* Check out all the cells.
- */
- depth = 0;
- if( zLowerBound ){
- zKey1 = sqliteMalloc( nLower+1 );
- memcpy(zKey1, zLowerBound, nLower);
- zKey1[nLower] = 0;
- }else{
- zKey1 = 0;
- }
- nKey1 = nLower;
- cur.pPage = pPage;
- for(i=0; i<pPage->nCell; i++){
- Cell *pCell = pPage->apCell[i];
- int sz;
-
- /* Check payload overflow pages
- */
- nKey2 = NKEY(pBt, pCell->h);
- sz = nKey2 + NDATA(pBt, pCell->h);
- sprintf(zContext, "On page %d cell %d: ", iPage, i);
- if( sz>MX_LOCAL_PAYLOAD ){
- int nPage = (sz - MX_LOCAL_PAYLOAD + OVERFLOW_SIZE - 1)/OVERFLOW_SIZE;
- checkList(pCheck, 0, SWAB32(pBt, pCell->ovfl), nPage, zContext);
- }
-
- /* Check that keys are in the right order
- */
- cur.idx = i;
- zKey2 = sqliteMallocRaw( nKey2+1 );
- getPayload(&cur, 0, nKey2, zKey2);
- if( zKey1 && keyCompare(zKey1, nKey1, zKey2, nKey2)>=0 ){
- checkAppendMsg(pCheck, zContext, "Key is out of order");
- }
-
- /* Check sanity of left child page.
- */
- pgno = SWAB32(pBt, pCell->h.leftChild);
- d2 = checkTreePage(pCheck, pgno, pPage, zContext, zKey1,nKey1,zKey2,nKey2);
- if( i>0 && d2!=depth ){
- checkAppendMsg(pCheck, zContext, "Child page depth differs");
- }
- depth = d2;
- sqliteFree(zKey1);
- zKey1 = zKey2;
- nKey1 = nKey2;
- }
- pgno = SWAB32(pBt, pPage->u.hdr.rightChild);
- sprintf(zContext, "On page %d at right child: ", iPage);
- checkTreePage(pCheck, pgno, pPage, zContext, zKey1,nKey1,zUpperBound,nUpper);
- sqliteFree(zKey1);
-
- /* Check for complete coverage of the page
- */
- memset(hit, 0, sizeof(hit));
- memset(hit, 1, sizeof(PageHdr));
- for(i=SWAB16(pBt, pPage->u.hdr.firstCell); i>0 && i<SQLITE_USABLE_SIZE; ){
- Cell *pCell = (Cell*)&pPage->u.aDisk[i];
- int j;
- for(j=i+cellSize(pBt, pCell)-1; j>=i; j--) hit[j]++;
- i = SWAB16(pBt, pCell->h.iNext);
- }
- for(i=SWAB16(pBt,pPage->u.hdr.firstFree); i>0 && i<SQLITE_USABLE_SIZE; ){
- FreeBlk *pFBlk = (FreeBlk*)&pPage->u.aDisk[i];
- int j;
- for(j=i+SWAB16(pBt,pFBlk->iSize)-1; j>=i; j--) hit[j]++;
- i = SWAB16(pBt,pFBlk->iNext);
- }
- for(i=0; i<SQLITE_USABLE_SIZE; i++){
- if( hit[i]==0 ){
- sprintf(zMsg, "Unused space at byte %d of page %d", i, iPage);
- checkAppendMsg(pCheck, zMsg, 0);
- break;
- }else if( hit[i]>1 ){
- sprintf(zMsg, "Multiple uses for byte %d of page %d", i, iPage);
- checkAppendMsg(pCheck, zMsg, 0);
- break;
- }
- }
-
- /* Check that free space is kept to a minimum
- */
-#if 0
- if( pParent && pParent->nCell>2 && pPage->nFree>3*SQLITE_USABLE_SIZE/4 ){
- sprintf(zMsg, "free space (%d) greater than max (%d)", pPage->nFree,
- SQLITE_USABLE_SIZE/3);
- checkAppendMsg(pCheck, zContext, zMsg);
- }
-#endif
-
- sqlitepager_unref(pPage);
- return depth;
-}
-
-/*
-** This routine does a complete check of the given BTree file. aRoot[] is
-** an array of pages numbers were each page number is the root page of
-** a table. nRoot is the number of entries in aRoot.
-**
-** If everything checks out, this routine returns NULL. If something is
-** amiss, an error message is written into memory obtained from malloc()
-** and a pointer to that error message is returned. The calling function
-** is responsible for freeing the error message when it is done.
-*/
-char *fileBtreeIntegrityCheck(Btree *pBt, int *aRoot, int nRoot){
- int i;
- int nRef;
- IntegrityCk sCheck;
-
- nRef = *sqlitepager_stats(pBt->pPager);
- if( lockBtree(pBt)!=SQLITE_OK ){
- return sqliteStrDup("Unable to acquire a read lock on the database");
- }
- sCheck.pBt = pBt;
- sCheck.pPager = pBt->pPager;
- sCheck.nPage = sqlitepager_pagecount(sCheck.pPager);
- if( sCheck.nPage==0 ){
- unlockBtreeIfUnused(pBt);
- return 0;
- }
- sCheck.anRef = sqliteMallocRaw( (sCheck.nPage+1)*sizeof(sCheck.anRef[0]) );
- sCheck.anRef[1] = 1;
- for(i=2; i<=sCheck.nPage; i++){ sCheck.anRef[i] = 0; }
- sCheck.zErrMsg = 0;
-
- /* Check the integrity of the freelist
- */
- checkList(&sCheck, 1, SWAB32(pBt, pBt->page1->freeList),
- SWAB32(pBt, pBt->page1->nFree), "Main freelist: ");
-
- /* Check all the tables.
- */
- for(i=0; i<nRoot; i++){
- if( aRoot[i]==0 ) continue;
- checkTreePage(&sCheck, aRoot[i], 0, "List of tree roots: ", 0,0,0,0);
- }
-
- /* Make sure every page in the file is referenced
- */
- for(i=1; i<=sCheck.nPage; i++){
- if( sCheck.anRef[i]==0 ){
- char zBuf[100];
- sprintf(zBuf, "Page %d is never used", i);
- checkAppendMsg(&sCheck, zBuf, 0);
- }
- }
-
- /* Make sure this analysis did not leave any unref() pages
- */
- unlockBtreeIfUnused(pBt);
- if( nRef != *sqlitepager_stats(pBt->pPager) ){
- char zBuf[100];
- sprintf(zBuf,
- "Outstanding page count goes from %d to %d during this analysis",
- nRef, *sqlitepager_stats(pBt->pPager)
- );
- checkAppendMsg(&sCheck, zBuf, 0);
- }
-
- /* Clean up and report errors.
- */
- sqliteFree(sCheck.anRef);
- return sCheck.zErrMsg;
-}
-
-/*
-** Return the full pathname of the underlying database file.
-*/
-static const char *fileBtreeGetFilename(Btree *pBt){
- assert( pBt->pPager!=0 );
- return sqlitepager_filename(pBt->pPager);
-}
-
-/*
-** Copy the complete content of pBtFrom into pBtTo. A transaction
-** must be active for both files.
-**
-** The size of file pBtFrom may be reduced by this operation.
-** If anything goes wrong, the transaction on pBtFrom is rolled back.
-*/
-static int fileBtreeCopyFile(Btree *pBtTo, Btree *pBtFrom){
- int rc = SQLITE_OK;
- Pgno i, nPage, nToPage;
-
- if( !pBtTo->inTrans || !pBtFrom->inTrans ) return SQLITE_ERROR;
- if( pBtTo->needSwab!=pBtFrom->needSwab ) return SQLITE_ERROR;
- if( pBtTo->pCursor ) return SQLITE_BUSY;
- memcpy(pBtTo->page1, pBtFrom->page1, SQLITE_USABLE_SIZE);
- rc = sqlitepager_overwrite(pBtTo->pPager, 1, pBtFrom->page1);
- nToPage = sqlitepager_pagecount(pBtTo->pPager);
- nPage = sqlitepager_pagecount(pBtFrom->pPager);
- for(i=2; rc==SQLITE_OK && i<=nPage; i++){
- void *pPage;
- rc = sqlitepager_get(pBtFrom->pPager, i, &pPage);
- if( rc ) break;
- rc = sqlitepager_overwrite(pBtTo->pPager, i, pPage);
- if( rc ) break;
- sqlitepager_unref(pPage);
- }
- for(i=nPage+1; rc==SQLITE_OK && i<=nToPage; i++){
- void *pPage;
- rc = sqlitepager_get(pBtTo->pPager, i, &pPage);
- if( rc ) break;
- rc = sqlitepager_write(pPage);
- sqlitepager_unref(pPage);
- sqlitepager_dont_write(pBtTo->pPager, i);
- }
- if( !rc && nPage<nToPage ){
- rc = sqlitepager_truncate(pBtTo->pPager, nPage);
- }
- if( rc ){
- fileBtreeRollback(pBtTo);
- }
- return rc;
-}
-
-/*
-** The following tables contain pointers to all of the interface
-** routines for this implementation of the B*Tree backend. To
-** substitute a different implemention of the backend, one has merely
-** to provide pointers to alternative functions in similar tables.
-*/
-static BtOps sqliteBtreeOps = {
- fileBtreeClose,
- fileBtreeSetCacheSize,
- fileBtreeSetSafetyLevel,
- fileBtreeBeginTrans,
- fileBtreeCommit,
- fileBtreeRollback,
- fileBtreeBeginCkpt,
- fileBtreeCommitCkpt,
- fileBtreeRollbackCkpt,
- fileBtreeCreateTable,
- fileBtreeCreateTable, /* Really sqliteBtreeCreateIndex() */
- fileBtreeDropTable,
- fileBtreeClearTable,
- fileBtreeCursor,
- fileBtreeGetMeta,
- fileBtreeUpdateMeta,
- fileBtreeIntegrityCheck,
- fileBtreeGetFilename,
- fileBtreeCopyFile,
- fileBtreePager,
-#ifdef SQLITE_TEST
- fileBtreePageDump,
-#endif
-};
-static BtCursorOps sqliteBtreeCursorOps = {
- fileBtreeMoveto,
- fileBtreeDelete,
- fileBtreeInsert,
- fileBtreeFirst,
- fileBtreeLast,
- fileBtreeNext,
- fileBtreePrevious,
- fileBtreeKeySize,
- fileBtreeKey,
- fileBtreeKeyCompare,
- fileBtreeDataSize,
- fileBtreeData,
- fileBtreeCloseCursor,
-#ifdef SQLITE_TEST
- fileBtreeCursorDump,
-#endif
-};
+++ /dev/null
-/*
-** 2001 September 15
-**
-** The author disclaims copyright to this source code. In place of
-** a legal notice, here is a blessing:
-**
-** May you do good and not evil.
-** May you find forgiveness for yourself and forgive others.
-** May you share freely, never taking more than you give.
-**
-*************************************************************************
-** This header file defines the interface that the sqlite B-Tree file
-** subsystem. See comments in the source code for a detailed description
-** of what each interface routine does.
-**
-** @(#) $Id: btree.h,v 1.1.1.1 2004/08/08 15:03:57 matt Exp $
-*/
-#ifndef _BTREE_H_
-#define _BTREE_H_
-
-/*
-** Forward declarations of structure
-*/
-typedef struct Btree Btree;
-typedef struct BtCursor BtCursor;
-typedef struct BtOps BtOps;
-typedef struct BtCursorOps BtCursorOps;
-
-
-/*
-** An instance of the following structure contains pointers to all
-** methods against an open BTree. Alternative BTree implementations
-** (examples: file based versus in-memory) can be created by substituting
-** different methods. Users of the BTree cannot tell the difference.
-**
-** In C++ we could do this by defining a virtual base class and then
-** creating subclasses for each different implementation. But this is
-** C not C++ so we have to be a little more explicit.
-*/
-struct BtOps {
- int (*Close)(Btree*);
- int (*SetCacheSize)(Btree*, int);
- int (*SetSafetyLevel)(Btree*, int);
- int (*BeginTrans)(Btree*);
- int (*Commit)(Btree*);
- int (*Rollback)(Btree*);
- int (*BeginCkpt)(Btree*);
- int (*CommitCkpt)(Btree*);
- int (*RollbackCkpt)(Btree*);
- int (*CreateTable)(Btree*, int*);
- int (*CreateIndex)(Btree*, int*);
- int (*DropTable)(Btree*, int);
- int (*ClearTable)(Btree*, int);
- int (*Cursor)(Btree*, int iTable, int wrFlag, BtCursor **ppCur);
- int (*GetMeta)(Btree*, int*);
- int (*UpdateMeta)(Btree*, int*);
- char *(*IntegrityCheck)(Btree*, int*, int);
- const char *(*GetFilename)(Btree*);
- int (*Copyfile)(Btree*,Btree*);
- struct Pager *(*Pager)(Btree*);
-#ifdef SQLITE_TEST
- int (*PageDump)(Btree*, int, int);
-#endif
-};
-
-/*
-** An instance of this structure defines all of the methods that can
-** be executed against a cursor.
-*/
-struct BtCursorOps {
- int (*Moveto)(BtCursor*, const void *pKey, int nKey, int *pRes);
- int (*Delete)(BtCursor*);
- int (*Insert)(BtCursor*, const void *pKey, int nKey,
- const void *pData, int nData);
- int (*First)(BtCursor*, int *pRes);
- int (*Last)(BtCursor*, int *pRes);
- int (*Next)(BtCursor*, int *pRes);
- int (*Previous)(BtCursor*, int *pRes);
- int (*KeySize)(BtCursor*, int *pSize);
- int (*Key)(BtCursor*, int offset, int amt, char *zBuf);
- int (*KeyCompare)(BtCursor*, const void *pKey, int nKey,
- int nIgnore, int *pRes);
- int (*DataSize)(BtCursor*, int *pSize);
- int (*Data)(BtCursor*, int offset, int amt, char *zBuf);
- int (*CloseCursor)(BtCursor*);
-#ifdef SQLITE_TEST
- int (*CursorDump)(BtCursor*, int*);
-#endif
-};
-
-/*
-** The number of 4-byte "meta" values contained on the first page of each
-** database file.
-*/
-#define SQLITE_N_BTREE_META 10
-
-int sqliteBtreeOpen(const char *zFilename, int mode, int nPg, Btree **ppBtree);
-int sqliteRbtreeOpen(const char *zFilename, int mode, int nPg, Btree **ppBtree);
-
-#define btOps(pBt) (*((BtOps **)(pBt)))
-#define btCOps(pCur) (*((BtCursorOps **)(pCur)))
-
-#define sqliteBtreeClose(pBt) (btOps(pBt)->Close(pBt))
-#define sqliteBtreeSetCacheSize(pBt, sz) (btOps(pBt)->SetCacheSize(pBt, sz))
-#define sqliteBtreeSetSafetyLevel(pBt, sl) (btOps(pBt)->SetSafetyLevel(pBt, sl))
-#define sqliteBtreeBeginTrans(pBt) (btOps(pBt)->BeginTrans(pBt))
-#define sqliteBtreeCommit(pBt) (btOps(pBt)->Commit(pBt))
-#define sqliteBtreeRollback(pBt) (btOps(pBt)->Rollback(pBt))
-#define sqliteBtreeBeginCkpt(pBt) (btOps(pBt)->BeginCkpt(pBt))
-#define sqliteBtreeCommitCkpt(pBt) (btOps(pBt)->CommitCkpt(pBt))
-#define sqliteBtreeRollbackCkpt(pBt) (btOps(pBt)->RollbackCkpt(pBt))
-#define sqliteBtreeCreateTable(pBt,piTable)\
- (btOps(pBt)->CreateTable(pBt,piTable))
-#define sqliteBtreeCreateIndex(pBt, piIndex)\
- (btOps(pBt)->CreateIndex(pBt, piIndex))
-#define sqliteBtreeDropTable(pBt, iTable) (btOps(pBt)->DropTable(pBt, iTable))
-#define sqliteBtreeClearTable(pBt, iTable)\
- (btOps(pBt)->ClearTable(pBt, iTable))
-#define sqliteBtreeCursor(pBt, iTable, wrFlag, ppCur)\
- (btOps(pBt)->Cursor(pBt, iTable, wrFlag, ppCur))
-#define sqliteBtreeMoveto(pCur, pKey, nKey, pRes)\
- (btCOps(pCur)->Moveto(pCur, pKey, nKey, pRes))
-#define sqliteBtreeDelete(pCur) (btCOps(pCur)->Delete(pCur))
-#define sqliteBtreeInsert(pCur, pKey, nKey, pData, nData) \
- (btCOps(pCur)->Insert(pCur, pKey, nKey, pData, nData))
-#define sqliteBtreeFirst(pCur, pRes) (btCOps(pCur)->First(pCur, pRes))
-#define sqliteBtreeLast(pCur, pRes) (btCOps(pCur)->Last(pCur, pRes))
-#define sqliteBtreeNext(pCur, pRes) (btCOps(pCur)->Next(pCur, pRes))
-#define sqliteBtreePrevious(pCur, pRes) (btCOps(pCur)->Previous(pCur, pRes))
-#define sqliteBtreeKeySize(pCur, pSize) (btCOps(pCur)->KeySize(pCur, pSize) )
-#define sqliteBtreeKey(pCur, offset, amt, zBuf)\
- (btCOps(pCur)->Key(pCur, offset, amt, zBuf))
-#define sqliteBtreeKeyCompare(pCur, pKey, nKey, nIgnore, pRes)\
- (btCOps(pCur)->KeyCompare(pCur, pKey, nKey, nIgnore, pRes))
-#define sqliteBtreeDataSize(pCur, pSize) (btCOps(pCur)->DataSize(pCur, pSize))
-#define sqliteBtreeData(pCur, offset, amt, zBuf)\
- (btCOps(pCur)->Data(pCur, offset, amt, zBuf))
-#define sqliteBtreeCloseCursor(pCur) (btCOps(pCur)->CloseCursor(pCur))
-#define sqliteBtreeGetMeta(pBt, aMeta) (btOps(pBt)->GetMeta(pBt, aMeta))
-#define sqliteBtreeUpdateMeta(pBt, aMeta) (btOps(pBt)->UpdateMeta(pBt, aMeta))
-#define sqliteBtreeIntegrityCheck(pBt, aRoot, nRoot)\
- (btOps(pBt)->IntegrityCheck(pBt, aRoot, nRoot))
-#define sqliteBtreeGetFilename(pBt) (btOps(pBt)->GetFilename(pBt))
-#define sqliteBtreeCopyFile(pBt1, pBt2) (btOps(pBt1)->Copyfile(pBt1, pBt2))
-#define sqliteBtreePager(pBt) (btOps(pBt)->Pager(pBt))
-
-#ifdef SQLITE_TEST
-#define sqliteBtreePageDump(pBt, pgno, recursive)\
- (btOps(pBt)->PageDump(pBt, pgno, recursive))
-#define sqliteBtreeCursorDump(pCur, aResult)\
- (btCOps(pCur)->CursorDump(pCur, aResult))
-int btree_native_byte_order;
-#endif /* SQLITE_TEST */
-
-
-#endif /* _BTREE_H_ */
+++ /dev/null
-/*
-** 2003 Feb 4
-**
-** The author disclaims copyright to this source code. In place of
-** a legal notice, here is a blessing:
-**
-** May you do good and not evil.
-** May you find forgiveness for yourself and forgive others.
-** May you share freely, never taking more than you give.
-**
-*************************************************************************
-** $Id: btree_rb.c,v 1.1.1.1 2004/08/08 15:03:57 matt Exp $
-**
-** This file implements an in-core database using Red-Black balanced
-** binary trees.
-**
-** It was contributed to SQLite by anonymous on 2003-Feb-04 23:24:49 UTC.
-*/
-#include "btree.h"
-#include "sqliteInt.h"
-#include <assert.h>
-
-/*
-** Omit this whole file if the SQLITE_OMIT_INMEMORYDB macro is
-** defined. This allows a lot of code to be omitted for installations
-** that do not need it.
-*/
-#ifndef SQLITE_OMIT_INMEMORYDB
-
-
-typedef struct BtRbTree BtRbTree;
-typedef struct BtRbNode BtRbNode;
-typedef struct BtRollbackOp BtRollbackOp;
-typedef struct Rbtree Rbtree;
-typedef struct RbtCursor RbtCursor;
-
-/* Forward declarations */
-static BtOps sqliteRbtreeOps;
-static BtCursorOps sqliteRbtreeCursorOps;
-
-/*
- * During each transaction (or checkpoint), a linked-list of
- * "rollback-operations" is accumulated. If the transaction is rolled back,
- * then the list of operations must be executed (to restore the database to
- * it's state before the transaction started). If the transaction is to be
- * committed, just delete the list.
- *
- * Each operation is represented as follows, depending on the value of eOp:
- *
- * ROLLBACK_INSERT -> Need to insert (pKey, pData) into table iTab.
- * ROLLBACK_DELETE -> Need to delete the record (pKey) into table iTab.
- * ROLLBACK_CREATE -> Need to create table iTab.
- * ROLLBACK_DROP -> Need to drop table iTab.
- */
-struct BtRollbackOp {
- u8 eOp;
- int iTab;
- int nKey;
- void *pKey;
- int nData;
- void *pData;
- BtRollbackOp *pNext;
-};
-
-/*
-** Legal values for BtRollbackOp.eOp:
-*/
-#define ROLLBACK_INSERT 1 /* Insert a record */
-#define ROLLBACK_DELETE 2 /* Delete a record */
-#define ROLLBACK_CREATE 3 /* Create a table */
-#define ROLLBACK_DROP 4 /* Drop a table */
-
-struct Rbtree {
- BtOps *pOps; /* Function table */
- int aMetaData[SQLITE_N_BTREE_META];
-
- int next_idx; /* next available table index */
- Hash tblHash; /* All created tables, by index */
- u8 isAnonymous; /* True if this Rbtree is to be deleted when closed */
- u8 eTransState; /* State of this Rbtree wrt transactions */
-
- BtRollbackOp *pTransRollback;
- BtRollbackOp *pCheckRollback;
- BtRollbackOp *pCheckRollbackTail;
-};
-
-/*
-** Legal values for Rbtree.eTransState.
-*/
-#define TRANS_NONE 0 /* No transaction is in progress */
-#define TRANS_INTRANSACTION 1 /* A transaction is in progress */
-#define TRANS_INCHECKPOINT 2 /* A checkpoint is in progress */
-#define TRANS_ROLLBACK 3 /* We are currently rolling back a checkpoint or
- * transaction. */
-
-struct RbtCursor {
- BtCursorOps *pOps; /* Function table */
- Rbtree *pRbtree;
- BtRbTree *pTree;
- int iTree; /* Index of pTree in pRbtree */
- BtRbNode *pNode;
- RbtCursor *pShared; /* List of all cursors on the same Rbtree */
- u8 eSkip; /* Determines if next step operation is a no-op */
- u8 wrFlag; /* True if this cursor is open for writing */
-};
-
-/*
-** Legal values for RbtCursor.eSkip.
-*/
-#define SKIP_NONE 0 /* Always step the cursor */
-#define SKIP_NEXT 1 /* The next sqliteRbtreeNext() is a no-op */
-#define SKIP_PREV 2 /* The next sqliteRbtreePrevious() is a no-op */
-#define SKIP_INVALID 3 /* Calls to Next() and Previous() are invalid */
-
-struct BtRbTree {
- RbtCursor *pCursors; /* All cursors pointing to this tree */
- BtRbNode *pHead; /* Head of the tree, or NULL */
-};
-
-struct BtRbNode {
- int nKey;
- void *pKey;
- int nData;
- void *pData;
- u8 isBlack; /* true for a black node, 0 for a red node */
- BtRbNode *pParent; /* Nodes parent node, NULL for the tree head */
- BtRbNode *pLeft; /* Nodes left child, or NULL */
- BtRbNode *pRight; /* Nodes right child, or NULL */
-
- int nBlackHeight; /* Only used during the red-black integrity check */
-};
-
-/* Forward declarations */
-static int memRbtreeMoveto(
- RbtCursor* pCur,
- const void *pKey,
- int nKey,
- int *pRes
-);
-static int memRbtreeClearTable(Rbtree* tree, int n);
-static int memRbtreeNext(RbtCursor* pCur, int *pRes);
-static int memRbtreeLast(RbtCursor* pCur, int *pRes);
-static int memRbtreePrevious(RbtCursor* pCur, int *pRes);
-
-
-/*
-** This routine checks all cursors that point to the same table
-** as pCur points to. If any of those cursors were opened with
-** wrFlag==0 then this routine returns SQLITE_LOCKED. If all
-** cursors point to the same table were opened with wrFlag==1
-** then this routine returns SQLITE_OK.
-**
-** In addition to checking for read-locks (where a read-lock
-** means a cursor opened with wrFlag==0) this routine also NULLs
-** out the pNode field of all other cursors.
-** This is necessary because an insert
-** or delete might change erase the node out from under
-** another cursor.
-*/
-static int checkReadLocks(RbtCursor *pCur){
- RbtCursor *p;
- assert( pCur->wrFlag );
- for(p=pCur->pTree->pCursors; p; p=p->pShared){
- if( p!=pCur ){
- if( p->wrFlag==0 ) return SQLITE_LOCKED;
- p->pNode = 0;
- }
- }
- return SQLITE_OK;
-}
-
-/*
- * The key-compare function for the red-black trees. Returns as follows:
- *
- * (key1 < key2) -1
- * (key1 == key2) 0
- * (key1 > key2) 1
- *
- * Keys are compared using memcmp(). If one key is an exact prefix of the
- * other, then the shorter key is less than the longer key.
- */
-static int key_compare(void const*pKey1, int nKey1, void const*pKey2, int nKey2)
-{
- int mcmp = memcmp(pKey1, pKey2, (nKey1 <= nKey2)?nKey1:nKey2);
- if( mcmp == 0){
- if( nKey1 == nKey2 ) return 0;
- return ((nKey1 < nKey2)?-1:1);
- }
- return ((mcmp>0)?1:-1);
-}
-
-/*
- * Perform the LEFT-rotate transformation on node X of tree pTree. This
- * transform is part of the red-black balancing code.
- *
- * | |
- * X Y
- * / \ / \
- * a Y X c
- * / \ / \
- * b c a b
- *
- * BEFORE AFTER
- */
-static void leftRotate(BtRbTree *pTree, BtRbNode *pX)
-{
- BtRbNode *pY;
- BtRbNode *pb;
- pY = pX->pRight;
- pb = pY->pLeft;
-
- pY->pParent = pX->pParent;
- if( pX->pParent ){
- if( pX->pParent->pLeft == pX ) pX->pParent->pLeft = pY;
- else pX->pParent->pRight = pY;
- }
- pY->pLeft = pX;
- pX->pParent = pY;
- pX->pRight = pb;
- if( pb ) pb->pParent = pX;
- if( pTree->pHead == pX ) pTree->pHead = pY;
-}
-
-/*
- * Perform the RIGHT-rotate transformation on node X of tree pTree. This
- * transform is part of the red-black balancing code.
- *
- * | |
- * X Y
- * / \ / \
- * Y c a X
- * / \ / \
- * a b b c
- *
- * BEFORE AFTER
- */
-static void rightRotate(BtRbTree *pTree, BtRbNode *pX)
-{
- BtRbNode *pY;
- BtRbNode *pb;
- pY = pX->pLeft;
- pb = pY->pRight;
-
- pY->pParent = pX->pParent;
- if( pX->pParent ){
- if( pX->pParent->pLeft == pX ) pX->pParent->pLeft = pY;
- else pX->pParent->pRight = pY;
- }
- pY->pRight = pX;
- pX->pParent = pY;
- pX->pLeft = pb;
- if( pb ) pb->pParent = pX;
- if( pTree->pHead == pX ) pTree->pHead = pY;
-}
-
-/*
- * A string-manipulation helper function for check_redblack_tree(). If (orig ==
- * NULL) a copy of val is returned. If (orig != NULL) then a copy of the *
- * concatenation of orig and val is returned. The original orig is deleted
- * (using sqliteFree()).
- */
-static char *append_val(char * orig, char const * val){
- char *z;
- if( !orig ){
- z = sqliteStrDup( val );
- } else{
- z = 0;
- sqliteSetString(&z, orig, val, (char*)0);
- sqliteFree( orig );
- }
- return z;
-}
-
-/*
- * Append a string representation of the entire node to orig and return it.
- * This is used to produce debugging information if check_redblack_tree() finds
- * a problem with a red-black binary tree.
- */
-static char *append_node(char * orig, BtRbNode *pNode, int indent)
-{
- char buf[128];
- int i;
-
- for( i=0; i<indent; i++ ){
- orig = append_val(orig, " ");
- }
-
- sprintf(buf, "%p", pNode);
- orig = append_val(orig, buf);
-
- if( pNode ){
- indent += 3;
- if( pNode->isBlack ){
- orig = append_val(orig, " B \n");
- }else{
- orig = append_val(orig, " R \n");
- }
- orig = append_node( orig, pNode->pLeft, indent );
- orig = append_node( orig, pNode->pRight, indent );
- }else{
- orig = append_val(orig, "\n");
- }
- return orig;
-}
-
-/*
- * Print a representation of a node to stdout. This function is only included
- * so you can call it from within a debugger if things get really bad. It
- * is not called from anyplace in the code.
- */
-static void print_node(BtRbNode *pNode)
-{
- char * str = append_node(0, pNode, 0);
- printf("%s", str);
-
- /* Suppress a warning message about print_node() being unused */
- (void)print_node;
-}
-
-/*
- * Check the following properties of the red-black tree:
- * (1) - If a node is red, both of it's children are black
- * (2) - Each path from a given node to a leaf (NULL) node passes thru the
- * same number of black nodes
- *
- * If there is a problem, append a description (using append_val() ) to *msg.
- */
-static void check_redblack_tree(BtRbTree * tree, char ** msg)
-{
- BtRbNode *pNode;
-
- /* 0 -> came from parent
- * 1 -> came from left
- * 2 -> came from right */
- int prev_step = 0;
-
- pNode = tree->pHead;
- while( pNode ){
- switch( prev_step ){
- case 0:
- if( pNode->pLeft ){
- pNode = pNode->pLeft;
- }else{
- prev_step = 1;
- }
- break;
- case 1:
- if( pNode->pRight ){
- pNode = pNode->pRight;
- prev_step = 0;
- }else{
- prev_step = 2;
- }
- break;
- case 2:
- /* Check red-black property (1) */
- if( !pNode->isBlack &&
- ( (pNode->pLeft && !pNode->pLeft->isBlack) ||
- (pNode->pRight && !pNode->pRight->isBlack) )
- ){
- char buf[128];
- sprintf(buf, "Red node with red child at %p\n", pNode);
- *msg = append_val(*msg, buf);
- *msg = append_node(*msg, tree->pHead, 0);
- *msg = append_val(*msg, "\n");
- }
-
- /* Check red-black property (2) */
- {
- int leftHeight = 0;
- int rightHeight = 0;
- if( pNode->pLeft ){
- leftHeight += pNode->pLeft->nBlackHeight;
- leftHeight += (pNode->pLeft->isBlack?1:0);
- }
- if( pNode->pRight ){
- rightHeight += pNode->pRight->nBlackHeight;
- rightHeight += (pNode->pRight->isBlack?1:0);
- }
- if( leftHeight != rightHeight ){
- char buf[128];
- sprintf(buf, "Different black-heights at %p\n", pNode);
- *msg = append_val(*msg, buf);
- *msg = append_node(*msg, tree->pHead, 0);
- *msg = append_val(*msg, "\n");
- }
- pNode->nBlackHeight = leftHeight;
- }
-
- if( pNode->pParent ){
- if( pNode == pNode->pParent->pLeft ) prev_step = 1;
- else prev_step = 2;
- }
- pNode = pNode->pParent;
- break;
- default: assert(0);
- }
- }
-}
-
-/*
- * Node pX has just been inserted into pTree (by code in sqliteRbtreeInsert()).
- * It is possible that pX is a red node with a red parent, which is a violation
- * of the red-black tree properties. This function performs rotations and
- * color changes to rebalance the tree
- */
-static void do_insert_balancing(BtRbTree *pTree, BtRbNode *pX)
-{
- /* In the first iteration of this loop, pX points to the red node just
- * inserted in the tree. If the parent of pX exists (pX is not the root
- * node) and is red, then the properties of the red-black tree are
- * violated.
- *
- * At the start of any subsequent iterations, pX points to a red node
- * with a red parent. In all other respects the tree is a legal red-black
- * binary tree. */
- while( pX != pTree->pHead && !pX->pParent->isBlack ){
- BtRbNode *pUncle;
- BtRbNode *pGrandparent;
-
- /* Grandparent of pX must exist and must be black. */
- pGrandparent = pX->pParent->pParent;
- assert( pGrandparent );
- assert( pGrandparent->isBlack );
-
- /* Uncle of pX may or may not exist. */
- if( pX->pParent == pGrandparent->pLeft )
- pUncle = pGrandparent->pRight;
- else
- pUncle = pGrandparent->pLeft;
-
- /* If the uncle of pX exists and is red, we do the following:
- * | |
- * G(b) G(r)
- * / \ / \
- * U(r) P(r) U(b) P(b)
- * \ \
- * X(r) X(r)
- *
- * BEFORE AFTER
- * pX is then set to G. If the parent of G is red, then the while loop
- * will run again. */
- if( pUncle && !pUncle->isBlack ){
- pGrandparent->isBlack = 0;
- pUncle->isBlack = 1;
- pX->pParent->isBlack = 1;
- pX = pGrandparent;
- }else{
-
- if( pX->pParent == pGrandparent->pLeft ){
- if( pX == pX->pParent->pRight ){
- /* If pX is a right-child, do the following transform, essentially
- * to change pX into a left-child:
- * | |
- * G(b) G(b)
- * / \ / \
- * P(r) U(b) X(r) U(b)
- * \ /
- * X(r) P(r) <-- new X
- *
- * BEFORE AFTER
- */
- pX = pX->pParent;
- leftRotate(pTree, pX);
- }
-
- /* Do the following transform, which balances the tree :)
- * | |
- * G(b) P(b)
- * / \ / \
- * P(r) U(b) X(r) G(r)
- * / \
- * X(r) U(b)
- *
- * BEFORE AFTER
- */
- assert( pGrandparent == pX->pParent->pParent );
- pGrandparent->isBlack = 0;
- pX->pParent->isBlack = 1;
- rightRotate( pTree, pGrandparent );
-
- }else{
- /* This code is symetric to the illustrated case above. */
- if( pX == pX->pParent->pLeft ){
- pX = pX->pParent;
- rightRotate(pTree, pX);
- }
- assert( pGrandparent == pX->pParent->pParent );
- pGrandparent->isBlack = 0;
- pX->pParent->isBlack = 1;
- leftRotate( pTree, pGrandparent );
- }
- }
- }
- pTree->pHead->isBlack = 1;
-}
-
-/*
- * A child of pParent, which in turn had child pX, has just been removed from
- * pTree (the figure below depicts the operation, Z is being removed). pParent
- * or pX, or both may be NULL.
- * | |
- * P P
- * / \ / \
- * Z X
- * / \
- * X nil
- *
- * This function is only called if Z was black. In this case the red-black tree
- * properties have been violated, and pX has an "extra black". This function
- * performs rotations and color-changes to re-balance the tree.
- */
-static
-void do_delete_balancing(BtRbTree *pTree, BtRbNode *pX, BtRbNode *pParent)
-{
- BtRbNode *pSib;
-
- /* TODO: Comment this code! */
- while( pX != pTree->pHead && (!pX || pX->isBlack) ){
- if( pX == pParent->pLeft ){
- pSib = pParent->pRight;
- if( pSib && !(pSib->isBlack) ){
- pSib->isBlack = 1;
- pParent->isBlack = 0;
- leftRotate(pTree, pParent);
- pSib = pParent->pRight;
- }
- if( !pSib ){
- pX = pParent;
- }else if(
- (!pSib->pLeft || pSib->pLeft->isBlack) &&
- (!pSib->pRight || pSib->pRight->isBlack) ) {
- pSib->isBlack = 0;
- pX = pParent;
- }else{
- if( (!pSib->pRight || pSib->pRight->isBlack) ){
- if( pSib->pLeft ) pSib->pLeft->isBlack = 1;
- pSib->isBlack = 0;
- rightRotate( pTree, pSib );
- pSib = pParent->pRight;
- }
- pSib->isBlack = pParent->isBlack;
- pParent->isBlack = 1;
- if( pSib->pRight ) pSib->pRight->isBlack = 1;
- leftRotate(pTree, pParent);
- pX = pTree->pHead;
- }
- }else{
- pSib = pParent->pLeft;
- if( pSib && !(pSib->isBlack) ){
- pSib->isBlack = 1;
- pParent->isBlack = 0;
- rightRotate(pTree, pParent);
- pSib = pParent->pLeft;
- }
- if( !pSib ){
- pX = pParent;
- }else if(
- (!pSib->pLeft || pSib->pLeft->isBlack) &&
- (!pSib->pRight || pSib->pRight->isBlack) ){
- pSib->isBlack = 0;
- pX = pParent;
- }else{
- if( (!pSib->pLeft || pSib->pLeft->isBlack) ){
- if( pSib->pRight ) pSib->pRight->isBlack = 1;
- pSib->isBlack = 0;
- leftRotate( pTree, pSib );
- pSib = pParent->pLeft;
- }
- pSib->isBlack = pParent->isBlack;
- pParent->isBlack = 1;
- if( pSib->pLeft ) pSib->pLeft->isBlack = 1;
- rightRotate(pTree, pParent);
- pX = pTree->pHead;
- }
- }
- pParent = pX->pParent;
- }
- if( pX ) pX->isBlack = 1;
-}
-
-/*
- * Create table n in tree pRbtree. Table n must not exist.
- */
-static void btreeCreateTable(Rbtree* pRbtree, int n)
-{
- BtRbTree *pNewTbl = sqliteMalloc(sizeof(BtRbTree));
- sqliteHashInsert(&pRbtree->tblHash, 0, n, pNewTbl);
-}
-
-/*
- * Log a single "rollback-op" for the given Rbtree. See comments for struct
- * BtRollbackOp.
- */
-static void btreeLogRollbackOp(Rbtree* pRbtree, BtRollbackOp *pRollbackOp)
-{
- assert( pRbtree->eTransState == TRANS_INCHECKPOINT ||
- pRbtree->eTransState == TRANS_INTRANSACTION );
- if( pRbtree->eTransState == TRANS_INTRANSACTION ){
- pRollbackOp->pNext = pRbtree->pTransRollback;
- pRbtree->pTransRollback = pRollbackOp;
- }
- if( pRbtree->eTransState == TRANS_INCHECKPOINT ){
- if( !pRbtree->pCheckRollback ){
- pRbtree->pCheckRollbackTail = pRollbackOp;
- }
- pRollbackOp->pNext = pRbtree->pCheckRollback;
- pRbtree->pCheckRollback = pRollbackOp;
- }
-}
-
-int sqliteRbtreeOpen(
- const char *zFilename,
- int mode,
- int nPg,
- Btree **ppBtree
-){
- Rbtree **ppRbtree = (Rbtree**)ppBtree;
- *ppRbtree = (Rbtree *)sqliteMalloc(sizeof(Rbtree));
- if( sqlite_malloc_failed ) goto open_no_mem;
- sqliteHashInit(&(*ppRbtree)->tblHash, SQLITE_HASH_INT, 0);
-
- /* Create a binary tree for the SQLITE_MASTER table at location 2 */
- btreeCreateTable(*ppRbtree, 2);
- if( sqlite_malloc_failed ) goto open_no_mem;
- (*ppRbtree)->next_idx = 3;
- (*ppRbtree)->pOps = &sqliteRbtreeOps;
- /* Set file type to 4; this is so that "attach ':memory:' as ...." does not
- ** think that the database in uninitialised and refuse to attach
- */
- (*ppRbtree)->aMetaData[2] = 4;
-
- return SQLITE_OK;
-
-open_no_mem:
- *ppBtree = 0;
- return SQLITE_NOMEM;
-}
-
-/*
- * Create a new table in the supplied Rbtree. Set *n to the new table number.
- * Return SQLITE_OK if the operation is a success.
- */
-static int memRbtreeCreateTable(Rbtree* tree, int* n)
-{
- assert( tree->eTransState != TRANS_NONE );
-
- *n = tree->next_idx++;
- btreeCreateTable(tree, *n);
- if( sqlite_malloc_failed ) return SQLITE_NOMEM;
-
- /* Set up the rollback structure (if we are not doing this as part of a
- * rollback) */
- if( tree->eTransState != TRANS_ROLLBACK ){
- BtRollbackOp *pRollbackOp = sqliteMalloc(sizeof(BtRollbackOp));
- if( pRollbackOp==0 ) return SQLITE_NOMEM;
- pRollbackOp->eOp = ROLLBACK_DROP;
- pRollbackOp->iTab = *n;
- btreeLogRollbackOp(tree, pRollbackOp);
- }
-
- return SQLITE_OK;
-}
-
-/*
- * Delete table n from the supplied Rbtree.
- */
-static int memRbtreeDropTable(Rbtree* tree, int n)
-{
- BtRbTree *pTree;
- assert( tree->eTransState != TRANS_NONE );
-
- memRbtreeClearTable(tree, n);
- pTree = sqliteHashInsert(&tree->tblHash, 0, n, 0);
- assert(pTree);
- assert( pTree->pCursors==0 );
- sqliteFree(pTree);
-
- if( tree->eTransState != TRANS_ROLLBACK ){
- BtRollbackOp *pRollbackOp = sqliteMalloc(sizeof(BtRollbackOp));
- if( pRollbackOp==0 ) return SQLITE_NOMEM;
- pRollbackOp->eOp = ROLLBACK_CREATE;
- pRollbackOp->iTab = n;
- btreeLogRollbackOp(tree, pRollbackOp);
- }
-
- return SQLITE_OK;
-}
-
-static int memRbtreeKeyCompare(RbtCursor* pCur, const void *pKey, int nKey,
- int nIgnore, int *pRes)
-{
- assert(pCur);
-
- if( !pCur->pNode ) {
- *pRes = -1;
- } else {
- if( (pCur->pNode->nKey - nIgnore) < 0 ){
- *pRes = -1;
- }else{
- *pRes = key_compare(pCur->pNode->pKey, pCur->pNode->nKey-nIgnore,
- pKey, nKey);
- }
- }
- return SQLITE_OK;
-}
-
-/*
- * Get a new cursor for table iTable of the supplied Rbtree. The wrFlag
- * parameter indicates that the cursor is open for writing.
- *
- * Note that RbtCursor.eSkip and RbtCursor.pNode both initialize to 0.
- */
-static int memRbtreeCursor(
- Rbtree* tree,
- int iTable,
- int wrFlag,
- RbtCursor **ppCur
-){
- RbtCursor *pCur;
- assert(tree);
- pCur = *ppCur = sqliteMalloc(sizeof(RbtCursor));
- if( sqlite_malloc_failed ) return SQLITE_NOMEM;
- pCur->pTree = sqliteHashFind(&tree->tblHash, 0, iTable);
- assert( pCur->pTree );
- pCur->pRbtree = tree;
- pCur->iTree = iTable;
- pCur->pOps = &sqliteRbtreeCursorOps;
- pCur->wrFlag = wrFlag;
- pCur->pShared = pCur->pTree->pCursors;
- pCur->pTree->pCursors = pCur;
-
- assert( (*ppCur)->pTree );
- return SQLITE_OK;
-}
-
-/*
- * Insert a new record into the Rbtree. The key is given by (pKey,nKey)
- * and the data is given by (pData,nData). The cursor is used only to
- * define what database the record should be inserted into. The cursor
- * is left pointing at the new record.
- *
- * If the key exists already in the tree, just replace the data.
- */
-static int memRbtreeInsert(
- RbtCursor* pCur,
- const void *pKey,
- int nKey,
- const void *pDataInput,
- int nData
-){
- void * pData;
- int match;
-
- /* It is illegal to call sqliteRbtreeInsert() if we are
- ** not in a transaction */
- assert( pCur->pRbtree->eTransState != TRANS_NONE );
-
- /* Make sure some other cursor isn't trying to read this same table */
- if( checkReadLocks(pCur) ){
- return SQLITE_LOCKED; /* The table pCur points to has a read lock */
- }
-
- /* Take a copy of the input data now, in case we need it for the
- * replace case */
- pData = sqliteMallocRaw(nData);
- if( sqlite_malloc_failed ) return SQLITE_NOMEM;
- memcpy(pData, pDataInput, nData);
-
- /* Move the cursor to a node near the key to be inserted. If the key already
- * exists in the table, then (match == 0). In this case we can just replace
- * the data associated with the entry, we don't need to manipulate the tree.
- *
- * If there is no exact match, then the cursor points at what would be either
- * the predecessor (match == -1) or successor (match == 1) of the
- * searched-for key, were it to be inserted. The new node becomes a child of
- * this node.
- *
- * The new node is initially red.
- */
- memRbtreeMoveto( pCur, pKey, nKey, &match);
- if( match ){
- BtRbNode *pNode = sqliteMalloc(sizeof(BtRbNode));
- if( pNode==0 ) return SQLITE_NOMEM;
- pNode->nKey = nKey;
- pNode->pKey = sqliteMallocRaw(nKey);
- if( sqlite_malloc_failed ) return SQLITE_NOMEM;
- memcpy(pNode->pKey, pKey, nKey);
- pNode->nData = nData;
- pNode->pData = pData;
- if( pCur->pNode ){
- switch( match ){
- case -1:
- assert( !pCur->pNode->pRight );
- pNode->pParent = pCur->pNode;
- pCur->pNode->pRight = pNode;
- break;
- case 1:
- assert( !pCur->pNode->pLeft );
- pNode->pParent = pCur->pNode;
- pCur->pNode->pLeft = pNode;
- break;
- default:
- assert(0);
- }
- }else{
- pCur->pTree->pHead = pNode;
- }
-
- /* Point the cursor at the node just inserted, as per SQLite requirements */
- pCur->pNode = pNode;
-
- /* A new node has just been inserted, so run the balancing code */
- do_insert_balancing(pCur->pTree, pNode);
-
- /* Set up a rollback-op in case we have to roll this operation back */
- if( pCur->pRbtree->eTransState != TRANS_ROLLBACK ){
- BtRollbackOp *pOp = sqliteMalloc( sizeof(BtRollbackOp) );
- if( pOp==0 ) return SQLITE_NOMEM;
- pOp->eOp = ROLLBACK_DELETE;
- pOp->iTab = pCur->iTree;
- pOp->nKey = pNode->nKey;
- pOp->pKey = sqliteMallocRaw( pOp->nKey );
- if( sqlite_malloc_failed ) return SQLITE_NOMEM;
- memcpy( pOp->pKey, pNode->pKey, pOp->nKey );
- btreeLogRollbackOp(pCur->pRbtree, pOp);
- }
-
- }else{
- /* No need to insert a new node in the tree, as the key already exists.
- * Just clobber the current nodes data. */
-
- /* Set up a rollback-op in case we have to roll this operation back */
- if( pCur->pRbtree->eTransState != TRANS_ROLLBACK ){
- BtRollbackOp *pOp = sqliteMalloc( sizeof(BtRollbackOp) );
- if( pOp==0 ) return SQLITE_NOMEM;
- pOp->iTab = pCur->iTree;
- pOp->nKey = pCur->pNode->nKey;
- pOp->pKey = sqliteMallocRaw( pOp->nKey );
- if( sqlite_malloc_failed ) return SQLITE_NOMEM;
- memcpy( pOp->pKey, pCur->pNode->pKey, pOp->nKey );
- pOp->nData = pCur->pNode->nData;
- pOp->pData = pCur->pNode->pData;
- pOp->eOp = ROLLBACK_INSERT;
- btreeLogRollbackOp(pCur->pRbtree, pOp);
- }else{
- sqliteFree( pCur->pNode->pData );
- }
-
- /* Actually clobber the nodes data */
- pCur->pNode->pData = pData;
- pCur->pNode->nData = nData;
- }
-
- return SQLITE_OK;
-}
-
-/* Move the cursor so that it points to an entry near pKey.
-** Return a success code.
-**
-** *pRes<0 The cursor is left pointing at an entry that
-** is smaller than pKey or if the table is empty
-** and the cursor is therefore left point to nothing.
-**
-** *pRes==0 The cursor is left pointing at an entry that
-** exactly matches pKey.
-**
-** *pRes>0 The cursor is left pointing at an entry that
-** is larger than pKey.
-*/
-static int memRbtreeMoveto(
- RbtCursor* pCur,
- const void *pKey,
- int nKey,
- int *pRes
-){
- BtRbNode *pTmp = 0;
-
- pCur->pNode = pCur->pTree->pHead;
- *pRes = -1;
- while( pCur->pNode && *pRes ) {
- *pRes = key_compare(pCur->pNode->pKey, pCur->pNode->nKey, pKey, nKey);
- pTmp = pCur->pNode;
- switch( *pRes ){
- case 1: /* cursor > key */
- pCur->pNode = pCur->pNode->pLeft;
- break;
- case -1: /* cursor < key */
- pCur->pNode = pCur->pNode->pRight;
- break;
- }
- }
-
- /* If (pCur->pNode == NULL), then we have failed to find a match. Set
- * pCur->pNode to pTmp, which is either NULL (if the tree is empty) or the
- * last node traversed in the search. In either case the relation ship
- * between pTmp and the searched for key is already stored in *pRes. pTmp is
- * either the successor or predecessor of the key we tried to move to. */
- if( !pCur->pNode ) pCur->pNode = pTmp;
- pCur->eSkip = SKIP_NONE;
-
- return SQLITE_OK;
-}
-
-
-/*
-** Delete the entry that the cursor is pointing to.
-**
-** The cursor is left pointing at either the next or the previous
-** entry. If the cursor is left pointing to the next entry, then
-** the pCur->eSkip flag is set to SKIP_NEXT which forces the next call to
-** sqliteRbtreeNext() to be a no-op. That way, you can always call
-** sqliteRbtreeNext() after a delete and the cursor will be left
-** pointing to the first entry after the deleted entry. Similarly,
-** pCur->eSkip is set to SKIP_PREV is the cursor is left pointing to
-** the entry prior to the deleted entry so that a subsequent call to
-** sqliteRbtreePrevious() will always leave the cursor pointing at the
-** entry immediately before the one that was deleted.
-*/
-static int memRbtreeDelete(RbtCursor* pCur)
-{
- BtRbNode *pZ; /* The one being deleted */
- BtRbNode *pChild; /* The child of the spliced out node */
-
- /* It is illegal to call sqliteRbtreeDelete() if we are
- ** not in a transaction */
- assert( pCur->pRbtree->eTransState != TRANS_NONE );
-
- /* Make sure some other cursor isn't trying to read this same table */
- if( checkReadLocks(pCur) ){
- return SQLITE_LOCKED; /* The table pCur points to has a read lock */
- }
-
- pZ = pCur->pNode;
- if( !pZ ){
- return SQLITE_OK;
- }
-
- /* If we are not currently doing a rollback, set up a rollback op for this
- * deletion */
- if( pCur->pRbtree->eTransState != TRANS_ROLLBACK ){
- BtRollbackOp *pOp = sqliteMalloc( sizeof(BtRollbackOp) );
- if( pOp==0 ) return SQLITE_NOMEM;
- pOp->iTab = pCur->iTree;
- pOp->nKey = pZ->nKey;
- pOp->pKey = pZ->pKey;
- pOp->nData = pZ->nData;
- pOp->pData = pZ->pData;
- pOp->eOp = ROLLBACK_INSERT;
- btreeLogRollbackOp(pCur->pRbtree, pOp);
- }
-
- /* First do a standard binary-tree delete (node pZ is to be deleted). How
- * to do this depends on how many children pZ has:
- *
- * If pZ has no children or one child, then splice out pZ. If pZ has two
- * children, splice out the successor of pZ and replace the key and data of
- * pZ with the key and data of the spliced out successor. */
- if( pZ->pLeft && pZ->pRight ){
- BtRbNode *pTmp;
- int dummy;
- pCur->eSkip = SKIP_NONE;
- memRbtreeNext(pCur, &dummy);
- assert( dummy == 0 );
- if( pCur->pRbtree->eTransState == TRANS_ROLLBACK ){
- sqliteFree(pZ->pKey);
- sqliteFree(pZ->pData);
- }
- pZ->pData = pCur->pNode->pData;
- pZ->nData = pCur->pNode->nData;
- pZ->pKey = pCur->pNode->pKey;
- pZ->nKey = pCur->pNode->nKey;
- pTmp = pZ;
- pZ = pCur->pNode;
- pCur->pNode = pTmp;
- pCur->eSkip = SKIP_NEXT;
- }else{
- int res;
- pCur->eSkip = SKIP_NONE;
- memRbtreeNext(pCur, &res);
- pCur->eSkip = SKIP_NEXT;
- if( res ){
- memRbtreeLast(pCur, &res);
- memRbtreePrevious(pCur, &res);
- pCur->eSkip = SKIP_PREV;
- }
- if( pCur->pRbtree->eTransState == TRANS_ROLLBACK ){
- sqliteFree(pZ->pKey);
- sqliteFree(pZ->pData);
- }
- }
-
- /* pZ now points at the node to be spliced out. This block does the
- * splicing. */
- {
- BtRbNode **ppParentSlot = 0;
- assert( !pZ->pLeft || !pZ->pRight ); /* pZ has at most one child */
- pChild = ((pZ->pLeft)?pZ->pLeft:pZ->pRight);
- if( pZ->pParent ){
- assert( pZ == pZ->pParent->pLeft || pZ == pZ->pParent->pRight );
- ppParentSlot = ((pZ == pZ->pParent->pLeft)
- ?&pZ->pParent->pLeft:&pZ->pParent->pRight);
- *ppParentSlot = pChild;
- }else{
- pCur->pTree->pHead = pChild;
- }
- if( pChild ) pChild->pParent = pZ->pParent;
- }
-
- /* pZ now points at the spliced out node. pChild is the only child of pZ, or
- * NULL if pZ has no children. If pZ is black, and not the tree root, then we
- * will have violated the "same number of black nodes in every path to a
- * leaf" property of the red-black tree. The code in do_delete_balancing()
- * repairs this. */
- if( pZ->isBlack ){
- do_delete_balancing(pCur->pTree, pChild, pZ->pParent);
- }
-
- sqliteFree(pZ);
- return SQLITE_OK;
-}
-
-/*
- * Empty table n of the Rbtree.
- */
-static int memRbtreeClearTable(Rbtree* tree, int n)
-{
- BtRbTree *pTree;
- BtRbNode *pNode;
-
- pTree = sqliteHashFind(&tree->tblHash, 0, n);
- assert(pTree);
-
- pNode = pTree->pHead;
- while( pNode ){
- if( pNode->pLeft ){
- pNode = pNode->pLeft;
- }
- else if( pNode->pRight ){
- pNode = pNode->pRight;
- }
- else {
- BtRbNode *pTmp = pNode->pParent;
- if( tree->eTransState == TRANS_ROLLBACK ){
- sqliteFree( pNode->pKey );
- sqliteFree( pNode->pData );
- }else{
- BtRollbackOp *pRollbackOp = sqliteMallocRaw(sizeof(BtRollbackOp));
- if( pRollbackOp==0 ) return SQLITE_NOMEM;
- pRollbackOp->eOp = ROLLBACK_INSERT;
- pRollbackOp->iTab = n;
- pRollbackOp->nKey = pNode->nKey;
- pRollbackOp->pKey = pNode->pKey;
- pRollbackOp->nData = pNode->nData;
- pRollbackOp->pData = pNode->pData;
- btreeLogRollbackOp(tree, pRollbackOp);
- }
- sqliteFree( pNode );
- if( pTmp ){
- if( pTmp->pLeft == pNode ) pTmp->pLeft = 0;
- else if( pTmp->pRight == pNode ) pTmp->pRight = 0;
- }
- pNode = pTmp;
- }
- }
-
- pTree->pHead = 0;
- return SQLITE_OK;
-}
-
-static int memRbtreeFirst(RbtCursor* pCur, int *pRes)
-{
- if( pCur->pTree->pHead ){
- pCur->pNode = pCur->pTree->pHead;
- while( pCur->pNode->pLeft ){
- pCur->pNode = pCur->pNode->pLeft;
- }
- }
- if( pCur->pNode ){
- *pRes = 0;
- }else{
- *pRes = 1;
- }
- pCur->eSkip = SKIP_NONE;
- return SQLITE_OK;
-}
-
-static int memRbtreeLast(RbtCursor* pCur, int *pRes)
-{
- if( pCur->pTree->pHead ){
- pCur->pNode = pCur->pTree->pHead;
- while( pCur->pNode->pRight ){
- pCur->pNode = pCur->pNode->pRight;
- }
- }
- if( pCur->pNode ){
- *pRes = 0;
- }else{
- *pRes = 1;
- }
- pCur->eSkip = SKIP_NONE;
- return SQLITE_OK;
-}
-
-/*
-** Advance the cursor to the next entry in the database. If
-** successful then set *pRes=0. If the cursor
-** was already pointing to the last entry in the database before
-** this routine was called, then set *pRes=1.
-*/
-static int memRbtreeNext(RbtCursor* pCur, int *pRes)
-{
- if( pCur->pNode && pCur->eSkip != SKIP_NEXT ){
- if( pCur->pNode->pRight ){
- pCur->pNode = pCur->pNode->pRight;
- while( pCur->pNode->pLeft )
- pCur->pNode = pCur->pNode->pLeft;
- }else{
- BtRbNode * pX = pCur->pNode;
- pCur->pNode = pX->pParent;
- while( pCur->pNode && (pCur->pNode->pRight == pX) ){
- pX = pCur->pNode;
- pCur->pNode = pX->pParent;
- }
- }
- }
- pCur->eSkip = SKIP_NONE;
-
- if( !pCur->pNode ){
- *pRes = 1;
- }else{
- *pRes = 0;
- }
-
- return SQLITE_OK;
-}
-
-static int memRbtreePrevious(RbtCursor* pCur, int *pRes)
-{
- if( pCur->pNode && pCur->eSkip != SKIP_PREV ){
- if( pCur->pNode->pLeft ){
- pCur->pNode = pCur->pNode->pLeft;
- while( pCur->pNode->pRight )
- pCur->pNode = pCur->pNode->pRight;
- }else{
- BtRbNode * pX = pCur->pNode;
- pCur->pNode = pX->pParent;
- while( pCur->pNode && (pCur->pNode->pLeft == pX) ){
- pX = pCur->pNode;
- pCur->pNode = pX->pParent;
- }
- }
- }
- pCur->eSkip = SKIP_NONE;
-
- if( !pCur->pNode ){
- *pRes = 1;
- }else{
- *pRes = 0;
- }
-
- return SQLITE_OK;
-}
-
-static int memRbtreeKeySize(RbtCursor* pCur, int *pSize)
-{
- if( pCur->pNode ){
- *pSize = pCur->pNode->nKey;
- }else{
- *pSize = 0;
- }
- return SQLITE_OK;
-}
-
-static int memRbtreeKey(RbtCursor* pCur, int offset, int amt, char *zBuf)
-{
- if( !pCur->pNode ) return 0;
- if( !pCur->pNode->pKey || ((amt + offset) <= pCur->pNode->nKey) ){
- memcpy(zBuf, ((char*)pCur->pNode->pKey)+offset, amt);
- }else{
- memcpy(zBuf, ((char*)pCur->pNode->pKey)+offset, pCur->pNode->nKey-offset);
- amt = pCur->pNode->nKey-offset;
- }
- return amt;
-}
-
-static int memRbtreeDataSize(RbtCursor* pCur, int *pSize)
-{
- if( pCur->pNode ){
- *pSize = pCur->pNode->nData;
- }else{
- *pSize = 0;
- }
- return SQLITE_OK;
-}
-
-static int memRbtreeData(RbtCursor *pCur, int offset, int amt, char *zBuf)
-{
- if( !pCur->pNode ) return 0;
- if( (amt + offset) <= pCur->pNode->nData ){
- memcpy(zBuf, ((char*)pCur->pNode->pData)+offset, amt);
- }else{
- memcpy(zBuf, ((char*)pCur->pNode->pData)+offset ,pCur->pNode->nData-offset);
- amt = pCur->pNode->nData-offset;
- }
- return amt;
-}
-
-static int memRbtreeCloseCursor(RbtCursor* pCur)
-{
- if( pCur->pTree->pCursors==pCur ){
- pCur->pTree->pCursors = pCur->pShared;
- }else{
- RbtCursor *p = pCur->pTree->pCursors;
- while( p && p->pShared!=pCur ){ p = p->pShared; }
- assert( p!=0 );
- if( p ){
- p->pShared = pCur->pShared;
- }
- }
- sqliteFree(pCur);
- return SQLITE_OK;
-}
-
-static int memRbtreeGetMeta(Rbtree* tree, int* aMeta)
-{
- memcpy( aMeta, tree->aMetaData, sizeof(int) * SQLITE_N_BTREE_META );
- return SQLITE_OK;
-}
-
-static int memRbtreeUpdateMeta(Rbtree* tree, int* aMeta)
-{
- memcpy( tree->aMetaData, aMeta, sizeof(int) * SQLITE_N_BTREE_META );
- return SQLITE_OK;
-}
-
-/*
- * Check that each table in the Rbtree meets the requirements for a red-black
- * binary tree. If an error is found, return an explanation of the problem in
- * memory obtained from sqliteMalloc(). Parameters aRoot and nRoot are ignored.
- */
-static char *memRbtreeIntegrityCheck(Rbtree* tree, int* aRoot, int nRoot)
-{
- char * msg = 0;
- HashElem *p;
-
- for(p=sqliteHashFirst(&tree->tblHash); p; p=sqliteHashNext(p)){
- BtRbTree *pTree = sqliteHashData(p);
- check_redblack_tree(pTree, &msg);
- }
-
- return msg;
-}
-
-static int memRbtreeSetCacheSize(Rbtree* tree, int sz)
-{
- return SQLITE_OK;
-}
-
-static int memRbtreeSetSafetyLevel(Rbtree *pBt, int level){
- return SQLITE_OK;
-}
-
-static int memRbtreeBeginTrans(Rbtree* tree)
-{
- if( tree->eTransState != TRANS_NONE )
- return SQLITE_ERROR;
-
- assert( tree->pTransRollback == 0 );
- tree->eTransState = TRANS_INTRANSACTION;
- return SQLITE_OK;
-}
-
-/*
-** Delete a linked list of BtRollbackOp structures.
-*/
-static void deleteRollbackList(BtRollbackOp *pOp){
- while( pOp ){
- BtRollbackOp *pTmp = pOp->pNext;
- sqliteFree(pOp->pData);
- sqliteFree(pOp->pKey);
- sqliteFree(pOp);
- pOp = pTmp;
- }
-}
-
-static int memRbtreeCommit(Rbtree* tree){
- /* Just delete pTransRollback and pCheckRollback */
- deleteRollbackList(tree->pCheckRollback);
- deleteRollbackList(tree->pTransRollback);
- tree->pTransRollback = 0;
- tree->pCheckRollback = 0;
- tree->pCheckRollbackTail = 0;
- tree->eTransState = TRANS_NONE;
- return SQLITE_OK;
-}
-
-/*
- * Close the supplied Rbtree. Delete everything associated with it.
- */
-static int memRbtreeClose(Rbtree* tree)
-{
- HashElem *p;
- memRbtreeCommit(tree);
- while( (p=sqliteHashFirst(&tree->tblHash))!=0 ){
- tree->eTransState = TRANS_ROLLBACK;
- memRbtreeDropTable(tree, sqliteHashKeysize(p));
- }
- sqliteHashClear(&tree->tblHash);
- sqliteFree(tree);
- return SQLITE_OK;
-}
-
-/*
- * Execute and delete the supplied rollback-list on pRbtree.
- */
-static void execute_rollback_list(Rbtree *pRbtree, BtRollbackOp *pList)
-{
- BtRollbackOp *pTmp;
- RbtCursor cur;
- int res;
-
- cur.pRbtree = pRbtree;
- cur.wrFlag = 1;
- while( pList ){
- switch( pList->eOp ){
- case ROLLBACK_INSERT:
- cur.pTree = sqliteHashFind( &pRbtree->tblHash, 0, pList->iTab );
- assert(cur.pTree);
- cur.iTree = pList->iTab;
- cur.eSkip = SKIP_NONE;
- memRbtreeInsert( &cur, pList->pKey,
- pList->nKey, pList->pData, pList->nData );
- break;
- case ROLLBACK_DELETE:
- cur.pTree = sqliteHashFind( &pRbtree->tblHash, 0, pList->iTab );
- assert(cur.pTree);
- cur.iTree = pList->iTab;
- cur.eSkip = SKIP_NONE;
- memRbtreeMoveto(&cur, pList->pKey, pList->nKey, &res);
- assert(res == 0);
- memRbtreeDelete( &cur );
- break;
- case ROLLBACK_CREATE:
- btreeCreateTable(pRbtree, pList->iTab);
- break;
- case ROLLBACK_DROP:
- memRbtreeDropTable(pRbtree, pList->iTab);
- break;
- default:
- assert(0);
- }
- sqliteFree(pList->pKey);
- sqliteFree(pList->pData);
- pTmp = pList->pNext;
- sqliteFree(pList);
- pList = pTmp;
- }
-}
-
-static int memRbtreeRollback(Rbtree* tree)
-{
- tree->eTransState = TRANS_ROLLBACK;
- execute_rollback_list(tree, tree->pCheckRollback);
- execute_rollback_list(tree, tree->pTransRollback);
- tree->pTransRollback = 0;
- tree->pCheckRollback = 0;
- tree->pCheckRollbackTail = 0;
- tree->eTransState = TRANS_NONE;
- return SQLITE_OK;
-}
-
-static int memRbtreeBeginCkpt(Rbtree* tree)
-{
- if( tree->eTransState != TRANS_INTRANSACTION )
- return SQLITE_ERROR;
-
- assert( tree->pCheckRollback == 0 );
- assert( tree->pCheckRollbackTail == 0 );
- tree->eTransState = TRANS_INCHECKPOINT;
- return SQLITE_OK;
-}
-
-static int memRbtreeCommitCkpt(Rbtree* tree)
-{
- if( tree->eTransState == TRANS_INCHECKPOINT ){
- if( tree->pCheckRollback ){
- tree->pCheckRollbackTail->pNext = tree->pTransRollback;
- tree->pTransRollback = tree->pCheckRollback;
- tree->pCheckRollback = 0;
- tree->pCheckRollbackTail = 0;
- }
- tree->eTransState = TRANS_INTRANSACTION;
- }
- return SQLITE_OK;
-}
-
-static int memRbtreeRollbackCkpt(Rbtree* tree)
-{
- if( tree->eTransState != TRANS_INCHECKPOINT ) return SQLITE_OK;
- tree->eTransState = TRANS_ROLLBACK;
- execute_rollback_list(tree, tree->pCheckRollback);
- tree->pCheckRollback = 0;
- tree->pCheckRollbackTail = 0;
- tree->eTransState = TRANS_INTRANSACTION;
- return SQLITE_OK;
-}
-
-#ifdef SQLITE_TEST
-static int memRbtreePageDump(Rbtree* tree, int pgno, int rec)
-{
- assert(!"Cannot call sqliteRbtreePageDump");
- return SQLITE_OK;
-}
-
-static int memRbtreeCursorDump(RbtCursor* pCur, int* aRes)
-{
- assert(!"Cannot call sqliteRbtreeCursorDump");
- return SQLITE_OK;
-}
-#endif
-
-static struct Pager *memRbtreePager(Rbtree* tree)
-{
- return 0;
-}
-
-/*
-** Return the full pathname of the underlying database file.
-*/
-static const char *memRbtreeGetFilename(Rbtree *pBt){
- return 0; /* A NULL return indicates there is no underlying file */
-}
-
-/*
-** The copy file function is not implemented for the in-memory database
-*/
-static int memRbtreeCopyFile(Rbtree *pBt, Rbtree *pBt2){
- return SQLITE_INTERNAL; /* Not implemented */
-}
-
-static BtOps sqliteRbtreeOps = {
- (int(*)(Btree*)) memRbtreeClose,
- (int(*)(Btree*,int)) memRbtreeSetCacheSize,
- (int(*)(Btree*,int)) memRbtreeSetSafetyLevel,
- (int(*)(Btree*)) memRbtreeBeginTrans,
- (int(*)(Btree*)) memRbtreeCommit,
- (int(*)(Btree*)) memRbtreeRollback,
- (int(*)(Btree*)) memRbtreeBeginCkpt,
- (int(*)(Btree*)) memRbtreeCommitCkpt,
- (int(*)(Btree*)) memRbtreeRollbackCkpt,
- (int(*)(Btree*,int*)) memRbtreeCreateTable,
- (int(*)(Btree*,int*)) memRbtreeCreateTable,
- (int(*)(Btree*,int)) memRbtreeDropTable,
- (int(*)(Btree*,int)) memRbtreeClearTable,
- (int(*)(Btree*,int,int,BtCursor**)) memRbtreeCursor,
- (int(*)(Btree*,int*)) memRbtreeGetMeta,
- (int(*)(Btree*,int*)) memRbtreeUpdateMeta,
- (char*(*)(Btree*,int*,int)) memRbtreeIntegrityCheck,
- (const char*(*)(Btree*)) memRbtreeGetFilename,
- (int(*)(Btree*,Btree*)) memRbtreeCopyFile,
- (struct Pager*(*)(Btree*)) memRbtreePager,
-#ifdef SQLITE_TEST
- (int(*)(Btree*,int,int)) memRbtreePageDump,
-#endif
-};
-
-static BtCursorOps sqliteRbtreeCursorOps = {
- (int(*)(BtCursor*,const void*,int,int*)) memRbtreeMoveto,
- (int(*)(BtCursor*)) memRbtreeDelete,
- (int(*)(BtCursor*,const void*,int,const void*,int)) memRbtreeInsert,
- (int(*)(BtCursor*,int*)) memRbtreeFirst,
- (int(*)(BtCursor*,int*)) memRbtreeLast,
- (int(*)(BtCursor*,int*)) memRbtreeNext,
- (int(*)(BtCursor*,int*)) memRbtreePrevious,
- (int(*)(BtCursor*,int*)) memRbtreeKeySize,
- (int(*)(BtCursor*,int,int,char*)) memRbtreeKey,
- (int(*)(BtCursor*,const void*,int,int,int*)) memRbtreeKeyCompare,
- (int(*)(BtCursor*,int*)) memRbtreeDataSize,
- (int(*)(BtCursor*,int,int,char*)) memRbtreeData,
- (int(*)(BtCursor*)) memRbtreeCloseCursor,
-#ifdef SQLITE_TEST
- (int(*)(BtCursor*,int*)) memRbtreeCursorDump,
-#endif
-
-};
-
-#endif /* SQLITE_OMIT_INMEMORYDB */
+++ /dev/null
-/*
-** 2001 September 15
-**
-** The author disclaims copyright to this source code. In place of
-** a legal notice, here is a blessing:
-**
-** May you do good and not evil.
-** May you find forgiveness for yourself and forgive others.
-** May you share freely, never taking more than you give.
-**
-*************************************************************************
-** This file contains C code routines that are called by the SQLite parser
-** when syntax rules are reduced. The routines in this file handle the
-** following kinds of SQL syntax:
-**
-** CREATE TABLE
-** DROP TABLE
-** CREATE INDEX
-** DROP INDEX
-** creating ID lists
-** BEGIN TRANSACTION
-** COMMIT
-** ROLLBACK
-** PRAGMA
-**
-** $Id: build.c,v 1.1.1.1 2004/08/08 15:03:57 matt Exp $
-*/
-#include "sqliteInt.h"
-#include <ctype.h>
-
-/*
-** This routine is called when a new SQL statement is beginning to
-** be parsed. Check to see if the schema for the database needs
-** to be read from the SQLITE_MASTER and SQLITE_TEMP_MASTER tables.
-** If it does, then read it.
-*/
-void sqliteBeginParse(Parse *pParse, int explainFlag){
- sqlite *db = pParse->db;
- int i;
- pParse->explain = explainFlag;
- if((db->flags & SQLITE_Initialized)==0 && db->init.busy==0 ){
- int rc = sqliteInit(db, &pParse->zErrMsg);
- if( rc!=SQLITE_OK ){
- pParse->rc = rc;
- pParse->nErr++;
- }
- }
- for(i=0; i<db->nDb; i++){
- DbClearProperty(db, i, DB_Locked);
- if( !db->aDb[i].inTrans ){
- DbClearProperty(db, i, DB_Cookie);
- }
- }
- pParse->nVar = 0;
-}
-
-/*
-** This routine is called after a single SQL statement has been
-** parsed and we want to execute the VDBE code to implement
-** that statement. Prior action routines should have already
-** constructed VDBE code to do the work of the SQL statement.
-** This routine just has to execute the VDBE code.
-**
-** Note that if an error occurred, it might be the case that
-** no VDBE code was generated.
-*/
-void sqliteExec(Parse *pParse){
- sqlite *db = pParse->db;
- Vdbe *v = pParse->pVdbe;
-
- if( v==0 && (v = sqliteGetVdbe(pParse))!=0 ){
- sqliteVdbeAddOp(v, OP_Halt, 0, 0);
- }
- if( sqlite_malloc_failed ) return;
- if( v && pParse->nErr==0 ){
- FILE *trace = (db->flags & SQLITE_VdbeTrace)!=0 ? stdout : 0;
- sqliteVdbeTrace(v, trace);
- sqliteVdbeMakeReady(v, pParse->nVar, pParse->explain);
- pParse->rc = pParse->nErr ? SQLITE_ERROR : SQLITE_DONE;
- pParse->colNamesSet = 0;
- }else if( pParse->rc==SQLITE_OK ){
- pParse->rc = SQLITE_ERROR;
- }
- pParse->nTab = 0;
- pParse->nMem = 0;
- pParse->nSet = 0;
- pParse->nAgg = 0;
- pParse->nVar = 0;
-}
-
-/*
-** Locate the in-memory structure that describes
-** a particular database table given the name
-** of that table and (optionally) the name of the database
-** containing the table. Return NULL if not found.
-**
-** If zDatabase is 0, all databases are searched for the
-** table and the first matching table is returned. (No checking
-** for duplicate table names is done.) The search order is
-** TEMP first, then MAIN, then any auxiliary databases added
-** using the ATTACH command.
-**
-** See also sqliteLocateTable().
-*/
-Table *sqliteFindTable(sqlite *db, const char *zName, const char *zDatabase){
- Table *p = 0;
- int i;
- for(i=0; i<db->nDb; i++){
- int j = (i<2) ? i^1 : i; /* Search TEMP before MAIN */
- if( zDatabase!=0 && sqliteStrICmp(zDatabase, db->aDb[j].zName) ) continue;
- p = sqliteHashFind(&db->aDb[j].tblHash, zName, strlen(zName)+1);
- if( p ) break;
- }
- return p;
-}
-
-/*
-** Locate the in-memory structure that describes
-** a particular database table given the name
-** of that table and (optionally) the name of the database
-** containing the table. Return NULL if not found.
-** Also leave an error message in pParse->zErrMsg.
-**
-** The difference between this routine and sqliteFindTable()
-** is that this routine leaves an error message in pParse->zErrMsg
-** where sqliteFindTable() does not.
-*/
-Table *sqliteLocateTable(Parse *pParse, const char *zName, const char *zDbase){
- Table *p;
-
- p = sqliteFindTable(pParse->db, zName, zDbase);
- if( p==0 ){
- if( zDbase ){
- sqliteErrorMsg(pParse, "no such table: %s.%s", zDbase, zName);
- }else if( sqliteFindTable(pParse->db, zName, 0)!=0 ){
- sqliteErrorMsg(pParse, "table \"%s\" is not in database \"%s\"",
- zName, zDbase);
- }else{
- sqliteErrorMsg(pParse, "no such table: %s", zName);
- }
- }
- return p;
-}
-
-/*
-** Locate the in-memory structure that describes
-** a particular index given the name of that index
-** and the name of the database that contains the index.
-** Return NULL if not found.
-**
-** If zDatabase is 0, all databases are searched for the
-** table and the first matching index is returned. (No checking
-** for duplicate index names is done.) The search order is
-** TEMP first, then MAIN, then any auxiliary databases added
-** using the ATTACH command.
-*/
-Index *sqliteFindIndex(sqlite *db, const char *zName, const char *zDb){
- Index *p = 0;
- int i;
- for(i=0; i<db->nDb; i++){
- int j = (i<2) ? i^1 : i; /* Search TEMP before MAIN */
- if( zDb && sqliteStrICmp(zDb, db->aDb[j].zName) ) continue;
- p = sqliteHashFind(&db->aDb[j].idxHash, zName, strlen(zName)+1);
- if( p ) break;
- }
- return p;
-}
-
-/*
-** Remove the given index from the index hash table, and free
-** its memory structures.
-**
-** The index is removed from the database hash tables but
-** it is not unlinked from the Table that it indexes.
-** Unlinking from the Table must be done by the calling function.
-*/
-static void sqliteDeleteIndex(sqlite *db, Index *p){
- Index *pOld;
-
- assert( db!=0 && p->zName!=0 );
- pOld = sqliteHashInsert(&db->aDb[p->iDb].idxHash, p->zName,
- strlen(p->zName)+1, 0);
- if( pOld!=0 && pOld!=p ){
- sqliteHashInsert(&db->aDb[p->iDb].idxHash, pOld->zName,
- strlen(pOld->zName)+1, pOld);
- }
- sqliteFree(p);
-}
-
-/*
-** Unlink the given index from its table, then remove
-** the index from the index hash table and free its memory
-** structures.
-*/
-void sqliteUnlinkAndDeleteIndex(sqlite *db, Index *pIndex){
- if( pIndex->pTable->pIndex==pIndex ){
- pIndex->pTable->pIndex = pIndex->pNext;
- }else{
- Index *p;
- for(p=pIndex->pTable->pIndex; p && p->pNext!=pIndex; p=p->pNext){}
- if( p && p->pNext==pIndex ){
- p->pNext = pIndex->pNext;
- }
- }
- sqliteDeleteIndex(db, pIndex);
-}
-
-/*
-** Erase all schema information from the in-memory hash tables of
-** database connection. This routine is called to reclaim memory
-** before the connection closes. It is also called during a rollback
-** if there were schema changes during the transaction.
-**
-** If iDb<=0 then reset the internal schema tables for all database
-** files. If iDb>=2 then reset the internal schema for only the
-** single file indicated.
-*/
-void sqliteResetInternalSchema(sqlite *db, int iDb){
- HashElem *pElem;
- Hash temp1;
- Hash temp2;
- int i, j;
-
- assert( iDb>=0 && iDb<db->nDb );
- db->flags &= ~SQLITE_Initialized;
- for(i=iDb; i<db->nDb; i++){
- Db *pDb = &db->aDb[i];
- temp1 = pDb->tblHash;
- temp2 = pDb->trigHash;
- sqliteHashInit(&pDb->trigHash, SQLITE_HASH_STRING, 0);
- sqliteHashClear(&pDb->aFKey);
- sqliteHashClear(&pDb->idxHash);
- for(pElem=sqliteHashFirst(&temp2); pElem; pElem=sqliteHashNext(pElem)){
- Trigger *pTrigger = sqliteHashData(pElem);
- sqliteDeleteTrigger(pTrigger);
- }
- sqliteHashClear(&temp2);
- sqliteHashInit(&pDb->tblHash, SQLITE_HASH_STRING, 0);
- for(pElem=sqliteHashFirst(&temp1); pElem; pElem=sqliteHashNext(pElem)){
- Table *pTab = sqliteHashData(pElem);
- sqliteDeleteTable(db, pTab);
- }
- sqliteHashClear(&temp1);
- DbClearProperty(db, i, DB_SchemaLoaded);
- if( iDb>0 ) return;
- }
- assert( iDb==0 );
- db->flags &= ~SQLITE_InternChanges;
-
- /* If one or more of the auxiliary database files has been closed,
- ** then remove then from the auxiliary database list. We take the
- ** opportunity to do this here since we have just deleted all of the
- ** schema hash tables and therefore do not have to make any changes
- ** to any of those tables.
- */
- for(i=0; i<db->nDb; i++){
- struct Db *pDb = &db->aDb[i];
- if( pDb->pBt==0 ){
- if( pDb->pAux && pDb->xFreeAux ) pDb->xFreeAux(pDb->pAux);
- pDb->pAux = 0;
- }
- }
- for(i=j=2; i<db->nDb; i++){
- struct Db *pDb = &db->aDb[i];
- if( pDb->pBt==0 ){
- sqliteFree(pDb->zName);
- pDb->zName = 0;
- continue;
- }
- if( j<i ){
- db->aDb[j] = db->aDb[i];
- }
- j++;
- }
- memset(&db->aDb[j], 0, (db->nDb-j)*sizeof(db->aDb[j]));
- db->nDb = j;
- if( db->nDb<=2 && db->aDb!=db->aDbStatic ){
- memcpy(db->aDbStatic, db->aDb, 2*sizeof(db->aDb[0]));
- sqliteFree(db->aDb);
- db->aDb = db->aDbStatic;
- }
-}
-
-/*
-** This routine is called whenever a rollback occurs. If there were
-** schema changes during the transaction, then we have to reset the
-** internal hash tables and reload them from disk.
-*/
-void sqliteRollbackInternalChanges(sqlite *db){
- if( db->flags & SQLITE_InternChanges ){
- sqliteResetInternalSchema(db, 0);
- }
-}
-
-/*
-** This routine is called when a commit occurs.
-*/
-void sqliteCommitInternalChanges(sqlite *db){
- db->aDb[0].schema_cookie = db->next_cookie;
- db->flags &= ~SQLITE_InternChanges;
-}
-
-/*
-** Remove the memory data structures associated with the given
-** Table. No changes are made to disk by this routine.
-**
-** This routine just deletes the data structure. It does not unlink
-** the table data structure from the hash table. Nor does it remove
-** foreign keys from the sqlite.aFKey hash table. But it does destroy
-** memory structures of the indices and foreign keys associated with
-** the table.
-**
-** Indices associated with the table are unlinked from the "db"
-** data structure if db!=NULL. If db==NULL, indices attached to
-** the table are deleted, but it is assumed they have already been
-** unlinked.
-*/
-void sqliteDeleteTable(sqlite *db, Table *pTable){
- int i;
- Index *pIndex, *pNext;
- FKey *pFKey, *pNextFKey;
-
- if( pTable==0 ) return;
-
- /* Delete all indices associated with this table
- */
- for(pIndex = pTable->pIndex; pIndex; pIndex=pNext){
- pNext = pIndex->pNext;
- assert( pIndex->iDb==pTable->iDb || (pTable->iDb==0 && pIndex->iDb==1) );
- sqliteDeleteIndex(db, pIndex);
- }
-
- /* Delete all foreign keys associated with this table. The keys
- ** should have already been unlinked from the db->aFKey hash table
- */
- for(pFKey=pTable->pFKey; pFKey; pFKey=pNextFKey){
- pNextFKey = pFKey->pNextFrom;
- assert( pTable->iDb<db->nDb );
- assert( sqliteHashFind(&db->aDb[pTable->iDb].aFKey,
- pFKey->zTo, strlen(pFKey->zTo)+1)!=pFKey );
- sqliteFree(pFKey);
- }
-
- /* Delete the Table structure itself.
- */
- for(i=0; i<pTable->nCol; i++){
- sqliteFree(pTable->aCol[i].zName);
- sqliteFree(pTable->aCol[i].zDflt);
- sqliteFree(pTable->aCol[i].zType);
- }
- sqliteFree(pTable->zName);
- sqliteFree(pTable->aCol);
- sqliteSelectDelete(pTable->pSelect);
- sqliteFree(pTable);
-}
-
-/*
-** Unlink the given table from the hash tables and the delete the
-** table structure with all its indices and foreign keys.
-*/
-static void sqliteUnlinkAndDeleteTable(sqlite *db, Table *p){
- Table *pOld;
- FKey *pF1, *pF2;
- int i = p->iDb;
- assert( db!=0 );
- pOld = sqliteHashInsert(&db->aDb[i].tblHash, p->zName, strlen(p->zName)+1, 0);
- assert( pOld==0 || pOld==p );
- for(pF1=p->pFKey; pF1; pF1=pF1->pNextFrom){
- int nTo = strlen(pF1->zTo) + 1;
- pF2 = sqliteHashFind(&db->aDb[i].aFKey, pF1->zTo, nTo);
- if( pF2==pF1 ){
- sqliteHashInsert(&db->aDb[i].aFKey, pF1->zTo, nTo, pF1->pNextTo);
- }else{
- while( pF2 && pF2->pNextTo!=pF1 ){ pF2=pF2->pNextTo; }
- if( pF2 ){
- pF2->pNextTo = pF1->pNextTo;
- }
- }
- }
- sqliteDeleteTable(db, p);
-}
-
-/*
-** Construct the name of a user table or index from a token.
-**
-** Space to hold the name is obtained from sqliteMalloc() and must
-** be freed by the calling function.
-*/
-char *sqliteTableNameFromToken(Token *pName){
- char *zName = sqliteStrNDup(pName->z, pName->n);
- sqliteDequote(zName);
- return zName;
-}
-
-/*
-** Generate code to open the appropriate master table. The table
-** opened will be SQLITE_MASTER for persistent tables and
-** SQLITE_TEMP_MASTER for temporary tables. The table is opened
-** on cursor 0.
-*/
-void sqliteOpenMasterTable(Vdbe *v, int isTemp){
- sqliteVdbeAddOp(v, OP_Integer, isTemp, 0);
- sqliteVdbeAddOp(v, OP_OpenWrite, 0, 2);
-}
-
-/*
-** Begin constructing a new table representation in memory. This is
-** the first of several action routines that get called in response
-** to a CREATE TABLE statement. In particular, this routine is called
-** after seeing tokens "CREATE" and "TABLE" and the table name. The
-** pStart token is the CREATE and pName is the table name. The isTemp
-** flag is true if the table should be stored in the auxiliary database
-** file instead of in the main database file. This is normally the case
-** when the "TEMP" or "TEMPORARY" keyword occurs in between
-** CREATE and TABLE.
-**
-** The new table record is initialized and put in pParse->pNewTable.
-** As more of the CREATE TABLE statement is parsed, additional action
-** routines will be called to add more information to this record.
-** At the end of the CREATE TABLE statement, the sqliteEndTable() routine
-** is called to complete the construction of the new table record.
-*/
-void sqliteStartTable(
- Parse *pParse, /* Parser context */
- Token *pStart, /* The "CREATE" token */
- Token *pName, /* Name of table or view to create */
- int isTemp, /* True if this is a TEMP table */
- int isView /* True if this is a VIEW */
-){
- Table *pTable;
- Index *pIdx;
- char *zName;
- sqlite *db = pParse->db;
- Vdbe *v;
- int iDb;
-
- pParse->sFirstToken = *pStart;
- zName = sqliteTableNameFromToken(pName);
- if( zName==0 ) return;
- if( db->init.iDb==1 ) isTemp = 1;
-#ifndef SQLITE_OMIT_AUTHORIZATION
- assert( (isTemp & 1)==isTemp );
- {
- int code;
- char *zDb = isTemp ? "temp" : "main";
- if( sqliteAuthCheck(pParse, SQLITE_INSERT, SCHEMA_TABLE(isTemp), 0, zDb) ){
- sqliteFree(zName);
- return;
- }
- if( isView ){
- if( isTemp ){
- code = SQLITE_CREATE_TEMP_VIEW;
- }else{
- code = SQLITE_CREATE_VIEW;
- }
- }else{
- if( isTemp ){
- code = SQLITE_CREATE_TEMP_TABLE;
- }else{
- code = SQLITE_CREATE_TABLE;
- }
- }
- if( sqliteAuthCheck(pParse, code, zName, 0, zDb) ){
- sqliteFree(zName);
- return;
- }
- }
-#endif
-
-
- /* Before trying to create a temporary table, make sure the Btree for
- ** holding temporary tables is open.
- */
- if( isTemp && db->aDb[1].pBt==0 && !pParse->explain ){
- int rc = sqliteBtreeFactory(db, 0, 0, MAX_PAGES, &db->aDb[1].pBt);
- if( rc!=SQLITE_OK ){
- sqliteErrorMsg(pParse, "unable to open a temporary database "
- "file for storing temporary tables");
- pParse->nErr++;
- return;
- }
- if( db->flags & SQLITE_InTrans ){
- rc = sqliteBtreeBeginTrans(db->aDb[1].pBt);
- if( rc!=SQLITE_OK ){
- sqliteErrorMsg(pParse, "unable to get a write lock on "
- "the temporary database file");
- return;
- }
- }
- }
-
- /* Make sure the new table name does not collide with an existing
- ** index or table name. Issue an error message if it does.
- **
- ** If we are re-reading the sqlite_master table because of a schema
- ** change and a new permanent table is found whose name collides with
- ** an existing temporary table, that is not an error.
- */
- pTable = sqliteFindTable(db, zName, 0);
- iDb = isTemp ? 1 : db->init.iDb;
- if( pTable!=0 && (pTable->iDb==iDb || !db->init.busy) ){
- sqliteErrorMsg(pParse, "table %T already exists", pName);
- sqliteFree(zName);
- return;
- }
- if( (pIdx = sqliteFindIndex(db, zName, 0))!=0 &&
- (pIdx->iDb==0 || !db->init.busy) ){
- sqliteErrorMsg(pParse, "there is already an index named %s", zName);
- sqliteFree(zName);
- return;
- }
- pTable = sqliteMalloc( sizeof(Table) );
- if( pTable==0 ){
- sqliteFree(zName);
- return;
- }
- pTable->zName = zName;
- pTable->nCol = 0;
- pTable->aCol = 0;
- pTable->iPKey = -1;
- pTable->pIndex = 0;
- pTable->iDb = iDb;
- if( pParse->pNewTable ) sqliteDeleteTable(db, pParse->pNewTable);
- pParse->pNewTable = pTable;
-
- /* Begin generating the code that will insert the table record into
- ** the SQLITE_MASTER table. Note in particular that we must go ahead
- ** and allocate the record number for the table entry now. Before any
- ** PRIMARY KEY or UNIQUE keywords are parsed. Those keywords will cause
- ** indices to be created and the table record must come before the
- ** indices. Hence, the record number for the table must be allocated
- ** now.
- */
- if( !db->init.busy && (v = sqliteGetVdbe(pParse))!=0 ){
- sqliteBeginWriteOperation(pParse, 0, isTemp);
- if( !isTemp ){
- sqliteVdbeAddOp(v, OP_Integer, db->file_format, 0);
- sqliteVdbeAddOp(v, OP_SetCookie, 0, 1);
- }
- sqliteOpenMasterTable(v, isTemp);
- sqliteVdbeAddOp(v, OP_NewRecno, 0, 0);
- sqliteVdbeAddOp(v, OP_Dup, 0, 0);
- sqliteVdbeAddOp(v, OP_String, 0, 0);
- sqliteVdbeAddOp(v, OP_PutIntKey, 0, 0);
- }
-}
-
-/*
-** Add a new column to the table currently being constructed.
-**
-** The parser calls this routine once for each column declaration
-** in a CREATE TABLE statement. sqliteStartTable() gets called
-** first to get things going. Then this routine is called for each
-** column.
-*/
-void sqliteAddColumn(Parse *pParse, Token *pName){
- Table *p;
- int i;
- char *z = 0;
- Column *pCol;
- if( (p = pParse->pNewTable)==0 ) return;
- sqliteSetNString(&z, pName->z, pName->n, 0);
- if( z==0 ) return;
- sqliteDequote(z);
- for(i=0; i<p->nCol; i++){
- if( sqliteStrICmp(z, p->aCol[i].zName)==0 ){
- sqliteErrorMsg(pParse, "duplicate column name: %s", z);
- sqliteFree(z);
- return;
- }
- }
- if( (p->nCol & 0x7)==0 ){
- Column *aNew;
- aNew = sqliteRealloc( p->aCol, (p->nCol+8)*sizeof(p->aCol[0]));
- if( aNew==0 ) return;
- p->aCol = aNew;
- }
- pCol = &p->aCol[p->nCol];
- memset(pCol, 0, sizeof(p->aCol[0]));
- pCol->zName = z;
- pCol->sortOrder = SQLITE_SO_NUM;
- p->nCol++;
-}
-
-/*
-** This routine is called by the parser while in the middle of
-** parsing a CREATE TABLE statement. A "NOT NULL" constraint has
-** been seen on a column. This routine sets the notNull flag on
-** the column currently under construction.
-*/
-void sqliteAddNotNull(Parse *pParse, int onError){
- Table *p;
- int i;
- if( (p = pParse->pNewTable)==0 ) return;
- i = p->nCol-1;
- if( i>=0 ) p->aCol[i].notNull = onError;
-}
-
-/*
-** This routine is called by the parser while in the middle of
-** parsing a CREATE TABLE statement. The pFirst token is the first
-** token in the sequence of tokens that describe the type of the
-** column currently under construction. pLast is the last token
-** in the sequence. Use this information to construct a string
-** that contains the typename of the column and store that string
-** in zType.
-*/
-void sqliteAddColumnType(Parse *pParse, Token *pFirst, Token *pLast){
- Table *p;
- int i, j;
- int n;
- char *z, **pz;
- Column *pCol;
- if( (p = pParse->pNewTable)==0 ) return;
- i = p->nCol-1;
- if( i<0 ) return;
- pCol = &p->aCol[i];
- pz = &pCol->zType;
- n = pLast->n + Addr(pLast->z) - Addr(pFirst->z);
- sqliteSetNString(pz, pFirst->z, n, 0);
- z = *pz;
- if( z==0 ) return;
- for(i=j=0; z[i]; i++){
- int c = z[i];
- if( isspace(c) ) continue;
- z[j++] = c;
- }
- z[j] = 0;
- if( pParse->db->file_format>=4 ){
- pCol->sortOrder = sqliteCollateType(z, n);
- }else{
- pCol->sortOrder = SQLITE_SO_NUM;
- }
-}
-
-/*
-** The given token is the default value for the last column added to
-** the table currently under construction. If "minusFlag" is true, it
-** means the value token was preceded by a minus sign.
-**
-** This routine is called by the parser while in the middle of
-** parsing a CREATE TABLE statement.
-*/
-void sqliteAddDefaultValue(Parse *pParse, Token *pVal, int minusFlag){
- Table *p;
- int i;
- char **pz;
- if( (p = pParse->pNewTable)==0 ) return;
- i = p->nCol-1;
- if( i<0 ) return;
- pz = &p->aCol[i].zDflt;
- if( minusFlag ){
- sqliteSetNString(pz, "-", 1, pVal->z, pVal->n, 0);
- }else{
- sqliteSetNString(pz, pVal->z, pVal->n, 0);
- }
- sqliteDequote(*pz);
-}
-
-/*
-** Designate the PRIMARY KEY for the table. pList is a list of names
-** of columns that form the primary key. If pList is NULL, then the
-** most recently added column of the table is the primary key.
-**
-** A table can have at most one primary key. If the table already has
-** a primary key (and this is the second primary key) then create an
-** error.
-**
-** If the PRIMARY KEY is on a single column whose datatype is INTEGER,
-** then we will try to use that column as the row id. (Exception:
-** For backwards compatibility with older databases, do not do this
-** if the file format version number is less than 1.) Set the Table.iPKey
-** field of the table under construction to be the index of the
-** INTEGER PRIMARY KEY column. Table.iPKey is set to -1 if there is
-** no INTEGER PRIMARY KEY.
-**
-** If the key is not an INTEGER PRIMARY KEY, then create a unique
-** index for the key. No index is created for INTEGER PRIMARY KEYs.
-*/
-void sqliteAddPrimaryKey(Parse *pParse, IdList *pList, int onError){
- Table *pTab = pParse->pNewTable;
- char *zType = 0;
- int iCol = -1, i;
- if( pTab==0 ) goto primary_key_exit;
- if( pTab->hasPrimKey ){
- sqliteErrorMsg(pParse,
- "table \"%s\" has more than one primary key", pTab->zName);
- goto primary_key_exit;
- }
- pTab->hasPrimKey = 1;
- if( pList==0 ){
- iCol = pTab->nCol - 1;
- pTab->aCol[iCol].isPrimKey = 1;
- }else{
- for(i=0; i<pList->nId; i++){
- for(iCol=0; iCol<pTab->nCol; iCol++){
- if( sqliteStrICmp(pList->a[i].zName, pTab->aCol[iCol].zName)==0 ) break;
- }
- if( iCol<pTab->nCol ) pTab->aCol[iCol].isPrimKey = 1;
- }
- if( pList->nId>1 ) iCol = -1;
- }
- if( iCol>=0 && iCol<pTab->nCol ){
- zType = pTab->aCol[iCol].zType;
- }
- if( pParse->db->file_format>=1 &&
- zType && sqliteStrICmp(zType, "INTEGER")==0 ){
- pTab->iPKey = iCol;
- pTab->keyConf = onError;
- }else{
- sqliteCreateIndex(pParse, 0, 0, pList, onError, 0, 0);
- pList = 0;
- }
-
-primary_key_exit:
- sqliteIdListDelete(pList);
- return;
-}
-
-/*
-** Return the appropriate collating type given a type name.
-**
-** The collation type is text (SQLITE_SO_TEXT) if the type
-** name contains the character stream "text" or "blob" or
-** "clob". Any other type name is collated as numeric
-** (SQLITE_SO_NUM).
-*/
-int sqliteCollateType(const char *zType, int nType){
- int i;
- for(i=0; i<nType-3; i++){
- int c = *(zType++) | 0x60;
- if( (c=='b' || c=='c') && sqliteStrNICmp(zType, "lob", 3)==0 ){
- return SQLITE_SO_TEXT;
- }
- if( c=='c' && sqliteStrNICmp(zType, "har", 3)==0 ){
- return SQLITE_SO_TEXT;
- }
- if( c=='t' && sqliteStrNICmp(zType, "ext", 3)==0 ){
- return SQLITE_SO_TEXT;
- }
- }
- return SQLITE_SO_NUM;
-}
-
-/*
-** This routine is called by the parser while in the middle of
-** parsing a CREATE TABLE statement. A "COLLATE" clause has
-** been seen on a column. This routine sets the Column.sortOrder on
-** the column currently under construction.
-*/
-void sqliteAddCollateType(Parse *pParse, int collType){
- Table *p;
- int i;
- if( (p = pParse->pNewTable)==0 ) return;
- i = p->nCol-1;
- if( i>=0 ) p->aCol[i].sortOrder = collType;
-}
-
-/*
-** Come up with a new random value for the schema cookie. Make sure
-** the new value is different from the old.
-**
-** The schema cookie is used to determine when the schema for the
-** database changes. After each schema change, the cookie value
-** changes. When a process first reads the schema it records the
-** cookie. Thereafter, whenever it goes to access the database,
-** it checks the cookie to make sure the schema has not changed
-** since it was last read.
-**
-** This plan is not completely bullet-proof. It is possible for
-** the schema to change multiple times and for the cookie to be
-** set back to prior value. But schema changes are infrequent
-** and the probability of hitting the same cookie value is only
-** 1 chance in 2^32. So we're safe enough.
-*/
-void sqliteChangeCookie(sqlite *db, Vdbe *v){
- if( db->next_cookie==db->aDb[0].schema_cookie ){
- unsigned char r;
- sqliteRandomness(1, &r);
- db->next_cookie = db->aDb[0].schema_cookie + r + 1;
- db->flags |= SQLITE_InternChanges;
- sqliteVdbeAddOp(v, OP_Integer, db->next_cookie, 0);
- sqliteVdbeAddOp(v, OP_SetCookie, 0, 0);
- }
-}
-
-/*
-** Measure the number of characters needed to output the given
-** identifier. The number returned includes any quotes used
-** but does not include the null terminator.
-*/
-static int identLength(const char *z){
- int n;
- int needQuote = 0;
- for(n=0; *z; n++, z++){
- if( *z=='\'' ){ n++; needQuote=1; }
- }
- return n + needQuote*2;
-}
-
-/*
-** Write an identifier onto the end of the given string. Add
-** quote characters as needed.
-*/
-static void identPut(char *z, int *pIdx, char *zIdent){
- int i, j, needQuote;
- i = *pIdx;
- for(j=0; zIdent[j]; j++){
- if( !isalnum(zIdent[j]) && zIdent[j]!='_' ) break;
- }
- needQuote = zIdent[j]!=0 || isdigit(zIdent[0])
- || sqliteKeywordCode(zIdent, j)!=TK_ID;
- if( needQuote ) z[i++] = '\'';
- for(j=0; zIdent[j]; j++){
- z[i++] = zIdent[j];
- if( zIdent[j]=='\'' ) z[i++] = '\'';
- }
- if( needQuote ) z[i++] = '\'';
- z[i] = 0;
- *pIdx = i;
-}
-
-/*
-** Generate a CREATE TABLE statement appropriate for the given
-** table. Memory to hold the text of the statement is obtained
-** from sqliteMalloc() and must be freed by the calling function.
-*/
-static char *createTableStmt(Table *p){
- int i, k, n;
- char *zStmt;
- char *zSep, *zSep2, *zEnd;
- n = 0;
- for(i=0; i<p->nCol; i++){
- n += identLength(p->aCol[i].zName);
- }
- n += identLength(p->zName);
- if( n<40 ){
- zSep = "";
- zSep2 = ",";
- zEnd = ")";
- }else{
- zSep = "\n ";
- zSep2 = ",\n ";
- zEnd = "\n)";
- }
- n += 35 + 6*p->nCol;
- zStmt = sqliteMallocRaw( n );
- if( zStmt==0 ) return 0;
- strcpy(zStmt, p->iDb==1 ? "CREATE TEMP TABLE " : "CREATE TABLE ");
- k = strlen(zStmt);
- identPut(zStmt, &k, p->zName);
- zStmt[k++] = '(';
- for(i=0; i<p->nCol; i++){
- strcpy(&zStmt[k], zSep);
- k += strlen(&zStmt[k]);
- zSep = zSep2;
- identPut(zStmt, &k, p->aCol[i].zName);
- }
- strcpy(&zStmt[k], zEnd);
- return zStmt;
-}
-
-/*
-** This routine is called to report the final ")" that terminates
-** a CREATE TABLE statement.
-**
-** The table structure that other action routines have been building
-** is added to the internal hash tables, assuming no errors have
-** occurred.
-**
-** An entry for the table is made in the master table on disk, unless
-** this is a temporary table or db->init.busy==1. When db->init.busy==1
-** it means we are reading the sqlite_master table because we just
-** connected to the database or because the sqlite_master table has
-** recently changes, so the entry for this table already exists in
-** the sqlite_master table. We do not want to create it again.
-**
-** If the pSelect argument is not NULL, it means that this routine
-** was called to create a table generated from a
-** "CREATE TABLE ... AS SELECT ..." statement. The column names of
-** the new table will match the result set of the SELECT.
-*/
-void sqliteEndTable(Parse *pParse, Token *pEnd, Select *pSelect){
- Table *p;
- sqlite *db = pParse->db;
-
- if( (pEnd==0 && pSelect==0) || pParse->nErr || sqlite_malloc_failed ) return;
- p = pParse->pNewTable;
- if( p==0 ) return;
-
- /* If the table is generated from a SELECT, then construct the
- ** list of columns and the text of the table.
- */
- if( pSelect ){
- Table *pSelTab = sqliteResultSetOfSelect(pParse, 0, pSelect);
- if( pSelTab==0 ) return;
- assert( p->aCol==0 );
- p->nCol = pSelTab->nCol;
- p->aCol = pSelTab->aCol;
- pSelTab->nCol = 0;
- pSelTab->aCol = 0;
- sqliteDeleteTable(0, pSelTab);
- }
-
- /* If the db->init.busy is 1 it means we are reading the SQL off the
- ** "sqlite_master" or "sqlite_temp_master" table on the disk.
- ** So do not write to the disk again. Extract the root page number
- ** for the table from the db->init.newTnum field. (The page number
- ** should have been put there by the sqliteOpenCb routine.)
- */
- if( db->init.busy ){
- p->tnum = db->init.newTnum;
- }
-
- /* If not initializing, then create a record for the new table
- ** in the SQLITE_MASTER table of the database. The record number
- ** for the new table entry should already be on the stack.
- **
- ** If this is a TEMPORARY table, write the entry into the auxiliary
- ** file instead of into the main database file.
- */
- if( !db->init.busy ){
- int n;
- Vdbe *v;
-
- v = sqliteGetVdbe(pParse);
- if( v==0 ) return;
- if( p->pSelect==0 ){
- /* A regular table */
- sqliteVdbeOp3(v, OP_CreateTable, 0, p->iDb, (char*)&p->tnum, P3_POINTER);
- }else{
- /* A view */
- sqliteVdbeAddOp(v, OP_Integer, 0, 0);
- }
- p->tnum = 0;
- sqliteVdbeAddOp(v, OP_Pull, 1, 0);
- sqliteVdbeOp3(v, OP_String, 0, 0, p->pSelect==0?"table":"view", P3_STATIC);
- sqliteVdbeOp3(v, OP_String, 0, 0, p->zName, 0);
- sqliteVdbeOp3(v, OP_String, 0, 0, p->zName, 0);
- sqliteVdbeAddOp(v, OP_Dup, 4, 0);
- sqliteVdbeAddOp(v, OP_String, 0, 0);
- if( pSelect ){
- char *z = createTableStmt(p);
- n = z ? strlen(z) : 0;
- sqliteVdbeChangeP3(v, -1, z, n);
- sqliteFree(z);
- }else{
- assert( pEnd!=0 );
- n = Addr(pEnd->z) - Addr(pParse->sFirstToken.z) + 1;
- sqliteVdbeChangeP3(v, -1, pParse->sFirstToken.z, n);
- }
- sqliteVdbeAddOp(v, OP_MakeRecord, 5, 0);
- sqliteVdbeAddOp(v, OP_PutIntKey, 0, 0);
- if( !p->iDb ){
- sqliteChangeCookie(db, v);
- }
- sqliteVdbeAddOp(v, OP_Close, 0, 0);
- if( pSelect ){
- sqliteVdbeAddOp(v, OP_Integer, p->iDb, 0);
- sqliteVdbeAddOp(v, OP_OpenWrite, 1, 0);
- pParse->nTab = 2;
- sqliteSelect(pParse, pSelect, SRT_Table, 1, 0, 0, 0);
- }
- sqliteEndWriteOperation(pParse);
- }
-
- /* Add the table to the in-memory representation of the database.
- */
- if( pParse->explain==0 && pParse->nErr==0 ){
- Table *pOld;
- FKey *pFKey;
- pOld = sqliteHashInsert(&db->aDb[p->iDb].tblHash,
- p->zName, strlen(p->zName)+1, p);
- if( pOld ){
- assert( p==pOld ); /* Malloc must have failed inside HashInsert() */
- return;
- }
- for(pFKey=p->pFKey; pFKey; pFKey=pFKey->pNextFrom){
- int nTo = strlen(pFKey->zTo) + 1;
- pFKey->pNextTo = sqliteHashFind(&db->aDb[p->iDb].aFKey, pFKey->zTo, nTo);
- sqliteHashInsert(&db->aDb[p->iDb].aFKey, pFKey->zTo, nTo, pFKey);
- }
- pParse->pNewTable = 0;
- db->nTable++;
- db->flags |= SQLITE_InternChanges;
- }
-}
-
-/*
-** The parser calls this routine in order to create a new VIEW
-*/
-void sqliteCreateView(
- Parse *pParse, /* The parsing context */
- Token *pBegin, /* The CREATE token that begins the statement */
- Token *pName, /* The token that holds the name of the view */
- Select *pSelect, /* A SELECT statement that will become the new view */
- int isTemp /* TRUE for a TEMPORARY view */
-){
- Table *p;
- int n;
- const char *z;
- Token sEnd;
- DbFixer sFix;
-
- sqliteStartTable(pParse, pBegin, pName, isTemp, 1);
- p = pParse->pNewTable;
- if( p==0 || pParse->nErr ){
- sqliteSelectDelete(pSelect);
- return;
- }
- if( sqliteFixInit(&sFix, pParse, p->iDb, "view", pName)
- && sqliteFixSelect(&sFix, pSelect)
- ){
- sqliteSelectDelete(pSelect);
- return;
- }
-
- /* Make a copy of the entire SELECT statement that defines the view.
- ** This will force all the Expr.token.z values to be dynamically
- ** allocated rather than point to the input string - which means that
- ** they will persist after the current sqlite_exec() call returns.
- */
- p->pSelect = sqliteSelectDup(pSelect);
- sqliteSelectDelete(pSelect);
- if( !pParse->db->init.busy ){
- sqliteViewGetColumnNames(pParse, p);
- }
-
- /* Locate the end of the CREATE VIEW statement. Make sEnd point to
- ** the end.
- */
- sEnd = pParse->sLastToken;
- if( sEnd.z[0]!=0 && sEnd.z[0]!=';' ){
- sEnd.z += sEnd.n;
- }
- sEnd.n = 0;
- n = sEnd.z - pBegin->z;
- z = pBegin->z;
- while( n>0 && (z[n-1]==';' || isspace(z[n-1])) ){ n--; }
- sEnd.z = &z[n-1];
- sEnd.n = 1;
-
- /* Use sqliteEndTable() to add the view to the SQLITE_MASTER table */
- sqliteEndTable(pParse, &sEnd, 0);
- return;
-}
-
-/*
-** The Table structure pTable is really a VIEW. Fill in the names of
-** the columns of the view in the pTable structure. Return the number
-** of errors. If an error is seen leave an error message in pParse->zErrMsg.
-*/
-int sqliteViewGetColumnNames(Parse *pParse, Table *pTable){
- ExprList *pEList;
- Select *pSel;
- Table *pSelTab;
- int nErr = 0;
-
- assert( pTable );
-
- /* A positive nCol means the columns names for this view are
- ** already known.
- */
- if( pTable->nCol>0 ) return 0;
-
- /* A negative nCol is a special marker meaning that we are currently
- ** trying to compute the column names. If we enter this routine with
- ** a negative nCol, it means two or more views form a loop, like this:
- **
- ** CREATE VIEW one AS SELECT * FROM two;
- ** CREATE VIEW two AS SELECT * FROM one;
- **
- ** Actually, this error is caught previously and so the following test
- ** should always fail. But we will leave it in place just to be safe.
- */
- if( pTable->nCol<0 ){
- sqliteErrorMsg(pParse, "view %s is circularly defined", pTable->zName);
- return 1;
- }
-
- /* If we get this far, it means we need to compute the table names.
- */
- assert( pTable->pSelect ); /* If nCol==0, then pTable must be a VIEW */
- pSel = pTable->pSelect;
-
- /* Note that the call to sqliteResultSetOfSelect() will expand any
- ** "*" elements in this list. But we will need to restore the list
- ** back to its original configuration afterwards, so we save a copy of
- ** the original in pEList.
- */
- pEList = pSel->pEList;
- pSel->pEList = sqliteExprListDup(pEList);
- if( pSel->pEList==0 ){
- pSel->pEList = pEList;
- return 1; /* Malloc failed */
- }
- pTable->nCol = -1;
- pSelTab = sqliteResultSetOfSelect(pParse, 0, pSel);
- if( pSelTab ){
- assert( pTable->aCol==0 );
- pTable->nCol = pSelTab->nCol;
- pTable->aCol = pSelTab->aCol;
- pSelTab->nCol = 0;
- pSelTab->aCol = 0;
- sqliteDeleteTable(0, pSelTab);
- DbSetProperty(pParse->db, pTable->iDb, DB_UnresetViews);
- }else{
- pTable->nCol = 0;
- nErr++;
- }
- sqliteSelectUnbind(pSel);
- sqliteExprListDelete(pSel->pEList);
- pSel->pEList = pEList;
- return nErr;
-}
-
-/*
-** Clear the column names from the VIEW pTable.
-**
-** This routine is called whenever any other table or view is modified.
-** The view passed into this routine might depend directly or indirectly
-** on the modified or deleted table so we need to clear the old column
-** names so that they will be recomputed.
-*/
-static void sqliteViewResetColumnNames(Table *pTable){
- int i;
- Column *pCol;
- assert( pTable!=0 && pTable->pSelect!=0 );
- for(i=0, pCol=pTable->aCol; i<pTable->nCol; i++, pCol++){
- sqliteFree(pCol->zName);
- sqliteFree(pCol->zDflt);
- sqliteFree(pCol->zType);
- }
- sqliteFree(pTable->aCol);
- pTable->aCol = 0;
- pTable->nCol = 0;
-}
-
-/*
-** Clear the column names from every VIEW in database idx.
-*/
-static void sqliteViewResetAll(sqlite *db, int idx){
- HashElem *i;
- if( !DbHasProperty(db, idx, DB_UnresetViews) ) return;
- for(i=sqliteHashFirst(&db->aDb[idx].tblHash); i; i=sqliteHashNext(i)){
- Table *pTab = sqliteHashData(i);
- if( pTab->pSelect ){
- sqliteViewResetColumnNames(pTab);
- }
- }
- DbClearProperty(db, idx, DB_UnresetViews);
-}
-
-/*
-** Given a token, look up a table with that name. If not found, leave
-** an error for the parser to find and return NULL.
-*/
-Table *sqliteTableFromToken(Parse *pParse, Token *pTok){
- char *zName;
- Table *pTab;
- zName = sqliteTableNameFromToken(pTok);
- if( zName==0 ) return 0;
- pTab = sqliteFindTable(pParse->db, zName, 0);
- sqliteFree(zName);
- if( pTab==0 ){
- sqliteErrorMsg(pParse, "no such table: %T", pTok);
- }
- return pTab;
-}
-
-/*
-** This routine is called to do the work of a DROP TABLE statement.
-** pName is the name of the table to be dropped.
-*/
-void sqliteDropTable(Parse *pParse, Token *pName, int isView){
- Table *pTable;
- Vdbe *v;
- int base;
- sqlite *db = pParse->db;
- int iDb;
-
- if( pParse->nErr || sqlite_malloc_failed ) return;
- pTable = sqliteTableFromToken(pParse, pName);
- if( pTable==0 ) return;
- iDb = pTable->iDb;
- assert( iDb>=0 && iDb<db->nDb );
-#ifndef SQLITE_OMIT_AUTHORIZATION
- {
- int code;
- const char *zTab = SCHEMA_TABLE(pTable->iDb);
- const char *zDb = db->aDb[pTable->iDb].zName;
- if( sqliteAuthCheck(pParse, SQLITE_DELETE, zTab, 0, zDb)){
- return;
- }
- if( isView ){
- if( iDb==1 ){
- code = SQLITE_DROP_TEMP_VIEW;
- }else{
- code = SQLITE_DROP_VIEW;
- }
- }else{
- if( iDb==1 ){
- code = SQLITE_DROP_TEMP_TABLE;
- }else{
- code = SQLITE_DROP_TABLE;
- }
- }
- if( sqliteAuthCheck(pParse, code, pTable->zName, 0, zDb) ){
- return;
- }
- if( sqliteAuthCheck(pParse, SQLITE_DELETE, pTable->zName, 0, zDb) ){
- return;
- }
- }
-#endif
- if( pTable->readOnly ){
- sqliteErrorMsg(pParse, "table %s may not be dropped", pTable->zName);
- pParse->nErr++;
- return;
- }
- if( isView && pTable->pSelect==0 ){
- sqliteErrorMsg(pParse, "use DROP TABLE to delete table %s", pTable->zName);
- return;
- }
- if( !isView && pTable->pSelect ){
- sqliteErrorMsg(pParse, "use DROP VIEW to delete view %s", pTable->zName);
- return;
- }
-
- /* Generate code to remove the table from the master table
- ** on disk.
- */
- v = sqliteGetVdbe(pParse);
- if( v ){
- static VdbeOpList dropTable[] = {
- { OP_Rewind, 0, ADDR(8), 0},
- { OP_String, 0, 0, 0}, /* 1 */
- { OP_MemStore, 1, 1, 0},
- { OP_MemLoad, 1, 0, 0}, /* 3 */
- { OP_Column, 0, 2, 0},
- { OP_Ne, 0, ADDR(7), 0},
- { OP_Delete, 0, 0, 0},
- { OP_Next, 0, ADDR(3), 0}, /* 7 */
- };
- Index *pIdx;
- Trigger *pTrigger;
- sqliteBeginWriteOperation(pParse, 0, pTable->iDb);
-
- /* Drop all triggers associated with the table being dropped */
- pTrigger = pTable->pTrigger;
- while( pTrigger ){
- assert( pTrigger->iDb==pTable->iDb || pTrigger->iDb==1 );
- sqliteDropTriggerPtr(pParse, pTrigger, 1);
- if( pParse->explain ){
- pTrigger = pTrigger->pNext;
- }else{
- pTrigger = pTable->pTrigger;
- }
- }
-
- /* Drop all SQLITE_MASTER entries that refer to the table */
- sqliteOpenMasterTable(v, pTable->iDb);
- base = sqliteVdbeAddOpList(v, ArraySize(dropTable), dropTable);
- sqliteVdbeChangeP3(v, base+1, pTable->zName, 0);
-
- /* Drop all SQLITE_TEMP_MASTER entries that refer to the table */
- if( pTable->iDb!=1 ){
- sqliteOpenMasterTable(v, 1);
- base = sqliteVdbeAddOpList(v, ArraySize(dropTable), dropTable);
- sqliteVdbeChangeP3(v, base+1, pTable->zName, 0);
- }
-
- if( pTable->iDb==0 ){
- sqliteChangeCookie(db, v);
- }
- sqliteVdbeAddOp(v, OP_Close, 0, 0);
- if( !isView ){
- sqliteVdbeAddOp(v, OP_Destroy, pTable->tnum, pTable->iDb);
- for(pIdx=pTable->pIndex; pIdx; pIdx=pIdx->pNext){
- sqliteVdbeAddOp(v, OP_Destroy, pIdx->tnum, pIdx->iDb);
- }
- }
- sqliteEndWriteOperation(pParse);
- }
-
- /* Delete the in-memory description of the table.
- **
- ** Exception: if the SQL statement began with the EXPLAIN keyword,
- ** then no changes should be made.
- */
- if( !pParse->explain ){
- sqliteUnlinkAndDeleteTable(db, pTable);
- db->flags |= SQLITE_InternChanges;
- }
- sqliteViewResetAll(db, iDb);
-}
-
-/*
-** This routine constructs a P3 string suitable for an OP_MakeIdxKey
-** opcode and adds that P3 string to the most recently inserted instruction
-** in the virtual machine. The P3 string consists of a single character
-** for each column in the index pIdx of table pTab. If the column uses
-** a numeric sort order, then the P3 string character corresponding to
-** that column is 'n'. If the column uses a text sort order, then the
-** P3 string is 't'. See the OP_MakeIdxKey opcode documentation for
-** additional information. See also the sqliteAddKeyType() routine.
-*/
-void sqliteAddIdxKeyType(Vdbe *v, Index *pIdx){
- char *zType;
- Table *pTab;
- int i, n;
- assert( pIdx!=0 && pIdx->pTable!=0 );
- pTab = pIdx->pTable;
- n = pIdx->nColumn;
- zType = sqliteMallocRaw( n+1 );
- if( zType==0 ) return;
- for(i=0; i<n; i++){
- int iCol = pIdx->aiColumn[i];
- assert( iCol>=0 && iCol<pTab->nCol );
- if( (pTab->aCol[iCol].sortOrder & SQLITE_SO_TYPEMASK)==SQLITE_SO_TEXT ){
- zType[i] = 't';
- }else{
- zType[i] = 'n';
- }
- }
- zType[n] = 0;
- sqliteVdbeChangeP3(v, -1, zType, n);
- sqliteFree(zType);
-}
-
-/*
-** This routine is called to create a new foreign key on the table
-** currently under construction. pFromCol determines which columns
-** in the current table point to the foreign key. If pFromCol==0 then
-** connect the key to the last column inserted. pTo is the name of
-** the table referred to. pToCol is a list of tables in the other
-** pTo table that the foreign key points to. flags contains all
-** information about the conflict resolution algorithms specified
-** in the ON DELETE, ON UPDATE and ON INSERT clauses.
-**
-** An FKey structure is created and added to the table currently
-** under construction in the pParse->pNewTable field. The new FKey
-** is not linked into db->aFKey at this point - that does not happen
-** until sqliteEndTable().
-**
-** The foreign key is set for IMMEDIATE processing. A subsequent call
-** to sqliteDeferForeignKey() might change this to DEFERRED.
-*/
-void sqliteCreateForeignKey(
- Parse *pParse, /* Parsing context */
- IdList *pFromCol, /* Columns in this table that point to other table */
- Token *pTo, /* Name of the other table */
- IdList *pToCol, /* Columns in the other table */
- int flags /* Conflict resolution algorithms. */
-){
- Table *p = pParse->pNewTable;
- int nByte;
- int i;
- int nCol;
- char *z;
- FKey *pFKey = 0;
-
- assert( pTo!=0 );
- if( p==0 || pParse->nErr ) goto fk_end;
- if( pFromCol==0 ){
- int iCol = p->nCol-1;
- if( iCol<0 ) goto fk_end;
- if( pToCol && pToCol->nId!=1 ){
- sqliteErrorMsg(pParse, "foreign key on %s"
- " should reference only one column of table %T",
- p->aCol[iCol].zName, pTo);
- goto fk_end;
- }
- nCol = 1;
- }else if( pToCol && pToCol->nId!=pFromCol->nId ){
- sqliteErrorMsg(pParse,
- "number of columns in foreign key does not match the number of "
- "columns in the referenced table");
- goto fk_end;
- }else{
- nCol = pFromCol->nId;
- }
- nByte = sizeof(*pFKey) + nCol*sizeof(pFKey->aCol[0]) + pTo->n + 1;
- if( pToCol ){
- for(i=0; i<pToCol->nId; i++){
- nByte += strlen(pToCol->a[i].zName) + 1;
- }
- }
- pFKey = sqliteMalloc( nByte );
- if( pFKey==0 ) goto fk_end;
- pFKey->pFrom = p;
- pFKey->pNextFrom = p->pFKey;
- z = (char*)&pFKey[1];
- pFKey->aCol = (struct sColMap*)z;
- z += sizeof(struct sColMap)*nCol;
- pFKey->zTo = z;
- memcpy(z, pTo->z, pTo->n);
- z[pTo->n] = 0;
- z += pTo->n+1;
- pFKey->pNextTo = 0;
- pFKey->nCol = nCol;
- if( pFromCol==0 ){
- pFKey->aCol[0].iFrom = p->nCol-1;
- }else{
- for(i=0; i<nCol; i++){
- int j;
- for(j=0; j<p->nCol; j++){
- if( sqliteStrICmp(p->aCol[j].zName, pFromCol->a[i].zName)==0 ){
- pFKey->aCol[i].iFrom = j;
- break;
- }
- }
- if( j>=p->nCol ){
- sqliteErrorMsg(pParse,
- "unknown column \"%s\" in foreign key definition",
- pFromCol->a[i].zName);
- goto fk_end;
- }
- }
- }
- if( pToCol ){
- for(i=0; i<nCol; i++){
- int n = strlen(pToCol->a[i].zName);
- pFKey->aCol[i].zCol = z;
- memcpy(z, pToCol->a[i].zName, n);
- z[n] = 0;
- z += n+1;
- }
- }
- pFKey->isDeferred = 0;
- pFKey->deleteConf = flags & 0xff;
- pFKey->updateConf = (flags >> 8 ) & 0xff;
- pFKey->insertConf = (flags >> 16 ) & 0xff;
-
- /* Link the foreign key to the table as the last step.
- */
- p->pFKey = pFKey;
- pFKey = 0;
-
-fk_end:
- sqliteFree(pFKey);
- sqliteIdListDelete(pFromCol);
- sqliteIdListDelete(pToCol);
-}
-
-/*
-** This routine is called when an INITIALLY IMMEDIATE or INITIALLY DEFERRED
-** clause is seen as part of a foreign key definition. The isDeferred
-** parameter is 1 for INITIALLY DEFERRED and 0 for INITIALLY IMMEDIATE.
-** The behavior of the most recently created foreign key is adjusted
-** accordingly.
-*/
-void sqliteDeferForeignKey(Parse *pParse, int isDeferred){
- Table *pTab;
- FKey *pFKey;
- if( (pTab = pParse->pNewTable)==0 || (pFKey = pTab->pFKey)==0 ) return;
- pFKey->isDeferred = isDeferred;
-}
-
-/*
-** Create a new index for an SQL table. pIndex is the name of the index
-** and pTable is the name of the table that is to be indexed. Both will
-** be NULL for a primary key or an index that is created to satisfy a
-** UNIQUE constraint. If pTable and pIndex are NULL, use pParse->pNewTable
-** as the table to be indexed. pParse->pNewTable is a table that is
-** currently being constructed by a CREATE TABLE statement.
-**
-** pList is a list of columns to be indexed. pList will be NULL if this
-** is a primary key or unique-constraint on the most recent column added
-** to the table currently under construction.
-*/
-void sqliteCreateIndex(
- Parse *pParse, /* All information about this parse */
- Token *pName, /* Name of the index. May be NULL */
- SrcList *pTable, /* Name of the table to index. Use pParse->pNewTable if 0 */
- IdList *pList, /* A list of columns to be indexed */
- int onError, /* OE_Abort, OE_Ignore, OE_Replace, or OE_None */
- Token *pStart, /* The CREATE token that begins a CREATE TABLE statement */
- Token *pEnd /* The ")" that closes the CREATE INDEX statement */
-){
- Table *pTab; /* Table to be indexed */
- Index *pIndex; /* The index to be created */
- char *zName = 0;
- int i, j;
- Token nullId; /* Fake token for an empty ID list */
- DbFixer sFix; /* For assigning database names to pTable */
- int isTemp; /* True for a temporary index */
- sqlite *db = pParse->db;
-
- if( pParse->nErr || sqlite_malloc_failed ) goto exit_create_index;
- if( db->init.busy
- && sqliteFixInit(&sFix, pParse, db->init.iDb, "index", pName)
- && sqliteFixSrcList(&sFix, pTable)
- ){
- goto exit_create_index;
- }
-
- /*
- ** Find the table that is to be indexed. Return early if not found.
- */
- if( pTable!=0 ){
- assert( pName!=0 );
- assert( pTable->nSrc==1 );
- pTab = sqliteSrcListLookup(pParse, pTable);
- }else{
- assert( pName==0 );
- pTab = pParse->pNewTable;
- }
- if( pTab==0 || pParse->nErr ) goto exit_create_index;
- if( pTab->readOnly ){
- sqliteErrorMsg(pParse, "table %s may not be indexed", pTab->zName);
- goto exit_create_index;
- }
- if( pTab->iDb>=2 && db->init.busy==0 ){
- sqliteErrorMsg(pParse, "table %s may not have indices added", pTab->zName);
- goto exit_create_index;
- }
- if( pTab->pSelect ){
- sqliteErrorMsg(pParse, "views may not be indexed");
- goto exit_create_index;
- }
- isTemp = pTab->iDb==1;
-
- /*
- ** Find the name of the index. Make sure there is not already another
- ** index or table with the same name.
- **
- ** Exception: If we are reading the names of permanent indices from the
- ** sqlite_master table (because some other process changed the schema) and
- ** one of the index names collides with the name of a temporary table or
- ** index, then we will continue to process this index.
- **
- ** If pName==0 it means that we are
- ** dealing with a primary key or UNIQUE constraint. We have to invent our
- ** own name.
- */
- if( pName && !db->init.busy ){
- Index *pISameName; /* Another index with the same name */
- Table *pTSameName; /* A table with same name as the index */
- zName = sqliteTableNameFromToken(pName);
- if( zName==0 ) goto exit_create_index;
- if( (pISameName = sqliteFindIndex(db, zName, 0))!=0 ){
- sqliteErrorMsg(pParse, "index %s already exists", zName);
- goto exit_create_index;
- }
- if( (pTSameName = sqliteFindTable(db, zName, 0))!=0 ){
- sqliteErrorMsg(pParse, "there is already a table named %s", zName);
- goto exit_create_index;
- }
- }else if( pName==0 ){
- char zBuf[30];
- int n;
- Index *pLoop;
- for(pLoop=pTab->pIndex, n=1; pLoop; pLoop=pLoop->pNext, n++){}
- sprintf(zBuf,"%d)",n);
- zName = 0;
- sqliteSetString(&zName, "(", pTab->zName, " autoindex ", zBuf, (char*)0);
- if( zName==0 ) goto exit_create_index;
- }else{
- zName = sqliteStrNDup(pName->z, pName->n);
- }
-
- /* Check for authorization to create an index.
- */
-#ifndef SQLITE_OMIT_AUTHORIZATION
- {
- const char *zDb = db->aDb[pTab->iDb].zName;
-
- assert( pTab->iDb==db->init.iDb || isTemp );
- if( sqliteAuthCheck(pParse, SQLITE_INSERT, SCHEMA_TABLE(isTemp), 0, zDb) ){
- goto exit_create_index;
- }
- i = SQLITE_CREATE_INDEX;
- if( isTemp ) i = SQLITE_CREATE_TEMP_INDEX;
- if( sqliteAuthCheck(pParse, i, zName, pTab->zName, zDb) ){
- goto exit_create_index;
- }
- }
-#endif
-
- /* If pList==0, it means this routine was called to make a primary
- ** key out of the last column added to the table under construction.
- ** So create a fake list to simulate this.
- */
- if( pList==0 ){
- nullId.z = pTab->aCol[pTab->nCol-1].zName;
- nullId.n = strlen(nullId.z);
- pList = sqliteIdListAppend(0, &nullId);
- if( pList==0 ) goto exit_create_index;
- }
-
- /*
- ** Allocate the index structure.
- */
- pIndex = sqliteMalloc( sizeof(Index) + strlen(zName) + 1 +
- sizeof(int)*pList->nId );
- if( pIndex==0 ) goto exit_create_index;
- pIndex->aiColumn = (int*)&pIndex[1];
- pIndex->zName = (char*)&pIndex->aiColumn[pList->nId];
- strcpy(pIndex->zName, zName);
- pIndex->pTable = pTab;
- pIndex->nColumn = pList->nId;
- pIndex->onError = onError;
- pIndex->autoIndex = pName==0;
- pIndex->iDb = isTemp ? 1 : db->init.iDb;
-
- /* Scan the names of the columns of the table to be indexed and
- ** load the column indices into the Index structure. Report an error
- ** if any column is not found.
- */
- for(i=0; i<pList->nId; i++){
- for(j=0; j<pTab->nCol; j++){
- if( sqliteStrICmp(pList->a[i].zName, pTab->aCol[j].zName)==0 ) break;
- }
- if( j>=pTab->nCol ){
- sqliteErrorMsg(pParse, "table %s has no column named %s",
- pTab->zName, pList->a[i].zName);
- sqliteFree(pIndex);
- goto exit_create_index;
- }
- pIndex->aiColumn[i] = j;
- }
-
- /* Link the new Index structure to its table and to the other
- ** in-memory database structures.
- */
- if( !pParse->explain ){
- Index *p;
- p = sqliteHashInsert(&db->aDb[pIndex->iDb].idxHash,
- pIndex->zName, strlen(pIndex->zName)+1, pIndex);
- if( p ){
- assert( p==pIndex ); /* Malloc must have failed */
- sqliteFree(pIndex);
- goto exit_create_index;
- }
- db->flags |= SQLITE_InternChanges;
- }
-
- /* When adding an index to the list of indices for a table, make
- ** sure all indices labeled OE_Replace come after all those labeled
- ** OE_Ignore. This is necessary for the correct operation of UPDATE
- ** and INSERT.
- */
- if( onError!=OE_Replace || pTab->pIndex==0
- || pTab->pIndex->onError==OE_Replace){
- pIndex->pNext = pTab->pIndex;
- pTab->pIndex = pIndex;
- }else{
- Index *pOther = pTab->pIndex;
- while( pOther->pNext && pOther->pNext->onError!=OE_Replace ){
- pOther = pOther->pNext;
- }
- pIndex->pNext = pOther->pNext;
- pOther->pNext = pIndex;
- }
-
- /* If the db->init.busy is 1 it means we are reading the SQL off the
- ** "sqlite_master" table on the disk. So do not write to the disk
- ** again. Extract the table number from the db->init.newTnum field.
- */
- if( db->init.busy && pTable!=0 ){
- pIndex->tnum = db->init.newTnum;
- }
-
- /* If the db->init.busy is 0 then create the index on disk. This
- ** involves writing the index into the master table and filling in the
- ** index with the current table contents.
- **
- ** The db->init.busy is 0 when the user first enters a CREATE INDEX
- ** command. db->init.busy is 1 when a database is opened and
- ** CREATE INDEX statements are read out of the master table. In
- ** the latter case the index already exists on disk, which is why
- ** we don't want to recreate it.
- **
- ** If pTable==0 it means this index is generated as a primary key
- ** or UNIQUE constraint of a CREATE TABLE statement. Since the table
- ** has just been created, it contains no data and the index initialization
- ** step can be skipped.
- */
- else if( db->init.busy==0 ){
- int n;
- Vdbe *v;
- int lbl1, lbl2;
- int i;
- int addr;
-
- v = sqliteGetVdbe(pParse);
- if( v==0 ) goto exit_create_index;
- if( pTable!=0 ){
- sqliteBeginWriteOperation(pParse, 0, isTemp);
- sqliteOpenMasterTable(v, isTemp);
- }
- sqliteVdbeAddOp(v, OP_NewRecno, 0, 0);
- sqliteVdbeOp3(v, OP_String, 0, 0, "index", P3_STATIC);
- sqliteVdbeOp3(v, OP_String, 0, 0, pIndex->zName, 0);
- sqliteVdbeOp3(v, OP_String, 0, 0, pTab->zName, 0);
- sqliteVdbeOp3(v, OP_CreateIndex, 0, isTemp,(char*)&pIndex->tnum,P3_POINTER);
- pIndex->tnum = 0;
- if( pTable ){
- sqliteVdbeCode(v,
- OP_Dup, 0, 0,
- OP_Integer, isTemp, 0,
- OP_OpenWrite, 1, 0,
- 0);
- }
- addr = sqliteVdbeAddOp(v, OP_String, 0, 0);
- if( pStart && pEnd ){
- n = Addr(pEnd->z) - Addr(pStart->z) + 1;
- sqliteVdbeChangeP3(v, addr, pStart->z, n);
- }
- sqliteVdbeAddOp(v, OP_MakeRecord, 5, 0);
- sqliteVdbeAddOp(v, OP_PutIntKey, 0, 0);
- if( pTable ){
- sqliteVdbeAddOp(v, OP_Integer, pTab->iDb, 0);
- sqliteVdbeOp3(v, OP_OpenRead, 2, pTab->tnum, pTab->zName, 0);
- lbl2 = sqliteVdbeMakeLabel(v);
- sqliteVdbeAddOp(v, OP_Rewind, 2, lbl2);
- lbl1 = sqliteVdbeAddOp(v, OP_Recno, 2, 0);
- for(i=0; i<pIndex->nColumn; i++){
- int iCol = pIndex->aiColumn[i];
- if( pTab->iPKey==iCol ){
- sqliteVdbeAddOp(v, OP_Dup, i, 0);
- }else{
- sqliteVdbeAddOp(v, OP_Column, 2, iCol);
- }
- }
- sqliteVdbeAddOp(v, OP_MakeIdxKey, pIndex->nColumn, 0);
- if( db->file_format>=4 ) sqliteAddIdxKeyType(v, pIndex);
- sqliteVdbeOp3(v, OP_IdxPut, 1, pIndex->onError!=OE_None,
- "indexed columns are not unique", P3_STATIC);
- sqliteVdbeAddOp(v, OP_Next, 2, lbl1);
- sqliteVdbeResolveLabel(v, lbl2);
- sqliteVdbeAddOp(v, OP_Close, 2, 0);
- sqliteVdbeAddOp(v, OP_Close, 1, 0);
- }
- if( pTable!=0 ){
- if( !isTemp ){
- sqliteChangeCookie(db, v);
- }
- sqliteVdbeAddOp(v, OP_Close, 0, 0);
- sqliteEndWriteOperation(pParse);
- }
- }
-
- /* Clean up before exiting */
-exit_create_index:
- sqliteIdListDelete(pList);
- sqliteSrcListDelete(pTable);
- sqliteFree(zName);
- return;
-}
-
-/*
-** This routine will drop an existing named index. This routine
-** implements the DROP INDEX statement.
-*/
-void sqliteDropIndex(Parse *pParse, SrcList *pName){
- Index *pIndex;
- Vdbe *v;
- sqlite *db = pParse->db;
-
- if( pParse->nErr || sqlite_malloc_failed ) return;
- assert( pName->nSrc==1 );
- pIndex = sqliteFindIndex(db, pName->a[0].zName, pName->a[0].zDatabase);
- if( pIndex==0 ){
- sqliteErrorMsg(pParse, "no such index: %S", pName, 0);
- goto exit_drop_index;
- }
- if( pIndex->autoIndex ){
- sqliteErrorMsg(pParse, "index associated with UNIQUE "
- "or PRIMARY KEY constraint cannot be dropped", 0);
- goto exit_drop_index;
- }
- if( pIndex->iDb>1 ){
- sqliteErrorMsg(pParse, "cannot alter schema of attached "
- "databases", 0);
- goto exit_drop_index;
- }
-#ifndef SQLITE_OMIT_AUTHORIZATION
- {
- int code = SQLITE_DROP_INDEX;
- Table *pTab = pIndex->pTable;
- const char *zDb = db->aDb[pIndex->iDb].zName;
- const char *zTab = SCHEMA_TABLE(pIndex->iDb);
- if( sqliteAuthCheck(pParse, SQLITE_DELETE, zTab, 0, zDb) ){
- goto exit_drop_index;
- }
- if( pIndex->iDb ) code = SQLITE_DROP_TEMP_INDEX;
- if( sqliteAuthCheck(pParse, code, pIndex->zName, pTab->zName, zDb) ){
- goto exit_drop_index;
- }
- }
-#endif
-
- /* Generate code to remove the index and from the master table */
- v = sqliteGetVdbe(pParse);
- if( v ){
- static VdbeOpList dropIndex[] = {
- { OP_Rewind, 0, ADDR(9), 0},
- { OP_String, 0, 0, 0}, /* 1 */
- { OP_MemStore, 1, 1, 0},
- { OP_MemLoad, 1, 0, 0}, /* 3 */
- { OP_Column, 0, 1, 0},
- { OP_Eq, 0, ADDR(8), 0},
- { OP_Next, 0, ADDR(3), 0},
- { OP_Goto, 0, ADDR(9), 0},
- { OP_Delete, 0, 0, 0}, /* 8 */
- };
- int base;
-
- sqliteBeginWriteOperation(pParse, 0, pIndex->iDb);
- sqliteOpenMasterTable(v, pIndex->iDb);
- base = sqliteVdbeAddOpList(v, ArraySize(dropIndex), dropIndex);
- sqliteVdbeChangeP3(v, base+1, pIndex->zName, 0);
- if( pIndex->iDb==0 ){
- sqliteChangeCookie(db, v);
- }
- sqliteVdbeAddOp(v, OP_Close, 0, 0);
- sqliteVdbeAddOp(v, OP_Destroy, pIndex->tnum, pIndex->iDb);
- sqliteEndWriteOperation(pParse);
- }
-
- /* Delete the in-memory description of this index.
- */
- if( !pParse->explain ){
- sqliteUnlinkAndDeleteIndex(db, pIndex);
- db->flags |= SQLITE_InternChanges;
- }
-
-exit_drop_index:
- sqliteSrcListDelete(pName);
-}
-
-/*
-** Append a new element to the given IdList. Create a new IdList if
-** need be.
-**
-** A new IdList is returned, or NULL if malloc() fails.
-*/
-IdList *sqliteIdListAppend(IdList *pList, Token *pToken){
- if( pList==0 ){
- pList = sqliteMalloc( sizeof(IdList) );
- if( pList==0 ) return 0;
- pList->nAlloc = 0;
- }
- if( pList->nId>=pList->nAlloc ){
- struct IdList_item *a;
- pList->nAlloc = pList->nAlloc*2 + 5;
- a = sqliteRealloc(pList->a, pList->nAlloc*sizeof(pList->a[0]) );
- if( a==0 ){
- sqliteIdListDelete(pList);
- return 0;
- }
- pList->a = a;
- }
- memset(&pList->a[pList->nId], 0, sizeof(pList->a[0]));
- if( pToken ){
- char **pz = &pList->a[pList->nId].zName;
- sqliteSetNString(pz, pToken->z, pToken->n, 0);
- if( *pz==0 ){
- sqliteIdListDelete(pList);
- return 0;
- }else{
- sqliteDequote(*pz);
- }
- }
- pList->nId++;
- return pList;
-}
-
-/*
-** Append a new table name to the given SrcList. Create a new SrcList if
-** need be. A new entry is created in the SrcList even if pToken is NULL.
-**
-** A new SrcList is returned, or NULL if malloc() fails.
-**
-** If pDatabase is not null, it means that the table has an optional
-** database name prefix. Like this: "database.table". The pDatabase
-** points to the table name and the pTable points to the database name.
-** The SrcList.a[].zName field is filled with the table name which might
-** come from pTable (if pDatabase is NULL) or from pDatabase.
-** SrcList.a[].zDatabase is filled with the database name from pTable,
-** or with NULL if no database is specified.
-**
-** In other words, if call like this:
-**
-** sqliteSrcListAppend(A,B,0);
-**
-** Then B is a table name and the database name is unspecified. If called
-** like this:
-**
-** sqliteSrcListAppend(A,B,C);
-**
-** Then C is the table name and B is the database name.
-*/
-SrcList *sqliteSrcListAppend(SrcList *pList, Token *pTable, Token *pDatabase){
- if( pList==0 ){
- pList = sqliteMalloc( sizeof(SrcList) );
- if( pList==0 ) return 0;
- pList->nAlloc = 1;
- }
- if( pList->nSrc>=pList->nAlloc ){
- SrcList *pNew;
- pList->nAlloc *= 2;
- pNew = sqliteRealloc(pList,
- sizeof(*pList) + (pList->nAlloc-1)*sizeof(pList->a[0]) );
- if( pNew==0 ){
- sqliteSrcListDelete(pList);
- return 0;
- }
- pList = pNew;
- }
- memset(&pList->a[pList->nSrc], 0, sizeof(pList->a[0]));
- if( pDatabase && pDatabase->z==0 ){
- pDatabase = 0;
- }
- if( pDatabase && pTable ){
- Token *pTemp = pDatabase;
- pDatabase = pTable;
- pTable = pTemp;
- }
- if( pTable ){
- char **pz = &pList->a[pList->nSrc].zName;
- sqliteSetNString(pz, pTable->z, pTable->n, 0);
- if( *pz==0 ){
- sqliteSrcListDelete(pList);
- return 0;
- }else{
- sqliteDequote(*pz);
- }
- }
- if( pDatabase ){
- char **pz = &pList->a[pList->nSrc].zDatabase;
- sqliteSetNString(pz, pDatabase->z, pDatabase->n, 0);
- if( *pz==0 ){
- sqliteSrcListDelete(pList);
- return 0;
- }else{
- sqliteDequote(*pz);
- }
- }
- pList->a[pList->nSrc].iCursor = -1;
- pList->nSrc++;
- return pList;
-}
-
-/*
-** Assign cursors to all tables in a SrcList
-*/
-void sqliteSrcListAssignCursors(Parse *pParse, SrcList *pList){
- int i;
- for(i=0; i<pList->nSrc; i++){
- if( pList->a[i].iCursor<0 ){
- pList->a[i].iCursor = pParse->nTab++;
- }
- }
-}
-
-/*
-** Add an alias to the last identifier on the given identifier list.
-*/
-void sqliteSrcListAddAlias(SrcList *pList, Token *pToken){
- if( pList && pList->nSrc>0 ){
- int i = pList->nSrc - 1;
- sqliteSetNString(&pList->a[i].zAlias, pToken->z, pToken->n, 0);
- sqliteDequote(pList->a[i].zAlias);
- }
-}
-
-/*
-** Delete an IdList.
-*/
-void sqliteIdListDelete(IdList *pList){
- int i;
- if( pList==0 ) return;
- for(i=0; i<pList->nId; i++){
- sqliteFree(pList->a[i].zName);
- }
- sqliteFree(pList->a);
- sqliteFree(pList);
-}
-
-/*
-** Return the index in pList of the identifier named zId. Return -1
-** if not found.
-*/
-int sqliteIdListIndex(IdList *pList, const char *zName){
- int i;
- if( pList==0 ) return -1;
- for(i=0; i<pList->nId; i++){
- if( sqliteStrICmp(pList->a[i].zName, zName)==0 ) return i;
- }
- return -1;
-}
-
-/*
-** Delete an entire SrcList including all its substructure.
-*/
-void sqliteSrcListDelete(SrcList *pList){
- int i;
- if( pList==0 ) return;
- for(i=0; i<pList->nSrc; i++){
- sqliteFree(pList->a[i].zDatabase);
- sqliteFree(pList->a[i].zName);
- sqliteFree(pList->a[i].zAlias);
- if( pList->a[i].pTab && pList->a[i].pTab->isTransient ){
- sqliteDeleteTable(0, pList->a[i].pTab);
- }
- sqliteSelectDelete(pList->a[i].pSelect);
- sqliteExprDelete(pList->a[i].pOn);
- sqliteIdListDelete(pList->a[i].pUsing);
- }
- sqliteFree(pList);
-}
-
-/*
-** Begin a transaction
-*/
-void sqliteBeginTransaction(Parse *pParse, int onError){
- sqlite *db;
-
- if( pParse==0 || (db=pParse->db)==0 || db->aDb[0].pBt==0 ) return;
- if( pParse->nErr || sqlite_malloc_failed ) return;
- if( sqliteAuthCheck(pParse, SQLITE_TRANSACTION, "BEGIN", 0, 0) ) return;
- if( db->flags & SQLITE_InTrans ){
- sqliteErrorMsg(pParse, "cannot start a transaction within a transaction");
- return;
- }
- sqliteBeginWriteOperation(pParse, 0, 0);
- if( !pParse->explain ){
- db->flags |= SQLITE_InTrans;
- db->onError = onError;
- }
-}
-
-/*
-** Commit a transaction
-*/
-void sqliteCommitTransaction(Parse *pParse){
- sqlite *db;
-
- if( pParse==0 || (db=pParse->db)==0 || db->aDb[0].pBt==0 ) return;
- if( pParse->nErr || sqlite_malloc_failed ) return;
- if( sqliteAuthCheck(pParse, SQLITE_TRANSACTION, "COMMIT", 0, 0) ) return;
- if( (db->flags & SQLITE_InTrans)==0 ){
- sqliteErrorMsg(pParse, "cannot commit - no transaction is active");
- return;
- }
- if( !pParse->explain ){
- db->flags &= ~SQLITE_InTrans;
- }
- sqliteEndWriteOperation(pParse);
- if( !pParse->explain ){
- db->onError = OE_Default;
- }
-}
-
-/*
-** Rollback a transaction
-*/
-void sqliteRollbackTransaction(Parse *pParse){
- sqlite *db;
- Vdbe *v;
-
- if( pParse==0 || (db=pParse->db)==0 || db->aDb[0].pBt==0 ) return;
- if( pParse->nErr || sqlite_malloc_failed ) return;
- if( sqliteAuthCheck(pParse, SQLITE_TRANSACTION, "ROLLBACK", 0, 0) ) return;
- if( (db->flags & SQLITE_InTrans)==0 ){
- sqliteErrorMsg(pParse, "cannot rollback - no transaction is active");
- return;
- }
- v = sqliteGetVdbe(pParse);
- if( v ){
- sqliteVdbeAddOp(v, OP_Rollback, 0, 0);
- }
- if( !pParse->explain ){
- db->flags &= ~SQLITE_InTrans;
- db->onError = OE_Default;
- }
-}
-
-/*
-** Generate VDBE code that will verify the schema cookie for all
-** named database files.
-*/
-void sqliteCodeVerifySchema(Parse *pParse, int iDb){
- sqlite *db = pParse->db;
- Vdbe *v = sqliteGetVdbe(pParse);
- assert( iDb>=0 && iDb<db->nDb );
- assert( db->aDb[iDb].pBt!=0 );
- if( iDb!=1 && !DbHasProperty(db, iDb, DB_Cookie) ){
- sqliteVdbeAddOp(v, OP_VerifyCookie, iDb, db->aDb[iDb].schema_cookie);
- DbSetProperty(db, iDb, DB_Cookie);
- }
-}
-
-/*
-** Generate VDBE code that prepares for doing an operation that
-** might change the database.
-**
-** This routine starts a new transaction if we are not already within
-** a transaction. If we are already within a transaction, then a checkpoint
-** is set if the setCheckpoint parameter is true. A checkpoint should
-** be set for operations that might fail (due to a constraint) part of
-** the way through and which will need to undo some writes without having to
-** rollback the whole transaction. For operations where all constraints
-** can be checked before any changes are made to the database, it is never
-** necessary to undo a write and the checkpoint should not be set.
-**
-** Only database iDb and the temp database are made writable by this call.
-** If iDb==0, then the main and temp databases are made writable. If
-** iDb==1 then only the temp database is made writable. If iDb>1 then the
-** specified auxiliary database and the temp database are made writable.
-*/
-void sqliteBeginWriteOperation(Parse *pParse, int setCheckpoint, int iDb){
- Vdbe *v;
- sqlite *db = pParse->db;
- if( DbHasProperty(db, iDb, DB_Locked) ) return;
- v = sqliteGetVdbe(pParse);
- if( v==0 ) return;
- if( !db->aDb[iDb].inTrans ){
- sqliteVdbeAddOp(v, OP_Transaction, iDb, 0);
- DbSetProperty(db, iDb, DB_Locked);
- sqliteCodeVerifySchema(pParse, iDb);
- if( iDb!=1 ){
- sqliteBeginWriteOperation(pParse, setCheckpoint, 1);
- }
- }else if( setCheckpoint ){
- sqliteVdbeAddOp(v, OP_Checkpoint, iDb, 0);
- DbSetProperty(db, iDb, DB_Locked);
- }
-}
-
-/*
-** Generate code that concludes an operation that may have changed
-** the database. If a statement transaction was started, then emit
-** an OP_Commit that will cause the changes to be committed to disk.
-**
-** Note that checkpoints are automatically committed at the end of
-** a statement. Note also that there can be multiple calls to
-** sqliteBeginWriteOperation() but there should only be a single
-** call to sqliteEndWriteOperation() at the conclusion of the statement.
-*/
-void sqliteEndWriteOperation(Parse *pParse){
- Vdbe *v;
- sqlite *db = pParse->db;
- if( pParse->trigStack ) return; /* if this is in a trigger */
- v = sqliteGetVdbe(pParse);
- if( v==0 ) return;
- if( db->flags & SQLITE_InTrans ){
- /* A BEGIN has executed. Do not commit until we see an explicit
- ** COMMIT statement. */
- }else{
- sqliteVdbeAddOp(v, OP_Commit, 0, 0);
- }
-}
+++ /dev/null
-/*
-** 2003 April 6
-**
-** The author disclaims copyright to this source code. In place of
-** a legal notice, here is a blessing:
-**
-** May you do good and not evil.
-** May you find forgiveness for yourself and forgive others.
-** May you share freely, never taking more than you give.
-**
-*************************************************************************
-** This file contains code used to implement the COPY command.
-**
-** $Id: copy.c,v 1.1.1.1 2004/08/08 15:03:57 matt Exp $
-*/
-#include "sqliteInt.h"
-
-/*
-** The COPY command is for compatibility with PostgreSQL and specificially
-** for the ability to read the output of pg_dump. The format is as
-** follows:
-**
-** COPY table FROM file [USING DELIMITERS string]
-**
-** "table" is an existing table name. We will read lines of code from
-** file to fill this table with data. File might be "stdin". The optional
-** delimiter string identifies the field separators. The default is a tab.
-*/
-void sqliteCopy(
- Parse *pParse, /* The parser context */
- SrcList *pTableName, /* The name of the table into which we will insert */
- Token *pFilename, /* The file from which to obtain information */
- Token *pDelimiter, /* Use this as the field delimiter */
- int onError /* What to do if a constraint fails */
-){
- Table *pTab;
- int i;
- Vdbe *v;
- int addr, end;
- char *zFile = 0;
- const char *zDb;
- sqlite *db = pParse->db;
-
-
- if( sqlite_malloc_failed ) goto copy_cleanup;
- assert( pTableName->nSrc==1 );
- pTab = sqliteSrcListLookup(pParse, pTableName);
- if( pTab==0 || sqliteIsReadOnly(pParse, pTab, 0) ) goto copy_cleanup;
- zFile = sqliteStrNDup(pFilename->z, pFilename->n);
- sqliteDequote(zFile);
- assert( pTab->iDb<db->nDb );
- zDb = db->aDb[pTab->iDb].zName;
- if( sqliteAuthCheck(pParse, SQLITE_INSERT, pTab->zName, 0, zDb)
- || sqliteAuthCheck(pParse, SQLITE_COPY, pTab->zName, zFile, zDb) ){
- goto copy_cleanup;
- }
- v = sqliteGetVdbe(pParse);
- if( v ){
- sqliteBeginWriteOperation(pParse, 1, pTab->iDb);
- addr = sqliteVdbeOp3(v, OP_FileOpen, 0, 0, pFilename->z, pFilename->n);
- sqliteVdbeDequoteP3(v, addr);
- sqliteOpenTableAndIndices(pParse, pTab, 0);
- if( db->flags & SQLITE_CountRows ){
- sqliteVdbeAddOp(v, OP_Integer, 0, 0); /* Initialize the row count */
- }
- end = sqliteVdbeMakeLabel(v);
- addr = sqliteVdbeAddOp(v, OP_FileRead, pTab->nCol, end);
- if( pDelimiter ){
- sqliteVdbeChangeP3(v, addr, pDelimiter->z, pDelimiter->n);
- sqliteVdbeDequoteP3(v, addr);
- }else{
- sqliteVdbeChangeP3(v, addr, "\t", 1);
- }
- if( pTab->iPKey>=0 ){
- sqliteVdbeAddOp(v, OP_FileColumn, pTab->iPKey, 0);
- sqliteVdbeAddOp(v, OP_MustBeInt, 0, 0);
- }else{
- sqliteVdbeAddOp(v, OP_NewRecno, 0, 0);
- }
- for(i=0; i<pTab->nCol; i++){
- if( i==pTab->iPKey ){
- /* The integer primary key column is filled with NULL since its
- ** value is always pulled from the record number */
- sqliteVdbeAddOp(v, OP_String, 0, 0);
- }else{
- sqliteVdbeAddOp(v, OP_FileColumn, i, 0);
- }
- }
- sqliteGenerateConstraintChecks(pParse, pTab, 0, 0, pTab->iPKey>=0,
- 0, onError, addr);
- sqliteCompleteInsertion(pParse, pTab, 0, 0, 0, 0, -1);
- if( (db->flags & SQLITE_CountRows)!=0 ){
- sqliteVdbeAddOp(v, OP_AddImm, 1, 0); /* Increment row count */
- }
- sqliteVdbeAddOp(v, OP_Goto, 0, addr);
- sqliteVdbeResolveLabel(v, end);
- sqliteVdbeAddOp(v, OP_Noop, 0, 0);
- sqliteEndWriteOperation(pParse);
- if( db->flags & SQLITE_CountRows ){
- sqliteVdbeAddOp(v, OP_ColumnName, 0, 1);
- sqliteVdbeChangeP3(v, -1, "rows inserted", P3_STATIC);
- sqliteVdbeAddOp(v, OP_Callback, 1, 0);
- }
- }
-
-copy_cleanup:
- sqliteSrcListDelete(pTableName);
- sqliteFree(zFile);
- return;
-}
+++ /dev/null
-/*
-** 2003 October 31
-**
-** The author disclaims copyright to this source code. In place of
-** a legal notice, here is a blessing:
-**
-** May you do good and not evil.
-** May you find forgiveness for yourself and forgive others.
-** May you share freely, never taking more than you give.
-**
-*************************************************************************
-** This file contains the C functions that implement date and time
-** functions for SQLite.
-**
-** There is only one exported symbol in this file - the function
-** sqliteRegisterDateTimeFunctions() found at the bottom of the file.
-** All other code has file scope.
-**
-** $Id: date.c,v 1.1.1.1 2004/08/08 15:03:57 matt Exp $
-**
-** NOTES:
-**
-** SQLite processes all times and dates as Julian Day numbers. The
-** dates and times are stored as the number of days since noon
-** in Greenwich on November 24, 4714 B.C. according to the Gregorian
-** calendar system.
-**
-** 1970-01-01 00:00:00 is JD 2440587.5
-** 2000-01-01 00:00:00 is JD 2451544.5
-**
-** This implemention requires years to be expressed as a 4-digit number
-** which means that only dates between 0000-01-01 and 9999-12-31 can
-** be represented, even though julian day numbers allow a much wider
-** range of dates.
-**
-** The Gregorian calendar system is used for all dates and times,
-** even those that predate the Gregorian calendar. Historians usually
-** use the Julian calendar for dates prior to 1582-10-15 and for some
-** dates afterwards, depending on locale. Beware of this difference.
-**
-** The conversion algorithms are implemented based on descriptions
-** in the following text:
-**
-** Jean Meeus
-** Astronomical Algorithms, 2nd Edition, 1998
-** ISBM 0-943396-61-1
-** Willmann-Bell, Inc
-** Richmond, Virginia (USA)
-*/
-#include "os.h"
-#include "sqliteInt.h"
-#include <ctype.h>
-#include <stdlib.h>
-#include <assert.h>
-#include <time.h>
-
-#ifndef SQLITE_OMIT_DATETIME_FUNCS
-
-/*
-** A structure for holding a single date and time.
-*/
-typedef struct DateTime DateTime;
-struct DateTime {
- double rJD; /* The julian day number */
- int Y, M, D; /* Year, month, and day */
- int h, m; /* Hour and minutes */
- int tz; /* Timezone offset in minutes */
- double s; /* Seconds */
- char validYMD; /* True if Y,M,D are valid */
- char validHMS; /* True if h,m,s are valid */
- char validJD; /* True if rJD is valid */
- char validTZ; /* True if tz is valid */
-};
-
-
-/*
-** Convert zDate into one or more integers. Additional arguments
-** come in groups of 5 as follows:
-**
-** N number of digits in the integer
-** min minimum allowed value of the integer
-** max maximum allowed value of the integer
-** nextC first character after the integer
-** pVal where to write the integers value.
-**
-** Conversions continue until one with nextC==0 is encountered.
-** The function returns the number of successful conversions.
-*/
-static int getDigits(const char *zDate, ...){
- va_list ap;
- int val;
- int N;
- int min;
- int max;
- int nextC;
- int *pVal;
- int cnt = 0;
- va_start(ap, zDate);
- do{
- N = va_arg(ap, int);
- min = va_arg(ap, int);
- max = va_arg(ap, int);
- nextC = va_arg(ap, int);
- pVal = va_arg(ap, int*);
- val = 0;
- while( N-- ){
- if( !isdigit(*zDate) ){
- return cnt;
- }
- val = val*10 + *zDate - '0';
- zDate++;
- }
- if( val<min || val>max || (nextC!=0 && nextC!=*zDate) ){
- return cnt;
- }
- *pVal = val;
- zDate++;
- cnt++;
- }while( nextC );
- return cnt;
-}
-
-/*
-** Read text from z[] and convert into a floating point number. Return
-** the number of digits converted.
-*/
-static int getValue(const char *z, double *pR){
- const char *zEnd;
- *pR = sqliteAtoF(z, &zEnd);
- return zEnd - z;
-}
-
-/*
-** Parse a timezone extension on the end of a date-time.
-** The extension is of the form:
-**
-** (+/-)HH:MM
-**
-** If the parse is successful, write the number of minutes
-** of change in *pnMin and return 0. If a parser error occurs,
-** return 0.
-**
-** A missing specifier is not considered an error.
-*/
-static int parseTimezone(const char *zDate, DateTime *p){
- int sgn = 0;
- int nHr, nMn;
- while( isspace(*zDate) ){ zDate++; }
- p->tz = 0;
- if( *zDate=='-' ){
- sgn = -1;
- }else if( *zDate=='+' ){
- sgn = +1;
- }else{
- return *zDate!=0;
- }
- zDate++;
- if( getDigits(zDate, 2, 0, 14, ':', &nHr, 2, 0, 59, 0, &nMn)!=2 ){
- return 1;
- }
- zDate += 5;
- p->tz = sgn*(nMn + nHr*60);
- while( isspace(*zDate) ){ zDate++; }
- return *zDate!=0;
-}
-
-/*
-** Parse times of the form HH:MM or HH:MM:SS or HH:MM:SS.FFFF.
-** The HH, MM, and SS must each be exactly 2 digits. The
-** fractional seconds FFFF can be one or more digits.
-**
-** Return 1 if there is a parsing error and 0 on success.
-*/
-static int parseHhMmSs(const char *zDate, DateTime *p){
- int h, m, s;
- double ms = 0.0;
- if( getDigits(zDate, 2, 0, 24, ':', &h, 2, 0, 59, 0, &m)!=2 ){
- return 1;
- }
- zDate += 5;
- if( *zDate==':' ){
- zDate++;
- if( getDigits(zDate, 2, 0, 59, 0, &s)!=1 ){
- return 1;
- }
- zDate += 2;
- if( *zDate=='.' && isdigit(zDate[1]) ){
- double rScale = 1.0;
- zDate++;
- while( isdigit(*zDate) ){
- ms = ms*10.0 + *zDate - '0';
- rScale *= 10.0;
- zDate++;
- }
- ms /= rScale;
- }
- }else{
- s = 0;
- }
- p->validJD = 0;
- p->validHMS = 1;
- p->h = h;
- p->m = m;
- p->s = s + ms;
- if( parseTimezone(zDate, p) ) return 1;
- p->validTZ = p->tz!=0;
- return 0;
-}
-
-/*
-** Convert from YYYY-MM-DD HH:MM:SS to julian day. We always assume
-** that the YYYY-MM-DD is according to the Gregorian calendar.
-**
-** Reference: Meeus page 61
-*/
-static void computeJD(DateTime *p){
- int Y, M, D, A, B, X1, X2;
-
- if( p->validJD ) return;
- if( p->validYMD ){
- Y = p->Y;
- M = p->M;
- D = p->D;
- }else{
- Y = 2000; /* If no YMD specified, assume 2000-Jan-01 */
- M = 1;
- D = 1;
- }
- if( M<=2 ){
- Y--;
- M += 12;
- }
- A = Y/100;
- B = 2 - A + (A/4);
- X1 = 365.25*(Y+4716);
- X2 = 30.6001*(M+1);
- p->rJD = X1 + X2 + D + B - 1524.5;
- p->validJD = 1;
- p->validYMD = 0;
- if( p->validHMS ){
- p->rJD += (p->h*3600.0 + p->m*60.0 + p->s)/86400.0;
- if( p->validTZ ){
- p->rJD += p->tz*60/86400.0;
- p->validHMS = 0;
- p->validTZ = 0;
- }
- }
-}
-
-/*
-** Parse dates of the form
-**
-** YYYY-MM-DD HH:MM:SS.FFF
-** YYYY-MM-DD HH:MM:SS
-** YYYY-MM-DD HH:MM
-** YYYY-MM-DD
-**
-** Write the result into the DateTime structure and return 0
-** on success and 1 if the input string is not a well-formed
-** date.
-*/
-static int parseYyyyMmDd(const char *zDate, DateTime *p){
- int Y, M, D, neg;
-
- if( zDate[0]=='-' ){
- zDate++;
- neg = 1;
- }else{
- neg = 0;
- }
- if( getDigits(zDate,4,0,9999,'-',&Y,2,1,12,'-',&M,2,1,31,0,&D)!=3 ){
- return 1;
- }
- zDate += 10;
- while( isspace(*zDate) ){ zDate++; }
- if( parseHhMmSs(zDate, p)==0 ){
- /* We got the time */
- }else if( *zDate==0 ){
- p->validHMS = 0;
- }else{
- return 1;
- }
- p->validJD = 0;
- p->validYMD = 1;
- p->Y = neg ? -Y : Y;
- p->M = M;
- p->D = D;
- if( p->validTZ ){
- computeJD(p);
- }
- return 0;
-}
-
-/*
-** Attempt to parse the given string into a Julian Day Number. Return
-** the number of errors.
-**
-** The following are acceptable forms for the input string:
-**
-** YYYY-MM-DD HH:MM:SS.FFF +/-HH:MM
-** DDDD.DD
-** now
-**
-** In the first form, the +/-HH:MM is always optional. The fractional
-** seconds extension (the ".FFF") is optional. The seconds portion
-** (":SS.FFF") is option. The year and date can be omitted as long
-** as there is a time string. The time string can be omitted as long
-** as there is a year and date.
-*/
-static int parseDateOrTime(const char *zDate, DateTime *p){
- memset(p, 0, sizeof(*p));
- if( parseYyyyMmDd(zDate,p)==0 ){
- return 0;
- }else if( parseHhMmSs(zDate, p)==0 ){
- return 0;
- }else if( sqliteStrICmp(zDate,"now")==0){
- double r;
- if( sqliteOsCurrentTime(&r)==0 ){
- p->rJD = r;
- p->validJD = 1;
- return 0;
- }
- return 1;
- }else if( sqliteIsNumber(zDate) ){
- p->rJD = sqliteAtoF(zDate, 0);
- p->validJD = 1;
- return 0;
- }
- return 1;
-}
-
-/*
-** Compute the Year, Month, and Day from the julian day number.
-*/
-static void computeYMD(DateTime *p){
- int Z, A, B, C, D, E, X1;
- if( p->validYMD ) return;
- if( !p->validJD ){
- p->Y = 2000;
- p->M = 1;
- p->D = 1;
- }else{
- Z = p->rJD + 0.5;
- A = (Z - 1867216.25)/36524.25;
- A = Z + 1 + A - (A/4);
- B = A + 1524;
- C = (B - 122.1)/365.25;
- D = 365.25*C;
- E = (B-D)/30.6001;
- X1 = 30.6001*E;
- p->D = B - D - X1;
- p->M = E<14 ? E-1 : E-13;
- p->Y = p->M>2 ? C - 4716 : C - 4715;
- }
- p->validYMD = 1;
-}
-
-/*
-** Compute the Hour, Minute, and Seconds from the julian day number.
-*/
-static void computeHMS(DateTime *p){
- int Z, s;
- if( p->validHMS ) return;
- Z = p->rJD + 0.5;
- s = (p->rJD + 0.5 - Z)*86400000.0 + 0.5;
- p->s = 0.001*s;
- s = p->s;
- p->s -= s;
- p->h = s/3600;
- s -= p->h*3600;
- p->m = s/60;
- p->s += s - p->m*60;
- p->validHMS = 1;
-}
-
-/*
-** Compute both YMD and HMS
-*/
-static void computeYMD_HMS(DateTime *p){
- computeYMD(p);
- computeHMS(p);
-}
-
-/*
-** Clear the YMD and HMS and the TZ
-*/
-static void clearYMD_HMS_TZ(DateTime *p){
- p->validYMD = 0;
- p->validHMS = 0;
- p->validTZ = 0;
-}
-
-/*
-** Compute the difference (in days) between localtime and UTC (a.k.a. GMT)
-** for the time value p where p is in UTC.
-*/
-static double localtimeOffset(DateTime *p){
- DateTime x, y;
- time_t t;
- struct tm *pTm;
- x = *p;
- computeYMD_HMS(&x);
- if( x.Y<1971 || x.Y>=2038 ){
- x.Y = 2000;
- x.M = 1;
- x.D = 1;
- x.h = 0;
- x.m = 0;
- x.s = 0.0;
- } else {
- int s = x.s + 0.5;
- x.s = s;
- }
- x.tz = 0;
- x.validJD = 0;
- computeJD(&x);
- t = (x.rJD-2440587.5)*86400.0 + 0.5;
- sqliteOsEnterMutex();
- pTm = localtime(&t);
- y.Y = pTm->tm_year + 1900;
- y.M = pTm->tm_mon + 1;
- y.D = pTm->tm_mday;
- y.h = pTm->tm_hour;
- y.m = pTm->tm_min;
- y.s = pTm->tm_sec;
- sqliteOsLeaveMutex();
- y.validYMD = 1;
- y.validHMS = 1;
- y.validJD = 0;
- y.validTZ = 0;
- computeJD(&y);
- return y.rJD - x.rJD;
-}
-
-/*
-** Process a modifier to a date-time stamp. The modifiers are
-** as follows:
-**
-** NNN days
-** NNN hours
-** NNN minutes
-** NNN.NNNN seconds
-** NNN months
-** NNN years
-** start of month
-** start of year
-** start of week
-** start of day
-** weekday N
-** unixepoch
-** localtime
-** utc
-**
-** Return 0 on success and 1 if there is any kind of error.
-*/
-static int parseModifier(const char *zMod, DateTime *p){
- int rc = 1;
- int n;
- double r;
- char *z, zBuf[30];
- z = zBuf;
- for(n=0; n<sizeof(zBuf)-1 && zMod[n]; n++){
- z[n] = tolower(zMod[n]);
- }
- z[n] = 0;
- switch( z[0] ){
- case 'l': {
- /* localtime
- **
- ** Assuming the current time value is UTC (a.k.a. GMT), shift it to
- ** show local time.
- */
- if( strcmp(z, "localtime")==0 ){
- computeJD(p);
- p->rJD += localtimeOffset(p);
- clearYMD_HMS_TZ(p);
- rc = 0;
- }
- break;
- }
- case 'u': {
- /*
- ** unixepoch
- **
- ** Treat the current value of p->rJD as the number of
- ** seconds since 1970. Convert to a real julian day number.
- */
- if( strcmp(z, "unixepoch")==0 && p->validJD ){
- p->rJD = p->rJD/86400.0 + 2440587.5;
- clearYMD_HMS_TZ(p);
- rc = 0;
- }else if( strcmp(z, "utc")==0 ){
- double c1;
- computeJD(p);
- c1 = localtimeOffset(p);
- p->rJD -= c1;
- clearYMD_HMS_TZ(p);
- p->rJD += c1 - localtimeOffset(p);
- rc = 0;
- }
- break;
- }
- case 'w': {
- /*
- ** weekday N
- **
- ** Move the date to the same time on the next occurrance of
- ** weekday N where 0==Sunday, 1==Monday, and so forth. If the
- ** date is already on the appropriate weekday, this is a no-op.
- */
- if( strncmp(z, "weekday ", 8)==0 && getValue(&z[8],&r)>0
- && (n=r)==r && n>=0 && r<7 ){
- int Z;
- computeYMD_HMS(p);
- p->validTZ = 0;
- p->validJD = 0;
- computeJD(p);
- Z = p->rJD + 1.5;
- Z %= 7;
- if( Z>n ) Z -= 7;
- p->rJD += n - Z;
- clearYMD_HMS_TZ(p);
- rc = 0;
- }
- break;
- }
- case 's': {
- /*
- ** start of TTTTT
- **
- ** Move the date backwards to the beginning of the current day,
- ** or month or year.
- */
- if( strncmp(z, "start of ", 9)!=0 ) break;
- z += 9;
- computeYMD(p);
- p->validHMS = 1;
- p->h = p->m = 0;
- p->s = 0.0;
- p->validTZ = 0;
- p->validJD = 0;
- if( strcmp(z,"month")==0 ){
- p->D = 1;
- rc = 0;
- }else if( strcmp(z,"year")==0 ){
- computeYMD(p);
- p->M = 1;
- p->D = 1;
- rc = 0;
- }else if( strcmp(z,"day")==0 ){
- rc = 0;
- }
- break;
- }
- case '+':
- case '-':
- case '0':
- case '1':
- case '2':
- case '3':
- case '4':
- case '5':
- case '6':
- case '7':
- case '8':
- case '9': {
- n = getValue(z, &r);
- if( n<=0 ) break;
- if( z[n]==':' ){
- /* A modifier of the form (+|-)HH:MM:SS.FFF adds (or subtracts) the
- ** specified number of hours, minutes, seconds, and fractional seconds
- ** to the time. The ".FFF" may be omitted. The ":SS.FFF" may be
- ** omitted.
- */
- const char *z2 = z;
- DateTime tx;
- int day;
- if( !isdigit(*z2) ) z2++;
- memset(&tx, 0, sizeof(tx));
- if( parseHhMmSs(z2, &tx) ) break;
- computeJD(&tx);
- tx.rJD -= 0.5;
- day = (int)tx.rJD;
- tx.rJD -= day;
- if( z[0]=='-' ) tx.rJD = -tx.rJD;
- computeJD(p);
- clearYMD_HMS_TZ(p);
- p->rJD += tx.rJD;
- rc = 0;
- break;
- }
- z += n;
- while( isspace(z[0]) ) z++;
- n = strlen(z);
- if( n>10 || n<3 ) break;
- if( z[n-1]=='s' ){ z[n-1] = 0; n--; }
- computeJD(p);
- rc = 0;
- if( n==3 && strcmp(z,"day")==0 ){
- p->rJD += r;
- }else if( n==4 && strcmp(z,"hour")==0 ){
- p->rJD += r/24.0;
- }else if( n==6 && strcmp(z,"minute")==0 ){
- p->rJD += r/(24.0*60.0);
- }else if( n==6 && strcmp(z,"second")==0 ){
- p->rJD += r/(24.0*60.0*60.0);
- }else if( n==5 && strcmp(z,"month")==0 ){
- int x, y;
- computeYMD_HMS(p);
- p->M += r;
- x = p->M>0 ? (p->M-1)/12 : (p->M-12)/12;
- p->Y += x;
- p->M -= x*12;
- p->validJD = 0;
- computeJD(p);
- y = r;
- if( y!=r ){
- p->rJD += (r - y)*30.0;
- }
- }else if( n==4 && strcmp(z,"year")==0 ){
- computeYMD_HMS(p);
- p->Y += r;
- p->validJD = 0;
- computeJD(p);
- }else{
- rc = 1;
- }
- clearYMD_HMS_TZ(p);
- break;
- }
- default: {
- break;
- }
- }
- return rc;
-}
-
-/*
-** Process time function arguments. argv[0] is a date-time stamp.
-** argv[1] and following are modifiers. Parse them all and write
-** the resulting time into the DateTime structure p. Return 0
-** on success and 1 if there are any errors.
-*/
-static int isDate(int argc, const char **argv, DateTime *p){
- int i;
- if( argc==0 ) return 1;
- if( argv[0]==0 || parseDateOrTime(argv[0], p) ) return 1;
- for(i=1; i<argc; i++){
- if( argv[i]==0 || parseModifier(argv[i], p) ) return 1;
- }
- return 0;
-}
-
-
-/*
-** The following routines implement the various date and time functions
-** of SQLite.
-*/
-
-/*
-** julianday( TIMESTRING, MOD, MOD, ...)
-**
-** Return the julian day number of the date specified in the arguments
-*/
-static void juliandayFunc(sqlite_func *context, int argc, const char **argv){
- DateTime x;
- if( isDate(argc, argv, &x)==0 ){
- computeJD(&x);
- sqlite_set_result_double(context, x.rJD);
- }
-}
-
-/*
-** datetime( TIMESTRING, MOD, MOD, ...)
-**
-** Return YYYY-MM-DD HH:MM:SS
-*/
-static void datetimeFunc(sqlite_func *context, int argc, const char **argv){
- DateTime x;
- if( isDate(argc, argv, &x)==0 ){
- char zBuf[100];
- computeYMD_HMS(&x);
- sprintf(zBuf, "%04d-%02d-%02d %02d:%02d:%02d",x.Y, x.M, x.D, x.h, x.m,
- (int)(x.s));
- sqlite_set_result_string(context, zBuf, -1);
- }
-}
-
-/*
-** time( TIMESTRING, MOD, MOD, ...)
-**
-** Return HH:MM:SS
-*/
-static void timeFunc(sqlite_func *context, int argc, const char **argv){
- DateTime x;
- if( isDate(argc, argv, &x)==0 ){
- char zBuf[100];
- computeHMS(&x);
- sprintf(zBuf, "%02d:%02d:%02d", x.h, x.m, (int)x.s);
- sqlite_set_result_string(context, zBuf, -1);
- }
-}
-
-/*
-** date( TIMESTRING, MOD, MOD, ...)
-**
-** Return YYYY-MM-DD
-*/
-static void dateFunc(sqlite_func *context, int argc, const char **argv){
- DateTime x;
- if( isDate(argc, argv, &x)==0 ){
- char zBuf[100];
- computeYMD(&x);
- sprintf(zBuf, "%04d-%02d-%02d", x.Y, x.M, x.D);
- sqlite_set_result_string(context, zBuf, -1);
- }
-}
-
-/*
-** strftime( FORMAT, TIMESTRING, MOD, MOD, ...)
-**
-** Return a string described by FORMAT. Conversions as follows:
-**
-** %d day of month
-** %f ** fractional seconds SS.SSS
-** %H hour 00-24
-** %j day of year 000-366
-** %J ** Julian day number
-** %m month 01-12
-** %M minute 00-59
-** %s seconds since 1970-01-01
-** %S seconds 00-59
-** %w day of week 0-6 sunday==0
-** %W week of year 00-53
-** %Y year 0000-9999
-** %% %
-*/
-static void strftimeFunc(sqlite_func *context, int argc, const char **argv){
- DateTime x;
- int n, i, j;
- char *z;
- const char *zFmt = argv[0];
- char zBuf[100];
- if( argv[0]==0 || isDate(argc-1, argv+1, &x) ) return;
- for(i=0, n=1; zFmt[i]; i++, n++){
- if( zFmt[i]=='%' ){
- switch( zFmt[i+1] ){
- case 'd':
- case 'H':
- case 'm':
- case 'M':
- case 'S':
- case 'W':
- n++;
- /* fall thru */
- case 'w':
- case '%':
- break;
- case 'f':
- n += 8;
- break;
- case 'j':
- n += 3;
- break;
- case 'Y':
- n += 8;
- break;
- case 's':
- case 'J':
- n += 50;
- break;
- default:
- return; /* ERROR. return a NULL */
- }
- i++;
- }
- }
- if( n<sizeof(zBuf) ){
- z = zBuf;
- }else{
- z = sqliteMalloc( n );
- if( z==0 ) return;
- }
- computeJD(&x);
- computeYMD_HMS(&x);
- for(i=j=0; zFmt[i]; i++){
- if( zFmt[i]!='%' ){
- z[j++] = zFmt[i];
- }else{
- i++;
- switch( zFmt[i] ){
- case 'd': sprintf(&z[j],"%02d",x.D); j+=2; break;
- case 'f': {
- int s = x.s;
- int ms = (x.s - s)*1000.0;
- sprintf(&z[j],"%02d.%03d",s,ms);
- j += strlen(&z[j]);
- break;
- }
- case 'H': sprintf(&z[j],"%02d",x.h); j+=2; break;
- case 'W': /* Fall thru */
- case 'j': {
- int n; /* Number of days since 1st day of year */
- DateTime y = x;
- y.validJD = 0;
- y.M = 1;
- y.D = 1;
- computeJD(&y);
- n = x.rJD - y.rJD;
- if( zFmt[i]=='W' ){
- int wd; /* 0=Monday, 1=Tuesday, ... 6=Sunday */
- wd = ((int)(x.rJD+0.5)) % 7;
- sprintf(&z[j],"%02d",(n+7-wd)/7);
- j += 2;
- }else{
- sprintf(&z[j],"%03d",n+1);
- j += 3;
- }
- break;
- }
- case 'J': sprintf(&z[j],"%.16g",x.rJD); j+=strlen(&z[j]); break;
- case 'm': sprintf(&z[j],"%02d",x.M); j+=2; break;
- case 'M': sprintf(&z[j],"%02d",x.m); j+=2; break;
- case 's': {
- sprintf(&z[j],"%d",(int)((x.rJD-2440587.5)*86400.0 + 0.5));
- j += strlen(&z[j]);
- break;
- }
- case 'S': sprintf(&z[j],"%02d",(int)(x.s+0.5)); j+=2; break;
- case 'w': z[j++] = (((int)(x.rJD+1.5)) % 7) + '0'; break;
- case 'Y': sprintf(&z[j],"%04d",x.Y); j+=strlen(&z[j]); break;
- case '%': z[j++] = '%'; break;
- }
- }
- }
- z[j] = 0;
- sqlite_set_result_string(context, z, -1);
- if( z!=zBuf ){
- sqliteFree(z);
- }
-}
-
-
-#endif /* !defined(SQLITE_OMIT_DATETIME_FUNCS) */
-
-/*
-** This function registered all of the above C functions as SQL
-** functions. This should be the only routine in this file with
-** external linkage.
-*/
-void sqliteRegisterDateTimeFunctions(sqlite *db){
-#ifndef SQLITE_OMIT_DATETIME_FUNCS
- static struct {
- char *zName;
- int nArg;
- int dataType;
- void (*xFunc)(sqlite_func*,int,const char**);
- } aFuncs[] = {
- { "julianday", -1, SQLITE_NUMERIC, juliandayFunc },
- { "date", -1, SQLITE_TEXT, dateFunc },
- { "time", -1, SQLITE_TEXT, timeFunc },
- { "datetime", -1, SQLITE_TEXT, datetimeFunc },
- { "strftime", -1, SQLITE_TEXT, strftimeFunc },
- };
- int i;
-
- for(i=0; i<sizeof(aFuncs)/sizeof(aFuncs[0]); i++){
- sqlite_create_function(db, aFuncs[i].zName,
- aFuncs[i].nArg, aFuncs[i].xFunc, 0);
- if( aFuncs[i].xFunc ){
- sqlite_function_type(db, aFuncs[i].zName, aFuncs[i].dataType);
- }
- }
-#endif
-}
+++ /dev/null
-/* $Id: dbdimp.c,v 1.2 2004/08/09 13:17:59 matt Exp $ */
-
-#include "SQLiteXS.h"
-
-DBISTATE_DECLARE;
-
-#ifndef SvPV_nolen
-#define SvPV_nolen(x) SvPV(x,PL_na)
-#endif
-
-#ifndef call_method
-#define call_method(x,y) perl_call_method(x,y)
-#endif
-
-#ifndef call_sv
-#define call_sv(x,y) perl_call_sv(x,y)
-#endif
-
-#define sqlite2_error(h,xxh,rc,what) _sqlite2_error(__FILE__, __LINE__, h, xxh, rc, what)
-
-void
-sqlite2_init(dbistate_t *dbistate)
-{
- dTHR;
- DBIS = dbistate;
-}
-
-static void
-_sqlite2_error(char *file, int line, SV *h, imp_xxh_t *imp_xxh, int rc, char *what)
-{
- dTHR;
-
- SV *errstr = DBIc_ERRSTR(imp_xxh);
- sv_setiv(DBIc_ERR(imp_xxh), (IV)rc);
- sv_setpv(errstr, what);
- sv_catpvf(errstr, "(%d) at %s line %d", rc, file, line);
-
- if (DBIS->debug >= 3) {
- PerlIO_printf(DBILOGFP, "sqlite error %d recorded: %s at %s line %d\n",
- rc, what, file, line);
- }
-}
-
-int
-sqlite2_db_login(SV *dbh, imp_dbh_t *imp_dbh, char *dbname, char *user, char *pass)
-{
- dTHR;
- int retval;
- char *errmsg = NULL;
-
- if (DBIS->debug >= 3) {
- PerlIO_printf(DBILOGFP, " login '%s' (version %s, encoding %s)\n",
- dbname, sqlite_version, sqlite_encoding);
- }
-
- if ((imp_dbh->db = sqlite_open(dbname, 0, &errmsg)) == NULL) {
- sqlite2_error(dbh, (imp_xxh_t*)imp_dbh, 1, errmsg);
- sqlite_freemem(errmsg);
- return FALSE;
- }
- DBIc_IMPSET_on(imp_dbh);
-
- imp_dbh->in_tran = FALSE;
- imp_dbh->no_utf8_flag = FALSE;
- imp_dbh->functions = newAV();
- imp_dbh->aggregates = newAV();
- imp_dbh->timeout = SQL_TIMEOUT;
-
- imp_dbh->handle_binary_nulls = FALSE;
-
- sqlite_busy_timeout(imp_dbh->db, SQL_TIMEOUT);
-
- if (retval = sqlite_exec(imp_dbh->db, "PRAGMA empty_result_callbacks = ON",
- NULL, NULL, &errmsg)
- != SQLITE_OK)
- {
- /* warn("failed to set pragma: %s\n", errmsg); */
- sqlite2_error(dbh, (imp_xxh_t*)imp_dbh, retval, errmsg);
- sqlite_freemem(errmsg);
- return FALSE;
- }
-
- if (retval = sqlite_exec(imp_dbh->db, "PRAGMA show_datatypes = ON",
- NULL, NULL, &errmsg)
- != SQLITE_OK)
- {
- /* warn("failed to set pragma: %s\n", errmsg); */
- sqlite2_error(dbh, (imp_xxh_t*)imp_dbh, retval, errmsg);
- sqlite_freemem(errmsg);
- return FALSE;
- }
-
- DBIc_ACTIVE_on(imp_dbh);
-
- return TRUE;
-}
-
-int
-sqlite2_busy_timeout ( SV *dbh, int timeout )
-{
- D_imp_dbh(dbh);
- if (timeout) {
- imp_dbh->timeout = timeout;
- sqlite_busy_timeout(imp_dbh->db, timeout);
- }
- return imp_dbh->timeout;
-}
-
-int
-sqlite2_db_disconnect (SV *dbh, imp_dbh_t *imp_dbh)
-{
- dTHR;
- DBIc_ACTIVE_off(imp_dbh);
-
- if (DBIc_is(imp_dbh, DBIcf_AutoCommit) == FALSE) {
- sqlite2_db_rollback(dbh, imp_dbh);
- }
-
- sqlite_close(imp_dbh->db);
- imp_dbh->db = NULL;
-
- av_undef(imp_dbh->functions);
- imp_dbh->functions = (AV *)NULL;
-
- av_undef(imp_dbh->aggregates);
- imp_dbh->aggregates = (AV *)NULL;
-
- return TRUE;
-}
-
-void
-sqlite2_db_destroy (SV *dbh, imp_dbh_t *imp_dbh)
-{
- dTHR;
- if (DBIc_ACTIVE(imp_dbh)) {
- sqlite2_db_disconnect(dbh, imp_dbh);
- }
- DBIc_IMPSET_off(imp_dbh);
-}
-
-int
-sqlite2_db_rollback(SV *dbh, imp_dbh_t *imp_dbh)
-{
- dTHR;
- int retval;
- char *errmsg;
-
- if (imp_dbh->in_tran) {
- if (retval = sqlite_exec(imp_dbh->db, "ROLLBACK TRANSACTION",
- NULL, NULL, &errmsg)
- != SQLITE_OK)
- {
- sqlite2_error(dbh, (imp_xxh_t*)imp_dbh, retval, errmsg);
- sqlite_freemem(errmsg);
- return FALSE;
- }
- imp_dbh->in_tran = FALSE;
- }
-
- return TRUE;
-}
-
-int
-sqlite2_db_commit(SV *dbh, imp_dbh_t *imp_dbh)
-{
- dTHR;
- int retval;
- char *errmsg;
-
- if (DBIc_is(imp_dbh, DBIcf_AutoCommit)) {
- warn("commit ineffective with AutoCommit");
- return TRUE;
- }
-
- if (imp_dbh->in_tran) {
- if (retval = sqlite_exec(imp_dbh->db, "COMMIT TRANSACTION",
- NULL, NULL, &errmsg)
- != SQLITE_OK)
- {
- sqlite2_error(dbh, (imp_xxh_t*)imp_dbh, retval, errmsg);
- sqlite_freemem(errmsg);
- return FALSE;
- }
- imp_dbh->in_tran = FALSE;
- }
- return TRUE;
-}
-
-int
-sqlite2_discon_all(SV *drh, imp_drh_t *imp_drh)
-{
- dTHR;
- return FALSE; /* no way to do this */
-}
-
-void
-sqlite2_st_parse_sql(imp_sth_t *imp_sth, char *statement)
-{
- D_imp_dbh_from_sth;
- bool in_literal = FALSE;
- SV *chunk;
- int num_params = 0;
-
- chunk = NEWSV(0, strlen(statement));
- sv_setpv(chunk, "");
-
- /* warn("parsing: %s\n", statement); */
-
- while (*statement) {
- /* warn("parse: %c => %s\n", *statement, SvPV_nolen(chunk)); */
- if (*statement == '\'') {
- if (in_literal) {
- /* either end of literal, or escape */
- if (statement[1] && statement[1] == '\'') {
- statement++;
- sv_catpvn(chunk, "''", 2);
- }
- else {
- sv_catpvn(chunk, "'", 1);
- in_literal = FALSE;
- }
- }
- else {
- in_literal = TRUE;
- sv_catpvn(chunk, "'", 1);
- }
- }
- else if (*statement == '?') {
- if (in_literal) {
- sv_catpvn(chunk, "?", 1);
- }
- else {
- num_params++;
- if (!imp_dbh->no_utf8_flag) {
- /* sv_utf8_encode(chunk); */
- }
- av_push(imp_sth->sql, chunk);
- chunk = NEWSV(0, 20);
- sv_setpvn(chunk, "", 0);
- }
- }
- else {
- sv_catpvn(chunk, statement, 1);
- }
- statement++;
- }
- av_push(imp_sth->sql, chunk);
- DBIc_NUM_PARAMS(imp_sth) = num_params;
-}
-
-int
-sqlite2_st_prepare (SV *sth, imp_sth_t *imp_sth,
- char *statement, SV *attribs)
-{
- dTHR;
- D_imp_dbh_from_sth;
-
- if (!DBIc_ACTIVE(imp_dbh)) {
- die("prepare on an inactive database handle");
- }
-
- /* warn("prepare statement\n"); */
- imp_sth->nrow = 0;
- imp_sth->ncols = 0;
- imp_sth->params = newAV();
- imp_sth->sql = newAV();
- imp_sth->results = 0;
- imp_sth->coldata = 0;
- imp_sth->retval = SQLITE_OK;
- sqlite2_st_parse_sql(imp_sth, statement);
-
- return TRUE;
-}
-
-char *
-sqlite2_quote(imp_dbh_t *imp_dbh, SV *val)
-{
- STRLEN len;
- char *cval = SvPV(val, len);
- SV *ret = sv_2mortal(NEWSV(0, SvCUR(val) + 2));
- sv_setpvn(ret, "", 0);
-
- while (len) {
- switch (*cval) {
- case '\'':
- sv_catpvn(ret, "''", 2);
- break;
- case 0:
- if (imp_dbh->handle_binary_nulls) {
- sv_catpvn(ret, "\\0", 2);
- break;
- }
- else {
- die("attempt to quote binary null without sqlite_handle_binary_nulls on");
- }
- case '\\':
- if (imp_dbh->handle_binary_nulls) {
- sv_catpvn(ret, "\\\\", 2);
- break;
- }
- default:
- sv_catpvn(ret, cval, 1);
- }
- *cval++; len--;
- }
- return SvPV_nolen(ret);
-}
-
-char *
-sqlite2_decode(imp_dbh_t *imp_dbh, char *input, size_t *len)
-{
- char *ret;
- char *swit;
-
- New(1, ret, *len, char);
- swit = ret;
-
- while (*input) {
- switch (*input) {
- case '\\':
- if (imp_dbh->handle_binary_nulls && input[1] && input[1] == '0') {
- *swit++ = '\0';
- *input++;
- (*len)--;
- break;
- }
- else if (imp_dbh->handle_binary_nulls && input[1] && input[1] == '\\') {
- *swit++ = '\\';
- *input++;
- (*len)--;
- break;
- }
- default:
- *swit++ = *input;
- }
- *input++;
- }
- return ret;
-}
-
-int
-_sqlite2_fetch_row (imp_sth_t *imp_sth)
-{
- while (1)
- {
- imp_sth->retval = sqlite_step(imp_sth->vm,
- &(imp_sth->ncols), (const char ***)&(imp_sth->results), (const char ***)&(imp_sth->coldata));
- if (imp_sth->retval == SQLITE_BUSY) {
- break; /* We should never get "busy" here because we set sqlite_timeout, so assume error */
- }
- break;
- }
- /* warn("step got: %d\nCol1: %s\n", imp_sth->retval, imp_sth->coldata[0]); */
- return imp_sth->retval;
-}
-
-int
-sqlite2_st_execute (SV *sth, imp_sth_t *imp_sth)
-{
- dTHR;
- D_imp_dbh_from_sth;
- SV *sql;
- I32 pos = 0;
- char *errmsg;
- int num_params = DBIc_NUM_PARAMS(imp_sth);
- I32 i;
- int retval;
-
- /* warn("execute\n"); */
-
- if (DBIc_ACTIVE(imp_sth)) {
- sqlite2_st_finish(sth, imp_sth);
- }
-
- sql = sv_2mortal(newSVsv(AvARRAY(imp_sth->sql)[pos++]));
-
- for (i = 0; i < num_params; i++) {
- SV *value = av_shift(imp_sth->params);
- if (value && SvOK(value)) {
- /* warn("binding param: %s\n", SvPV_nolen(value); */
- sv_catpvn(sql, "'", 1);
- sv_catpv(sql, sqlite2_quote(imp_dbh, value));
- sv_catpvn(sql, "'", 1);
- /* warn("inserting string length: %d\n", SvCUR(sql)); */
- }
- else {
- /* warn("binding NULL\n"); */
- sv_catpvn(sql, "NULL", 4);
- }
- if (value) {
- SvREFCNT_dec(value);
- }
- sv_catsv(sql, AvARRAY(imp_sth->sql)[pos++]);
- }
- /* warn("Executing: %s;\n", SvPV_nolen(sql)); */
-
- if ( (!DBIc_is(imp_dbh, DBIcf_AutoCommit)) && (!imp_dbh->in_tran) ) {
- if (retval = sqlite_exec(imp_dbh->db, "BEGIN TRANSACTION",
- NULL, NULL, &errmsg)
- != SQLITE_OK)
- {
- sqlite2_error(sth, (imp_xxh_t*)imp_sth, retval, errmsg);
- sqlite_freemem(errmsg);
- return -2;
- }
- imp_dbh->in_tran = TRUE;
- }
-
- imp_sth->results = NULL;
- if (retval = sqlite_compile(imp_dbh->db, SvPV_nolen(sql), 0, &(imp_sth->vm), &errmsg) != SQLITE_OK)
- {
- sqlite2_error(sth, (imp_xxh_t*)imp_sth, retval, errmsg);
- sqlite_freemem(errmsg);
- return -2;
- }
-
- if (_sqlite2_fetch_row(imp_sth) == SQLITE_ERROR) {
- sqlite_finalize(imp_sth->vm, &errmsg);
- sqlite2_error(sth, (imp_xxh_t*)imp_sth, imp_sth->retval, errmsg);
- sqlite_freemem(errmsg);
- return -2;
- }
-
- DBIc_NUM_FIELDS(imp_sth) = imp_sth->ncols;
- imp_sth->nrow = -1;
-
- /* warn("Execute returned %d cols\n", imp_sth->ncols); */
- if (imp_sth->ncols == 0) {
- sqlite_finalize(imp_sth->vm, 0);
- imp_sth->nrow = sqlite_changes(imp_dbh->db);
- DBIc_IMPSET_on(imp_sth);
- return imp_sth->nrow;
- }
-
- DBIc_ACTIVE_on(imp_sth);
- /* warn("exec ok - %d rows, %d cols\n", imp_sth->nrow, imp_sth->ncols); */
- DBIc_IMPSET_on(imp_sth);
- return 0;
-}
-
-int
-sqlite2_st_rows (SV *sth, imp_sth_t *imp_sth)
-{
- return imp_sth->nrow;
-}
-
-int
-sqlite2_bind_ph (SV *sth, imp_sth_t *imp_sth,
- SV *param, SV *value, IV sql_type, SV *attribs,
- int is_inout, IV maxlen)
-{
- if (is_inout) {
- croak("InOut bind params not implemented");
- }
- /* warn("bind: %s => %s\n", SvPV_nolen(param), SvPV_nolen(value)); */
- if (sql_type >= SQL_NUMERIC && sql_type <= SQL_DOUBLE) {
- av_store(imp_sth->params, SvIV(param) - 1, newSVnv(SvNV(value)));
- }
- else {
- av_store(imp_sth->params, SvIV(param) - 1, SvREFCNT_inc(value));
- }
-}
-
-AV *
-sqlite2_st_fetch (SV *sth, imp_sth_t *imp_sth)
-{
- AV *av;
- D_imp_dbh_from_sth;
- int numFields = DBIc_NUM_FIELDS(imp_sth);
- int chopBlanks = DBIc_is(imp_sth, DBIcf_ChopBlanks);
- int i;
-
- /* warn("current_entry == %d\nnumFields == %d\nnrow == %d",
- current_entry, numFields, imp_sth->nrow); */
-
- /*
- if (!DBIc_ACTIVE(imp_sth)) {
- return Nullav;
- }
- */
-
- if ((imp_sth->retval == SQLITE_DONE) || (imp_sth->retval == SQLITE_ERROR)) {
- sqlite2_st_finish(sth, imp_sth);
- return Nullav;
- }
-
- if (imp_sth->nrow == -1) {
- imp_sth->nrow++;
- }
- imp_sth->nrow++;
-
- av = DBIS->get_fbav(imp_sth);
- for (i = 0; i < numFields; i++) {
- char *val = imp_sth->results[i];
- /* warn("fetching: %d == %s\n", i, val); */
- if (val != NULL) {
- size_t len = strlen(val);
- char *decoded;
- if (chopBlanks) {
- val = savepv(val);
- while((len > 0) && (val[len-1] == ' ')) {
- len--;
- }
- val[len] = '\0';
- }
- decoded = sqlite2_decode(imp_dbh, val, &len);
- sv_setpvn(AvARRAY(av)[i], decoded, len);
- Safefree(decoded);
- if (chopBlanks) Safefree(val);
-
- if (!imp_dbh->no_utf8_flag) {
- /* sv_utf8_encode(AvARRAY(av)[i]); */
- }
- }
- else {
- sv_setsv(AvARRAY(av)[i], &PL_sv_undef);
- }
- }
- _sqlite2_fetch_row(imp_sth);
- return av;
-}
-
-int
-sqlite2_st_finish (SV *sth, imp_sth_t *imp_sth)
-{
- /* warn("finish statement\n"); */
- if (DBIc_ACTIVE(imp_sth)) {
- char *errmsg;
- DBIc_ACTIVE_off(imp_sth);
- if (imp_sth->retval = sqlite_finalize(imp_sth->vm, &errmsg) == SQLITE_ERROR) {
- warn("finalize failed! %s\n", errmsg);
- sqlite2_error(sth, (imp_xxh_t*)imp_sth, imp_sth->retval, errmsg);
- sqlite_freemem(errmsg);
- return FALSE;
- }
- }
- return TRUE;
-}
-
-void
-sqlite2_st_destroy (SV *sth, imp_sth_t *imp_sth)
-{
- /* warn("destroy statement\n"); */
- if (DBIc_ACTIVE(imp_sth)) {
- sqlite2_st_finish(sth, imp_sth);
- }
- SvREFCNT_dec((SV*)imp_sth->sql);
- SvREFCNT_dec((SV*)imp_sth->params);
- DBIc_IMPSET_off(imp_sth);
-}
-
-int
-sqlite2_st_blob_read (SV *sth, imp_sth_t *imp_sth,
- int field, long offset, long len, SV *destrv, long destoffset)
-{
- return 0;
-}
-
-int
-sqlite2_db_STORE_attrib (SV *dbh, imp_dbh_t *imp_dbh, SV *keysv, SV *valuesv)
-{
- dTHR;
- char *key = SvPV_nolen(keysv);
- char *errmsg;
- int retval;
-
- if (strEQ(key, "AutoCommit")) {
- if (SvTRUE(valuesv)) {
- /* commit tran? */
- if ( (!DBIc_is(imp_dbh, DBIcf_AutoCommit)) && (imp_dbh->in_tran) ) {
- if (retval = sqlite_exec(imp_dbh->db, "COMMIT TRANSACTION",
- NULL, NULL, &errmsg)
- != SQLITE_OK)
- {
- sqlite2_error(dbh, (imp_xxh_t*)imp_dbh, retval, errmsg);
- sqlite_freemem(errmsg);
- return TRUE;
- }
- imp_dbh->in_tran = FALSE;
- }
- }
- DBIc_set(imp_dbh, DBIcf_AutoCommit, SvTRUE(valuesv));
- return TRUE;
- }
- else if (strEQ(key, "sqlite_no_utf8_flag") || strEQ(key, "NoUTF8Flag")) {
- warn("NoUTF8Flag is deprecated due to perl unicode weirdness\n");
- if (SvTRUE(valuesv)) {
- imp_dbh->no_utf8_flag = TRUE;
- }
- else {
- imp_dbh->no_utf8_flag = FALSE;
- }
- return TRUE;
- }
- else if (strEQ(key, "sqlite_handle_binary_nulls")) {
- if (SvTRUE(valuesv)) {
- imp_dbh->handle_binary_nulls = TRUE;
- }
- else {
- imp_dbh->handle_binary_nulls = FALSE;
- }
- return TRUE;
- }
- return FALSE;
-}
-
-SV *
-sqlite2_db_FETCH_attrib (SV *dbh, imp_dbh_t *imp_dbh, SV *keysv)
-{
- dTHR;
- char *key = SvPV_nolen(keysv);
-
- if (strEQ(key, "sqlite_no_utf8_flag") || strEQ(key, "NoUTF8Flag")) {
- return newSViv(imp_dbh->no_utf8_flag ? 1 : 0);
- }
- if (strEQ(key, "sqlite_version")) {
- return newSVpv(sqlite_version, strlen(sqlite_version));
- }
- if (strEQ(key, "sqlite_encoding")) {
- return newSVpv(sqlite_encoding, strlen(sqlite_encoding));
- }
- return NULL;
-}
-
-int
-sqlite2_st_STORE_attrib (SV *sth, imp_sth_t *imp_sth, SV *keysv, SV *valuesv)
-{
- char *key = SvPV_nolen(keysv);
- return FALSE;
-}
-
-SV *
-sqlite2_st_FETCH_attrib (SV *sth, imp_sth_t *imp_sth, SV *keysv)
-{
- char *key = SvPV_nolen(keysv);
- SV *retsv = NULL;
- int i;
-
- if (!imp_sth->coldata) {
- return retsv;
- }
-
- i = DBIc_NUM_FIELDS(imp_sth);
-
- if (strEQ(key, "NAME")) {
- AV *av = newAV();
- av_extend(av, i);
- retsv = sv_2mortal(newRV(sv_2mortal((SV*)av)));
- while (--i >= 0) {
- char *fieldname = imp_sth->coldata[i];
- /* warn("Name [%d]: %s\n", i, fieldname); */
- char *dot = instr(fieldname, ".");
- if (dot) /* drop table name from field name */
- fieldname = ++dot;
- av_store(av, i, newSVpv(fieldname, 0));
- }
- }
- else if (strEQ(key, "PRECISION")) {
- AV *av = newAV();
- retsv = sv_2mortal(newRV(sv_2mortal((SV*)av)));
- }
- else if (strEQ(key, "TYPE")) {
- int i_base = i;
- AV *av = newAV();
- av_extend(av, i);
- retsv = sv_2mortal(newRV(sv_2mortal((SV*)av)));
- i = i * 2;
- while (--i >= i_base) {
- char *fieldname = imp_sth->coldata[i];
- /* warn("Type [%d]: %s\n", i, fieldname); */
- char *dot = instr(fieldname, ".");
- if (dot) /* drop table name from field name */
- fieldname = ++dot;
- av_store(av, i - i_base, newSVpv(fieldname, 0));
- }
- }
- else if (strEQ(key, "NULLABLE")) {
- AV *av = newAV();
- retsv = sv_2mortal(newRV(sv_2mortal((SV*)av)));
- }
- else if (strEQ(key, "SCALE")) {
- AV *av = newAV();
- retsv = sv_2mortal(newRV(sv_2mortal((SV*)av)));
- }
- else if (strEQ(key, "NUM_OF_FIELDS")) {
- retsv = sv_2mortal(newSViv(i));
- }
-
- return retsv;
-}
-
-static void
-sqlite2_db_set_result(sqlite_func *context, SV *result, int is_error )
-{
- STRLEN len;
- char *s;
-
- if ( is_error ) {
- s = SvPV(result, len);
- sqlite_set_result_error( context, s, len );
- return;
- }
-
- if ( !SvOK(result) ) {
- sqlite_set_result_string( context, NULL, -1 );
- } else if( SvIOK(result) ) {
- sqlite_set_result_int( context, SvIV(result));
- } else if ( !is_error && SvIOK(result) ) {
- sqlite_set_result_double( context, SvNV(result));
- } else {
- s = SvPV(result, len);
- sqlite_set_result_string( context, s, len );
- }
-}
-
-static void
-sqlite2_db_func_dispatcher(sqlite_func *context, int argc, const char **argv)
-{
- dSP;
- int count;
- int i;
- SV *func;
-
- func = sqlite_user_data(context);
-
- ENTER;
- SAVETMPS;
-
- PUSHMARK(SP);
- for ( i=0; i < argc; i++ ) {
- SV *arg;
-
- if ( !argv[i] ) {
- arg = &PL_sv_undef;
- } else {
- arg = sv_2mortal( newSVpv(argv[i], 0));
- }
-
- XPUSHs(arg);
- }
- PUTBACK;
-
- count = call_sv(func, G_SCALAR|G_EVAL);
-
- SPAGAIN;
-
- /* Check for an error */
- if (SvTRUE(ERRSV) ) {
- sqlite2_db_set_result( context, ERRSV, 1);
- POPs;
- } else if ( count != 1 ) {
- SV *err = sv_2mortal(newSVpvf( "function should return 1 argument, got %d",
- count ));
-
- sqlite2_db_set_result( context, err, 1);
- /* Clear the stack */
- for ( i=0; i < count; i++ ) {
- POPs;
- }
- } else {
- sqlite2_db_set_result( context, POPs, 0 );
- }
-
- PUTBACK;
-
- FREETMPS;
- LEAVE;
-}
-
-void
-sqlite2_db_create_function( SV *dbh, const char *name, int argc, SV *func )
-{
- D_imp_dbh(dbh);
- int rv;
-
- /* Copy the function reference */
- SV *func_sv = newSVsv(func);
- av_push( imp_dbh->functions, func_sv );
-
- rv = sqlite_create_function( imp_dbh->db, name, argc,
- sqlite2_db_func_dispatcher, func_sv );
- if ( rv != SQLITE_OK )
- {
- croak( "sqlite_create_function failed with error %s",
- sqlite_error_string(rv) );
- }
-}
-
-typedef struct aggrInfo aggrInfo;
-struct aggrInfo {
- SV *aggr_inst;
- SV *err;
- int inited;
-};
-
-static void
-sqlite2_db_aggr_new_dispatcher( sqlite_func *context, aggrInfo *aggr_info )
-{
- dSP;
- SV *pkg = NULL;
- int count = 0;
-
- aggr_info->err = NULL;
- aggr_info->aggr_inst = NULL;
-
- pkg = sqlite_user_data(context);
- if ( !pkg )
- return;
-
- ENTER;
- SAVETMPS;
-
- PUSHMARK(SP);
- XPUSHs( sv_2mortal( newSVsv(pkg) ) );
- PUTBACK;
-
- count = call_method ("new", G_EVAL|G_SCALAR);
- SPAGAIN;
-
- aggr_info->inited = 1;
-
- if ( SvTRUE( ERRSV ) ) {
- aggr_info->err = newSVpvf ("error during aggregator's new(): %s",
- SvPV_nolen (ERRSV));
- POPs;
- } else if ( count != 1 ) {
- int i;
-
- aggr_info->err = newSVpvf( "new() should return one value, got %d",
- count );
- /* Clear the stack */
- for ( i=0; i < count; i++ ) {
- POPs;
- }
- } else {
- SV *aggr = POPs;
- if ( SvROK(aggr) ) {
- aggr_info->aggr_inst = newSVsv(aggr);
- } else{
- aggr_info->err = newSVpvf( "new() should return a blessed reference" );
- }
- }
-
- PUTBACK;
-
- FREETMPS;
- LEAVE;
-
- return;
-}
-
-static void
-sqlite2_db_aggr_step_dispatcher (sqlite_func *context,
- int argc, const char **argv)
-{
- dSP;
- int i;
- aggrInfo *aggr;
-
- aggr = sqlite_aggregate_context (context, sizeof (aggrInfo));
- if ( !aggr )
- return;
-
- ENTER;
- SAVETMPS;
-
- /* initialize on first step */
- if ( !aggr->inited ) {
- sqlite2_db_aggr_new_dispatcher( context, aggr );
- }
-
- if ( aggr->err || !aggr->aggr_inst )
- goto cleanup;
-
- PUSHMARK(SP);
- XPUSHs( sv_2mortal( newSVsv( aggr->aggr_inst ) ));
- for ( i=0; i < argc; i++ ) {
- SV *arg;
-
- if ( !argv[i] ) {
- arg = &PL_sv_undef;
- } else {
- arg = sv_2mortal( newSVpv(argv[i], 0));
- }
-
- XPUSHs(arg);
- }
- PUTBACK;
-
- call_method ("step", G_SCALAR|G_EVAL|G_DISCARD);
-
- /* Check for an error */
- if (SvTRUE(ERRSV) ) {
- aggr->err = newSVpvf( "error during aggregator's step(): %s",
- SvPV_nolen(ERRSV));
- POPs;
- }
-
- cleanup:
- FREETMPS;
- LEAVE;
-}
-
-static void
-sqlite2_db_aggr_finalize_dispatcher( sqlite_func *context )
-{
- dSP;
- aggrInfo *aggr, myAggr;
- int count = 0;
-
- aggr = sqlite_aggregate_context (context, sizeof (aggrInfo));
-
- ENTER;
- SAVETMPS;
-
- if ( !aggr ) {
- /* SQLite seems to refuse to create a context structure
- from finalize() */
- aggr = &myAggr;
- aggr->aggr_inst = NULL;
- aggr->err = NULL;
- sqlite2_db_aggr_new_dispatcher (context, aggr);
- }
-
- if ( ! aggr->err && aggr->aggr_inst ) {
- PUSHMARK(SP);
- XPUSHs( sv_2mortal( newSVsv( aggr->aggr_inst )) );
- PUTBACK;
-
- count = call_method( "finalize", G_SCALAR|G_EVAL );
- SPAGAIN;
-
- if ( SvTRUE(ERRSV) ) {
- aggr->err = newSVpvf ("error during aggregator's finalize(): %s",
- SvPV_nolen(ERRSV) ) ;
- POPs;
- } else if ( count != 1 ) {
- int i;
- aggr->err = newSVpvf( "finalize() should return 1 value, got %d",
- count );
- /* Clear the stack */
- for ( i=0; i<count; i++ ) {
- POPs;
- }
- } else {
- sqlite2_db_set_result( context, POPs, 0 );
- }
- PUTBACK;
- }
-
- if ( aggr->err ) {
- warn( "DBD::SQLite: error in aggregator cannot be reported to SQLite: %s", SvPV_nolen( aggr->err ) );
-
- /* sqlite2_db_set_result( context, aggr->err, 1 ); */
- SvREFCNT_dec( aggr->err );
- aggr->err = NULL;
- }
-
- if ( aggr->aggr_inst ) {
- SvREFCNT_dec( aggr->aggr_inst );
- aggr->aggr_inst = NULL;
- }
-
- FREETMPS;
- LEAVE;
-}
-
-void
-sqlite2_db_create_aggregate( SV *dbh, const char *name, int argc, SV *aggr_pkg )
-{
- D_imp_dbh(dbh);
- int rv;
-
- /* Copy the aggregate reference */
- SV *aggr_pkg_copy = newSVsv(aggr_pkg);
- av_push( imp_dbh->aggregates, aggr_pkg_copy );
-
- rv = sqlite_create_aggregate( imp_dbh->db, name, argc,
- sqlite2_db_aggr_step_dispatcher,
- sqlite2_db_aggr_finalize_dispatcher,
- aggr_pkg_copy );
-
- if ( rv != SQLITE_OK )
- {
- croak( "sqlite_create_aggregate failed with error %s",
- sqlite_error_string(rv) );
- }
-}
-
-/* end */
+++ /dev/null
-/* $Id: dbdimp.h,v 1.2 2004/08/09 13:17:59 matt Exp $ */
-
-#ifndef _DBDIMP_H
-#define _DBDIMP_H 1
-
-#include "SQLiteXS.h"
-#include "sqliteInt.h"
-
-/* 30 second timeout by default */
-#define SQL_TIMEOUT 30000
-#define BUSY_PAUSE_USEC 500
-
-/* Driver Handle */
-struct imp_drh_st {
- dbih_drc_t com;
- /* sqlite specific bits */
-};
-
-/* Database Handle */
-struct imp_dbh_st {
- dbih_dbc_t com;
- /* sqlite specific bits */
- struct sqlite *db;
- bool in_tran;
- bool no_utf8_flag;
- bool handle_binary_nulls;
- int timeout;
- AV *functions;
- AV *aggregates;
-};
-
-/* Statement Handle */
-struct imp_sth_st {
- dbih_stc_t com;
- /* sqlite specific bits */
- AV *sql;
- sqlite_vm *vm;
- char **results;
- char **coldata;
- int retval;
- int nrow;
- int ncols;
- AV *params;
-};
-
-#define dbd_init sqlite2_init
-#define dbd_discon_all sqlite2_discon_all
-#define dbd_db_login sqlite2_db_login
-#define dbd_db_do sqlite2_db_do
-#define dbd_db_commit sqlite2_db_commit
-#define dbd_db_rollback sqlite2_db_rollback
-#define dbd_db_disconnect sqlite2_db_disconnect
-#define dbd_db_destroy sqlite2_db_destroy
-#define dbd_db_STORE_attrib sqlite2_db_STORE_attrib
-#define dbd_db_FETCH_attrib sqlite2_db_FETCH_attrib
-#define dbd_db_STORE_attrib_k sqlite2_db_STORE_attrib_k
-#define dbd_db_FETCH_attrib_k sqlite2_db_FETCH_attrib_k
-#define dbd_st_prepare sqlite2_st_prepare
-#define dbd_st_rows sqlite2_st_rows
-#define dbd_st_execute sqlite2_st_execute
-#define dbd_st_fetch sqlite2_st_fetch
-#define dbd_st_finish sqlite2_st_finish
-#define dbd_st_destroy sqlite2_st_destroy
-#define dbd_st_blob_read sqlite2_st_blob_read
-#define dbd_st_STORE_attrib sqlite2_st_STORE_attrib
-#define dbd_st_FETCH_attrib sqlite2_st_FETCH_attrib
-#define dbd_st_STORE_attrib_k sqlite2_st_STORE_attrib_k
-#define dbd_st_FETCH_attrib_k sqlite2_st_FETCH_attrib_k
-#define dbd_bind_ph sqlite2_bind_ph
-
-void sqlite2_db_create_function(SV *dbh, const char *name, int argc, SV *func);
-void sqlite2_db_create_aggregate( SV *dbh, const char *name, int argc, SV *aggr );
-
-#ifdef SvUTF8_on
-
-static SV *
-newUTF8SVpv(char *s, STRLEN len) {
- register SV *sv;
-
- sv = newSVpv(s, len);
- SvUTF8_on(sv);
- return sv;
-} /* End new UTF8SVpv */
-
-static SV *
-newUTF8SVpvn(char *s, STRLEN len) {
- register SV *sv;
-
- sv = newSV(0);
- sv_setpvn(sv, s, len);
- SvUTF8_on(sv);
- return sv;
-}
-
-#else /* SvUTF8_on not defined */
-
-#define newUTF8SVpv newSVpv
-#define newUTF8SVpvn newSVpvn
-#define SvUTF8_on(a) (a)
-#define sv_utf8_upgrade(a) (a)
-
-#endif
-
-#endif /* _DBDIMP_H */
+++ /dev/null
-/*
-** 2001 September 15
-**
-** The author disclaims copyright to this source code. In place of
-** a legal notice, here is a blessing:
-**
-** May you do good and not evil.
-** May you find forgiveness for yourself and forgive others.
-** May you share freely, never taking more than you give.
-**
-*************************************************************************
-** This file contains C code routines that are called by the parser
-** to handle DELETE FROM statements.
-**
-** $Id: delete.c,v 1.1.1.1 2004/08/08 15:03:57 matt Exp $
-*/
-#include "sqliteInt.h"
-
-/*
-** Look up every table that is named in pSrc. If any table is not found,
-** add an error message to pParse->zErrMsg and return NULL. If all tables
-** are found, return a pointer to the last table.
-*/
-Table *sqliteSrcListLookup(Parse *pParse, SrcList *pSrc){
- Table *pTab = 0;
- int i;
- for(i=0; i<pSrc->nSrc; i++){
- const char *zTab = pSrc->a[i].zName;
- const char *zDb = pSrc->a[i].zDatabase;
- pTab = sqliteLocateTable(pParse, zTab, zDb);
- pSrc->a[i].pTab = pTab;
- }
- return pTab;
-}
-
-/*
-** Check to make sure the given table is writable. If it is not
-** writable, generate an error message and return 1. If it is
-** writable return 0;
-*/
-int sqliteIsReadOnly(Parse *pParse, Table *pTab, int viewOk){
- if( pTab->readOnly ){
- sqliteErrorMsg(pParse, "table %s may not be modified", pTab->zName);
- return 1;
- }
- if( !viewOk && pTab->pSelect ){
- sqliteErrorMsg(pParse, "cannot modify %s because it is a view",pTab->zName);
- return 1;
- }
- return 0;
-}
-
-/*
-** Process a DELETE FROM statement.
-*/
-void sqliteDeleteFrom(
- Parse *pParse, /* The parser context */
- SrcList *pTabList, /* The table from which we should delete things */
- Expr *pWhere /* The WHERE clause. May be null */
-){
- Vdbe *v; /* The virtual database engine */
- Table *pTab; /* The table from which records will be deleted */
- const char *zDb; /* Name of database holding pTab */
- int end, addr; /* A couple addresses of generated code */
- int i; /* Loop counter */
- WhereInfo *pWInfo; /* Information about the WHERE clause */
- Index *pIdx; /* For looping over indices of the table */
- int iCur; /* VDBE Cursor number for pTab */
- sqlite *db; /* Main database structure */
- int isView; /* True if attempting to delete from a view */
- AuthContext sContext; /* Authorization context */
-
- int row_triggers_exist = 0; /* True if any triggers exist */
- int before_triggers; /* True if there are BEFORE triggers */
- int after_triggers; /* True if there are AFTER triggers */
- int oldIdx = -1; /* Cursor for the OLD table of AFTER triggers */
-
- sContext.pParse = 0;
- if( pParse->nErr || sqlite_malloc_failed ){
- pTabList = 0;
- goto delete_from_cleanup;
- }
- db = pParse->db;
- assert( pTabList->nSrc==1 );
-
- /* Locate the table which we want to delete. This table has to be
- ** put in an SrcList structure because some of the subroutines we
- ** will be calling are designed to work with multiple tables and expect
- ** an SrcList* parameter instead of just a Table* parameter.
- */
- pTab = sqliteSrcListLookup(pParse, pTabList);
- if( pTab==0 ) goto delete_from_cleanup;
- before_triggers = sqliteTriggersExist(pParse, pTab->pTrigger,
- TK_DELETE, TK_BEFORE, TK_ROW, 0);
- after_triggers = sqliteTriggersExist(pParse, pTab->pTrigger,
- TK_DELETE, TK_AFTER, TK_ROW, 0);
- row_triggers_exist = before_triggers || after_triggers;
- isView = pTab->pSelect!=0;
- if( sqliteIsReadOnly(pParse, pTab, before_triggers) ){
- goto delete_from_cleanup;
- }
- assert( pTab->iDb<db->nDb );
- zDb = db->aDb[pTab->iDb].zName;
- if( sqliteAuthCheck(pParse, SQLITE_DELETE, pTab->zName, 0, zDb) ){
- goto delete_from_cleanup;
- }
-
- /* If pTab is really a view, make sure it has been initialized.
- */
- if( isView && sqliteViewGetColumnNames(pParse, pTab) ){
- goto delete_from_cleanup;
- }
-
- /* Allocate a cursor used to store the old.* data for a trigger.
- */
- if( row_triggers_exist ){
- oldIdx = pParse->nTab++;
- }
-
- /* Resolve the column names in all the expressions.
- */
- assert( pTabList->nSrc==1 );
- iCur = pTabList->a[0].iCursor = pParse->nTab++;
- if( pWhere ){
- if( sqliteExprResolveIds(pParse, pTabList, 0, pWhere) ){
- goto delete_from_cleanup;
- }
- if( sqliteExprCheck(pParse, pWhere, 0, 0) ){
- goto delete_from_cleanup;
- }
- }
-
- /* Start the view context
- */
- if( isView ){
- sqliteAuthContextPush(pParse, &sContext, pTab->zName);
- }
-
- /* Begin generating code.
- */
- v = sqliteGetVdbe(pParse);
- if( v==0 ){
- goto delete_from_cleanup;
- }
- sqliteBeginWriteOperation(pParse, row_triggers_exist, pTab->iDb);
-
- /* If we are trying to delete from a view, construct that view into
- ** a temporary table.
- */
- if( isView ){
- Select *pView = sqliteSelectDup(pTab->pSelect);
- sqliteSelect(pParse, pView, SRT_TempTable, iCur, 0, 0, 0);
- sqliteSelectDelete(pView);
- }
-
- /* Initialize the counter of the number of rows deleted, if
- ** we are counting rows.
- */
- if( db->flags & SQLITE_CountRows ){
- sqliteVdbeAddOp(v, OP_Integer, 0, 0);
- }
-
- /* Special case: A DELETE without a WHERE clause deletes everything.
- ** It is easier just to erase the whole table. Note, however, that
- ** this means that the row change count will be incorrect.
- */
- if( pWhere==0 && !row_triggers_exist ){
- if( db->flags & SQLITE_CountRows ){
- /* If counting rows deleted, just count the total number of
- ** entries in the table. */
- int endOfLoop = sqliteVdbeMakeLabel(v);
- int addr;
- if( !isView ){
- sqliteVdbeAddOp(v, OP_Integer, pTab->iDb, 0);
- sqliteVdbeAddOp(v, OP_OpenRead, iCur, pTab->tnum);
- }
- sqliteVdbeAddOp(v, OP_Rewind, iCur, sqliteVdbeCurrentAddr(v)+2);
- addr = sqliteVdbeAddOp(v, OP_AddImm, 1, 0);
- sqliteVdbeAddOp(v, OP_Next, iCur, addr);
- sqliteVdbeResolveLabel(v, endOfLoop);
- sqliteVdbeAddOp(v, OP_Close, iCur, 0);
- }
- if( !isView ){
- sqliteVdbeAddOp(v, OP_Clear, pTab->tnum, pTab->iDb);
- for(pIdx=pTab->pIndex; pIdx; pIdx=pIdx->pNext){
- sqliteVdbeAddOp(v, OP_Clear, pIdx->tnum, pIdx->iDb);
- }
- }
- }
-
- /* The usual case: There is a WHERE clause so we have to scan through
- ** the table and pick which records to delete.
- */
- else{
- /* Begin the database scan
- */
- pWInfo = sqliteWhereBegin(pParse, pTabList, pWhere, 1, 0);
- if( pWInfo==0 ) goto delete_from_cleanup;
-
- /* Remember the key of every item to be deleted.
- */
- sqliteVdbeAddOp(v, OP_ListWrite, 0, 0);
- if( db->flags & SQLITE_CountRows ){
- sqliteVdbeAddOp(v, OP_AddImm, 1, 0);
- }
-
- /* End the database scan loop.
- */
- sqliteWhereEnd(pWInfo);
-
- /* Open the pseudo-table used to store OLD if there are triggers.
- */
- if( row_triggers_exist ){
- sqliteVdbeAddOp(v, OP_OpenPseudo, oldIdx, 0);
- }
-
- /* Delete every item whose key was written to the list during the
- ** database scan. We have to delete items after the scan is complete
- ** because deleting an item can change the scan order.
- */
- sqliteVdbeAddOp(v, OP_ListRewind, 0, 0);
- end = sqliteVdbeMakeLabel(v);
-
- /* This is the beginning of the delete loop when there are
- ** row triggers.
- */
- if( row_triggers_exist ){
- addr = sqliteVdbeAddOp(v, OP_ListRead, 0, end);
- sqliteVdbeAddOp(v, OP_Dup, 0, 0);
- if( !isView ){
- sqliteVdbeAddOp(v, OP_Integer, pTab->iDb, 0);
- sqliteVdbeAddOp(v, OP_OpenRead, iCur, pTab->tnum);
- }
- sqliteVdbeAddOp(v, OP_MoveTo, iCur, 0);
-
- sqliteVdbeAddOp(v, OP_Recno, iCur, 0);
- sqliteVdbeAddOp(v, OP_RowData, iCur, 0);
- sqliteVdbeAddOp(v, OP_PutIntKey, oldIdx, 0);
- if( !isView ){
- sqliteVdbeAddOp(v, OP_Close, iCur, 0);
- }
-
- sqliteCodeRowTrigger(pParse, TK_DELETE, 0, TK_BEFORE, pTab, -1,
- oldIdx, (pParse->trigStack)?pParse->trigStack->orconf:OE_Default,
- addr);
- }
-
- if( !isView ){
- /* Open cursors for the table we are deleting from and all its
- ** indices. If there are row triggers, this happens inside the
- ** OP_ListRead loop because the cursor have to all be closed
- ** before the trigger fires. If there are no row triggers, the
- ** cursors are opened only once on the outside the loop.
- */
- pParse->nTab = iCur + 1;
- sqliteOpenTableAndIndices(pParse, pTab, iCur);
-
- /* This is the beginning of the delete loop when there are no
- ** row triggers */
- if( !row_triggers_exist ){
- addr = sqliteVdbeAddOp(v, OP_ListRead, 0, end);
- }
-
- /* Delete the row */
- sqliteGenerateRowDelete(db, v, pTab, iCur, pParse->trigStack==0);
- }
-
- /* If there are row triggers, close all cursors then invoke
- ** the AFTER triggers
- */
- if( row_triggers_exist ){
- if( !isView ){
- for(i=1, pIdx=pTab->pIndex; pIdx; i++, pIdx=pIdx->pNext){
- sqliteVdbeAddOp(v, OP_Close, iCur + i, pIdx->tnum);
- }
- sqliteVdbeAddOp(v, OP_Close, iCur, 0);
- }
- sqliteCodeRowTrigger(pParse, TK_DELETE, 0, TK_AFTER, pTab, -1,
- oldIdx, (pParse->trigStack)?pParse->trigStack->orconf:OE_Default,
- addr);
- }
-
- /* End of the delete loop */
- sqliteVdbeAddOp(v, OP_Goto, 0, addr);
- sqliteVdbeResolveLabel(v, end);
- sqliteVdbeAddOp(v, OP_ListReset, 0, 0);
-
- /* Close the cursors after the loop if there are no row triggers */
- if( !row_triggers_exist ){
- for(i=1, pIdx=pTab->pIndex; pIdx; i++, pIdx=pIdx->pNext){
- sqliteVdbeAddOp(v, OP_Close, iCur + i, pIdx->tnum);
- }
- sqliteVdbeAddOp(v, OP_Close, iCur, 0);
- pParse->nTab = iCur;
- }
- }
- sqliteVdbeAddOp(v, OP_SetCounts, 0, 0);
- sqliteEndWriteOperation(pParse);
-
- /*
- ** Return the number of rows that were deleted.
- */
- if( db->flags & SQLITE_CountRows ){
- sqliteVdbeAddOp(v, OP_ColumnName, 0, 1);
- sqliteVdbeChangeP3(v, -1, "rows deleted", P3_STATIC);
- sqliteVdbeAddOp(v, OP_Callback, 1, 0);
- }
-
-delete_from_cleanup:
- sqliteAuthContextPop(&sContext);
- sqliteSrcListDelete(pTabList);
- sqliteExprDelete(pWhere);
- return;
-}
-
-/*
-** This routine generates VDBE code that causes a single row of a
-** single table to be deleted.
-**
-** The VDBE must be in a particular state when this routine is called.
-** These are the requirements:
-**
-** 1. A read/write cursor pointing to pTab, the table containing the row
-** to be deleted, must be opened as cursor number "base".
-**
-** 2. Read/write cursors for all indices of pTab must be open as
-** cursor number base+i for the i-th index.
-**
-** 3. The record number of the row to be deleted must be on the top
-** of the stack.
-**
-** This routine pops the top of the stack to remove the record number
-** and then generates code to remove both the table record and all index
-** entries that point to that record.
-*/
-void sqliteGenerateRowDelete(
- sqlite *db, /* The database containing the index */
- Vdbe *v, /* Generate code into this VDBE */
- Table *pTab, /* Table containing the row to be deleted */
- int iCur, /* Cursor number for the table */
- int count /* Increment the row change counter */
-){
- int addr;
- addr = sqliteVdbeAddOp(v, OP_NotExists, iCur, 0);
- sqliteGenerateRowIndexDelete(db, v, pTab, iCur, 0);
- sqliteVdbeAddOp(v, OP_Delete, iCur,
- (count?OPFLAG_NCHANGE:0) | OPFLAG_CSCHANGE);
- sqliteVdbeChangeP2(v, addr, sqliteVdbeCurrentAddr(v));
-}
-
-/*
-** This routine generates VDBE code that causes the deletion of all
-** index entries associated with a single row of a single table.
-**
-** The VDBE must be in a particular state when this routine is called.
-** These are the requirements:
-**
-** 1. A read/write cursor pointing to pTab, the table containing the row
-** to be deleted, must be opened as cursor number "iCur".
-**
-** 2. Read/write cursors for all indices of pTab must be open as
-** cursor number iCur+i for the i-th index.
-**
-** 3. The "iCur" cursor must be pointing to the row that is to be
-** deleted.
-*/
-void sqliteGenerateRowIndexDelete(
- sqlite *db, /* The database containing the index */
- Vdbe *v, /* Generate code into this VDBE */
- Table *pTab, /* Table containing the row to be deleted */
- int iCur, /* Cursor number for the table */
- char *aIdxUsed /* Only delete if aIdxUsed!=0 && aIdxUsed[i]!=0 */
-){
- int i;
- Index *pIdx;
-
- for(i=1, pIdx=pTab->pIndex; pIdx; i++, pIdx=pIdx->pNext){
- int j;
- if( aIdxUsed!=0 && aIdxUsed[i-1]==0 ) continue;
- sqliteVdbeAddOp(v, OP_Recno, iCur, 0);
- for(j=0; j<pIdx->nColumn; j++){
- int idx = pIdx->aiColumn[j];
- if( idx==pTab->iPKey ){
- sqliteVdbeAddOp(v, OP_Dup, j, 0);
- }else{
- sqliteVdbeAddOp(v, OP_Column, iCur, idx);
- }
- }
- sqliteVdbeAddOp(v, OP_MakeIdxKey, pIdx->nColumn, 0);
- if( db->file_format>=4 ) sqliteAddIdxKeyType(v, pIdx);
- sqliteVdbeAddOp(v, OP_IdxDelete, iCur+i, 0);
- }
-}
+++ /dev/null
-/*
-** 2002 April 25
-**
-** The author disclaims copyright to this source code. In place of
-** a legal notice, here is a blessing:
-**
-** May you do good and not evil.
-** May you find forgiveness for yourself and forgive others.
-** May you share freely, never taking more than you give.
-**
-*************************************************************************
-** This file contains helper routines used to translate binary data into
-** a null-terminated string (suitable for use in SQLite) and back again.
-** These are convenience routines for use by people who want to store binary
-** data in an SQLite database. The code in this file is not used by any other
-** part of the SQLite library.
-**
-** $Id: encode.c,v 1.1.1.1 2004/08/08 15:03:57 matt Exp $
-*/
-#include <string.h>
-#include <assert.h>
-
-/*
-** How This Encoder Works
-**
-** The output is allowed to contain any character except 0x27 (') and
-** 0x00. This is accomplished by using an escape character to encode
-** 0x27 and 0x00 as a two-byte sequence. The escape character is always
-** 0x01. An 0x00 is encoded as the two byte sequence 0x01 0x01. The
-** 0x27 character is encoded as the two byte sequence 0x01 0x28. Finally,
-** the escape character itself is encoded as the two-character sequence
-** 0x01 0x02.
-**
-** To summarize, the encoder works by using an escape sequences as follows:
-**
-** 0x00 -> 0x01 0x01
-** 0x01 -> 0x01 0x02
-** 0x27 -> 0x01 0x28
-**
-** If that were all the encoder did, it would work, but in certain cases
-** it could double the size of the encoded string. For example, to
-** encode a string of 100 0x27 characters would require 100 instances of
-** the 0x01 0x03 escape sequence resulting in a 200-character output.
-** We would prefer to keep the size of the encoded string smaller than
-** this.
-**
-** To minimize the encoding size, we first add a fixed offset value to each
-** byte in the sequence. The addition is modulo 256. (That is to say, if
-** the sum of the original character value and the offset exceeds 256, then
-** the higher order bits are truncated.) The offset is chosen to minimize
-** the number of characters in the string that need to be escaped. For
-** example, in the case above where the string was composed of 100 0x27
-** characters, the offset might be 0x01. Each of the 0x27 characters would
-** then be converted into an 0x28 character which would not need to be
-** escaped at all and so the 100 character input string would be converted
-** into just 100 characters of output. Actually 101 characters of output -
-** we have to record the offset used as the first byte in the sequence so
-** that the string can be decoded. Since the offset value is stored as
-** part of the output string and the output string is not allowed to contain
-** characters 0x00 or 0x27, the offset cannot be 0x00 or 0x27.
-**
-** Here, then, are the encoding steps:
-**
-** (1) Choose an offset value and make it the first character of
-** output.
-**
-** (2) Copy each input character into the output buffer, one by
-** one, adding the offset value as you copy.
-**
-** (3) If the value of an input character plus offset is 0x00, replace
-** that one character by the two-character sequence 0x01 0x01.
-** If the sum is 0x01, replace it with 0x01 0x02. If the sum
-** is 0x27, replace it with 0x01 0x03.
-**
-** (4) Put a 0x00 terminator at the end of the output.
-**
-** Decoding is obvious:
-**
-** (5) Copy encoded characters except the first into the decode
-** buffer. Set the first encoded character aside for use as
-** the offset in step 7 below.
-**
-** (6) Convert each 0x01 0x01 sequence into a single character 0x00.
-** Convert 0x01 0x02 into 0x01. Convert 0x01 0x28 into 0x27.
-**
-** (7) Subtract the offset value that was the first character of
-** the encoded buffer from all characters in the output buffer.
-**
-** The only tricky part is step (1) - how to compute an offset value to
-** minimize the size of the output buffer. This is accomplished by testing
-** all offset values and picking the one that results in the fewest number
-** of escapes. To do that, we first scan the entire input and count the
-** number of occurances of each character value in the input. Suppose
-** the number of 0x00 characters is N(0), the number of occurances of 0x01
-** is N(1), and so forth up to the number of occurances of 0xff is N(255).
-** An offset of 0 is not allowed so we don't have to test it. The number
-** of escapes required for an offset of 1 is N(1)+N(2)+N(40). The number
-** of escapes required for an offset of 2 is N(2)+N(3)+N(41). And so forth.
-** In this way we find the offset that gives the minimum number of escapes,
-** and thus minimizes the length of the output string.
-*/
-
-/*
-** Encode a binary buffer "in" of size n bytes so that it contains
-** no instances of characters '\'' or '\000'. The output is
-** null-terminated and can be used as a string value in an INSERT
-** or UPDATE statement. Use sqlite_decode_binary() to convert the
-** string back into its original binary.
-**
-** The result is written into a preallocated output buffer "out".
-** "out" must be able to hold at least 2 +(257*n)/254 bytes.
-** In other words, the output will be expanded by as much as 3
-** bytes for every 254 bytes of input plus 2 bytes of fixed overhead.
-** (This is approximately 2 + 1.0118*n or about a 1.2% size increase.)
-**
-** The return value is the number of characters in the encoded
-** string, excluding the "\000" terminator.
-**
-** If out==NULL then no output is generated but the routine still returns
-** the number of characters that would have been generated if out had
-** not been NULL.
-*/
-int sqlite_encode_binary(const unsigned char *in, int n, unsigned char *out){
- int i, j, e, m;
- unsigned char x;
- int cnt[256];
- if( n<=0 ){
- if( out ){
- out[0] = 'x';
- out[1] = 0;
- }
- return 1;
- }
- memset(cnt, 0, sizeof(cnt));
- for(i=n-1; i>=0; i--){ cnt[in[i]]++; }
- m = n;
- for(i=1; i<256; i++){
- int sum;
- if( i=='\'' ) continue;
- sum = cnt[i] + cnt[(i+1)&0xff] + cnt[(i+'\'')&0xff];
- if( sum<m ){
- m = sum;
- e = i;
- if( m==0 ) break;
- }
- }
- if( out==0 ){
- return n+m+1;
- }
- out[0] = e;
- j = 1;
- for(i=0; i<n; i++){
- x = in[i] - e;
- if( x==0 || x==1 || x=='\''){
- out[j++] = 1;
- x++;
- }
- out[j++] = x;
- }
- out[j] = 0;
- assert( j==n+m+1 );
- return j;
-}
-
-/*
-** Decode the string "in" into binary data and write it into "out".
-** This routine reverses the encoding created by sqlite_encode_binary().
-** The output will always be a few bytes less than the input. The number
-** of bytes of output is returned. If the input is not a well-formed
-** encoding, -1 is returned.
-**
-** The "in" and "out" parameters may point to the same buffer in order
-** to decode a string in place.
-*/
-int sqlite_decode_binary(const unsigned char *in, unsigned char *out){
- int i, e;
- unsigned char c;
- e = *(in++);
- i = 0;
- while( (c = *(in++))!=0 ){
- if( c==1 ){
- c = *(in++) - 1;
- }
- out[i++] = c + e;
- }
- return i;
-}
-
-#ifdef ENCODER_TEST
-#include <stdio.h>
-/*
-** The subroutines above are not tested by the usual test suite. To test
-** these routines, compile just this one file with a -DENCODER_TEST=1 option
-** and run the result.
-*/
-int main(int argc, char **argv){
- int i, j, n, m, nOut, nByteIn, nByteOut;
- unsigned char in[30000];
- unsigned char out[33000];
-
- nByteIn = nByteOut = 0;
- for(i=0; i<sizeof(in); i++){
- printf("Test %d: ", i+1);
- n = rand() % (i+1);
- if( i%100==0 ){
- int k;
- for(j=k=0; j<n; j++){
- /* if( k==0 || k=='\'' ) k++; */
- in[j] = k;
- k = (k+1)&0xff;
- }
- }else{
- for(j=0; j<n; j++) in[j] = rand() & 0xff;
- }
- nByteIn += n;
- nOut = sqlite_encode_binary(in, n, out);
- nByteOut += nOut;
- if( nOut!=strlen(out) ){
- printf(" ERROR return value is %d instead of %d\n", nOut, strlen(out));
- exit(1);
- }
- if( nOut!=sqlite_encode_binary(in, n, 0) ){
- printf(" ERROR actual output size disagrees with predicted size\n");
- exit(1);
- }
- m = (256*n + 1262)/253;
- printf("size %d->%d (max %d)", n, strlen(out)+1, m);
- if( strlen(out)+1>m ){
- printf(" ERROR output too big\n");
- exit(1);
- }
- for(j=0; out[j]; j++){
- if( out[j]=='\'' ){
- printf(" ERROR contains (')\n");
- exit(1);
- }
- }
- j = sqlite_decode_binary(out, out);
- if( j!=n ){
- printf(" ERROR decode size %d\n", j);
- exit(1);
- }
- if( memcmp(in, out, n)!=0 ){
- printf(" ERROR decode mismatch\n");
- exit(1);
- }
- printf(" OK\n");
- }
- fprintf(stderr,"Finished. Total encoding: %d->%d bytes\n",
- nByteIn, nByteOut);
- fprintf(stderr,"Avg size increase: %.3f%%\n",
- (nByteOut-nByteIn)*100.0/(double)nByteIn);
-}
-#endif /* ENCODER_TEST */
+++ /dev/null
-/*
-** 2001 September 15
-**
-** The author disclaims copyright to this source code. In place of
-** a legal notice, here is a blessing:
-**
-** May you do good and not evil.
-** May you find forgiveness for yourself and forgive others.
-** May you share freely, never taking more than you give.
-**
-*************************************************************************
-** This file contains routines used for analyzing expressions and
-** for generating VDBE code that evaluates expressions in SQLite.
-**
-** $Id: expr.c,v 1.1.1.1 2004/08/08 15:03:57 matt Exp $
-*/
-#include "sqliteInt.h"
-#include <ctype.h>
-
-/*
-** Construct a new expression node and return a pointer to it. Memory
-** for this node is obtained from sqliteMalloc(). The calling function
-** is responsible for making sure the node eventually gets freed.
-*/
-Expr *sqliteExpr(int op, Expr *pLeft, Expr *pRight, Token *pToken){
- Expr *pNew;
- pNew = sqliteMalloc( sizeof(Expr) );
- if( pNew==0 ){
- /* When malloc fails, we leak memory from pLeft and pRight */
- return 0;
- }
- pNew->op = op;
- pNew->pLeft = pLeft;
- pNew->pRight = pRight;
- if( pToken ){
- assert( pToken->dyn==0 );
- pNew->token = *pToken;
- pNew->span = *pToken;
- }else{
- assert( pNew->token.dyn==0 );
- assert( pNew->token.z==0 );
- assert( pNew->token.n==0 );
- if( pLeft && pRight ){
- sqliteExprSpan(pNew, &pLeft->span, &pRight->span);
- }else{
- pNew->span = pNew->token;
- }
- }
- return pNew;
-}
-
-/*
-** Set the Expr.span field of the given expression to span all
-** text between the two given tokens.
-*/
-void sqliteExprSpan(Expr *pExpr, Token *pLeft, Token *pRight){
- assert( pRight!=0 );
- assert( pLeft!=0 );
- /* Note: pExpr might be NULL due to a prior malloc failure */
- if( pExpr && pRight->z && pLeft->z ){
- if( pLeft->dyn==0 && pRight->dyn==0 ){
- pExpr->span.z = pLeft->z;
- pExpr->span.n = pRight->n + Addr(pRight->z) - Addr(pLeft->z);
- }else{
- pExpr->span.z = 0;
- }
- }
-}
-
-/*
-** Construct a new expression node for a function with multiple
-** arguments.
-*/
-Expr *sqliteExprFunction(ExprList *pList, Token *pToken){
- Expr *pNew;
- pNew = sqliteMalloc( sizeof(Expr) );
- if( pNew==0 ){
- /* sqliteExprListDelete(pList); // Leak pList when malloc fails */
- return 0;
- }
- pNew->op = TK_FUNCTION;
- pNew->pList = pList;
- if( pToken ){
- assert( pToken->dyn==0 );
- pNew->token = *pToken;
- }else{
- pNew->token.z = 0;
- }
- pNew->span = pNew->token;
- return pNew;
-}
-
-/*
-** Recursively delete an expression tree.
-*/
-void sqliteExprDelete(Expr *p){
- if( p==0 ) return;
- if( p->span.dyn ) sqliteFree((char*)p->span.z);
- if( p->token.dyn ) sqliteFree((char*)p->token.z);
- sqliteExprDelete(p->pLeft);
- sqliteExprDelete(p->pRight);
- sqliteExprListDelete(p->pList);
- sqliteSelectDelete(p->pSelect);
- sqliteFree(p);
-}
-
-
-/*
-** The following group of routines make deep copies of expressions,
-** expression lists, ID lists, and select statements. The copies can
-** be deleted (by being passed to their respective ...Delete() routines)
-** without effecting the originals.
-**
-** The expression list, ID, and source lists return by sqliteExprListDup(),
-** sqliteIdListDup(), and sqliteSrcListDup() can not be further expanded
-** by subsequent calls to sqlite*ListAppend() routines.
-**
-** Any tables that the SrcList might point to are not duplicated.
-*/
-Expr *sqliteExprDup(Expr *p){
- Expr *pNew;
- if( p==0 ) return 0;
- pNew = sqliteMallocRaw( sizeof(*p) );
- if( pNew==0 ) return 0;
- memcpy(pNew, p, sizeof(*pNew));
- if( p->token.z!=0 ){
- pNew->token.z = sqliteStrDup(p->token.z);
- pNew->token.dyn = 1;
- }else{
- assert( pNew->token.z==0 );
- }
- pNew->span.z = 0;
- pNew->pLeft = sqliteExprDup(p->pLeft);
- pNew->pRight = sqliteExprDup(p->pRight);
- pNew->pList = sqliteExprListDup(p->pList);
- pNew->pSelect = sqliteSelectDup(p->pSelect);
- return pNew;
-}
-void sqliteTokenCopy(Token *pTo, Token *pFrom){
- if( pTo->dyn ) sqliteFree((char*)pTo->z);
- if( pFrom->z ){
- pTo->n = pFrom->n;
- pTo->z = sqliteStrNDup(pFrom->z, pFrom->n);
- pTo->dyn = 1;
- }else{
- pTo->z = 0;
- }
-}
-ExprList *sqliteExprListDup(ExprList *p){
- ExprList *pNew;
- struct ExprList_item *pItem;
- int i;
- if( p==0 ) return 0;
- pNew = sqliteMalloc( sizeof(*pNew) );
- if( pNew==0 ) return 0;
- pNew->nExpr = pNew->nAlloc = p->nExpr;
- pNew->a = pItem = sqliteMalloc( p->nExpr*sizeof(p->a[0]) );
- if( pItem==0 ){
- sqliteFree(pNew);
- return 0;
- }
- for(i=0; i<p->nExpr; i++, pItem++){
- Expr *pNewExpr, *pOldExpr;
- pItem->pExpr = pNewExpr = sqliteExprDup(pOldExpr = p->a[i].pExpr);
- if( pOldExpr->span.z!=0 && pNewExpr ){
- /* Always make a copy of the span for top-level expressions in the
- ** expression list. The logic in SELECT processing that determines
- ** the names of columns in the result set needs this information */
- sqliteTokenCopy(&pNewExpr->span, &pOldExpr->span);
- }
- assert( pNewExpr==0 || pNewExpr->span.z!=0
- || pOldExpr->span.z==0 || sqlite_malloc_failed );
- pItem->zName = sqliteStrDup(p->a[i].zName);
- pItem->sortOrder = p->a[i].sortOrder;
- pItem->isAgg = p->a[i].isAgg;
- pItem->done = 0;
- }
- return pNew;
-}
-SrcList *sqliteSrcListDup(SrcList *p){
- SrcList *pNew;
- int i;
- int nByte;
- if( p==0 ) return 0;
- nByte = sizeof(*p) + (p->nSrc>0 ? sizeof(p->a[0]) * (p->nSrc-1) : 0);
- pNew = sqliteMallocRaw( nByte );
- if( pNew==0 ) return 0;
- pNew->nSrc = pNew->nAlloc = p->nSrc;
- for(i=0; i<p->nSrc; i++){
- struct SrcList_item *pNewItem = &pNew->a[i];
- struct SrcList_item *pOldItem = &p->a[i];
- pNewItem->zDatabase = sqliteStrDup(pOldItem->zDatabase);
- pNewItem->zName = sqliteStrDup(pOldItem->zName);
- pNewItem->zAlias = sqliteStrDup(pOldItem->zAlias);
- pNewItem->jointype = pOldItem->jointype;
- pNewItem->iCursor = pOldItem->iCursor;
- pNewItem->pTab = 0;
- pNewItem->pSelect = sqliteSelectDup(pOldItem->pSelect);
- pNewItem->pOn = sqliteExprDup(pOldItem->pOn);
- pNewItem->pUsing = sqliteIdListDup(pOldItem->pUsing);
- }
- return pNew;
-}
-IdList *sqliteIdListDup(IdList *p){
- IdList *pNew;
- int i;
- if( p==0 ) return 0;
- pNew = sqliteMallocRaw( sizeof(*pNew) );
- if( pNew==0 ) return 0;
- pNew->nId = pNew->nAlloc = p->nId;
- pNew->a = sqliteMallocRaw( p->nId*sizeof(p->a[0]) );
- if( pNew->a==0 ) return 0;
- for(i=0; i<p->nId; i++){
- struct IdList_item *pNewItem = &pNew->a[i];
- struct IdList_item *pOldItem = &p->a[i];
- pNewItem->zName = sqliteStrDup(pOldItem->zName);
- pNewItem->idx = pOldItem->idx;
- }
- return pNew;
-}
-Select *sqliteSelectDup(Select *p){
- Select *pNew;
- if( p==0 ) return 0;
- pNew = sqliteMallocRaw( sizeof(*p) );
- if( pNew==0 ) return 0;
- pNew->isDistinct = p->isDistinct;
- pNew->pEList = sqliteExprListDup(p->pEList);
- pNew->pSrc = sqliteSrcListDup(p->pSrc);
- pNew->pWhere = sqliteExprDup(p->pWhere);
- pNew->pGroupBy = sqliteExprListDup(p->pGroupBy);
- pNew->pHaving = sqliteExprDup(p->pHaving);
- pNew->pOrderBy = sqliteExprListDup(p->pOrderBy);
- pNew->op = p->op;
- pNew->pPrior = sqliteSelectDup(p->pPrior);
- pNew->nLimit = p->nLimit;
- pNew->nOffset = p->nOffset;
- pNew->zSelect = 0;
- pNew->iLimit = -1;
- pNew->iOffset = -1;
- return pNew;
-}
-
-
-/*
-** Add a new element to the end of an expression list. If pList is
-** initially NULL, then create a new expression list.
-*/
-ExprList *sqliteExprListAppend(ExprList *pList, Expr *pExpr, Token *pName){
- if( pList==0 ){
- pList = sqliteMalloc( sizeof(ExprList) );
- if( pList==0 ){
- /* sqliteExprDelete(pExpr); // Leak memory if malloc fails */
- return 0;
- }
- assert( pList->nAlloc==0 );
- }
- if( pList->nAlloc<=pList->nExpr ){
- pList->nAlloc = pList->nAlloc*2 + 4;
- pList->a = sqliteRealloc(pList->a, pList->nAlloc*sizeof(pList->a[0]));
- if( pList->a==0 ){
- /* sqliteExprDelete(pExpr); // Leak memory if malloc fails */
- pList->nExpr = pList->nAlloc = 0;
- return pList;
- }
- }
- assert( pList->a!=0 );
- if( pExpr || pName ){
- struct ExprList_item *pItem = &pList->a[pList->nExpr++];
- memset(pItem, 0, sizeof(*pItem));
- pItem->pExpr = pExpr;
- if( pName ){
- sqliteSetNString(&pItem->zName, pName->z, pName->n, 0);
- sqliteDequote(pItem->zName);
- }
- }
- return pList;
-}
-
-/*
-** Delete an entire expression list.
-*/
-void sqliteExprListDelete(ExprList *pList){
- int i;
- if( pList==0 ) return;
- assert( pList->a!=0 || (pList->nExpr==0 && pList->nAlloc==0) );
- assert( pList->nExpr<=pList->nAlloc );
- for(i=0; i<pList->nExpr; i++){
- sqliteExprDelete(pList->a[i].pExpr);
- sqliteFree(pList->a[i].zName);
- }
- sqliteFree(pList->a);
- sqliteFree(pList);
-}
-
-/*
-** Walk an expression tree. Return 1 if the expression is constant
-** and 0 if it involves variables.
-**
-** For the purposes of this function, a double-quoted string (ex: "abc")
-** is considered a variable but a single-quoted string (ex: 'abc') is
-** a constant.
-*/
-int sqliteExprIsConstant(Expr *p){
- switch( p->op ){
- case TK_ID:
- case TK_COLUMN:
- case TK_DOT:
- case TK_FUNCTION:
- return 0;
- case TK_NULL:
- case TK_STRING:
- case TK_INTEGER:
- case TK_FLOAT:
- case TK_VARIABLE:
- return 1;
- default: {
- if( p->pLeft && !sqliteExprIsConstant(p->pLeft) ) return 0;
- if( p->pRight && !sqliteExprIsConstant(p->pRight) ) return 0;
- if( p->pList ){
- int i;
- for(i=0; i<p->pList->nExpr; i++){
- if( !sqliteExprIsConstant(p->pList->a[i].pExpr) ) return 0;
- }
- }
- return p->pLeft!=0 || p->pRight!=0 || (p->pList && p->pList->nExpr>0);
- }
- }
- return 0;
-}
-
-/*
-** If the given expression codes a constant integer that is small enough
-** to fit in a 32-bit integer, return 1 and put the value of the integer
-** in *pValue. If the expression is not an integer or if it is too big
-** to fit in a signed 32-bit integer, return 0 and leave *pValue unchanged.
-*/
-int sqliteExprIsInteger(Expr *p, int *pValue){
- switch( p->op ){
- case TK_INTEGER: {
- if( sqliteFitsIn32Bits(p->token.z) ){
- *pValue = atoi(p->token.z);
- return 1;
- }
- break;
- }
- case TK_STRING: {
- const char *z = p->token.z;
- int n = p->token.n;
- if( n>0 && z[0]=='-' ){ z++; n--; }
- while( n>0 && *z && isdigit(*z) ){ z++; n--; }
- if( n==0 && sqliteFitsIn32Bits(p->token.z) ){
- *pValue = atoi(p->token.z);
- return 1;
- }
- break;
- }
- case TK_UPLUS: {
- return sqliteExprIsInteger(p->pLeft, pValue);
- }
- case TK_UMINUS: {
- int v;
- if( sqliteExprIsInteger(p->pLeft, &v) ){
- *pValue = -v;
- return 1;
- }
- break;
- }
- default: break;
- }
- return 0;
-}
-
-/*
-** Return TRUE if the given string is a row-id column name.
-*/
-int sqliteIsRowid(const char *z){
- if( sqliteStrICmp(z, "_ROWID_")==0 ) return 1;
- if( sqliteStrICmp(z, "ROWID")==0 ) return 1;
- if( sqliteStrICmp(z, "OID")==0 ) return 1;
- return 0;
-}
-
-/*
-** Given the name of a column of the form X.Y.Z or Y.Z or just Z, look up
-** that name in the set of source tables in pSrcList and make the pExpr
-** expression node refer back to that source column. The following changes
-** are made to pExpr:
-**
-** pExpr->iDb Set the index in db->aDb[] of the database holding
-** the table.
-** pExpr->iTable Set to the cursor number for the table obtained
-** from pSrcList.
-** pExpr->iColumn Set to the column number within the table.
-** pExpr->dataType Set to the appropriate data type for the column.
-** pExpr->op Set to TK_COLUMN.
-** pExpr->pLeft Any expression this points to is deleted
-** pExpr->pRight Any expression this points to is deleted.
-**
-** The pDbToken is the name of the database (the "X"). This value may be
-** NULL meaning that name is of the form Y.Z or Z. Any available database
-** can be used. The pTableToken is the name of the table (the "Y"). This
-** value can be NULL if pDbToken is also NULL. If pTableToken is NULL it
-** means that the form of the name is Z and that columns from any table
-** can be used.
-**
-** If the name cannot be resolved unambiguously, leave an error message
-** in pParse and return non-zero. Return zero on success.
-*/
-static int lookupName(
- Parse *pParse, /* The parsing context */
- Token *pDbToken, /* Name of the database containing table, or NULL */
- Token *pTableToken, /* Name of table containing column, or NULL */
- Token *pColumnToken, /* Name of the column. */
- SrcList *pSrcList, /* List of tables used to resolve column names */
- ExprList *pEList, /* List of expressions used to resolve "AS" */
- Expr *pExpr /* Make this EXPR node point to the selected column */
-){
- char *zDb = 0; /* Name of the database. The "X" in X.Y.Z */
- char *zTab = 0; /* Name of the table. The "Y" in X.Y.Z or Y.Z */
- char *zCol = 0; /* Name of the column. The "Z" */
- int i, j; /* Loop counters */
- int cnt = 0; /* Number of matching column names */
- int cntTab = 0; /* Number of matching table names */
- sqlite *db = pParse->db; /* The database */
-
- assert( pColumnToken && pColumnToken->z ); /* The Z in X.Y.Z cannot be NULL */
- if( pDbToken && pDbToken->z ){
- zDb = sqliteStrNDup(pDbToken->z, pDbToken->n);
- sqliteDequote(zDb);
- }else{
- zDb = 0;
- }
- if( pTableToken && pTableToken->z ){
- zTab = sqliteStrNDup(pTableToken->z, pTableToken->n);
- sqliteDequote(zTab);
- }else{
- assert( zDb==0 );
- zTab = 0;
- }
- zCol = sqliteStrNDup(pColumnToken->z, pColumnToken->n);
- sqliteDequote(zCol);
- if( sqlite_malloc_failed ){
- return 1; /* Leak memory (zDb and zTab) if malloc fails */
- }
- assert( zTab==0 || pEList==0 );
-
- pExpr->iTable = -1;
- for(i=0; i<pSrcList->nSrc; i++){
- struct SrcList_item *pItem = &pSrcList->a[i];
- Table *pTab = pItem->pTab;
- Column *pCol;
-
- if( pTab==0 ) continue;
- assert( pTab->nCol>0 );
- if( zTab ){
- if( pItem->zAlias ){
- char *zTabName = pItem->zAlias;
- if( sqliteStrICmp(zTabName, zTab)!=0 ) continue;
- }else{
- char *zTabName = pTab->zName;
- if( zTabName==0 || sqliteStrICmp(zTabName, zTab)!=0 ) continue;
- if( zDb!=0 && sqliteStrICmp(db->aDb[pTab->iDb].zName, zDb)!=0 ){
- continue;
- }
- }
- }
- if( 0==(cntTab++) ){
- pExpr->iTable = pItem->iCursor;
- pExpr->iDb = pTab->iDb;
- }
- for(j=0, pCol=pTab->aCol; j<pTab->nCol; j++, pCol++){
- if( sqliteStrICmp(pCol->zName, zCol)==0 ){
- cnt++;
- pExpr->iTable = pItem->iCursor;
- pExpr->iDb = pTab->iDb;
- /* Substitute the rowid (column -1) for the INTEGER PRIMARY KEY */
- pExpr->iColumn = j==pTab->iPKey ? -1 : j;
- pExpr->dataType = pCol->sortOrder & SQLITE_SO_TYPEMASK;
- break;
- }
- }
- }
-
- /* If we have not already resolved the name, then maybe
- ** it is a new.* or old.* trigger argument reference
- */
- if( zDb==0 && zTab!=0 && cnt==0 && pParse->trigStack!=0 ){
- TriggerStack *pTriggerStack = pParse->trigStack;
- Table *pTab = 0;
- if( pTriggerStack->newIdx != -1 && sqliteStrICmp("new", zTab) == 0 ){
- pExpr->iTable = pTriggerStack->newIdx;
- assert( pTriggerStack->pTab );
- pTab = pTriggerStack->pTab;
- }else if( pTriggerStack->oldIdx != -1 && sqliteStrICmp("old", zTab) == 0 ){
- pExpr->iTable = pTriggerStack->oldIdx;
- assert( pTriggerStack->pTab );
- pTab = pTriggerStack->pTab;
- }
-
- if( pTab ){
- int j;
- Column *pCol = pTab->aCol;
-
- pExpr->iDb = pTab->iDb;
- cntTab++;
- for(j=0; j < pTab->nCol; j++, pCol++) {
- if( sqliteStrICmp(pCol->zName, zCol)==0 ){
- cnt++;
- pExpr->iColumn = j==pTab->iPKey ? -1 : j;
- pExpr->dataType = pCol->sortOrder & SQLITE_SO_TYPEMASK;
- break;
- }
- }
- }
- }
-
- /*
- ** Perhaps the name is a reference to the ROWID
- */
- if( cnt==0 && cntTab==1 && sqliteIsRowid(zCol) ){
- cnt = 1;
- pExpr->iColumn = -1;
- pExpr->dataType = SQLITE_SO_NUM;
- }
-
- /*
- ** If the input is of the form Z (not Y.Z or X.Y.Z) then the name Z
- ** might refer to an result-set alias. This happens, for example, when
- ** we are resolving names in the WHERE clause of the following command:
- **
- ** SELECT a+b AS x FROM table WHERE x<10;
- **
- ** In cases like this, replace pExpr with a copy of the expression that
- ** forms the result set entry ("a+b" in the example) and return immediately.
- ** Note that the expression in the result set should have already been
- ** resolved by the time the WHERE clause is resolved.
- */
- if( cnt==0 && pEList!=0 ){
- for(j=0; j<pEList->nExpr; j++){
- char *zAs = pEList->a[j].zName;
- if( zAs!=0 && sqliteStrICmp(zAs, zCol)==0 ){
- assert( pExpr->pLeft==0 && pExpr->pRight==0 );
- pExpr->op = TK_AS;
- pExpr->iColumn = j;
- pExpr->pLeft = sqliteExprDup(pEList->a[j].pExpr);
- sqliteFree(zCol);
- assert( zTab==0 && zDb==0 );
- return 0;
- }
- }
- }
-
- /*
- ** If X and Y are NULL (in other words if only the column name Z is
- ** supplied) and the value of Z is enclosed in double-quotes, then
- ** Z is a string literal if it doesn't match any column names. In that
- ** case, we need to return right away and not make any changes to
- ** pExpr.
- */
- if( cnt==0 && zTab==0 && pColumnToken->z[0]=='"' ){
- sqliteFree(zCol);
- return 0;
- }
-
- /*
- ** cnt==0 means there was not match. cnt>1 means there were two or
- ** more matches. Either way, we have an error.
- */
- if( cnt!=1 ){
- char *z = 0;
- char *zErr;
- zErr = cnt==0 ? "no such column: %s" : "ambiguous column name: %s";
- if( zDb ){
- sqliteSetString(&z, zDb, ".", zTab, ".", zCol, 0);
- }else if( zTab ){
- sqliteSetString(&z, zTab, ".", zCol, 0);
- }else{
- z = sqliteStrDup(zCol);
- }
- sqliteErrorMsg(pParse, zErr, z);
- sqliteFree(z);
- }
-
- /* Clean up and return
- */
- sqliteFree(zDb);
- sqliteFree(zTab);
- sqliteFree(zCol);
- sqliteExprDelete(pExpr->pLeft);
- pExpr->pLeft = 0;
- sqliteExprDelete(pExpr->pRight);
- pExpr->pRight = 0;
- pExpr->op = TK_COLUMN;
- sqliteAuthRead(pParse, pExpr, pSrcList);
- return cnt!=1;
-}
-
-/*
-** This routine walks an expression tree and resolves references to
-** table columns. Nodes of the form ID.ID or ID resolve into an
-** index to the table in the table list and a column offset. The
-** Expr.opcode for such nodes is changed to TK_COLUMN. The Expr.iTable
-** value is changed to the index of the referenced table in pTabList
-** plus the "base" value. The base value will ultimately become the
-** VDBE cursor number for a cursor that is pointing into the referenced
-** table. The Expr.iColumn value is changed to the index of the column
-** of the referenced table. The Expr.iColumn value for the special
-** ROWID column is -1. Any INTEGER PRIMARY KEY column is tried as an
-** alias for ROWID.
-**
-** We also check for instances of the IN operator. IN comes in two
-** forms:
-**
-** expr IN (exprlist)
-** and
-** expr IN (SELECT ...)
-**
-** The first form is handled by creating a set holding the list
-** of allowed values. The second form causes the SELECT to generate
-** a temporary table.
-**
-** This routine also looks for scalar SELECTs that are part of an expression.
-** If it finds any, it generates code to write the value of that select
-** into a memory cell.
-**
-** Unknown columns or tables provoke an error. The function returns
-** the number of errors seen and leaves an error message on pParse->zErrMsg.
-*/
-int sqliteExprResolveIds(
- Parse *pParse, /* The parser context */
- SrcList *pSrcList, /* List of tables used to resolve column names */
- ExprList *pEList, /* List of expressions used to resolve "AS" */
- Expr *pExpr /* The expression to be analyzed. */
-){
- int i;
-
- if( pExpr==0 || pSrcList==0 ) return 0;
- for(i=0; i<pSrcList->nSrc; i++){
- assert( pSrcList->a[i].iCursor>=0 && pSrcList->a[i].iCursor<pParse->nTab );
- }
- switch( pExpr->op ){
- /* Double-quoted strings (ex: "abc") are used as identifiers if
- ** possible. Otherwise they remain as strings. Single-quoted
- ** strings (ex: 'abc') are always string literals.
- */
- case TK_STRING: {
- if( pExpr->token.z[0]=='\'' ) break;
- /* Fall thru into the TK_ID case if this is a double-quoted string */
- }
- /* A lone identifier is the name of a columnd.
- */
- case TK_ID: {
- if( lookupName(pParse, 0, 0, &pExpr->token, pSrcList, pEList, pExpr) ){
- return 1;
- }
- break;
- }
-
- /* A table name and column name: ID.ID
- ** Or a database, table and column: ID.ID.ID
- */
- case TK_DOT: {
- Token *pColumn;
- Token *pTable;
- Token *pDb;
- Expr *pRight;
-
- pRight = pExpr->pRight;
- if( pRight->op==TK_ID ){
- pDb = 0;
- pTable = &pExpr->pLeft->token;
- pColumn = &pRight->token;
- }else{
- assert( pRight->op==TK_DOT );
- pDb = &pExpr->pLeft->token;
- pTable = &pRight->pLeft->token;
- pColumn = &pRight->pRight->token;
- }
- if( lookupName(pParse, pDb, pTable, pColumn, pSrcList, 0, pExpr) ){
- return 1;
- }
- break;
- }
-
- case TK_IN: {
- Vdbe *v = sqliteGetVdbe(pParse);
- if( v==0 ) return 1;
- if( sqliteExprResolveIds(pParse, pSrcList, pEList, pExpr->pLeft) ){
- return 1;
- }
- if( pExpr->pSelect ){
- /* Case 1: expr IN (SELECT ...)
- **
- ** Generate code to write the results of the select into a temporary
- ** table. The cursor number of the temporary table has already
- ** been put in iTable by sqliteExprResolveInSelect().
- */
- pExpr->iTable = pParse->nTab++;
- sqliteVdbeAddOp(v, OP_OpenTemp, pExpr->iTable, 1);
- sqliteSelect(pParse, pExpr->pSelect, SRT_Set, pExpr->iTable, 0,0,0);
- }else if( pExpr->pList ){
- /* Case 2: expr IN (exprlist)
- **
- ** Create a set to put the exprlist values in. The Set id is stored
- ** in iTable.
- */
- int i, iSet;
- for(i=0; i<pExpr->pList->nExpr; i++){
- Expr *pE2 = pExpr->pList->a[i].pExpr;
- if( !sqliteExprIsConstant(pE2) ){
- sqliteErrorMsg(pParse,
- "right-hand side of IN operator must be constant");
- return 1;
- }
- if( sqliteExprCheck(pParse, pE2, 0, 0) ){
- return 1;
- }
- }
- iSet = pExpr->iTable = pParse->nSet++;
- for(i=0; i<pExpr->pList->nExpr; i++){
- Expr *pE2 = pExpr->pList->a[i].pExpr;
- switch( pE2->op ){
- case TK_FLOAT:
- case TK_INTEGER:
- case TK_STRING: {
- int addr;
- assert( pE2->token.z );
- addr = sqliteVdbeOp3(v, OP_SetInsert, iSet, 0,
- pE2->token.z, pE2->token.n);
- sqliteVdbeDequoteP3(v, addr);
- break;
- }
- default: {
- sqliteExprCode(pParse, pE2);
- sqliteVdbeAddOp(v, OP_SetInsert, iSet, 0);
- break;
- }
- }
- }
- }
- break;
- }
-
- case TK_SELECT: {
- /* This has to be a scalar SELECT. Generate code to put the
- ** value of this select in a memory cell and record the number
- ** of the memory cell in iColumn.
- */
- pExpr->iColumn = pParse->nMem++;
- if( sqliteSelect(pParse, pExpr->pSelect, SRT_Mem, pExpr->iColumn,0,0,0) ){
- return 1;
- }
- break;
- }
-
- /* For all else, just recursively walk the tree */
- default: {
- if( pExpr->pLeft
- && sqliteExprResolveIds(pParse, pSrcList, pEList, pExpr->pLeft) ){
- return 1;
- }
- if( pExpr->pRight
- && sqliteExprResolveIds(pParse, pSrcList, pEList, pExpr->pRight) ){
- return 1;
- }
- if( pExpr->pList ){
- int i;
- ExprList *pList = pExpr->pList;
- for(i=0; i<pList->nExpr; i++){
- Expr *pArg = pList->a[i].pExpr;
- if( sqliteExprResolveIds(pParse, pSrcList, pEList, pArg) ){
- return 1;
- }
- }
- }
- }
- }
- return 0;
-}
-
-/*
-** pExpr is a node that defines a function of some kind. It might
-** be a syntactic function like "count(x)" or it might be a function
-** that implements an operator, like "a LIKE b".
-**
-** This routine makes *pzName point to the name of the function and
-** *pnName hold the number of characters in the function name.
-*/
-static void getFunctionName(Expr *pExpr, const char **pzName, int *pnName){
- switch( pExpr->op ){
- case TK_FUNCTION: {
- *pzName = pExpr->token.z;
- *pnName = pExpr->token.n;
- break;
- }
- case TK_LIKE: {
- *pzName = "like";
- *pnName = 4;
- break;
- }
- case TK_GLOB: {
- *pzName = "glob";
- *pnName = 4;
- break;
- }
- default: {
- *pzName = "can't happen";
- *pnName = 12;
- break;
- }
- }
-}
-
-/*
-** Error check the functions in an expression. Make sure all
-** function names are recognized and all functions have the correct
-** number of arguments. Leave an error message in pParse->zErrMsg
-** if anything is amiss. Return the number of errors.
-**
-** if pIsAgg is not null and this expression is an aggregate function
-** (like count(*) or max(value)) then write a 1 into *pIsAgg.
-*/
-int sqliteExprCheck(Parse *pParse, Expr *pExpr, int allowAgg, int *pIsAgg){
- int nErr = 0;
- if( pExpr==0 ) return 0;
- switch( pExpr->op ){
- case TK_GLOB:
- case TK_LIKE:
- case TK_FUNCTION: {
- int n = pExpr->pList ? pExpr->pList->nExpr : 0; /* Number of arguments */
- int no_such_func = 0; /* True if no such function exists */
- int wrong_num_args = 0; /* True if wrong number of arguments */
- int is_agg = 0; /* True if is an aggregate function */
- int i;
- int nId; /* Number of characters in function name */
- const char *zId; /* The function name. */
- FuncDef *pDef;
-
- getFunctionName(pExpr, &zId, &nId);
- pDef = sqliteFindFunction(pParse->db, zId, nId, n, 0);
- if( pDef==0 ){
- pDef = sqliteFindFunction(pParse->db, zId, nId, -1, 0);
- if( pDef==0 ){
- no_such_func = 1;
- }else{
- wrong_num_args = 1;
- }
- }else{
- is_agg = pDef->xFunc==0;
- }
- if( is_agg && !allowAgg ){
- sqliteErrorMsg(pParse, "misuse of aggregate function %.*s()", nId, zId);
- nErr++;
- is_agg = 0;
- }else if( no_such_func ){
- sqliteErrorMsg(pParse, "no such function: %.*s", nId, zId);
- nErr++;
- }else if( wrong_num_args ){
- sqliteErrorMsg(pParse,"wrong number of arguments to function %.*s()",
- nId, zId);
- nErr++;
- }
- if( is_agg ){
- pExpr->op = TK_AGG_FUNCTION;
- if( pIsAgg ) *pIsAgg = 1;
- }
- for(i=0; nErr==0 && i<n; i++){
- nErr = sqliteExprCheck(pParse, pExpr->pList->a[i].pExpr,
- allowAgg && !is_agg, pIsAgg);
- }
- if( pDef==0 ){
- /* Already reported an error */
- }else if( pDef->dataType>=0 ){
- if( pDef->dataType<n ){
- pExpr->dataType =
- sqliteExprType(pExpr->pList->a[pDef->dataType].pExpr);
- }else{
- pExpr->dataType = SQLITE_SO_NUM;
- }
- }else if( pDef->dataType==SQLITE_ARGS ){
- pDef->dataType = SQLITE_SO_TEXT;
- for(i=0; i<n; i++){
- if( sqliteExprType(pExpr->pList->a[i].pExpr)==SQLITE_SO_NUM ){
- pExpr->dataType = SQLITE_SO_NUM;
- break;
- }
- }
- }else if( pDef->dataType==SQLITE_NUMERIC ){
- pExpr->dataType = SQLITE_SO_NUM;
- }else{
- pExpr->dataType = SQLITE_SO_TEXT;
- }
- }
- default: {
- if( pExpr->pLeft ){
- nErr = sqliteExprCheck(pParse, pExpr->pLeft, allowAgg, pIsAgg);
- }
- if( nErr==0 && pExpr->pRight ){
- nErr = sqliteExprCheck(pParse, pExpr->pRight, allowAgg, pIsAgg);
- }
- if( nErr==0 && pExpr->pList ){
- int n = pExpr->pList->nExpr;
- int i;
- for(i=0; nErr==0 && i<n; i++){
- Expr *pE2 = pExpr->pList->a[i].pExpr;
- nErr = sqliteExprCheck(pParse, pE2, allowAgg, pIsAgg);
- }
- }
- break;
- }
- }
- return nErr;
-}
-
-/*
-** Return either SQLITE_SO_NUM or SQLITE_SO_TEXT to indicate whether the
-** given expression should sort as numeric values or as text.
-**
-** The sqliteExprResolveIds() and sqliteExprCheck() routines must have
-** both been called on the expression before it is passed to this routine.
-*/
-int sqliteExprType(Expr *p){
- if( p==0 ) return SQLITE_SO_NUM;
- while( p ) switch( p->op ){
- case TK_PLUS:
- case TK_MINUS:
- case TK_STAR:
- case TK_SLASH:
- case TK_AND:
- case TK_OR:
- case TK_ISNULL:
- case TK_NOTNULL:
- case TK_NOT:
- case TK_UMINUS:
- case TK_UPLUS:
- case TK_BITAND:
- case TK_BITOR:
- case TK_BITNOT:
- case TK_LSHIFT:
- case TK_RSHIFT:
- case TK_REM:
- case TK_INTEGER:
- case TK_FLOAT:
- case TK_IN:
- case TK_BETWEEN:
- case TK_GLOB:
- case TK_LIKE:
- return SQLITE_SO_NUM;
-
- case TK_STRING:
- case TK_NULL:
- case TK_CONCAT:
- case TK_VARIABLE:
- return SQLITE_SO_TEXT;
-
- case TK_LT:
- case TK_LE:
- case TK_GT:
- case TK_GE:
- case TK_NE:
- case TK_EQ:
- if( sqliteExprType(p->pLeft)==SQLITE_SO_NUM ){
- return SQLITE_SO_NUM;
- }
- p = p->pRight;
- break;
-
- case TK_AS:
- p = p->pLeft;
- break;
-
- case TK_COLUMN:
- case TK_FUNCTION:
- case TK_AGG_FUNCTION:
- return p->dataType;
-
- case TK_SELECT:
- assert( p->pSelect );
- assert( p->pSelect->pEList );
- assert( p->pSelect->pEList->nExpr>0 );
- p = p->pSelect->pEList->a[0].pExpr;
- break;
-
- case TK_CASE: {
- if( p->pRight && sqliteExprType(p->pRight)==SQLITE_SO_NUM ){
- return SQLITE_SO_NUM;
- }
- if( p->pList ){
- int i;
- ExprList *pList = p->pList;
- for(i=1; i<pList->nExpr; i+=2){
- if( sqliteExprType(pList->a[i].pExpr)==SQLITE_SO_NUM ){
- return SQLITE_SO_NUM;
- }
- }
- }
- return SQLITE_SO_TEXT;
- }
-
- default:
- assert( p->op==TK_ABORT ); /* Can't Happen */
- break;
- }
- return SQLITE_SO_NUM;
-}
-
-/*
-** Generate code into the current Vdbe to evaluate the given
-** expression and leave the result on the top of stack.
-*/
-void sqliteExprCode(Parse *pParse, Expr *pExpr){
- Vdbe *v = pParse->pVdbe;
- int op;
- if( v==0 || pExpr==0 ) return;
- switch( pExpr->op ){
- case TK_PLUS: op = OP_Add; break;
- case TK_MINUS: op = OP_Subtract; break;
- case TK_STAR: op = OP_Multiply; break;
- case TK_SLASH: op = OP_Divide; break;
- case TK_AND: op = OP_And; break;
- case TK_OR: op = OP_Or; break;
- case TK_LT: op = OP_Lt; break;
- case TK_LE: op = OP_Le; break;
- case TK_GT: op = OP_Gt; break;
- case TK_GE: op = OP_Ge; break;
- case TK_NE: op = OP_Ne; break;
- case TK_EQ: op = OP_Eq; break;
- case TK_ISNULL: op = OP_IsNull; break;
- case TK_NOTNULL: op = OP_NotNull; break;
- case TK_NOT: op = OP_Not; break;
- case TK_UMINUS: op = OP_Negative; break;
- case TK_BITAND: op = OP_BitAnd; break;
- case TK_BITOR: op = OP_BitOr; break;
- case TK_BITNOT: op = OP_BitNot; break;
- case TK_LSHIFT: op = OP_ShiftLeft; break;
- case TK_RSHIFT: op = OP_ShiftRight; break;
- case TK_REM: op = OP_Remainder; break;
- default: break;
- }
- switch( pExpr->op ){
- case TK_COLUMN: {
- if( pParse->useAgg ){
- sqliteVdbeAddOp(v, OP_AggGet, 0, pExpr->iAgg);
- }else if( pExpr->iColumn>=0 ){
- sqliteVdbeAddOp(v, OP_Column, pExpr->iTable, pExpr->iColumn);
- }else{
- sqliteVdbeAddOp(v, OP_Recno, pExpr->iTable, 0);
- }
- break;
- }
- case TK_STRING:
- case TK_FLOAT:
- case TK_INTEGER: {
- if( pExpr->op==TK_INTEGER && sqliteFitsIn32Bits(pExpr->token.z) ){
- sqliteVdbeAddOp(v, OP_Integer, atoi(pExpr->token.z), 0);
- }else{
- sqliteVdbeAddOp(v, OP_String, 0, 0);
- }
- assert( pExpr->token.z );
- sqliteVdbeChangeP3(v, -1, pExpr->token.z, pExpr->token.n);
- sqliteVdbeDequoteP3(v, -1);
- break;
- }
- case TK_NULL: {
- sqliteVdbeAddOp(v, OP_String, 0, 0);
- break;
- }
- case TK_VARIABLE: {
- sqliteVdbeAddOp(v, OP_Variable, pExpr->iTable, 0);
- break;
- }
- case TK_LT:
- case TK_LE:
- case TK_GT:
- case TK_GE:
- case TK_NE:
- case TK_EQ: {
- if( pParse->db->file_format>=4 && sqliteExprType(pExpr)==SQLITE_SO_TEXT ){
- op += 6; /* Convert numeric opcodes to text opcodes */
- }
- /* Fall through into the next case */
- }
- case TK_AND:
- case TK_OR:
- case TK_PLUS:
- case TK_STAR:
- case TK_MINUS:
- case TK_REM:
- case TK_BITAND:
- case TK_BITOR:
- case TK_SLASH: {
- sqliteExprCode(pParse, pExpr->pLeft);
- sqliteExprCode(pParse, pExpr->pRight);
- sqliteVdbeAddOp(v, op, 0, 0);
- break;
- }
- case TK_LSHIFT:
- case TK_RSHIFT: {
- sqliteExprCode(pParse, pExpr->pRight);
- sqliteExprCode(pParse, pExpr->pLeft);
- sqliteVdbeAddOp(v, op, 0, 0);
- break;
- }
- case TK_CONCAT: {
- sqliteExprCode(pParse, pExpr->pLeft);
- sqliteExprCode(pParse, pExpr->pRight);
- sqliteVdbeAddOp(v, OP_Concat, 2, 0);
- break;
- }
- case TK_UMINUS: {
- assert( pExpr->pLeft );
- if( pExpr->pLeft->op==TK_FLOAT || pExpr->pLeft->op==TK_INTEGER ){
- Token *p = &pExpr->pLeft->token;
- char *z = sqliteMalloc( p->n + 2 );
- sprintf(z, "-%.*s", p->n, p->z);
- if( pExpr->pLeft->op==TK_INTEGER && sqliteFitsIn32Bits(z) ){
- sqliteVdbeAddOp(v, OP_Integer, atoi(z), 0);
- }else{
- sqliteVdbeAddOp(v, OP_String, 0, 0);
- }
- sqliteVdbeChangeP3(v, -1, z, p->n+1);
- sqliteFree(z);
- break;
- }
- /* Fall through into TK_NOT */
- }
- case TK_BITNOT:
- case TK_NOT: {
- sqliteExprCode(pParse, pExpr->pLeft);
- sqliteVdbeAddOp(v, op, 0, 0);
- break;
- }
- case TK_ISNULL:
- case TK_NOTNULL: {
- int dest;
- sqliteVdbeAddOp(v, OP_Integer, 1, 0);
- sqliteExprCode(pParse, pExpr->pLeft);
- dest = sqliteVdbeCurrentAddr(v) + 2;
- sqliteVdbeAddOp(v, op, 1, dest);
- sqliteVdbeAddOp(v, OP_AddImm, -1, 0);
- break;
- }
- case TK_AGG_FUNCTION: {
- sqliteVdbeAddOp(v, OP_AggGet, 0, pExpr->iAgg);
- break;
- }
- case TK_GLOB:
- case TK_LIKE:
- case TK_FUNCTION: {
- ExprList *pList = pExpr->pList;
- int nExpr = pList ? pList->nExpr : 0;
- FuncDef *pDef;
- int nId;
- const char *zId;
- getFunctionName(pExpr, &zId, &nId);
- pDef = sqliteFindFunction(pParse->db, zId, nId, nExpr, 0);
- assert( pDef!=0 );
- nExpr = sqliteExprCodeExprList(pParse, pList, pDef->includeTypes);
- sqliteVdbeOp3(v, OP_Function, nExpr, 0, (char*)pDef, P3_POINTER);
- break;
- }
- case TK_SELECT: {
- sqliteVdbeAddOp(v, OP_MemLoad, pExpr->iColumn, 0);
- break;
- }
- case TK_IN: {
- int addr;
- sqliteVdbeAddOp(v, OP_Integer, 1, 0);
- sqliteExprCode(pParse, pExpr->pLeft);
- addr = sqliteVdbeCurrentAddr(v);
- sqliteVdbeAddOp(v, OP_NotNull, -1, addr+4);
- sqliteVdbeAddOp(v, OP_Pop, 2, 0);
- sqliteVdbeAddOp(v, OP_String, 0, 0);
- sqliteVdbeAddOp(v, OP_Goto, 0, addr+6);
- if( pExpr->pSelect ){
- sqliteVdbeAddOp(v, OP_Found, pExpr->iTable, addr+6);
- }else{
- sqliteVdbeAddOp(v, OP_SetFound, pExpr->iTable, addr+6);
- }
- sqliteVdbeAddOp(v, OP_AddImm, -1, 0);
- break;
- }
- case TK_BETWEEN: {
- sqliteExprCode(pParse, pExpr->pLeft);
- sqliteVdbeAddOp(v, OP_Dup, 0, 0);
- sqliteExprCode(pParse, pExpr->pList->a[0].pExpr);
- sqliteVdbeAddOp(v, OP_Ge, 0, 0);
- sqliteVdbeAddOp(v, OP_Pull, 1, 0);
- sqliteExprCode(pParse, pExpr->pList->a[1].pExpr);
- sqliteVdbeAddOp(v, OP_Le, 0, 0);
- sqliteVdbeAddOp(v, OP_And, 0, 0);
- break;
- }
- case TK_UPLUS:
- case TK_AS: {
- sqliteExprCode(pParse, pExpr->pLeft);
- break;
- }
- case TK_CASE: {
- int expr_end_label;
- int jumpInst;
- int addr;
- int nExpr;
- int i;
-
- assert(pExpr->pList);
- assert((pExpr->pList->nExpr % 2) == 0);
- assert(pExpr->pList->nExpr > 0);
- nExpr = pExpr->pList->nExpr;
- expr_end_label = sqliteVdbeMakeLabel(v);
- if( pExpr->pLeft ){
- sqliteExprCode(pParse, pExpr->pLeft);
- }
- for(i=0; i<nExpr; i=i+2){
- sqliteExprCode(pParse, pExpr->pList->a[i].pExpr);
- if( pExpr->pLeft ){
- sqliteVdbeAddOp(v, OP_Dup, 1, 1);
- jumpInst = sqliteVdbeAddOp(v, OP_Ne, 1, 0);
- sqliteVdbeAddOp(v, OP_Pop, 1, 0);
- }else{
- jumpInst = sqliteVdbeAddOp(v, OP_IfNot, 1, 0);
- }
- sqliteExprCode(pParse, pExpr->pList->a[i+1].pExpr);
- sqliteVdbeAddOp(v, OP_Goto, 0, expr_end_label);
- addr = sqliteVdbeCurrentAddr(v);
- sqliteVdbeChangeP2(v, jumpInst, addr);
- }
- if( pExpr->pLeft ){
- sqliteVdbeAddOp(v, OP_Pop, 1, 0);
- }
- if( pExpr->pRight ){
- sqliteExprCode(pParse, pExpr->pRight);
- }else{
- sqliteVdbeAddOp(v, OP_String, 0, 0);
- }
- sqliteVdbeResolveLabel(v, expr_end_label);
- break;
- }
- case TK_RAISE: {
- if( !pParse->trigStack ){
- sqliteErrorMsg(pParse,
- "RAISE() may only be used within a trigger-program");
- pParse->nErr++;
- return;
- }
- if( pExpr->iColumn == OE_Rollback ||
- pExpr->iColumn == OE_Abort ||
- pExpr->iColumn == OE_Fail ){
- sqliteVdbeOp3(v, OP_Halt, SQLITE_CONSTRAINT, pExpr->iColumn,
- pExpr->token.z, pExpr->token.n);
- sqliteVdbeDequoteP3(v, -1);
- } else {
- assert( pExpr->iColumn == OE_Ignore );
- sqliteVdbeOp3(v, OP_Goto, 0, pParse->trigStack->ignoreJump,
- "(IGNORE jump)", 0);
- }
- }
- break;
- }
-}
-
-/*
-** Generate code that pushes the value of every element of the given
-** expression list onto the stack. If the includeTypes flag is true,
-** then also push a string that is the datatype of each element onto
-** the stack after the value.
-**
-** Return the number of elements pushed onto the stack.
-*/
-int sqliteExprCodeExprList(
- Parse *pParse, /* Parsing context */
- ExprList *pList, /* The expression list to be coded */
- int includeTypes /* TRUE to put datatypes on the stack too */
-){
- struct ExprList_item *pItem;
- int i, n;
- Vdbe *v;
- if( pList==0 ) return 0;
- v = sqliteGetVdbe(pParse);
- n = pList->nExpr;
- for(pItem=pList->a, i=0; i<n; i++, pItem++){
- sqliteExprCode(pParse, pItem->pExpr);
- if( includeTypes ){
- sqliteVdbeOp3(v, OP_String, 0, 0,
- sqliteExprType(pItem->pExpr)==SQLITE_SO_NUM ? "numeric" : "text",
- P3_STATIC);
- }
- }
- return includeTypes ? n*2 : n;
-}
-
-/*
-** Generate code for a boolean expression such that a jump is made
-** to the label "dest" if the expression is true but execution
-** continues straight thru if the expression is false.
-**
-** If the expression evaluates to NULL (neither true nor false), then
-** take the jump if the jumpIfNull flag is true.
-*/
-void sqliteExprIfTrue(Parse *pParse, Expr *pExpr, int dest, int jumpIfNull){
- Vdbe *v = pParse->pVdbe;
- int op = 0;
- if( v==0 || pExpr==0 ) return;
- switch( pExpr->op ){
- case TK_LT: op = OP_Lt; break;
- case TK_LE: op = OP_Le; break;
- case TK_GT: op = OP_Gt; break;
- case TK_GE: op = OP_Ge; break;
- case TK_NE: op = OP_Ne; break;
- case TK_EQ: op = OP_Eq; break;
- case TK_ISNULL: op = OP_IsNull; break;
- case TK_NOTNULL: op = OP_NotNull; break;
- default: break;
- }
- switch( pExpr->op ){
- case TK_AND: {
- int d2 = sqliteVdbeMakeLabel(v);
- sqliteExprIfFalse(pParse, pExpr->pLeft, d2, !jumpIfNull);
- sqliteExprIfTrue(pParse, pExpr->pRight, dest, jumpIfNull);
- sqliteVdbeResolveLabel(v, d2);
- break;
- }
- case TK_OR: {
- sqliteExprIfTrue(pParse, pExpr->pLeft, dest, jumpIfNull);
- sqliteExprIfTrue(pParse, pExpr->pRight, dest, jumpIfNull);
- break;
- }
- case TK_NOT: {
- sqliteExprIfFalse(pParse, pExpr->pLeft, dest, jumpIfNull);
- break;
- }
- case TK_LT:
- case TK_LE:
- case TK_GT:
- case TK_GE:
- case TK_NE:
- case TK_EQ: {
- sqliteExprCode(pParse, pExpr->pLeft);
- sqliteExprCode(pParse, pExpr->pRight);
- if( pParse->db->file_format>=4 && sqliteExprType(pExpr)==SQLITE_SO_TEXT ){
- op += 6; /* Convert numeric opcodes to text opcodes */
- }
- sqliteVdbeAddOp(v, op, jumpIfNull, dest);
- break;
- }
- case TK_ISNULL:
- case TK_NOTNULL: {
- sqliteExprCode(pParse, pExpr->pLeft);
- sqliteVdbeAddOp(v, op, 1, dest);
- break;
- }
- case TK_IN: {
- int addr;
- sqliteExprCode(pParse, pExpr->pLeft);
- addr = sqliteVdbeCurrentAddr(v);
- sqliteVdbeAddOp(v, OP_NotNull, -1, addr+3);
- sqliteVdbeAddOp(v, OP_Pop, 1, 0);
- sqliteVdbeAddOp(v, OP_Goto, 0, jumpIfNull ? dest : addr+4);
- if( pExpr->pSelect ){
- sqliteVdbeAddOp(v, OP_Found, pExpr->iTable, dest);
- }else{
- sqliteVdbeAddOp(v, OP_SetFound, pExpr->iTable, dest);
- }
- break;
- }
- case TK_BETWEEN: {
- int addr;
- sqliteExprCode(pParse, pExpr->pLeft);
- sqliteVdbeAddOp(v, OP_Dup, 0, 0);
- sqliteExprCode(pParse, pExpr->pList->a[0].pExpr);
- addr = sqliteVdbeAddOp(v, OP_Lt, !jumpIfNull, 0);
- sqliteExprCode(pParse, pExpr->pList->a[1].pExpr);
- sqliteVdbeAddOp(v, OP_Le, jumpIfNull, dest);
- sqliteVdbeAddOp(v, OP_Integer, 0, 0);
- sqliteVdbeChangeP2(v, addr, sqliteVdbeCurrentAddr(v));
- sqliteVdbeAddOp(v, OP_Pop, 1, 0);
- break;
- }
- default: {
- sqliteExprCode(pParse, pExpr);
- sqliteVdbeAddOp(v, OP_If, jumpIfNull, dest);
- break;
- }
- }
-}
-
-/*
-** Generate code for a boolean expression such that a jump is made
-** to the label "dest" if the expression is false but execution
-** continues straight thru if the expression is true.
-**
-** If the expression evaluates to NULL (neither true nor false) then
-** jump if jumpIfNull is true or fall through if jumpIfNull is false.
-*/
-void sqliteExprIfFalse(Parse *pParse, Expr *pExpr, int dest, int jumpIfNull){
- Vdbe *v = pParse->pVdbe;
- int op = 0;
- if( v==0 || pExpr==0 ) return;
- switch( pExpr->op ){
- case TK_LT: op = OP_Ge; break;
- case TK_LE: op = OP_Gt; break;
- case TK_GT: op = OP_Le; break;
- case TK_GE: op = OP_Lt; break;
- case TK_NE: op = OP_Eq; break;
- case TK_EQ: op = OP_Ne; break;
- case TK_ISNULL: op = OP_NotNull; break;
- case TK_NOTNULL: op = OP_IsNull; break;
- default: break;
- }
- switch( pExpr->op ){
- case TK_AND: {
- sqliteExprIfFalse(pParse, pExpr->pLeft, dest, jumpIfNull);
- sqliteExprIfFalse(pParse, pExpr->pRight, dest, jumpIfNull);
- break;
- }
- case TK_OR: {
- int d2 = sqliteVdbeMakeLabel(v);
- sqliteExprIfTrue(pParse, pExpr->pLeft, d2, !jumpIfNull);
- sqliteExprIfFalse(pParse, pExpr->pRight, dest, jumpIfNull);
- sqliteVdbeResolveLabel(v, d2);
- break;
- }
- case TK_NOT: {
- sqliteExprIfTrue(pParse, pExpr->pLeft, dest, jumpIfNull);
- break;
- }
- case TK_LT:
- case TK_LE:
- case TK_GT:
- case TK_GE:
- case TK_NE:
- case TK_EQ: {
- if( pParse->db->file_format>=4 && sqliteExprType(pExpr)==SQLITE_SO_TEXT ){
- /* Convert numeric comparison opcodes into text comparison opcodes.
- ** This step depends on the fact that the text comparision opcodes are
- ** always 6 greater than their corresponding numeric comparison
- ** opcodes.
- */
- assert( OP_Eq+6 == OP_StrEq );
- op += 6;
- }
- sqliteExprCode(pParse, pExpr->pLeft);
- sqliteExprCode(pParse, pExpr->pRight);
- sqliteVdbeAddOp(v, op, jumpIfNull, dest);
- break;
- }
- case TK_ISNULL:
- case TK_NOTNULL: {
- sqliteExprCode(pParse, pExpr->pLeft);
- sqliteVdbeAddOp(v, op, 1, dest);
- break;
- }
- case TK_IN: {
- int addr;
- sqliteExprCode(pParse, pExpr->pLeft);
- addr = sqliteVdbeCurrentAddr(v);
- sqliteVdbeAddOp(v, OP_NotNull, -1, addr+3);
- sqliteVdbeAddOp(v, OP_Pop, 1, 0);
- sqliteVdbeAddOp(v, OP_Goto, 0, jumpIfNull ? dest : addr+4);
- if( pExpr->pSelect ){
- sqliteVdbeAddOp(v, OP_NotFound, pExpr->iTable, dest);
- }else{
- sqliteVdbeAddOp(v, OP_SetNotFound, pExpr->iTable, dest);
- }
- break;
- }
- case TK_BETWEEN: {
- int addr;
- sqliteExprCode(pParse, pExpr->pLeft);
- sqliteVdbeAddOp(v, OP_Dup, 0, 0);
- sqliteExprCode(pParse, pExpr->pList->a[0].pExpr);
- addr = sqliteVdbeCurrentAddr(v);
- sqliteVdbeAddOp(v, OP_Ge, !jumpIfNull, addr+3);
- sqliteVdbeAddOp(v, OP_Pop, 1, 0);
- sqliteVdbeAddOp(v, OP_Goto, 0, dest);
- sqliteExprCode(pParse, pExpr->pList->a[1].pExpr);
- sqliteVdbeAddOp(v, OP_Gt, jumpIfNull, dest);
- break;
- }
- default: {
- sqliteExprCode(pParse, pExpr);
- sqliteVdbeAddOp(v, OP_IfNot, jumpIfNull, dest);
- break;
- }
- }
-}
-
-/*
-** Do a deep comparison of two expression trees. Return TRUE (non-zero)
-** if they are identical and return FALSE if they differ in any way.
-*/
-int sqliteExprCompare(Expr *pA, Expr *pB){
- int i;
- if( pA==0 ){
- return pB==0;
- }else if( pB==0 ){
- return 0;
- }
- if( pA->op!=pB->op ) return 0;
- if( !sqliteExprCompare(pA->pLeft, pB->pLeft) ) return 0;
- if( !sqliteExprCompare(pA->pRight, pB->pRight) ) return 0;
- if( pA->pList ){
- if( pB->pList==0 ) return 0;
- if( pA->pList->nExpr!=pB->pList->nExpr ) return 0;
- for(i=0; i<pA->pList->nExpr; i++){
- if( !sqliteExprCompare(pA->pList->a[i].pExpr, pB->pList->a[i].pExpr) ){
- return 0;
- }
- }
- }else if( pB->pList ){
- return 0;
- }
- if( pA->pSelect || pB->pSelect ) return 0;
- if( pA->iTable!=pB->iTable || pA->iColumn!=pB->iColumn ) return 0;
- if( pA->token.z ){
- if( pB->token.z==0 ) return 0;
- if( pB->token.n!=pA->token.n ) return 0;
- if( sqliteStrNICmp(pA->token.z, pB->token.z, pB->token.n)!=0 ) return 0;
- }
- return 1;
-}
-
-/*
-** Add a new element to the pParse->aAgg[] array and return its index.
-*/
-static int appendAggInfo(Parse *pParse){
- if( (pParse->nAgg & 0x7)==0 ){
- int amt = pParse->nAgg + 8;
- AggExpr *aAgg = sqliteRealloc(pParse->aAgg, amt*sizeof(pParse->aAgg[0]));
- if( aAgg==0 ){
- return -1;
- }
- pParse->aAgg = aAgg;
- }
- memset(&pParse->aAgg[pParse->nAgg], 0, sizeof(pParse->aAgg[0]));
- return pParse->nAgg++;
-}
-
-/*
-** Analyze the given expression looking for aggregate functions and
-** for variables that need to be added to the pParse->aAgg[] array.
-** Make additional entries to the pParse->aAgg[] array as necessary.
-**
-** This routine should only be called after the expression has been
-** analyzed by sqliteExprResolveIds() and sqliteExprCheck().
-**
-** If errors are seen, leave an error message in zErrMsg and return
-** the number of errors.
-*/
-int sqliteExprAnalyzeAggregates(Parse *pParse, Expr *pExpr){
- int i;
- AggExpr *aAgg;
- int nErr = 0;
-
- if( pExpr==0 ) return 0;
- switch( pExpr->op ){
- case TK_COLUMN: {
- aAgg = pParse->aAgg;
- for(i=0; i<pParse->nAgg; i++){
- if( aAgg[i].isAgg ) continue;
- if( aAgg[i].pExpr->iTable==pExpr->iTable
- && aAgg[i].pExpr->iColumn==pExpr->iColumn ){
- break;
- }
- }
- if( i>=pParse->nAgg ){
- i = appendAggInfo(pParse);
- if( i<0 ) return 1;
- pParse->aAgg[i].isAgg = 0;
- pParse->aAgg[i].pExpr = pExpr;
- }
- pExpr->iAgg = i;
- break;
- }
- case TK_AGG_FUNCTION: {
- aAgg = pParse->aAgg;
- for(i=0; i<pParse->nAgg; i++){
- if( !aAgg[i].isAgg ) continue;
- if( sqliteExprCompare(aAgg[i].pExpr, pExpr) ){
- break;
- }
- }
- if( i>=pParse->nAgg ){
- i = appendAggInfo(pParse);
- if( i<0 ) return 1;
- pParse->aAgg[i].isAgg = 1;
- pParse->aAgg[i].pExpr = pExpr;
- pParse->aAgg[i].pFunc = sqliteFindFunction(pParse->db,
- pExpr->token.z, pExpr->token.n,
- pExpr->pList ? pExpr->pList->nExpr : 0, 0);
- }
- pExpr->iAgg = i;
- break;
- }
- default: {
- if( pExpr->pLeft ){
- nErr = sqliteExprAnalyzeAggregates(pParse, pExpr->pLeft);
- }
- if( nErr==0 && pExpr->pRight ){
- nErr = sqliteExprAnalyzeAggregates(pParse, pExpr->pRight);
- }
- if( nErr==0 && pExpr->pList ){
- int n = pExpr->pList->nExpr;
- int i;
- for(i=0; nErr==0 && i<n; i++){
- nErr = sqliteExprAnalyzeAggregates(pParse, pExpr->pList->a[i].pExpr);
- }
- }
- break;
- }
- }
- return nErr;
-}
-
-/*
-** Locate a user function given a name and a number of arguments.
-** Return a pointer to the FuncDef structure that defines that
-** function, or return NULL if the function does not exist.
-**
-** If the createFlag argument is true, then a new (blank) FuncDef
-** structure is created and liked into the "db" structure if a
-** no matching function previously existed. When createFlag is true
-** and the nArg parameter is -1, then only a function that accepts
-** any number of arguments will be returned.
-**
-** If createFlag is false and nArg is -1, then the first valid
-** function found is returned. A function is valid if either xFunc
-** or xStep is non-zero.
-*/
-FuncDef *sqliteFindFunction(
- sqlite *db, /* An open database */
- const char *zName, /* Name of the function. Not null-terminated */
- int nName, /* Number of characters in the name */
- int nArg, /* Number of arguments. -1 means any number */
- int createFlag /* Create new entry if true and does not otherwise exist */
-){
- FuncDef *pFirst, *p, *pMaybe;
- pFirst = p = (FuncDef*)sqliteHashFind(&db->aFunc, zName, nName);
- if( p && !createFlag && nArg<0 ){
- while( p && p->xFunc==0 && p->xStep==0 ){ p = p->pNext; }
- return p;
- }
- pMaybe = 0;
- while( p && p->nArg!=nArg ){
- if( p->nArg<0 && !createFlag && (p->xFunc || p->xStep) ) pMaybe = p;
- p = p->pNext;
- }
- if( p && !createFlag && p->xFunc==0 && p->xStep==0 ){
- return 0;
- }
- if( p==0 && pMaybe ){
- assert( createFlag==0 );
- return pMaybe;
- }
- if( p==0 && createFlag && (p = sqliteMalloc(sizeof(*p)))!=0 ){
- p->nArg = nArg;
- p->pNext = pFirst;
- p->dataType = pFirst ? pFirst->dataType : SQLITE_NUMERIC;
- sqliteHashInsert(&db->aFunc, zName, nName, (void*)p);
- }
- return p;
-}
+++ /dev/null
-/*
-** 2002 February 23
-**
-** The author disclaims copyright to this source code. In place of
-** a legal notice, here is a blessing:
-**
-** May you do good and not evil.
-** May you find forgiveness for yourself and forgive others.
-** May you share freely, never taking more than you give.
-**
-*************************************************************************
-** This file contains the C functions that implement various SQL
-** functions of SQLite.
-**
-** There is only one exported symbol in this file - the function
-** sqliteRegisterBuildinFunctions() found at the bottom of the file.
-** All other code has file scope.
-**
-** $Id: func.c,v 1.1.1.1 2004/08/08 15:03:57 matt Exp $
-*/
-#include <ctype.h>
-#include <math.h>
-#include <stdlib.h>
-#include <assert.h>
-#include "sqliteInt.h"
-#include "os.h"
-
-/*
-** Implementation of the non-aggregate min() and max() functions
-*/
-static void minmaxFunc(sqlite_func *context, int argc, const char **argv){
- const char *zBest;
- int i;
- int (*xCompare)(const char*, const char*);
- int mask; /* 0 for min() or 0xffffffff for max() */
-
- if( argc==0 ) return;
- mask = (int)sqlite_user_data(context);
- zBest = argv[0];
- if( zBest==0 ) return;
- if( argv[1][0]=='n' ){
- xCompare = sqliteCompare;
- }else{
- xCompare = strcmp;
- }
- for(i=2; i<argc; i+=2){
- if( argv[i]==0 ) return;
- if( (xCompare(argv[i], zBest)^mask)<0 ){
- zBest = argv[i];
- }
- }
- sqlite_set_result_string(context, zBest, -1);
-}
-
-/*
-** Return the type of the argument.
-*/
-static void typeofFunc(sqlite_func *context, int argc, const char **argv){
- assert( argc==2 );
- sqlite_set_result_string(context, argv[1], -1);
-}
-
-/*
-** Implementation of the length() function
-*/
-static void lengthFunc(sqlite_func *context, int argc, const char **argv){
- const char *z;
- int len;
-
- assert( argc==1 );
- z = argv[0];
- if( z==0 ) return;
-#ifdef SQLITE_UTF8
- for(len=0; *z; z++){ if( (0xc0&*z)!=0x80 ) len++; }
-#else
- len = strlen(z);
-#endif
- sqlite_set_result_int(context, len);
-}
-
-/*
-** Implementation of the abs() function
-*/
-static void absFunc(sqlite_func *context, int argc, const char **argv){
- const char *z;
- assert( argc==1 );
- z = argv[0];
- if( z==0 ) return;
- if( z[0]=='-' && isdigit(z[1]) ) z++;
- sqlite_set_result_string(context, z, -1);
-}
-
-/*
-** Implementation of the substr() function
-*/
-static void substrFunc(sqlite_func *context, int argc, const char **argv){
- const char *z;
-#ifdef SQLITE_UTF8
- const char *z2;
- int i;
-#endif
- int p1, p2, len;
- assert( argc==3 );
- z = argv[0];
- if( z==0 ) return;
- p1 = atoi(argv[1]?argv[1]:0);
- p2 = atoi(argv[2]?argv[2]:0);
-#ifdef SQLITE_UTF8
- for(len=0, z2=z; *z2; z2++){ if( (0xc0&*z2)!=0x80 ) len++; }
-#else
- len = strlen(z);
-#endif
- if( p1<0 ){
- p1 += len;
- if( p1<0 ){
- p2 += p1;
- p1 = 0;
- }
- }else if( p1>0 ){
- p1--;
- }
- if( p1+p2>len ){
- p2 = len-p1;
- }
-#ifdef SQLITE_UTF8
- for(i=0; i<p1 && z[i]; i++){
- if( (z[i]&0xc0)==0x80 ) p1++;
- }
- while( z[i] && (z[i]&0xc0)==0x80 ){ i++; p1++; }
- for(; i<p1+p2 && z[i]; i++){
- if( (z[i]&0xc0)==0x80 ) p2++;
- }
- while( z[i] && (z[i]&0xc0)==0x80 ){ i++; p2++; }
-#endif
- if( p2<0 ) p2 = 0;
- sqlite_set_result_string(context, &z[p1], p2);
-}
-
-/*
-** Implementation of the round() function
-*/
-static void roundFunc(sqlite_func *context, int argc, const char **argv){
- int n;
- double r;
- char zBuf[100];
- assert( argc==1 || argc==2 );
- if( argv[0]==0 || (argc==2 && argv[1]==0) ) return;
- n = argc==2 ? atoi(argv[1]) : 0;
- if( n>30 ) n = 30;
- if( n<0 ) n = 0;
- r = sqliteAtoF(argv[0], 0);
- sprintf(zBuf,"%.*f",n,r);
- sqlite_set_result_string(context, zBuf, -1);
-}
-
-/*
-** Implementation of the upper() and lower() SQL functions.
-*/
-static void upperFunc(sqlite_func *context, int argc, const char **argv){
- unsigned char *z;
- int i;
- if( argc<1 || argv[0]==0 ) return;
- z = (unsigned char*)sqlite_set_result_string(context, argv[0], -1);
- if( z==0 ) return;
- for(i=0; z[i]; i++){
- if( islower(z[i]) ) z[i] = toupper(z[i]);
- }
-}
-static void lowerFunc(sqlite_func *context, int argc, const char **argv){
- unsigned char *z;
- int i;
- if( argc<1 || argv[0]==0 ) return;
- z = (unsigned char*)sqlite_set_result_string(context, argv[0], -1);
- if( z==0 ) return;
- for(i=0; z[i]; i++){
- if( isupper(z[i]) ) z[i] = tolower(z[i]);
- }
-}
-
-/*
-** Implementation of the IFNULL(), NVL(), and COALESCE() functions.
-** All three do the same thing. They return the first non-NULL
-** argument.
-*/
-static void ifnullFunc(sqlite_func *context, int argc, const char **argv){
- int i;
- for(i=0; i<argc; i++){
- if( argv[i] ){
- sqlite_set_result_string(context, argv[i], -1);
- break;
- }
- }
-}
-
-/*
-** Implementation of random(). Return a random integer.
-*/
-static void randomFunc(sqlite_func *context, int argc, const char **argv){
- int r;
- sqliteRandomness(sizeof(r), &r);
- sqlite_set_result_int(context, r);
-}
-
-/*
-** Implementation of the last_insert_rowid() SQL function. The return
-** value is the same as the sqlite_last_insert_rowid() API function.
-*/
-static void last_insert_rowid(sqlite_func *context, int arg, const char **argv){
- sqlite *db = sqlite_user_data(context);
- sqlite_set_result_int(context, sqlite_last_insert_rowid(db));
-}
-
-/*
-** Implementation of the change_count() SQL function. The return
-** value is the same as the sqlite_changes() API function.
-*/
-static void change_count(sqlite_func *context, int arg, const char **argv){
- sqlite *db = sqlite_user_data(context);
- sqlite_set_result_int(context, sqlite_changes(db));
-}
-
-/*
-** Implementation of the last_statement_change_count() SQL function. The
-** return value is the same as the sqlite_last_statement_changes() API function.
-*/
-static void last_statement_change_count(sqlite_func *context, int arg,
- const char **argv){
- sqlite *db = sqlite_user_data(context);
- sqlite_set_result_int(context, sqlite_last_statement_changes(db));
-}
-
-/*
-** Implementation of the like() SQL function. This function implements
-** the build-in LIKE operator. The first argument to the function is the
-** string and the second argument is the pattern. So, the SQL statements:
-**
-** A LIKE B
-**
-** is implemented as like(A,B).
-*/
-static void likeFunc(sqlite_func *context, int arg, const char **argv){
- if( argv[0]==0 || argv[1]==0 ) return;
- sqlite_set_result_int(context,
- sqliteLikeCompare((const unsigned char*)argv[0],
- (const unsigned char*)argv[1]));
-}
-
-/*
-** Implementation of the glob() SQL function. This function implements
-** the build-in GLOB operator. The first argument to the function is the
-** string and the second argument is the pattern. So, the SQL statements:
-**
-** A GLOB B
-**
-** is implemented as glob(A,B).
-*/
-static void globFunc(sqlite_func *context, int arg, const char **argv){
- if( argv[0]==0 || argv[1]==0 ) return;
- sqlite_set_result_int(context,
- sqliteGlobCompare((const unsigned char*)argv[0],
- (const unsigned char*)argv[1]));
-}
-
-/*
-** Implementation of the NULLIF(x,y) function. The result is the first
-** argument if the arguments are different. The result is NULL if the
-** arguments are equal to each other.
-*/
-static void nullifFunc(sqlite_func *context, int argc, const char **argv){
- if( argv[0]!=0 && sqliteCompare(argv[0],argv[1])!=0 ){
- sqlite_set_result_string(context, argv[0], -1);
- }
-}
-
-/*
-** Implementation of the VERSION(*) function. The result is the version
-** of the SQLite library that is running.
-*/
-static void versionFunc(sqlite_func *context, int argc, const char **argv){
- sqlite_set_result_string(context, sqlite_version, -1);
-}
-
-/*
-** EXPERIMENTAL - This is not an official function. The interface may
-** change. This function may disappear. Do not write code that depends
-** on this function.
-**
-** Implementation of the QUOTE() function. This function takes a single
-** argument. If the argument is numeric, the return value is the same as
-** the argument. If the argument is NULL, the return value is the string
-** "NULL". Otherwise, the argument is enclosed in single quotes with
-** single-quote escapes.
-*/
-static void quoteFunc(sqlite_func *context, int argc, const char **argv){
- if( argc<1 ) return;
- if( argv[0]==0 ){
- sqlite_set_result_string(context, "NULL", 4);
- }else if( sqliteIsNumber(argv[0]) ){
- sqlite_set_result_string(context, argv[0], -1);
- }else{
- int i,j,n;
- char *z;
- for(i=n=0; argv[0][i]; i++){ if( argv[0][i]=='\'' ) n++; }
- z = sqliteMalloc( i+n+3 );
- if( z==0 ) return;
- z[0] = '\'';
- for(i=0, j=1; argv[0][i]; i++){
- z[j++] = argv[0][i];
- if( argv[0][i]=='\'' ){
- z[j++] = '\'';
- }
- }
- z[j++] = '\'';
- z[j] = 0;
- sqlite_set_result_string(context, z, j);
- sqliteFree(z);
- }
-}
-
-#ifdef SQLITE_SOUNDEX
-/*
-** Compute the soundex encoding of a word.
-*/
-static void soundexFunc(sqlite_func *context, int argc, const char **argv){
- char zResult[8];
- const char *zIn;
- int i, j;
- static const unsigned char iCode[] = {
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 1, 2, 3, 0, 1, 2, 0, 0, 2, 2, 4, 5, 5, 0,
- 1, 2, 6, 2, 3, 0, 1, 0, 2, 0, 2, 0, 0, 0, 0, 0,
- 0, 0, 1, 2, 3, 0, 1, 2, 0, 0, 2, 2, 4, 5, 5, 0,
- 1, 2, 6, 2, 3, 0, 1, 0, 2, 0, 2, 0, 0, 0, 0, 0,
- };
- assert( argc==1 );
- zIn = argv[0];
- for(i=0; zIn[i] && !isalpha(zIn[i]); i++){}
- if( zIn[i] ){
- zResult[0] = toupper(zIn[i]);
- for(j=1; j<4 && zIn[i]; i++){
- int code = iCode[zIn[i]&0x7f];
- if( code>0 ){
- zResult[j++] = code + '0';
- }
- }
- while( j<4 ){
- zResult[j++] = '0';
- }
- zResult[j] = 0;
- sqlite_set_result_string(context, zResult, 4);
- }else{
- sqlite_set_result_string(context, "?000", 4);
- }
-}
-#endif
-
-#ifdef SQLITE_TEST
-/*
-** This function generates a string of random characters. Used for
-** generating test data.
-*/
-static void randStr(sqlite_func *context, int argc, const char **argv){
- static const unsigned char zSrc[] =
- "abcdefghijklmnopqrstuvwxyz"
- "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
- "0123456789"
- ".-!,:*^+=_|?/<> ";
- int iMin, iMax, n, r, i;
- unsigned char zBuf[1000];
- if( argc>=1 ){
- iMin = atoi(argv[0]);
- if( iMin<0 ) iMin = 0;
- if( iMin>=sizeof(zBuf) ) iMin = sizeof(zBuf)-1;
- }else{
- iMin = 1;
- }
- if( argc>=2 ){
- iMax = atoi(argv[1]);
- if( iMax<iMin ) iMax = iMin;
- if( iMax>=sizeof(zBuf) ) iMax = sizeof(zBuf)-1;
- }else{
- iMax = 50;
- }
- n = iMin;
- if( iMax>iMin ){
- sqliteRandomness(sizeof(r), &r);
- r &= 0x7fffffff;
- n += r%(iMax + 1 - iMin);
- }
- assert( n<sizeof(zBuf) );
- sqliteRandomness(n, zBuf);
- for(i=0; i<n; i++){
- zBuf[i] = zSrc[zBuf[i]%(sizeof(zSrc)-1)];
- }
- zBuf[n] = 0;
- sqlite_set_result_string(context, zBuf, n);
-}
-#endif
-
-/*
-** An instance of the following structure holds the context of a
-** sum() or avg() aggregate computation.
-*/
-typedef struct SumCtx SumCtx;
-struct SumCtx {
- double sum; /* Sum of terms */
- int cnt; /* Number of elements summed */
-};
-
-/*
-** Routines used to compute the sum or average.
-*/
-static void sumStep(sqlite_func *context, int argc, const char **argv){
- SumCtx *p;
- if( argc<1 ) return;
- p = sqlite_aggregate_context(context, sizeof(*p));
- if( p && argv[0] ){
- p->sum += sqliteAtoF(argv[0], 0);
- p->cnt++;
- }
-}
-static void sumFinalize(sqlite_func *context){
- SumCtx *p;
- p = sqlite_aggregate_context(context, sizeof(*p));
- sqlite_set_result_double(context, p ? p->sum : 0.0);
-}
-static void avgFinalize(sqlite_func *context){
- SumCtx *p;
- p = sqlite_aggregate_context(context, sizeof(*p));
- if( p && p->cnt>0 ){
- sqlite_set_result_double(context, p->sum/(double)p->cnt);
- }
-}
-
-/*
-** An instance of the following structure holds the context of a
-** variance or standard deviation computation.
-*/
-typedef struct StdDevCtx StdDevCtx;
-struct StdDevCtx {
- double sum; /* Sum of terms */
- double sum2; /* Sum of the squares of terms */
- int cnt; /* Number of terms counted */
-};
-
-#if 0 /* Omit because math library is required */
-/*
-** Routines used to compute the standard deviation as an aggregate.
-*/
-static void stdDevStep(sqlite_func *context, int argc, const char **argv){
- StdDevCtx *p;
- double x;
- if( argc<1 ) return;
- p = sqlite_aggregate_context(context, sizeof(*p));
- if( p && argv[0] ){
- x = sqliteAtoF(argv[0], 0);
- p->sum += x;
- p->sum2 += x*x;
- p->cnt++;
- }
-}
-static void stdDevFinalize(sqlite_func *context){
- double rN = sqlite_aggregate_count(context);
- StdDevCtx *p = sqlite_aggregate_context(context, sizeof(*p));
- if( p && p->cnt>1 ){
- double rCnt = cnt;
- sqlite_set_result_double(context,
- sqrt((p->sum2 - p->sum*p->sum/rCnt)/(rCnt-1.0)));
- }
-}
-#endif
-
-/*
-** The following structure keeps track of state information for the
-** count() aggregate function.
-*/
-typedef struct CountCtx CountCtx;
-struct CountCtx {
- int n;
-};
-
-/*
-** Routines to implement the count() aggregate function.
-*/
-static void countStep(sqlite_func *context, int argc, const char **argv){
- CountCtx *p;
- p = sqlite_aggregate_context(context, sizeof(*p));
- if( (argc==0 || argv[0]) && p ){
- p->n++;
- }
-}
-static void countFinalize(sqlite_func *context){
- CountCtx *p;
- p = sqlite_aggregate_context(context, sizeof(*p));
- sqlite_set_result_int(context, p ? p->n : 0);
-}
-
-/*
-** This function tracks state information for the min() and max()
-** aggregate functions.
-*/
-typedef struct MinMaxCtx MinMaxCtx;
-struct MinMaxCtx {
- char *z; /* The best so far */
- char zBuf[28]; /* Space that can be used for storage */
-};
-
-/*
-** Routines to implement min() and max() aggregate functions.
-*/
-static void minmaxStep(sqlite_func *context, int argc, const char **argv){
- MinMaxCtx *p;
- int (*xCompare)(const char*, const char*);
- int mask; /* 0 for min() or 0xffffffff for max() */
-
- assert( argc==2 );
- if( argv[0]==0 ) return; /* Ignore NULL values */
- if( argv[1][0]=='n' ){
- xCompare = sqliteCompare;
- }else{
- xCompare = strcmp;
- }
- mask = (int)sqlite_user_data(context);
- assert( mask==0 || mask==-1 );
- p = sqlite_aggregate_context(context, sizeof(*p));
- if( p==0 || argc<1 ) return;
- if( p->z==0 || (xCompare(argv[0],p->z)^mask)<0 ){
- int len;
- if( p->zBuf[0] ){
- sqliteFree(p->z);
- }
- len = strlen(argv[0]);
- if( len < sizeof(p->zBuf)-1 ){
- p->z = &p->zBuf[1];
- p->zBuf[0] = 0;
- }else{
- p->z = sqliteMalloc( len+1 );
- p->zBuf[0] = 1;
- if( p->z==0 ) return;
- }
- strcpy(p->z, argv[0]);
- }
-}
-static void minMaxFinalize(sqlite_func *context){
- MinMaxCtx *p;
- p = sqlite_aggregate_context(context, sizeof(*p));
- if( p && p->z && p->zBuf[0]<2 ){
- sqlite_set_result_string(context, p->z, strlen(p->z));
- }
- if( p && p->zBuf[0] ){
- sqliteFree(p->z);
- }
-}
-
-/*
-** This function registered all of the above C functions as SQL
-** functions. This should be the only routine in this file with
-** external linkage.
-*/
-void sqliteRegisterBuiltinFunctions(sqlite *db){
- static struct {
- char *zName;
- signed char nArg;
- signed char dataType;
- u8 argType; /* 0: none. 1: db 2: (-1) */
- void (*xFunc)(sqlite_func*,int,const char**);
- } aFuncs[] = {
- { "min", -1, SQLITE_ARGS, 0, minmaxFunc },
- { "min", 0, 0, 0, 0 },
- { "max", -1, SQLITE_ARGS, 2, minmaxFunc },
- { "max", 0, 0, 2, 0 },
- { "typeof", 1, SQLITE_TEXT, 0, typeofFunc },
- { "length", 1, SQLITE_NUMERIC, 0, lengthFunc },
- { "substr", 3, SQLITE_TEXT, 0, substrFunc },
- { "abs", 1, SQLITE_NUMERIC, 0, absFunc },
- { "round", 1, SQLITE_NUMERIC, 0, roundFunc },
- { "round", 2, SQLITE_NUMERIC, 0, roundFunc },
- { "upper", 1, SQLITE_TEXT, 0, upperFunc },
- { "lower", 1, SQLITE_TEXT, 0, lowerFunc },
- { "coalesce", -1, SQLITE_ARGS, 0, ifnullFunc },
- { "coalesce", 0, 0, 0, 0 },
- { "coalesce", 1, 0, 0, 0 },
- { "ifnull", 2, SQLITE_ARGS, 0, ifnullFunc },
- { "random", -1, SQLITE_NUMERIC, 0, randomFunc },
- { "like", 2, SQLITE_NUMERIC, 0, likeFunc },
- { "glob", 2, SQLITE_NUMERIC, 0, globFunc },
- { "nullif", 2, SQLITE_ARGS, 0, nullifFunc },
- { "sqlite_version",0,SQLITE_TEXT, 0, versionFunc},
- { "quote", 1, SQLITE_ARGS, 0, quoteFunc },
- { "last_insert_rowid", 0, SQLITE_NUMERIC, 1, last_insert_rowid },
- { "change_count", 0, SQLITE_NUMERIC, 1, change_count },
- { "last_statement_change_count",
- 0, SQLITE_NUMERIC, 1, last_statement_change_count },
-#ifdef SQLITE_SOUNDEX
- { "soundex", 1, SQLITE_TEXT, 0, soundexFunc},
-#endif
-#ifdef SQLITE_TEST
- { "randstr", 2, SQLITE_TEXT, 0, randStr },
-#endif
- };
- static struct {
- char *zName;
- signed char nArg;
- signed char dataType;
- u8 argType;
- void (*xStep)(sqlite_func*,int,const char**);
- void (*xFinalize)(sqlite_func*);
- } aAggs[] = {
- { "min", 1, 0, 0, minmaxStep, minMaxFinalize },
- { "max", 1, 0, 2, minmaxStep, minMaxFinalize },
- { "sum", 1, SQLITE_NUMERIC, 0, sumStep, sumFinalize },
- { "avg", 1, SQLITE_NUMERIC, 0, sumStep, avgFinalize },
- { "count", 0, SQLITE_NUMERIC, 0, countStep, countFinalize },
- { "count", 1, SQLITE_NUMERIC, 0, countStep, countFinalize },
-#if 0
- { "stddev", 1, SQLITE_NUMERIC, 0, stdDevStep, stdDevFinalize },
-#endif
- };
- static const char *azTypeFuncs[] = { "min", "max", "typeof" };
- int i;
-
- for(i=0; i<sizeof(aFuncs)/sizeof(aFuncs[0]); i++){
- void *pArg;
- switch( aFuncs[i].argType ){
- case 0: pArg = 0; break;
- case 1: pArg = db; break;
- case 2: pArg = (void*)(-1); break;
- }
- sqlite_create_function(db, aFuncs[i].zName,
- aFuncs[i].nArg, aFuncs[i].xFunc, pArg);
- if( aFuncs[i].xFunc ){
- sqlite_function_type(db, aFuncs[i].zName, aFuncs[i].dataType);
- }
- }
- for(i=0; i<sizeof(aAggs)/sizeof(aAggs[0]); i++){
- void *pArg;
- switch( aAggs[i].argType ){
- case 0: pArg = 0; break;
- case 1: pArg = db; break;
- case 2: pArg = (void*)(-1); break;
- }
- sqlite_create_aggregate(db, aAggs[i].zName,
- aAggs[i].nArg, aAggs[i].xStep, aAggs[i].xFinalize, pArg);
- sqlite_function_type(db, aAggs[i].zName, aAggs[i].dataType);
- }
- for(i=0; i<sizeof(azTypeFuncs)/sizeof(azTypeFuncs[0]); i++){
- int n = strlen(azTypeFuncs[i]);
- FuncDef *p = sqliteHashFind(&db->aFunc, azTypeFuncs[i], n);
- while( p ){
- p->includeTypes = 1;
- p = p->pNext;
- }
- }
- sqliteRegisterDateTimeFunctions(db);
-}
+++ /dev/null
-use strict;
-use LWP::Simple qw(getstore);
-use Fatal qw(chdir);
-use ExtUtils::Command;
-
-my $version = shift || die "Usage: getsqlite.pl <version>\n";
-
-print("downloading http://www.sqlite.org/sqlite-$version.tar.gz\n");
-if (getstore(
- "http://www.sqlite.org/sqlite-$version.tar.gz",
- "sqlite.tar.gz") != 200) {
- die "Failed to download";
-}
-print("done\n");
-
-rm_rf('sqlite');
-xsystem("tar zxvf sqlite.tar.gz");
-chdir("sqlite");
-xsystem("sh configure --enable-utf8");
-xsystem("make parse.c sqlite.h opcodes.h opcodes.c");
-
-my %skip = map { $_ => 1 } map { chomp; $_ } <DATA>;
-warn("Skip: $_\n") for keys %skip;
-
-foreach (<*.[ch]>, `find src -name \\*.[ch]`) {
- chomp;
- next if $skip{$_};
- xsystem("cp $_ ../");
-}
-
-exit(0);
-
-sub xsystem {
- local $, = ", ";
- print("@_\n");
- my $ret = system(@_);
- if ($ret != 0) {
- die "system(@_) failed: $?";
- }
-}
-
-__DATA__
-lempar.c
-src/threadtest.c
-src/test1.c
-src/test2.c
-src/test3.c
-src/tclsqlite.c
-src/shell.c
-src/lemon.c
-src/md5.c
-
+++ /dev/null
-/*
-** 2001 September 22
-**
-** The author disclaims copyright to this source code. In place of
-** a legal notice, here is a blessing:
-**
-** May you do good and not evil.
-** May you find forgiveness for yourself and forgive others.
-** May you share freely, never taking more than you give.
-**
-*************************************************************************
-** This is the implementation of generic hash-tables
-** used in SQLite.
-**
-** $Id: hash.c,v 1.1.1.1 2004/08/08 15:03:57 matt Exp $
-*/
-#include "sqliteInt.h"
-#include <assert.h>
-
-/* Turn bulk memory into a hash table object by initializing the
-** fields of the Hash structure.
-**
-** "new" is a pointer to the hash table that is to be initialized.
-** keyClass is one of the constants SQLITE_HASH_INT, SQLITE_HASH_POINTER,
-** SQLITE_HASH_BINARY, or SQLITE_HASH_STRING. The value of keyClass
-** determines what kind of key the hash table will use. "copyKey" is
-** true if the hash table should make its own private copy of keys and
-** false if it should just use the supplied pointer. CopyKey only makes
-** sense for SQLITE_HASH_STRING and SQLITE_HASH_BINARY and is ignored
-** for other key classes.
-*/
-void sqliteHashInit(Hash *new, int keyClass, int copyKey){
- assert( new!=0 );
- assert( keyClass>=SQLITE_HASH_INT && keyClass<=SQLITE_HASH_BINARY );
- new->keyClass = keyClass;
- new->copyKey = copyKey &&
- (keyClass==SQLITE_HASH_STRING || keyClass==SQLITE_HASH_BINARY);
- new->first = 0;
- new->count = 0;
- new->htsize = 0;
- new->ht = 0;
-}
-
-/* Remove all entries from a hash table. Reclaim all memory.
-** Call this routine to delete a hash table or to reset a hash table
-** to the empty state.
-*/
-void sqliteHashClear(Hash *pH){
- HashElem *elem; /* For looping over all elements of the table */
-
- assert( pH!=0 );
- elem = pH->first;
- pH->first = 0;
- if( pH->ht ) sqliteFree(pH->ht);
- pH->ht = 0;
- pH->htsize = 0;
- while( elem ){
- HashElem *next_elem = elem->next;
- if( pH->copyKey && elem->pKey ){
- sqliteFree(elem->pKey);
- }
- sqliteFree(elem);
- elem = next_elem;
- }
- pH->count = 0;
-}
-
-/*
-** Hash and comparison functions when the mode is SQLITE_HASH_INT
-*/
-static int intHash(const void *pKey, int nKey){
- return nKey ^ (nKey<<8) ^ (nKey>>8);
-}
-static int intCompare(const void *pKey1, int n1, const void *pKey2, int n2){
- return n2 - n1;
-}
-
-#if 0 /* NOT USED */
-/*
-** Hash and comparison functions when the mode is SQLITE_HASH_POINTER
-*/
-static int ptrHash(const void *pKey, int nKey){
- uptr x = Addr(pKey);
- return x ^ (x<<8) ^ (x>>8);
-}
-static int ptrCompare(const void *pKey1, int n1, const void *pKey2, int n2){
- if( pKey1==pKey2 ) return 0;
- if( pKey1<pKey2 ) return -1;
- return 1;
-}
-#endif
-
-/*
-** Hash and comparison functions when the mode is SQLITE_HASH_STRING
-*/
-static int strHash(const void *pKey, int nKey){
- return sqliteHashNoCase((const char*)pKey, nKey);
-}
-static int strCompare(const void *pKey1, int n1, const void *pKey2, int n2){
- if( n1!=n2 ) return n2-n1;
- return sqliteStrNICmp((const char*)pKey1,(const char*)pKey2,n1);
-}
-
-/*
-** Hash and comparison functions when the mode is SQLITE_HASH_BINARY
-*/
-static int binHash(const void *pKey, int nKey){
- int h = 0;
- const char *z = (const char *)pKey;
- while( nKey-- > 0 ){
- h = (h<<3) ^ h ^ *(z++);
- }
- return h & 0x7fffffff;
-}
-static int binCompare(const void *pKey1, int n1, const void *pKey2, int n2){
- if( n1!=n2 ) return n2-n1;
- return memcmp(pKey1,pKey2,n1);
-}
-
-/*
-** Return a pointer to the appropriate hash function given the key class.
-**
-** The C syntax in this function definition may be unfamilar to some
-** programmers, so we provide the following additional explanation:
-**
-** The name of the function is "hashFunction". The function takes a
-** single parameter "keyClass". The return value of hashFunction()
-** is a pointer to another function. Specifically, the return value
-** of hashFunction() is a pointer to a function that takes two parameters
-** with types "const void*" and "int" and returns an "int".
-*/
-static int (*hashFunction(int keyClass))(const void*,int){
- switch( keyClass ){
- case SQLITE_HASH_INT: return &intHash;
- /* case SQLITE_HASH_POINTER: return &ptrHash; // NOT USED */
- case SQLITE_HASH_STRING: return &strHash;
- case SQLITE_HASH_BINARY: return &binHash;;
- default: break;
- }
- return 0;
-}
-
-/*
-** Return a pointer to the appropriate hash function given the key class.
-**
-** For help in interpreted the obscure C code in the function definition,
-** see the header comment on the previous function.
-*/
-static int (*compareFunction(int keyClass))(const void*,int,const void*,int){
- switch( keyClass ){
- case SQLITE_HASH_INT: return &intCompare;
- /* case SQLITE_HASH_POINTER: return &ptrCompare; // NOT USED */
- case SQLITE_HASH_STRING: return &strCompare;
- case SQLITE_HASH_BINARY: return &binCompare;
- default: break;
- }
- return 0;
-}
-
-
-/* Resize the hash table so that it cantains "new_size" buckets.
-** "new_size" must be a power of 2. The hash table might fail
-** to resize if sqliteMalloc() fails.
-*/
-static void rehash(Hash *pH, int new_size){
- struct _ht *new_ht; /* The new hash table */
- HashElem *elem, *next_elem; /* For looping over existing elements */
- HashElem *x; /* Element being copied to new hash table */
- int (*xHash)(const void*,int); /* The hash function */
-
- assert( (new_size & (new_size-1))==0 );
- new_ht = (struct _ht *)sqliteMalloc( new_size*sizeof(struct _ht) );
- if( new_ht==0 ) return;
- if( pH->ht ) sqliteFree(pH->ht);
- pH->ht = new_ht;
- pH->htsize = new_size;
- xHash = hashFunction(pH->keyClass);
- for(elem=pH->first, pH->first=0; elem; elem = next_elem){
- int h = (*xHash)(elem->pKey, elem->nKey) & (new_size-1);
- next_elem = elem->next;
- x = new_ht[h].chain;
- if( x ){
- elem->next = x;
- elem->prev = x->prev;
- if( x->prev ) x->prev->next = elem;
- else pH->first = elem;
- x->prev = elem;
- }else{
- elem->next = pH->first;
- if( pH->first ) pH->first->prev = elem;
- elem->prev = 0;
- pH->first = elem;
- }
- new_ht[h].chain = elem;
- new_ht[h].count++;
- }
-}
-
-/* This function (for internal use only) locates an element in an
-** hash table that matches the given key. The hash for this key has
-** already been computed and is passed as the 4th parameter.
-*/
-static HashElem *findElementGivenHash(
- const Hash *pH, /* The pH to be searched */
- const void *pKey, /* The key we are searching for */
- int nKey,
- int h /* The hash for this key. */
-){
- HashElem *elem; /* Used to loop thru the element list */
- int count; /* Number of elements left to test */
- int (*xCompare)(const void*,int,const void*,int); /* comparison function */
-
- if( pH->ht ){
- elem = pH->ht[h].chain;
- count = pH->ht[h].count;
- xCompare = compareFunction(pH->keyClass);
- while( count-- && elem ){
- if( (*xCompare)(elem->pKey,elem->nKey,pKey,nKey)==0 ){
- return elem;
- }
- elem = elem->next;
- }
- }
- return 0;
-}
-
-/* Remove a single entry from the hash table given a pointer to that
-** element and a hash on the element's key.
-*/
-static void removeElementGivenHash(
- Hash *pH, /* The pH containing "elem" */
- HashElem* elem, /* The element to be removed from the pH */
- int h /* Hash value for the element */
-){
- if( elem->prev ){
- elem->prev->next = elem->next;
- }else{
- pH->first = elem->next;
- }
- if( elem->next ){
- elem->next->prev = elem->prev;
- }
- if( pH->ht[h].chain==elem ){
- pH->ht[h].chain = elem->next;
- }
- pH->ht[h].count--;
- if( pH->ht[h].count<=0 ){
- pH->ht[h].chain = 0;
- }
- if( pH->copyKey && elem->pKey ){
- sqliteFree(elem->pKey);
- }
- sqliteFree( elem );
- pH->count--;
-}
-
-/* Attempt to locate an element of the hash table pH with a key
-** that matches pKey,nKey. Return the data for this element if it is
-** found, or NULL if there is no match.
-*/
-void *sqliteHashFind(const Hash *pH, const void *pKey, int nKey){
- int h; /* A hash on key */
- HashElem *elem; /* The element that matches key */
- int (*xHash)(const void*,int); /* The hash function */
-
- if( pH==0 || pH->ht==0 ) return 0;
- xHash = hashFunction(pH->keyClass);
- assert( xHash!=0 );
- h = (*xHash)(pKey,nKey);
- assert( (pH->htsize & (pH->htsize-1))==0 );
- elem = findElementGivenHash(pH,pKey,nKey, h & (pH->htsize-1));
- return elem ? elem->data : 0;
-}
-
-/* Insert an element into the hash table pH. The key is pKey,nKey
-** and the data is "data".
-**
-** If no element exists with a matching key, then a new
-** element is created. A copy of the key is made if the copyKey
-** flag is set. NULL is returned.
-**
-** If another element already exists with the same key, then the
-** new data replaces the old data and the old data is returned.
-** The key is not copied in this instance. If a malloc fails, then
-** the new data is returned and the hash table is unchanged.
-**
-** If the "data" parameter to this function is NULL, then the
-** element corresponding to "key" is removed from the hash table.
-*/
-void *sqliteHashInsert(Hash *pH, const void *pKey, int nKey, void *data){
- int hraw; /* Raw hash value of the key */
- int h; /* the hash of the key modulo hash table size */
- HashElem *elem; /* Used to loop thru the element list */
- HashElem *new_elem; /* New element added to the pH */
- int (*xHash)(const void*,int); /* The hash function */
-
- assert( pH!=0 );
- xHash = hashFunction(pH->keyClass);
- assert( xHash!=0 );
- hraw = (*xHash)(pKey, nKey);
- assert( (pH->htsize & (pH->htsize-1))==0 );
- h = hraw & (pH->htsize-1);
- elem = findElementGivenHash(pH,pKey,nKey,h);
- if( elem ){
- void *old_data = elem->data;
- if( data==0 ){
- removeElementGivenHash(pH,elem,h);
- }else{
- elem->data = data;
- }
- return old_data;
- }
- if( data==0 ) return 0;
- new_elem = (HashElem*)sqliteMalloc( sizeof(HashElem) );
- if( new_elem==0 ) return data;
- if( pH->copyKey && pKey!=0 ){
- new_elem->pKey = sqliteMallocRaw( nKey );
- if( new_elem->pKey==0 ){
- sqliteFree(new_elem);
- return data;
- }
- memcpy((void*)new_elem->pKey, pKey, nKey);
- }else{
- new_elem->pKey = (void*)pKey;
- }
- new_elem->nKey = nKey;
- pH->count++;
- if( pH->htsize==0 ) rehash(pH,8);
- if( pH->htsize==0 ){
- pH->count = 0;
- sqliteFree(new_elem);
- return data;
- }
- if( pH->count > pH->htsize ){
- rehash(pH,pH->htsize*2);
- }
- assert( (pH->htsize & (pH->htsize-1))==0 );
- h = hraw & (pH->htsize-1);
- elem = pH->ht[h].chain;
- if( elem ){
- new_elem->next = elem;
- new_elem->prev = elem->prev;
- if( elem->prev ){ elem->prev->next = new_elem; }
- else { pH->first = new_elem; }
- elem->prev = new_elem;
- }else{
- new_elem->next = pH->first;
- new_elem->prev = 0;
- if( pH->first ){ pH->first->prev = new_elem; }
- pH->first = new_elem;
- }
- pH->ht[h].count++;
- pH->ht[h].chain = new_elem;
- new_elem->data = data;
- return 0;
-}
+++ /dev/null
-/*
-** 2001 September 22
-**
-** The author disclaims copyright to this source code. In place of
-** a legal notice, here is a blessing:
-**
-** May you do good and not evil.
-** May you find forgiveness for yourself and forgive others.
-** May you share freely, never taking more than you give.
-**
-*************************************************************************
-** This is the header file for the generic hash-table implemenation
-** used in SQLite.
-**
-** $Id: hash.h,v 1.1.1.1 2004/08/08 15:03:57 matt Exp $
-*/
-#ifndef _SQLITE_HASH_H_
-#define _SQLITE_HASH_H_
-
-/* Forward declarations of structures. */
-typedef struct Hash Hash;
-typedef struct HashElem HashElem;
-
-/* A complete hash table is an instance of the following structure.
-** The internals of this structure are intended to be opaque -- client
-** code should not attempt to access or modify the fields of this structure
-** directly. Change this structure only by using the routines below.
-** However, many of the "procedures" and "functions" for modifying and
-** accessing this structure are really macros, so we can't really make
-** this structure opaque.
-*/
-struct Hash {
- char keyClass; /* SQLITE_HASH_INT, _POINTER, _STRING, _BINARY */
- char copyKey; /* True if copy of key made on insert */
- int count; /* Number of entries in this table */
- HashElem *first; /* The first element of the array */
- int htsize; /* Number of buckets in the hash table */
- struct _ht { /* the hash table */
- int count; /* Number of entries with this hash */
- HashElem *chain; /* Pointer to first entry with this hash */
- } *ht;
-};
-
-/* Each element in the hash table is an instance of the following
-** structure. All elements are stored on a single doubly-linked list.
-**
-** Again, this structure is intended to be opaque, but it can't really
-** be opaque because it is used by macros.
-*/
-struct HashElem {
- HashElem *next, *prev; /* Next and previous elements in the table */
- void *data; /* Data associated with this element */
- void *pKey; int nKey; /* Key associated with this element */
-};
-
-/*
-** There are 4 different modes of operation for a hash table:
-**
-** SQLITE_HASH_INT nKey is used as the key and pKey is ignored.
-**
-** SQLITE_HASH_POINTER pKey is used as the key and nKey is ignored.
-**
-** SQLITE_HASH_STRING pKey points to a string that is nKey bytes long
-** (including the null-terminator, if any). Case
-** is ignored in comparisons.
-**
-** SQLITE_HASH_BINARY pKey points to binary data nKey bytes long.
-** memcmp() is used to compare keys.
-**
-** A copy of the key is made for SQLITE_HASH_STRING and SQLITE_HASH_BINARY
-** if the copyKey parameter to HashInit is 1.
-*/
-#define SQLITE_HASH_INT 1
-/* #define SQLITE_HASH_POINTER 2 // NOT USED */
-#define SQLITE_HASH_STRING 3
-#define SQLITE_HASH_BINARY 4
-
-/*
-** Access routines. To delete, insert a NULL pointer.
-*/
-void sqliteHashInit(Hash*, int keytype, int copyKey);
-void *sqliteHashInsert(Hash*, const void *pKey, int nKey, void *pData);
-void *sqliteHashFind(const Hash*, const void *pKey, int nKey);
-void sqliteHashClear(Hash*);
-
-/*
-** Macros for looping over all elements of a hash table. The idiom is
-** like this:
-**
-** Hash h;
-** HashElem *p;
-** ...
-** for(p=sqliteHashFirst(&h); p; p=sqliteHashNext(p)){
-** SomeStructure *pData = sqliteHashData(p);
-** // do something with pData
-** }
-*/
-#define sqliteHashFirst(H) ((H)->first)
-#define sqliteHashNext(E) ((E)->next)
-#define sqliteHashData(E) ((E)->data)
-#define sqliteHashKey(E) ((E)->pKey)
-#define sqliteHashKeysize(E) ((E)->nKey)
-
-/*
-** Number of entries in a hash table
-*/
-#define sqliteHashCount(H) ((H)->count)
-
-#endif /* _SQLITE_HASH_H_ */
+++ /dev/null
-/*
-** 2001 September 15
-**
-** The author disclaims copyright to this source code. In place of
-** a legal notice, here is a blessing:
-**
-** May you do good and not evil.
-** May you find forgiveness for yourself and forgive others.
-** May you share freely, never taking more than you give.
-**
-*************************************************************************
-** This file contains C code routines that are called by the parser
-** to handle INSERT statements in SQLite.
-**
-** $Id: insert.c,v 1.1.1.1 2004/08/08 15:03:57 matt Exp $
-*/
-#include "sqliteInt.h"
-
-/*
-** This routine is call to handle SQL of the following forms:
-**
-** insert into TABLE (IDLIST) values(EXPRLIST)
-** insert into TABLE (IDLIST) select
-**
-** The IDLIST following the table name is always optional. If omitted,
-** then a list of all columns for the table is substituted. The IDLIST
-** appears in the pColumn parameter. pColumn is NULL if IDLIST is omitted.
-**
-** The pList parameter holds EXPRLIST in the first form of the INSERT
-** statement above, and pSelect is NULL. For the second form, pList is
-** NULL and pSelect is a pointer to the select statement used to generate
-** data for the insert.
-**
-** The code generated follows one of three templates. For a simple
-** select with data coming from a VALUES clause, the code executes
-** once straight down through. The template looks like this:
-**
-** open write cursor to <table> and its indices
-** puts VALUES clause expressions onto the stack
-** write the resulting record into <table>
-** cleanup
-**
-** If the statement is of the form
-**
-** INSERT INTO <table> SELECT ...
-**
-** And the SELECT clause does not read from <table> at any time, then
-** the generated code follows this template:
-**
-** goto B
-** A: setup for the SELECT
-** loop over the tables in the SELECT
-** gosub C
-** end loop
-** cleanup after the SELECT
-** goto D
-** B: open write cursor to <table> and its indices
-** goto A
-** C: insert the select result into <table>
-** return
-** D: cleanup
-**
-** The third template is used if the insert statement takes its
-** values from a SELECT but the data is being inserted into a table
-** that is also read as part of the SELECT. In the third form,
-** we have to use a intermediate table to store the results of
-** the select. The template is like this:
-**
-** goto B
-** A: setup for the SELECT
-** loop over the tables in the SELECT
-** gosub C
-** end loop
-** cleanup after the SELECT
-** goto D
-** C: insert the select result into the intermediate table
-** return
-** B: open a cursor to an intermediate table
-** goto A
-** D: open write cursor to <table> and its indices
-** loop over the intermediate table
-** transfer values form intermediate table into <table>
-** end the loop
-** cleanup
-*/
-void sqliteInsert(
- Parse *pParse, /* Parser context */
- SrcList *pTabList, /* Name of table into which we are inserting */
- ExprList *pList, /* List of values to be inserted */
- Select *pSelect, /* A SELECT statement to use as the data source */
- IdList *pColumn, /* Column names corresponding to IDLIST. */
- int onError /* How to handle constraint errors */
-){
- Table *pTab; /* The table to insert into */
- char *zTab; /* Name of the table into which we are inserting */
- const char *zDb; /* Name of the database holding this table */
- int i, j, idx; /* Loop counters */
- Vdbe *v; /* Generate code into this virtual machine */
- Index *pIdx; /* For looping over indices of the table */
- int nColumn; /* Number of columns in the data */
- int base; /* VDBE Cursor number for pTab */
- int iCont, iBreak; /* Beginning and end of the loop over srcTab */
- sqlite *db; /* The main database structure */
- int keyColumn = -1; /* Column that is the INTEGER PRIMARY KEY */
- int endOfLoop; /* Label for the end of the insertion loop */
- int useTempTable; /* Store SELECT results in intermediate table */
- int srcTab; /* Data comes from this temporary cursor if >=0 */
- int iSelectLoop; /* Address of code that implements the SELECT */
- int iCleanup; /* Address of the cleanup code */
- int iInsertBlock; /* Address of the subroutine used to insert data */
- int iCntMem; /* Memory cell used for the row counter */
- int isView; /* True if attempting to insert into a view */
-
- int row_triggers_exist = 0; /* True if there are FOR EACH ROW triggers */
- int before_triggers; /* True if there are BEFORE triggers */
- int after_triggers; /* True if there are AFTER triggers */
- int newIdx = -1; /* Cursor for the NEW table */
-
- if( pParse->nErr || sqlite_malloc_failed ) goto insert_cleanup;
- db = pParse->db;
-
- /* Locate the table into which we will be inserting new information.
- */
- assert( pTabList->nSrc==1 );
- zTab = pTabList->a[0].zName;
- if( zTab==0 ) goto insert_cleanup;
- pTab = sqliteSrcListLookup(pParse, pTabList);
- if( pTab==0 ){
- goto insert_cleanup;
- }
- assert( pTab->iDb<db->nDb );
- zDb = db->aDb[pTab->iDb].zName;
- if( sqliteAuthCheck(pParse, SQLITE_INSERT, pTab->zName, 0, zDb) ){
- goto insert_cleanup;
- }
-
- /* Ensure that:
- * (a) the table is not read-only,
- * (b) that if it is a view then ON INSERT triggers exist
- */
- before_triggers = sqliteTriggersExist(pParse, pTab->pTrigger, TK_INSERT,
- TK_BEFORE, TK_ROW, 0);
- after_triggers = sqliteTriggersExist(pParse, pTab->pTrigger, TK_INSERT,
- TK_AFTER, TK_ROW, 0);
- row_triggers_exist = before_triggers || after_triggers;
- isView = pTab->pSelect!=0;
- if( sqliteIsReadOnly(pParse, pTab, before_triggers) ){
- goto insert_cleanup;
- }
- if( pTab==0 ) goto insert_cleanup;
-
- /* If pTab is really a view, make sure it has been initialized.
- */
- if( isView && sqliteViewGetColumnNames(pParse, pTab) ){
- goto insert_cleanup;
- }
-
- /* Allocate a VDBE
- */
- v = sqliteGetVdbe(pParse);
- if( v==0 ) goto insert_cleanup;
- sqliteBeginWriteOperation(pParse, pSelect || row_triggers_exist, pTab->iDb);
-
- /* if there are row triggers, allocate a temp table for new.* references. */
- if( row_triggers_exist ){
- newIdx = pParse->nTab++;
- }
-
- /* Figure out how many columns of data are supplied. If the data
- ** is coming from a SELECT statement, then this step also generates
- ** all the code to implement the SELECT statement and invoke a subroutine
- ** to process each row of the result. (Template 2.) If the SELECT
- ** statement uses the the table that is being inserted into, then the
- ** subroutine is also coded here. That subroutine stores the SELECT
- ** results in a temporary table. (Template 3.)
- */
- if( pSelect ){
- /* Data is coming from a SELECT. Generate code to implement that SELECT
- */
- int rc, iInitCode;
- iInitCode = sqliteVdbeAddOp(v, OP_Goto, 0, 0);
- iSelectLoop = sqliteVdbeCurrentAddr(v);
- iInsertBlock = sqliteVdbeMakeLabel(v);
- rc = sqliteSelect(pParse, pSelect, SRT_Subroutine, iInsertBlock, 0,0,0);
- if( rc || pParse->nErr || sqlite_malloc_failed ) goto insert_cleanup;
- iCleanup = sqliteVdbeMakeLabel(v);
- sqliteVdbeAddOp(v, OP_Goto, 0, iCleanup);
- assert( pSelect->pEList );
- nColumn = pSelect->pEList->nExpr;
-
- /* Set useTempTable to TRUE if the result of the SELECT statement
- ** should be written into a temporary table. Set to FALSE if each
- ** row of the SELECT can be written directly into the result table.
- **
- ** A temp table must be used if the table being updated is also one
- ** of the tables being read by the SELECT statement. Also use a
- ** temp table in the case of row triggers.
- */
- if( row_triggers_exist ){
- useTempTable = 1;
- }else{
- int addr = sqliteVdbeFindOp(v, OP_OpenRead, pTab->tnum);
- useTempTable = 0;
- if( addr>0 ){
- VdbeOp *pOp = sqliteVdbeGetOp(v, addr-2);
- if( pOp->opcode==OP_Integer && pOp->p1==pTab->iDb ){
- useTempTable = 1;
- }
- }
- }
-
- if( useTempTable ){
- /* Generate the subroutine that SELECT calls to process each row of
- ** the result. Store the result in a temporary table
- */
- srcTab = pParse->nTab++;
- sqliteVdbeResolveLabel(v, iInsertBlock);
- sqliteVdbeAddOp(v, OP_MakeRecord, nColumn, 0);
- sqliteVdbeAddOp(v, OP_NewRecno, srcTab, 0);
- sqliteVdbeAddOp(v, OP_Pull, 1, 0);
- sqliteVdbeAddOp(v, OP_PutIntKey, srcTab, 0);
- sqliteVdbeAddOp(v, OP_Return, 0, 0);
-
- /* The following code runs first because the GOTO at the very top
- ** of the program jumps to it. Create the temporary table, then jump
- ** back up and execute the SELECT code above.
- */
- sqliteVdbeChangeP2(v, iInitCode, sqliteVdbeCurrentAddr(v));
- sqliteVdbeAddOp(v, OP_OpenTemp, srcTab, 0);
- sqliteVdbeAddOp(v, OP_Goto, 0, iSelectLoop);
- sqliteVdbeResolveLabel(v, iCleanup);
- }else{
- sqliteVdbeChangeP2(v, iInitCode, sqliteVdbeCurrentAddr(v));
- }
- }else{
- /* This is the case if the data for the INSERT is coming from a VALUES
- ** clause
- */
- SrcList dummy;
- assert( pList!=0 );
- srcTab = -1;
- useTempTable = 0;
- assert( pList );
- nColumn = pList->nExpr;
- dummy.nSrc = 0;
- for(i=0; i<nColumn; i++){
- if( sqliteExprResolveIds(pParse, &dummy, 0, pList->a[i].pExpr) ){
- goto insert_cleanup;
- }
- if( sqliteExprCheck(pParse, pList->a[i].pExpr, 0, 0) ){
- goto insert_cleanup;
- }
- }
- }
-
- /* Make sure the number of columns in the source data matches the number
- ** of columns to be inserted into the table.
- */
- if( pColumn==0 && nColumn!=pTab->nCol ){
- sqliteErrorMsg(pParse,
- "table %S has %d columns but %d values were supplied",
- pTabList, 0, pTab->nCol, nColumn);
- goto insert_cleanup;
- }
- if( pColumn!=0 && nColumn!=pColumn->nId ){
- sqliteErrorMsg(pParse, "%d values for %d columns", nColumn, pColumn->nId);
- goto insert_cleanup;
- }
-
- /* If the INSERT statement included an IDLIST term, then make sure
- ** all elements of the IDLIST really are columns of the table and
- ** remember the column indices.
- **
- ** If the table has an INTEGER PRIMARY KEY column and that column
- ** is named in the IDLIST, then record in the keyColumn variable
- ** the index into IDLIST of the primary key column. keyColumn is
- ** the index of the primary key as it appears in IDLIST, not as
- ** is appears in the original table. (The index of the primary
- ** key in the original table is pTab->iPKey.)
- */
- if( pColumn ){
- for(i=0; i<pColumn->nId; i++){
- pColumn->a[i].idx = -1;
- }
- for(i=0; i<pColumn->nId; i++){
- for(j=0; j<pTab->nCol; j++){
- if( sqliteStrICmp(pColumn->a[i].zName, pTab->aCol[j].zName)==0 ){
- pColumn->a[i].idx = j;
- if( j==pTab->iPKey ){
- keyColumn = i;
- }
- break;
- }
- }
- if( j>=pTab->nCol ){
- if( sqliteIsRowid(pColumn->a[i].zName) ){
- keyColumn = i;
- }else{
- sqliteErrorMsg(pParse, "table %S has no column named %s",
- pTabList, 0, pColumn->a[i].zName);
- pParse->nErr++;
- goto insert_cleanup;
- }
- }
- }
- }
-
- /* If there is no IDLIST term but the table has an integer primary
- ** key, the set the keyColumn variable to the primary key column index
- ** in the original table definition.
- */
- if( pColumn==0 ){
- keyColumn = pTab->iPKey;
- }
-
- /* Open the temp table for FOR EACH ROW triggers
- */
- if( row_triggers_exist ){
- sqliteVdbeAddOp(v, OP_OpenPseudo, newIdx, 0);
- }
-
- /* Initialize the count of rows to be inserted
- */
- if( db->flags & SQLITE_CountRows ){
- iCntMem = pParse->nMem++;
- sqliteVdbeAddOp(v, OP_Integer, 0, 0);
- sqliteVdbeAddOp(v, OP_MemStore, iCntMem, 1);
- }
-
- /* Open tables and indices if there are no row triggers */
- if( !row_triggers_exist ){
- base = pParse->nTab;
- idx = sqliteOpenTableAndIndices(pParse, pTab, base);
- pParse->nTab += idx;
- }
-
- /* If the data source is a temporary table, then we have to create
- ** a loop because there might be multiple rows of data. If the data
- ** source is a subroutine call from the SELECT statement, then we need
- ** to launch the SELECT statement processing.
- */
- if( useTempTable ){
- iBreak = sqliteVdbeMakeLabel(v);
- sqliteVdbeAddOp(v, OP_Rewind, srcTab, iBreak);
- iCont = sqliteVdbeCurrentAddr(v);
- }else if( pSelect ){
- sqliteVdbeAddOp(v, OP_Goto, 0, iSelectLoop);
- sqliteVdbeResolveLabel(v, iInsertBlock);
- }
-
- /* Run the BEFORE and INSTEAD OF triggers, if there are any
- */
- endOfLoop = sqliteVdbeMakeLabel(v);
- if( before_triggers ){
-
- /* build the NEW.* reference row. Note that if there is an INTEGER
- ** PRIMARY KEY into which a NULL is being inserted, that NULL will be
- ** translated into a unique ID for the row. But on a BEFORE trigger,
- ** we do not know what the unique ID will be (because the insert has
- ** not happened yet) so we substitute a rowid of -1
- */
- if( keyColumn<0 ){
- sqliteVdbeAddOp(v, OP_Integer, -1, 0);
- }else if( useTempTable ){
- sqliteVdbeAddOp(v, OP_Column, srcTab, keyColumn);
- }else if( pSelect ){
- sqliteVdbeAddOp(v, OP_Dup, nColumn - keyColumn - 1, 1);
- }else{
- sqliteExprCode(pParse, pList->a[keyColumn].pExpr);
- sqliteVdbeAddOp(v, OP_NotNull, -1, sqliteVdbeCurrentAddr(v)+3);
- sqliteVdbeAddOp(v, OP_Pop, 1, 0);
- sqliteVdbeAddOp(v, OP_Integer, -1, 0);
- sqliteVdbeAddOp(v, OP_MustBeInt, 0, 0);
- }
-
- /* Create the new column data
- */
- for(i=0; i<pTab->nCol; i++){
- if( pColumn==0 ){
- j = i;
- }else{
- for(j=0; j<pColumn->nId; j++){
- if( pColumn->a[j].idx==i ) break;
- }
- }
- if( pColumn && j>=pColumn->nId ){
- sqliteVdbeOp3(v, OP_String, 0, 0, pTab->aCol[i].zDflt, P3_STATIC);
- }else if( useTempTable ){
- sqliteVdbeAddOp(v, OP_Column, srcTab, j);
- }else if( pSelect ){
- sqliteVdbeAddOp(v, OP_Dup, nColumn-j-1, 1);
- }else{
- sqliteExprCode(pParse, pList->a[j].pExpr);
- }
- }
- sqliteVdbeAddOp(v, OP_MakeRecord, pTab->nCol, 0);
- sqliteVdbeAddOp(v, OP_PutIntKey, newIdx, 0);
-
- /* Fire BEFORE or INSTEAD OF triggers */
- if( sqliteCodeRowTrigger(pParse, TK_INSERT, 0, TK_BEFORE, pTab,
- newIdx, -1, onError, endOfLoop) ){
- goto insert_cleanup;
- }
- }
-
- /* If any triggers exists, the opening of tables and indices is deferred
- ** until now.
- */
- if( row_triggers_exist && !isView ){
- base = pParse->nTab;
- idx = sqliteOpenTableAndIndices(pParse, pTab, base);
- pParse->nTab += idx;
- }
-
- /* Push the record number for the new entry onto the stack. The
- ** record number is a randomly generate integer created by NewRecno
- ** except when the table has an INTEGER PRIMARY KEY column, in which
- ** case the record number is the same as that column.
- */
- if( !isView ){
- if( keyColumn>=0 ){
- if( useTempTable ){
- sqliteVdbeAddOp(v, OP_Column, srcTab, keyColumn);
- }else if( pSelect ){
- sqliteVdbeAddOp(v, OP_Dup, nColumn - keyColumn - 1, 1);
- }else{
- sqliteExprCode(pParse, pList->a[keyColumn].pExpr);
- }
- /* If the PRIMARY KEY expression is NULL, then use OP_NewRecno
- ** to generate a unique primary key value.
- */
- sqliteVdbeAddOp(v, OP_NotNull, -1, sqliteVdbeCurrentAddr(v)+3);
- sqliteVdbeAddOp(v, OP_Pop, 1, 0);
- sqliteVdbeAddOp(v, OP_NewRecno, base, 0);
- sqliteVdbeAddOp(v, OP_MustBeInt, 0, 0);
- }else{
- sqliteVdbeAddOp(v, OP_NewRecno, base, 0);
- }
-
- /* Push onto the stack, data for all columns of the new entry, beginning
- ** with the first column.
- */
- for(i=0; i<pTab->nCol; i++){
- if( i==pTab->iPKey ){
- /* The value of the INTEGER PRIMARY KEY column is always a NULL.
- ** Whenever this column is read, the record number will be substituted
- ** in its place. So will fill this column with a NULL to avoid
- ** taking up data space with information that will never be used. */
- sqliteVdbeAddOp(v, OP_String, 0, 0);
- continue;
- }
- if( pColumn==0 ){
- j = i;
- }else{
- for(j=0; j<pColumn->nId; j++){
- if( pColumn->a[j].idx==i ) break;
- }
- }
- if( pColumn && j>=pColumn->nId ){
- sqliteVdbeOp3(v, OP_String, 0, 0, pTab->aCol[i].zDflt, P3_STATIC);
- }else if( useTempTable ){
- sqliteVdbeAddOp(v, OP_Column, srcTab, j);
- }else if( pSelect ){
- sqliteVdbeAddOp(v, OP_Dup, i+nColumn-j, 1);
- }else{
- sqliteExprCode(pParse, pList->a[j].pExpr);
- }
- }
-
- /* Generate code to check constraints and generate index keys and
- ** do the insertion.
- */
- sqliteGenerateConstraintChecks(pParse, pTab, base, 0, keyColumn>=0,
- 0, onError, endOfLoop);
- sqliteCompleteInsertion(pParse, pTab, base, 0,0,0,
- after_triggers ? newIdx : -1);
- }
-
- /* Update the count of rows that are inserted
- */
- if( (db->flags & SQLITE_CountRows)!=0 ){
- sqliteVdbeAddOp(v, OP_MemIncr, iCntMem, 0);
- }
-
- if( row_triggers_exist ){
- /* Close all tables opened */
- if( !isView ){
- sqliteVdbeAddOp(v, OP_Close, base, 0);
- for(idx=1, pIdx=pTab->pIndex; pIdx; pIdx=pIdx->pNext, idx++){
- sqliteVdbeAddOp(v, OP_Close, idx+base, 0);
- }
- }
-
- /* Code AFTER triggers */
- if( sqliteCodeRowTrigger(pParse, TK_INSERT, 0, TK_AFTER, pTab, newIdx, -1,
- onError, endOfLoop) ){
- goto insert_cleanup;
- }
- }
-
- /* The bottom of the loop, if the data source is a SELECT statement
- */
- sqliteVdbeResolveLabel(v, endOfLoop);
- if( useTempTable ){
- sqliteVdbeAddOp(v, OP_Next, srcTab, iCont);
- sqliteVdbeResolveLabel(v, iBreak);
- sqliteVdbeAddOp(v, OP_Close, srcTab, 0);
- }else if( pSelect ){
- sqliteVdbeAddOp(v, OP_Pop, nColumn, 0);
- sqliteVdbeAddOp(v, OP_Return, 0, 0);
- sqliteVdbeResolveLabel(v, iCleanup);
- }
-
- if( !row_triggers_exist ){
- /* Close all tables opened */
- sqliteVdbeAddOp(v, OP_Close, base, 0);
- for(idx=1, pIdx=pTab->pIndex; pIdx; pIdx=pIdx->pNext, idx++){
- sqliteVdbeAddOp(v, OP_Close, idx+base, 0);
- }
- }
-
- sqliteVdbeAddOp(v, OP_SetCounts, 0, 0);
- sqliteEndWriteOperation(pParse);
-
- /*
- ** Return the number of rows inserted.
- */
- if( db->flags & SQLITE_CountRows ){
- sqliteVdbeOp3(v, OP_ColumnName, 0, 1, "rows inserted", P3_STATIC);
- sqliteVdbeAddOp(v, OP_MemLoad, iCntMem, 0);
- sqliteVdbeAddOp(v, OP_Callback, 1, 0);
- }
-
-insert_cleanup:
- sqliteSrcListDelete(pTabList);
- if( pList ) sqliteExprListDelete(pList);
- if( pSelect ) sqliteSelectDelete(pSelect);
- sqliteIdListDelete(pColumn);
-}
-
-/*
-** Generate code to do a constraint check prior to an INSERT or an UPDATE.
-**
-** When this routine is called, the stack contains (from bottom to top)
-** the following values:
-**
-** 1. The recno of the row to be updated before the update. This
-** value is omitted unless we are doing an UPDATE that involves a
-** change to the record number.
-**
-** 2. The recno of the row after the update.
-**
-** 3. The data in the first column of the entry after the update.
-**
-** i. Data from middle columns...
-**
-** N. The data in the last column of the entry after the update.
-**
-** The old recno shown as entry (1) above is omitted unless both isUpdate
-** and recnoChng are 1. isUpdate is true for UPDATEs and false for
-** INSERTs and recnoChng is true if the record number is being changed.
-**
-** The code generated by this routine pushes additional entries onto
-** the stack which are the keys for new index entries for the new record.
-** The order of index keys is the same as the order of the indices on
-** the pTable->pIndex list. A key is only created for index i if
-** aIdxUsed!=0 and aIdxUsed[i]!=0.
-**
-** This routine also generates code to check constraints. NOT NULL,
-** CHECK, and UNIQUE constraints are all checked. If a constraint fails,
-** then the appropriate action is performed. There are five possible
-** actions: ROLLBACK, ABORT, FAIL, REPLACE, and IGNORE.
-**
-** Constraint type Action What Happens
-** --------------- ---------- ----------------------------------------
-** any ROLLBACK The current transaction is rolled back and
-** sqlite_exec() returns immediately with a
-** return code of SQLITE_CONSTRAINT.
-**
-** any ABORT Back out changes from the current command
-** only (do not do a complete rollback) then
-** cause sqlite_exec() to return immediately
-** with SQLITE_CONSTRAINT.
-**
-** any FAIL Sqlite_exec() returns immediately with a
-** return code of SQLITE_CONSTRAINT. The
-** transaction is not rolled back and any
-** prior changes are retained.
-**
-** any IGNORE The record number and data is popped from
-** the stack and there is an immediate jump
-** to label ignoreDest.
-**
-** NOT NULL REPLACE The NULL value is replace by the default
-** value for that column. If the default value
-** is NULL, the action is the same as ABORT.
-**
-** UNIQUE REPLACE The other row that conflicts with the row
-** being inserted is removed.
-**
-** CHECK REPLACE Illegal. The results in an exception.
-**
-** Which action to take is determined by the overrideError parameter.
-** Or if overrideError==OE_Default, then the pParse->onError parameter
-** is used. Or if pParse->onError==OE_Default then the onError value
-** for the constraint is used.
-**
-** The calling routine must open a read/write cursor for pTab with
-** cursor number "base". All indices of pTab must also have open
-** read/write cursors with cursor number base+i for the i-th cursor.
-** Except, if there is no possibility of a REPLACE action then
-** cursors do not need to be open for indices where aIdxUsed[i]==0.
-**
-** If the isUpdate flag is true, it means that the "base" cursor is
-** initially pointing to an entry that is being updated. The isUpdate
-** flag causes extra code to be generated so that the "base" cursor
-** is still pointing at the same entry after the routine returns.
-** Without the isUpdate flag, the "base" cursor might be moved.
-*/
-void sqliteGenerateConstraintChecks(
- Parse *pParse, /* The parser context */
- Table *pTab, /* the table into which we are inserting */
- int base, /* Index of a read/write cursor pointing at pTab */
- char *aIdxUsed, /* Which indices are used. NULL means all are used */
- int recnoChng, /* True if the record number will change */
- int isUpdate, /* True for UPDATE, False for INSERT */
- int overrideError, /* Override onError to this if not OE_Default */
- int ignoreDest /* Jump to this label on an OE_Ignore resolution */
-){
- int i;
- Vdbe *v;
- int nCol;
- int onError;
- int addr;
- int extra;
- int iCur;
- Index *pIdx;
- int seenReplace = 0;
- int jumpInst1, jumpInst2;
- int contAddr;
- int hasTwoRecnos = (isUpdate && recnoChng);
-
- v = sqliteGetVdbe(pParse);
- assert( v!=0 );
- assert( pTab->pSelect==0 ); /* This table is not a VIEW */
- nCol = pTab->nCol;
-
- /* Test all NOT NULL constraints.
- */
- for(i=0; i<nCol; i++){
- if( i==pTab->iPKey ){
- continue;
- }
- onError = pTab->aCol[i].notNull;
- if( onError==OE_None ) continue;
- if( overrideError!=OE_Default ){
- onError = overrideError;
- }else if( pParse->db->onError!=OE_Default ){
- onError = pParse->db->onError;
- }else if( onError==OE_Default ){
- onError = OE_Abort;
- }
- if( onError==OE_Replace && pTab->aCol[i].zDflt==0 ){
- onError = OE_Abort;
- }
- sqliteVdbeAddOp(v, OP_Dup, nCol-1-i, 1);
- addr = sqliteVdbeAddOp(v, OP_NotNull, 1, 0);
- switch( onError ){
- case OE_Rollback:
- case OE_Abort:
- case OE_Fail: {
- char *zMsg = 0;
- sqliteVdbeAddOp(v, OP_Halt, SQLITE_CONSTRAINT, onError);
- sqliteSetString(&zMsg, pTab->zName, ".", pTab->aCol[i].zName,
- " may not be NULL", (char*)0);
- sqliteVdbeChangeP3(v, -1, zMsg, P3_DYNAMIC);
- break;
- }
- case OE_Ignore: {
- sqliteVdbeAddOp(v, OP_Pop, nCol+1+hasTwoRecnos, 0);
- sqliteVdbeAddOp(v, OP_Goto, 0, ignoreDest);
- break;
- }
- case OE_Replace: {
- sqliteVdbeOp3(v, OP_String, 0, 0, pTab->aCol[i].zDflt, P3_STATIC);
- sqliteVdbeAddOp(v, OP_Push, nCol-i, 0);
- break;
- }
- default: assert(0);
- }
- sqliteVdbeChangeP2(v, addr, sqliteVdbeCurrentAddr(v));
- }
-
- /* Test all CHECK constraints
- */
- /**** TBD ****/
-
- /* If we have an INTEGER PRIMARY KEY, make sure the primary key
- ** of the new record does not previously exist. Except, if this
- ** is an UPDATE and the primary key is not changing, that is OK.
- */
- if( recnoChng ){
- onError = pTab->keyConf;
- if( overrideError!=OE_Default ){
- onError = overrideError;
- }else if( pParse->db->onError!=OE_Default ){
- onError = pParse->db->onError;
- }else if( onError==OE_Default ){
- onError = OE_Abort;
- }
-
- if( isUpdate ){
- sqliteVdbeAddOp(v, OP_Dup, nCol+1, 1);
- sqliteVdbeAddOp(v, OP_Dup, nCol+1, 1);
- jumpInst1 = sqliteVdbeAddOp(v, OP_Eq, 0, 0);
- }
- sqliteVdbeAddOp(v, OP_Dup, nCol, 1);
- jumpInst2 = sqliteVdbeAddOp(v, OP_NotExists, base, 0);
- switch( onError ){
- default: {
- onError = OE_Abort;
- /* Fall thru into the next case */
- }
- case OE_Rollback:
- case OE_Abort:
- case OE_Fail: {
- sqliteVdbeOp3(v, OP_Halt, SQLITE_CONSTRAINT, onError,
- "PRIMARY KEY must be unique", P3_STATIC);
- break;
- }
- case OE_Replace: {
- sqliteGenerateRowIndexDelete(pParse->db, v, pTab, base, 0);
- if( isUpdate ){
- sqliteVdbeAddOp(v, OP_Dup, nCol+hasTwoRecnos, 1);
- sqliteVdbeAddOp(v, OP_MoveTo, base, 0);
- }
- seenReplace = 1;
- break;
- }
- case OE_Ignore: {
- assert( seenReplace==0 );
- sqliteVdbeAddOp(v, OP_Pop, nCol+1+hasTwoRecnos, 0);
- sqliteVdbeAddOp(v, OP_Goto, 0, ignoreDest);
- break;
- }
- }
- contAddr = sqliteVdbeCurrentAddr(v);
- sqliteVdbeChangeP2(v, jumpInst2, contAddr);
- if( isUpdate ){
- sqliteVdbeChangeP2(v, jumpInst1, contAddr);
- sqliteVdbeAddOp(v, OP_Dup, nCol+1, 1);
- sqliteVdbeAddOp(v, OP_MoveTo, base, 0);
- }
- }
-
- /* Test all UNIQUE constraints by creating entries for each UNIQUE
- ** index and making sure that duplicate entries do not already exist.
- ** Add the new records to the indices as we go.
- */
- extra = -1;
- for(iCur=0, pIdx=pTab->pIndex; pIdx; pIdx=pIdx->pNext, iCur++){
- if( aIdxUsed && aIdxUsed[iCur]==0 ) continue; /* Skip unused indices */
- extra++;
-
- /* Create a key for accessing the index entry */
- sqliteVdbeAddOp(v, OP_Dup, nCol+extra, 1);
- for(i=0; i<pIdx->nColumn; i++){
- int idx = pIdx->aiColumn[i];
- if( idx==pTab->iPKey ){
- sqliteVdbeAddOp(v, OP_Dup, i+extra+nCol+1, 1);
- }else{
- sqliteVdbeAddOp(v, OP_Dup, i+extra+nCol-idx, 1);
- }
- }
- jumpInst1 = sqliteVdbeAddOp(v, OP_MakeIdxKey, pIdx->nColumn, 0);
- if( pParse->db->file_format>=4 ) sqliteAddIdxKeyType(v, pIdx);
-
- /* Find out what action to take in case there is an indexing conflict */
- onError = pIdx->onError;
- if( onError==OE_None ) continue; /* pIdx is not a UNIQUE index */
- if( overrideError!=OE_Default ){
- onError = overrideError;
- }else if( pParse->db->onError!=OE_Default ){
- onError = pParse->db->onError;
- }else if( onError==OE_Default ){
- onError = OE_Abort;
- }
- if( seenReplace ){
- if( onError==OE_Ignore ) onError = OE_Replace;
- else if( onError==OE_Fail ) onError = OE_Abort;
- }
-
-
- /* Check to see if the new index entry will be unique */
- sqliteVdbeAddOp(v, OP_Dup, extra+nCol+1+hasTwoRecnos, 1);
- jumpInst2 = sqliteVdbeAddOp(v, OP_IsUnique, base+iCur+1, 0);
-
- /* Generate code that executes if the new index entry is not unique */
- switch( onError ){
- case OE_Rollback:
- case OE_Abort:
- case OE_Fail: {
- int j, n1, n2;
- char zErrMsg[200];
- strcpy(zErrMsg, pIdx->nColumn>1 ? "columns " : "column ");
- n1 = strlen(zErrMsg);
- for(j=0; j<pIdx->nColumn && n1<sizeof(zErrMsg)-30; j++){
- char *zCol = pTab->aCol[pIdx->aiColumn[j]].zName;
- n2 = strlen(zCol);
- if( j>0 ){
- strcpy(&zErrMsg[n1], ", ");
- n1 += 2;
- }
- if( n1+n2>sizeof(zErrMsg)-30 ){
- strcpy(&zErrMsg[n1], "...");
- n1 += 3;
- break;
- }else{
- strcpy(&zErrMsg[n1], zCol);
- n1 += n2;
- }
- }
- strcpy(&zErrMsg[n1],
- pIdx->nColumn>1 ? " are not unique" : " is not unique");
- sqliteVdbeOp3(v, OP_Halt, SQLITE_CONSTRAINT, onError, zErrMsg, 0);
- break;
- }
- case OE_Ignore: {
- assert( seenReplace==0 );
- sqliteVdbeAddOp(v, OP_Pop, nCol+extra+3+hasTwoRecnos, 0);
- sqliteVdbeAddOp(v, OP_Goto, 0, ignoreDest);
- break;
- }
- case OE_Replace: {
- sqliteGenerateRowDelete(pParse->db, v, pTab, base, 0);
- if( isUpdate ){
- sqliteVdbeAddOp(v, OP_Dup, nCol+extra+1+hasTwoRecnos, 1);
- sqliteVdbeAddOp(v, OP_MoveTo, base, 0);
- }
- seenReplace = 1;
- break;
- }
- default: assert(0);
- }
- contAddr = sqliteVdbeCurrentAddr(v);
-#if NULL_DISTINCT_FOR_UNIQUE
- sqliteVdbeChangeP2(v, jumpInst1, contAddr);
-#endif
- sqliteVdbeChangeP2(v, jumpInst2, contAddr);
- }
-}
-
-/*
-** This routine generates code to finish the INSERT or UPDATE operation
-** that was started by a prior call to sqliteGenerateConstraintChecks.
-** The stack must contain keys for all active indices followed by data
-** and the recno for the new entry. This routine creates the new
-** entries in all indices and in the main table.
-**
-** The arguments to this routine should be the same as the first six
-** arguments to sqliteGenerateConstraintChecks.
-*/
-void sqliteCompleteInsertion(
- Parse *pParse, /* The parser context */
- Table *pTab, /* the table into which we are inserting */
- int base, /* Index of a read/write cursor pointing at pTab */
- char *aIdxUsed, /* Which indices are used. NULL means all are used */
- int recnoChng, /* True if the record number will change */
- int isUpdate, /* True for UPDATE, False for INSERT */
- int newIdx /* Index of NEW table for triggers. -1 if none */
-){
- int i;
- Vdbe *v;
- int nIdx;
- Index *pIdx;
-
- v = sqliteGetVdbe(pParse);
- assert( v!=0 );
- assert( pTab->pSelect==0 ); /* This table is not a VIEW */
- for(nIdx=0, pIdx=pTab->pIndex; pIdx; pIdx=pIdx->pNext, nIdx++){}
- for(i=nIdx-1; i>=0; i--){
- if( aIdxUsed && aIdxUsed[i]==0 ) continue;
- sqliteVdbeAddOp(v, OP_IdxPut, base+i+1, 0);
- }
- sqliteVdbeAddOp(v, OP_MakeRecord, pTab->nCol, 0);
- if( newIdx>=0 ){
- sqliteVdbeAddOp(v, OP_Dup, 1, 0);
- sqliteVdbeAddOp(v, OP_Dup, 1, 0);
- sqliteVdbeAddOp(v, OP_PutIntKey, newIdx, 0);
- }
- sqliteVdbeAddOp(v, OP_PutIntKey, base,
- (pParse->trigStack?0:OPFLAG_NCHANGE) |
- (isUpdate?0:OPFLAG_LASTROWID) | OPFLAG_CSCHANGE);
- if( isUpdate && recnoChng ){
- sqliteVdbeAddOp(v, OP_Pop, 1, 0);
- }
-}
-
-/*
-** Generate code that will open write cursors for a table and for all
-** indices of that table. The "base" parameter is the cursor number used
-** for the table. Indices are opened on subsequent cursors.
-**
-** Return the total number of cursors opened. This is always at least
-** 1 (for the main table) plus more for each cursor.
-*/
-int sqliteOpenTableAndIndices(Parse *pParse, Table *pTab, int base){
- int i;
- Index *pIdx;
- Vdbe *v = sqliteGetVdbe(pParse);
- assert( v!=0 );
- sqliteVdbeAddOp(v, OP_Integer, pTab->iDb, 0);
- sqliteVdbeOp3(v, OP_OpenWrite, base, pTab->tnum, pTab->zName, P3_STATIC);
- for(i=1, pIdx=pTab->pIndex; pIdx; pIdx=pIdx->pNext, i++){
- sqliteVdbeAddOp(v, OP_Integer, pIdx->iDb, 0);
- sqliteVdbeOp3(v, OP_OpenWrite, i+base, pIdx->tnum, pIdx->zName, P3_STATIC);
- }
- return i;
-}
+++ /dev/null
-# $Id: SQLite2.pm,v 1.2 2004/09/10 15:43:39 matt Exp $
-
-package DBD::SQLite2;
-use strict;
-
-use DBI;
-use vars qw($err $errstr $state $drh $VERSION @ISA);
-$VERSION = '0.33';
-
-use DynaLoader();
-@ISA = ('DynaLoader');
-
-__PACKAGE__->bootstrap($VERSION);
-
-$drh = undef;
-
-sub driver {
- return $drh if $drh;
- my ($class, $attr) = @_;
-
- $class .= "::dr";
-
- $drh = DBI::_new_drh($class, {
- Name => 'SQLite2',
- Version => $VERSION,
- Attribution => 'DBD::SQLite2 by Matt Sergeant',
- });
-
- return $drh;
-}
-
-sub CLONE {
- undef $drh;
-}
-
-package DBD::SQLite2::dr;
-
-sub connect {
- my ($drh, $dbname, $user, $auth, $attr) = @_;
-
- my $dbh = DBI::_new_dbh($drh, {
- Name => $dbname,
- });
-
- my $real_dbname = $dbname;
- if ($dbname =~ /=/) {
- foreach my $attrib (split(/;/, $dbname)) {
- my ($k, $v) = split(/=/, $attrib, 2);
- if ($k eq 'dbname') {
- $real_dbname = $v;
- }
- else {
- # TODO: add to attribs
- }
- }
- }
- DBD::SQLite2::db::_login($dbh, $real_dbname, $user, $auth)
- or return undef;
-
- return $dbh;
-}
-
-package DBD::SQLite2::db;
-
-sub prepare {
- my ($dbh, $statement, @attribs) = @_;
-
- my $sth = DBI::_new_sth($dbh, {
- Statement => $statement,
- });
-
- DBD::SQLite2::st::_prepare($sth, $statement, @attribs)
- or return undef;
-
- return $sth;
-}
-
-
-sub table_info {
- my ($dbh, $CatVal, $SchVal, $TblVal, $TypVal) = @_;
- # SQL/CLI (ISO/IEC JTC 1/SC 32 N 0595), 6.63 Tables
- # Based on DBD::Oracle's
- # See also http://www.ch-werner.de/sqliteodbc/html/sqliteodbc_8c.html#a117
-
- my @Where = ();
- my $Sql;
- if ( defined($CatVal) && $CatVal eq '%'
- && defined($SchVal) && $SchVal eq ''
- && defined($TblVal) && $TblVal eq '') { # Rule 19a
- $Sql = <<'SQL';
-SELECT NULL TABLE_CAT
- , NULL TABLE_SCHEM
- , NULL TABLE_NAME
- , NULL TABLE_TYPE
- , NULL REMARKS
-SQL
- }
- elsif ( defined($SchVal) && $SchVal eq '%'
- && defined($CatVal) && $CatVal eq ''
- && defined($TblVal) && $TblVal eq '') { # Rule 19b
- $Sql = <<'SQL';
-SELECT NULL TABLE_CAT
- , NULL TABLE_SCHEM
- , NULL TABLE_NAME
- , NULL TABLE_TYPE
- , NULL REMARKS
-SQL
- }
- elsif ( defined($TypVal) && $TypVal eq '%'
- && defined($CatVal) && $CatVal eq ''
- && defined($SchVal) && $SchVal eq ''
- && defined($TblVal) && $TblVal eq '') { # Rule 19c
- $Sql = <<'SQL';
-SELECT NULL TABLE_CAT
- , NULL TABLE_SCHEM
- , NULL TABLE_NAME
- , t.tt TABLE_TYPE
- , NULL REMARKS
-FROM (
- SELECT 'TABLE' tt UNION
- SELECT 'VIEW' tt UNION
- SELECT 'LOCAL TEMPORARY' tt
-) t
-ORDER BY TABLE_TYPE
-SQL
- }
- else {
- $Sql = <<'SQL';
-SELECT *
-FROM
-(
-SELECT NULL TABLE_CAT
- , NULL TABLE_SCHEM
- , tbl_name TABLE_NAME
- , TABLE_TYPE
- , NULL REMARKS
- , sql sqlite_sql
-FROM (
- SELECT tbl_name, upper(type) TABLE_TYPE, sql
- FROM sqlite_master
- WHERE type IN ( 'table','view')
-UNION ALL
- SELECT tbl_name, 'LOCAL TEMPORARY' TABLE_TYPE, sql
- FROM sqlite_temp_master
- WHERE type IN ( 'table','view')
-UNION ALL
- SELECT 'sqlite_master' tbl_name, 'SYSTEM TABLE' TABLE_TYPE, NULL sql
-UNION ALL
- SELECT 'sqlite_temp_master' tbl_name, 'SYSTEM TABLE' TABLE_TYPE, NULL sql
-)
-)
-SQL
- if ( defined $TblVal ) {
- push @Where, "TABLE_NAME LIKE '$TblVal'";
- }
- if ( defined $TypVal ) {
- my $table_type_list;
- $TypVal =~ s/^\s+//;
- $TypVal =~ s/\s+$//;
- my @ttype_list = split (/\s*,\s*/, $TypVal);
- foreach my $table_type (@ttype_list) {
- if ($table_type !~ /^'.*'$/) {
- $table_type = "'" . $table_type . "'";
- }
- $table_type_list = join(", ", @ttype_list);
- }
- push @Where, "TABLE_TYPE IN (\U$table_type_list)"
- if $table_type_list;
- }
- $Sql .= ' WHERE ' . join("\n AND ", @Where ) . "\n" if @Where;
- $Sql .= " ORDER BY TABLE_TYPE, TABLE_SCHEM, TABLE_NAME\n";
- }
- my $sth = $dbh->prepare($Sql) or return undef;
- $sth->execute or return undef;
- $sth;
-}
-
-
-sub primary_key_info {
- my($dbh, $catalog, $schema, $table) = @_;
-
- my @pk_info;
-
- my $sth_tables = $dbh->table_info($catalog, $schema, $table, '');
-
- # this is a hack but much simpler than using pragma index_list etc
- # also the pragma doesn't list 'INTEGER PRIMARK KEY' autoinc PKs!
- while ( my $row = $sth_tables->fetchrow_hashref ) {
- my $sql = $row->{sqlite_sql} or next;
- next unless $sql =~ /(.*?)\s*PRIMARY\s+KEY\s*(?:\(\s*(.*?)\s*\))?/si;
- my @pk = split /\s*,\s*/, $2 || '';
- unless (@pk) {
- my $prefix = $1;
- $prefix =~ s/.*create\s+table\s+.*?\(//i;
- $prefix = (split /\s*,\s*/, $prefix)[-1];
- @pk = (split /\s+/, $prefix)[0]; # take first word as name
- }
- #warn "GOT PK $row->{TABLE_NAME} (@pk)\n";
- my $key_seq = 0;
- for my $pk_field (@pk) {
- push @pk_info, {
- TABLE_SCHEM => $row->{TABLE_SCHEM},
- TABLE_NAME => $row->{TABLE_NAME},
- COLUMN_NAME => $pk_field,
- KEY_SEQ => ++$key_seq,
- PK_NAME => 'PRIMARY KEY',
- };
- }
- }
-
- my $sponge = DBI->connect("DBI:Sponge:", '','')
- or return $dbh->DBI::set_err($DBI::err, "DBI::Sponge: $DBI::errstr");
- my @names = qw(TABLE_CAT TABLE_SCHEM TABLE_NAME COLUMN_NAME KEY_SEQ PK_NAME);
- my $sth = $sponge->prepare("column_info $table", {
- rows => [ map { [ @{$_}{@names} ] } @pk_info ],
- NUM_OF_FIELDS => scalar @names,
- NAME => \@names,
- }) or return $dbh->DBI::set_err($sponge->err(), $sponge->errstr());
- return $sth;
-}
-
-sub type_info_all {
- my ($dbh) = @_;
-return; # XXX code just copied from DBD::Oracle, not yet thought about
- my $names = {
- TYPE_NAME => 0,
- DATA_TYPE => 1,
- COLUMN_SIZE => 2,
- LITERAL_PREFIX => 3,
- LITERAL_SUFFIX => 4,
- CREATE_PARAMS => 5,
- NULLABLE => 6,
- CASE_SENSITIVE => 7,
- SEARCHABLE => 8,
- UNSIGNED_ATTRIBUTE => 9,
- FIXED_PREC_SCALE =>10,
- AUTO_UNIQUE_VALUE =>11,
- LOCAL_TYPE_NAME =>12,
- MINIMUM_SCALE =>13,
- MAXIMUM_SCALE =>14,
- SQL_DATA_TYPE =>15,
- SQL_DATETIME_SUB=>16,
- NUM_PREC_RADIX =>17,
- };
- my $ti = [
- $names,
- [ 'CHAR', 1, 255, '\'', '\'', 'max length', 1, 1, 3,
- undef, '0', '0', undef, undef, undef, 1, undef, undef
- ],
- [ 'NUMBER', 3, 38, undef, undef, 'precision,scale', 1, '0', 3,
- '0', '0', '0', undef, '0', 38, 3, undef, 10
- ],
- [ 'DOUBLE', 8, 15, undef, undef, undef, 1, '0', 3,
- '0', '0', '0', undef, undef, undef, 8, undef, 10
- ],
- [ 'DATE', 9, 19, '\'', '\'', undef, 1, '0', 3,
- undef, '0', '0', undef, '0', '0', 11, undef, undef
- ],
- [ 'VARCHAR', 12, 1024*1024, '\'', '\'', 'max length', 1, 1, 3,
- undef, '0', '0', undef, undef, undef, 12, undef, undef
- ]
- ];
- return $ti;
-}
-
-
-1;
-__END__
-
-=head1 NAME
-
-DBD::SQLite2 - Self Contained RDBMS in a DBI Driver (sqlite 2.x)
-
-=head1 SYNOPSIS
-
- use DBI;
- my $dbh = DBI->connect("dbi:SQLite2:dbname=dbfile","","");
-
-=head1 DESCRIPTION
-
-SQLite is a public domain RDBMS database engine that you can find
-at http://www.hwaci.com/sw/sqlite/.
-
-Rather than ask you to install SQLite first, because SQLite is public
-domain, DBD::SQLite2 includes the entire thing in the distribution. So
-in order to get a fast transaction capable RDBMS working for your
-perl project you simply have to install this module, and B<nothing>
-else.
-
-SQLite supports the following features:
-
-=over 4
-
-=item Implements a large subset of SQL92
-
-See http://www.hwaci.com/sw/sqlite/lang.html for details.
-
-=item A complete DB in a single disk file
-
-Everything for your database is stored in a single disk file, making it
-easier to move things around than with DBD::CSV.
-
-=item Atomic commit and rollback
-
-Yes, DBD::SQLite2 is small and light, but it supports full transactions!
-
-=item Extensible
-
-User-defined aggregate or regular functions can be registered with the
-SQL parser.
-
-=back
-
-There's lots more to it, so please refer to the docs on the SQLite web
-page, listed above, for SQL details. Also refer to L<DBI> for details
-on how to use DBI itself.
-
-=head1 CONFORMANCE WITH DBI SPECIFICATION
-
-The API works like every DBI module does. Please see L<DBI> for more
-details about core features.
-
-Currently many statement attributes are not implemented or are
-limited by the typeless nature of the SQLite database.
-
-=head1 DRIVER PRIVATE ATTRIBUTES
-
-=head2 Database Handle Attributes
-
-=over 4
-
-=item sqlite_version
-
-Returns the version of the SQLite library which DBD::SQLite2 is using, e.g., "2.8.0".
-
-=item sqlite_encoding
-
-Returns either "UTF-8" or "iso8859" to indicate how the SQLite library was compiled.
-
-=item sqlite_handle_binary_nulls
-
-Set this attribute to 1 to transparently handle binary nulls in quoted
-and returned data.
-
-B<NOTE:> This will cause all backslash characters (C<\>) to be doubled
-up in all columns regardless of whether or not they contain binary
-data or not. This may break your database if you use it from another
-application. This does not use the built in sqlite_encode_binary
-and sqlite_decode_binary functions, which may be considered a bug.
-
-=back
-
-=head1 DRIVER PRIVATE METHODS
-
-=head2 $dbh->func('last_insert_rowid')
-
-This method returns the last inserted rowid. If you specify an INTEGER PRIMARY
-KEY as the first column in your table, that is the column that is returned.
-Otherwise, it is the hidden ROWID column. See the sqlite docs for details.
-
-=head2 $dbh->func( $name, $argc, $func_ref, "create_function" )
-
-This method will register a new function which will be useable in SQL
-query. The method's parameters are:
-
-=over
-
-=item $name
-
-The name of the function. This is the name of the function as it will
-be used from SQL.
-
-=item $argc
-
-The number of arguments taken by the function. If this number is -1,
-the function can take any number of arguments.
-
-=item $func_ref
-
-This should be a reference to the function's implementation.
-
-=back
-
-For example, here is how to define a now() function which returns the
-current number of seconds since the epoch:
-
- $dbh->func( 'now', 0, sub { return time }, 'create_function' );
-
-After this, it could be use from SQL as:
-
- INSERT INTO mytable ( now() );
-
-=head2 $dbh->func( $name, $argc, $pkg, 'create_aggregate' )
-
-This method will register a new aggregate function which can then used
-from SQL. The method's parameters are:
-
-=over
-
-=item $name
-
-The name of the aggregate function, this is the name under which the
-function will be available from SQL.
-
-=item $argc
-
-This is an integer which tells the SQL parser how many arguments the
-function takes. If that number is -1, the function can take any number
-of arguments.
-
-=item $pkg
-
-This is the package which implements the aggregator interface.
-
-=back
-
-The aggregator interface consists of defining three methods:
-
-=over
-
-=item new()
-
-This method will be called once to create an object which should
-be used to aggregate the rows in a particular group. The step() and
-finalize() methods will be called upon the reference return by
-the method.
-
-=item step(@_)
-
-This method will be called once for each rows in the aggregate.
-
-=item finalize()
-
-This method will be called once all rows in the aggregate were
-processed and it should return the aggregate function's result. When
-there is no rows in the aggregate, finalize() will be called right
-after new().
-
-=back
-
-Here is a simple aggregate function which returns the variance
-(example adapted from pysqlite):
-
- package variance;
-
- sub new { bless [], shift; }
-
- sub step {
- my ( $self, $value ) = @_;
-
- push @$self, $value;
- }
-
- sub finalize {
- my $self = $_[0];
-
- my $n = @$self;
-
- # Variance is NULL unless there is more than one row
- return undef unless $n || $n == 1;
-
- my $mu = 0;
- foreach my $v ( @$self ) {
- $mu += $v;
- }
- $mu /= $n;
-
- my $sigma = 0;
- foreach my $v ( @$self ) {
- $sigma += ($x - $mu)**2;
- }
- $sigma = $sigma / ($n - 1);
-
- return $sigma;
- }
-
- $dbh->func( "variance", 1, 'variance', "create_aggregate" );
-
-The aggregate function can then be used as:
-
- SELECT group_name, variance(score) FROM results
- GROUP BY group_name;
-
-=head1 NOTES
-
-To access the database from the command line, try using dbish which comes with
-the DBI module. Just type:
-
- dbish dbi:SQLite:foo.db
-
-On the command line to access the file F<foo.db>.
-
-Alternatively you can install SQLite from the link above without conflicting
-with DBD::SQLite2 and use the supplied C<sqlite> command line tool.
-
-=head1 PERFORMANCE
-
-SQLite is fast, very fast. I recently processed my 72MB log file with it,
-inserting the data (400,000+ rows) by using transactions and only committing
-every 1000 rows (otherwise the insertion is quite slow), and then performing
-queries on the data.
-
-Queries like count(*) and avg(bytes) took fractions of a second to return,
-but what surprised me most of all was:
-
- SELECT url, count(*) as count FROM access_log
- GROUP BY url
- ORDER BY count desc
- LIMIT 20
-
-To discover the top 20 hit URLs on the site (http://axkit.org), and it
-returned within 2 seconds. I'm seriously considering switching my log
-analysis code to use this little speed demon!
-
-Oh yeah, and that was with no indexes on the table, on a 400MHz PIII.
-
-For best performance be sure to tune your hdparm settings if you are
-using linux. Also you might want to set:
-
- PRAGMA default_synchronous = OFF
-
-Which will prevent sqlite from doing fsync's when writing (which
-slows down non-transactional writes significantly) at the expense of some
-peace of mind. Also try playing with the cache_size pragma.
-
-=head1 BUGS
-
-Likely to be many, please use http://rt.cpan.org/ for reporting bugs.
-
-=head1 AUTHOR
-
-Matt Sergeant, matt@sergeant.org
-
-Perl extension functions contributed by Francis J. Lacoste
-<flacoste@logreport.org> and Wolfgang Sourdeau
-<wolfgang@logreport.org>
-
-=head1 SEE ALSO
-
-L<DBI>.
-
-=cut
+++ /dev/null
-/*
-** 2001 September 15
-**
-** The author disclaims copyright to this source code. In place of
-** a legal notice, here is a blessing:
-**
-** May you do good and not evil.
-** May you find forgiveness for yourself and forgive others.
-** May you share freely, never taking more than you give.
-**
-*************************************************************************
-** Main file for the SQLite library. The routines in this file
-** implement the programmer interface to the library. Routines in
-** other files are for internal use by SQLite and should not be
-** accessed by users of the library.
-**
-** $Id: main.c,v 1.1.1.1 2004/08/08 15:03:57 matt Exp $
-*/
-#include "sqliteInt.h"
-#include "os.h"
-#include <ctype.h>
-
-/*
-** A pointer to this structure is used to communicate information
-** from sqliteInit into the sqliteInitCallback.
-*/
-typedef struct {
- sqlite *db; /* The database being initialized */
- char **pzErrMsg; /* Error message stored here */
-} InitData;
-
-/*
-** Fill the InitData structure with an error message that indicates
-** that the database is corrupt.
-*/
-static void corruptSchema(InitData *pData, const char *zExtra){
- sqliteSetString(pData->pzErrMsg, "malformed database schema",
- zExtra!=0 && zExtra[0]!=0 ? " - " : (char*)0, zExtra, (char*)0);
-}
-
-/*
-** This is the callback routine for the code that initializes the
-** database. See sqliteInit() below for additional information.
-**
-** Each callback contains the following information:
-**
-** argv[0] = "file-format" or "schema-cookie" or "table" or "index"
-** argv[1] = table or index name or meta statement type.
-** argv[2] = root page number for table or index. NULL for meta.
-** argv[3] = SQL text for a CREATE TABLE or CREATE INDEX statement.
-** argv[4] = "1" for temporary files, "0" for main database, "2" or more
-** for auxiliary database files.
-**
-*/
-static
-int sqliteInitCallback(void *pInit, int argc, char **argv, char **azColName){
- InitData *pData = (InitData*)pInit;
- int nErr = 0;
-
- assert( argc==5 );
- if( argv==0 ) return 0; /* Might happen if EMPTY_RESULT_CALLBACKS are on */
- if( argv[0]==0 ){
- corruptSchema(pData, 0);
- return 1;
- }
- switch( argv[0][0] ){
- case 'v':
- case 'i':
- case 't': { /* CREATE TABLE, CREATE INDEX, or CREATE VIEW statements */
- sqlite *db = pData->db;
- if( argv[2]==0 || argv[4]==0 ){
- corruptSchema(pData, 0);
- return 1;
- }
- if( argv[3] && argv[3][0] ){
- /* Call the parser to process a CREATE TABLE, INDEX or VIEW.
- ** But because db->init.busy is set to 1, no VDBE code is generated
- ** or executed. All the parser does is build the internal data
- ** structures that describe the table, index, or view.
- */
- char *zErr;
- assert( db->init.busy );
- db->init.iDb = atoi(argv[4]);
- assert( db->init.iDb>=0 && db->init.iDb<db->nDb );
- db->init.newTnum = atoi(argv[2]);
- if( sqlite_exec(db, argv[3], 0, 0, &zErr) ){
- corruptSchema(pData, zErr);
- sqlite_freemem(zErr);
- }
- db->init.iDb = 0;
- }else{
- /* If the SQL column is blank it means this is an index that
- ** was created to be the PRIMARY KEY or to fulfill a UNIQUE
- ** constraint for a CREATE TABLE. The index should have already
- ** been created when we processed the CREATE TABLE. All we have
- ** to do here is record the root page number for that index.
- */
- int iDb;
- Index *pIndex;
-
- iDb = atoi(argv[4]);
- assert( iDb>=0 && iDb<db->nDb );
- pIndex = sqliteFindIndex(db, argv[1], db->aDb[iDb].zName);
- if( pIndex==0 || pIndex->tnum!=0 ){
- /* This can occur if there exists an index on a TEMP table which
- ** has the same name as another index on a permanent index. Since
- ** the permanent table is hidden by the TEMP table, we can also
- ** safely ignore the index on the permanent table.
- */
- /* Do Nothing */;
- }else{
- pIndex->tnum = atoi(argv[2]);
- }
- }
- break;
- }
- default: {
- /* This can not happen! */
- nErr = 1;
- assert( nErr==0 );
- }
- }
- return nErr;
-}
-
-/*
-** This is a callback procedure used to reconstruct a table. The
-** name of the table to be reconstructed is passed in as argv[0].
-**
-** This routine is used to automatically upgrade a database from
-** format version 1 or 2 to version 3. The correct operation of
-** this routine relys on the fact that no indices are used when
-** copying a table out to a temporary file.
-**
-** The change from version 2 to version 3 occurred between SQLite
-** version 2.5.6 and 2.6.0 on 2002-July-18.
-*/
-static
-int upgrade_3_callback(void *pInit, int argc, char **argv, char **NotUsed){
- InitData *pData = (InitData*)pInit;
- int rc;
- Table *pTab;
- Trigger *pTrig;
- char *zErr = 0;
-
- pTab = sqliteFindTable(pData->db, argv[0], 0);
- assert( pTab!=0 );
- assert( sqliteStrICmp(pTab->zName, argv[0])==0 );
- if( pTab ){
- pTrig = pTab->pTrigger;
- pTab->pTrigger = 0; /* Disable all triggers before rebuilding the table */
- }
- rc = sqlite_exec_printf(pData->db,
- "CREATE TEMP TABLE sqlite_x AS SELECT * FROM '%q'; "
- "DELETE FROM '%q'; "
- "INSERT INTO '%q' SELECT * FROM sqlite_x; "
- "DROP TABLE sqlite_x;",
- 0, 0, &zErr, argv[0], argv[0], argv[0]);
- if( zErr ){
- if( *pData->pzErrMsg ) sqlite_freemem(*pData->pzErrMsg);
- *pData->pzErrMsg = zErr;
- }
-
- /* If an error occurred in the SQL above, then the transaction will
- ** rollback which will delete the internal symbol tables. This will
- ** cause the structure that pTab points to be deleted. In case that
- ** happened, we need to refetch pTab.
- */
- pTab = sqliteFindTable(pData->db, argv[0], 0);
- if( pTab ){
- assert( sqliteStrICmp(pTab->zName, argv[0])==0 );
- pTab->pTrigger = pTrig; /* Re-enable triggers */
- }
- return rc!=SQLITE_OK;
-}
-
-
-
-/*
-** Attempt to read the database schema and initialize internal
-** data structures for a single database file. The index of the
-** database file is given by iDb. iDb==0 is used for the main
-** database. iDb==1 should never be used. iDb>=2 is used for
-** auxiliary databases. Return one of the SQLITE_ error codes to
-** indicate success or failure.
-*/
-static int sqliteInitOne(sqlite *db, int iDb, char **pzErrMsg){
- int rc;
- BtCursor *curMain;
- int size;
- Table *pTab;
- char const *azArg[6];
- char zDbNum[30];
- int meta[SQLITE_N_BTREE_META];
- InitData initData;
- char const *zMasterSchema;
- char const *zMasterName;
- char *zSql = 0;
-
- /*
- ** The master database table has a structure like this
- */
- static char master_schema[] =
- "CREATE TABLE sqlite_master(\n"
- " type text,\n"
- " name text,\n"
- " tbl_name text,\n"
- " rootpage integer,\n"
- " sql text\n"
- ")"
- ;
- static char temp_master_schema[] =
- "CREATE TEMP TABLE sqlite_temp_master(\n"
- " type text,\n"
- " name text,\n"
- " tbl_name text,\n"
- " rootpage integer,\n"
- " sql text\n"
- ")"
- ;
-
- assert( iDb>=0 && iDb<db->nDb );
-
- /* zMasterSchema and zInitScript are set to point at the master schema
- ** and initialisation script appropriate for the database being
- ** initialised. zMasterName is the name of the master table.
- */
- if( iDb==1 ){
- zMasterSchema = temp_master_schema;
- zMasterName = TEMP_MASTER_NAME;
- }else{
- zMasterSchema = master_schema;
- zMasterName = MASTER_NAME;
- }
-
- /* Construct the schema table.
- */
- sqliteSafetyOff(db);
- azArg[0] = "table";
- azArg[1] = zMasterName;
- azArg[2] = "2";
- azArg[3] = zMasterSchema;
- sprintf(zDbNum, "%d", iDb);
- azArg[4] = zDbNum;
- azArg[5] = 0;
- initData.db = db;
- initData.pzErrMsg = pzErrMsg;
- sqliteInitCallback(&initData, 5, (char **)azArg, 0);
- pTab = sqliteFindTable(db, zMasterName, db->aDb[iDb].zName);
- if( pTab ){
- pTab->readOnly = 1;
- }else{
- return SQLITE_NOMEM;
- }
- sqliteSafetyOn(db);
-
- /* Create a cursor to hold the database open
- */
- if( db->aDb[iDb].pBt==0 ) return SQLITE_OK;
- rc = sqliteBtreeCursor(db->aDb[iDb].pBt, 2, 0, &curMain);
- if( rc ){
- sqliteSetString(pzErrMsg, sqlite_error_string(rc), (char*)0);
- return rc;
- }
-
- /* Get the database meta information
- */
- rc = sqliteBtreeGetMeta(db->aDb[iDb].pBt, meta);
- if( rc ){
- sqliteSetString(pzErrMsg, sqlite_error_string(rc), (char*)0);
- sqliteBtreeCloseCursor(curMain);
- return rc;
- }
- db->aDb[iDb].schema_cookie = meta[1];
- if( iDb==0 ){
- db->next_cookie = meta[1];
- db->file_format = meta[2];
- size = meta[3];
- if( size==0 ){ size = MAX_PAGES; }
- db->cache_size = size;
- db->safety_level = meta[4];
- if( meta[6]>0 && meta[6]<=2 && db->temp_store==0 ){
- db->temp_store = meta[6];
- }
- if( db->safety_level==0 ) db->safety_level = 2;
-
- /*
- ** file_format==1 Version 2.1.0.
- ** file_format==2 Version 2.2.0. Add support for INTEGER PRIMARY KEY.
- ** file_format==3 Version 2.6.0. Fix empty-string index bug.
- ** file_format==4 Version 2.7.0. Add support for separate numeric and
- ** text datatypes.
- */
- if( db->file_format==0 ){
- /* This happens if the database was initially empty */
- db->file_format = 4;
- }else if( db->file_format>4 ){
- sqliteBtreeCloseCursor(curMain);
- sqliteSetString(pzErrMsg, "unsupported file format", (char*)0);
- return SQLITE_ERROR;
- }
- }else if( iDb!=1 && (db->file_format!=meta[2] || db->file_format<4) ){
- assert( db->file_format>=4 );
- if( meta[2]==0 ){
- sqliteSetString(pzErrMsg, "cannot attach empty database: ",
- db->aDb[iDb].zName, (char*)0);
- }else{
- sqliteSetString(pzErrMsg, "incompatible file format in auxiliary "
- "database: ", db->aDb[iDb].zName, (char*)0);
- }
- sqliteBtreeClose(db->aDb[iDb].pBt);
- db->aDb[iDb].pBt = 0;
- return SQLITE_FORMAT;
- }
- sqliteBtreeSetCacheSize(db->aDb[iDb].pBt, db->cache_size);
- sqliteBtreeSetSafetyLevel(db->aDb[iDb].pBt, meta[4]==0 ? 2 : meta[4]);
-
- /* Read the schema information out of the schema tables
- */
- assert( db->init.busy );
- sqliteSafetyOff(db);
-
- /* The following SQL will read the schema from the master tables.
- ** The first version works with SQLite file formats 2 or greater.
- ** The second version is for format 1 files.
- **
- ** Beginning with file format 2, the rowid for new table entries
- ** (including entries in sqlite_master) is an increasing integer.
- ** So for file format 2 and later, we can play back sqlite_master
- ** and all the CREATE statements will appear in the right order.
- ** But with file format 1, table entries were random and so we
- ** have to make sure the CREATE TABLEs occur before their corresponding
- ** CREATE INDEXs. (We don't have to deal with CREATE VIEW or
- ** CREATE TRIGGER in file format 1 because those constructs did
- ** not exist then.)
- */
- if( db->file_format>=2 ){
- sqliteSetString(&zSql,
- "SELECT type, name, rootpage, sql, ", zDbNum, " FROM \"",
- db->aDb[iDb].zName, "\".", zMasterName, (char*)0);
- }else{
- sqliteSetString(&zSql,
- "SELECT type, name, rootpage, sql, ", zDbNum, " FROM \"",
- db->aDb[iDb].zName, "\".", zMasterName,
- " WHERE type IN ('table', 'index')"
- " ORDER BY CASE type WHEN 'table' THEN 0 ELSE 1 END", (char*)0);
- }
- rc = sqlite_exec(db, zSql, sqliteInitCallback, &initData, 0);
-
- sqliteFree(zSql);
- sqliteSafetyOn(db);
- sqliteBtreeCloseCursor(curMain);
- if( sqlite_malloc_failed ){
- sqliteSetString(pzErrMsg, "out of memory", (char*)0);
- rc = SQLITE_NOMEM;
- sqliteResetInternalSchema(db, 0);
- }
- if( rc==SQLITE_OK ){
- DbSetProperty(db, iDb, DB_SchemaLoaded);
- }else{
- sqliteResetInternalSchema(db, iDb);
- }
- return rc;
-}
-
-/*
-** Initialize all database files - the main database file, the file
-** used to store temporary tables, and any additional database files
-** created using ATTACH statements. Return a success code. If an
-** error occurs, write an error message into *pzErrMsg.
-**
-** After the database is initialized, the SQLITE_Initialized
-** bit is set in the flags field of the sqlite structure. An
-** attempt is made to initialize the database as soon as it
-** is opened. If that fails (perhaps because another process
-** has the sqlite_master table locked) than another attempt
-** is made the first time the database is accessed.
-*/
-int sqliteInit(sqlite *db, char **pzErrMsg){
- int i, rc;
-
- if( db->init.busy ) return SQLITE_OK;
- assert( (db->flags & SQLITE_Initialized)==0 );
- rc = SQLITE_OK;
- db->init.busy = 1;
- for(i=0; rc==SQLITE_OK && i<db->nDb; i++){
- if( DbHasProperty(db, i, DB_SchemaLoaded) || i==1 ) continue;
- rc = sqliteInitOne(db, i, pzErrMsg);
- if( rc ){
- sqliteResetInternalSchema(db, i);
- }
- }
-
- /* Once all the other databases have been initialised, load the schema
- ** for the TEMP database. This is loaded last, as the TEMP database
- ** schema may contain references to objects in other databases.
- */
- if( rc==SQLITE_OK && db->nDb>1 && !DbHasProperty(db, 1, DB_SchemaLoaded) ){
- rc = sqliteInitOne(db, 1, pzErrMsg);
- if( rc ){
- sqliteResetInternalSchema(db, 1);
- }
- }
-
- db->init.busy = 0;
- if( rc==SQLITE_OK ){
- db->flags |= SQLITE_Initialized;
- sqliteCommitInternalChanges(db);
- }
-
- /* If the database is in formats 1 or 2, then upgrade it to
- ** version 3. This will reconstruct all indices. If the
- ** upgrade fails for any reason (ex: out of disk space, database
- ** is read only, interrupt received, etc.) then fail the init.
- */
- if( rc==SQLITE_OK && db->file_format<3 ){
- char *zErr = 0;
- InitData initData;
- int meta[SQLITE_N_BTREE_META];
-
- db->magic = SQLITE_MAGIC_OPEN;
- initData.db = db;
- initData.pzErrMsg = &zErr;
- db->file_format = 3;
- rc = sqlite_exec(db,
- "BEGIN; SELECT name FROM sqlite_master WHERE type='table';",
- upgrade_3_callback,
- &initData,
- &zErr);
- if( rc==SQLITE_OK ){
- sqliteBtreeGetMeta(db->aDb[0].pBt, meta);
- meta[2] = 4;
- sqliteBtreeUpdateMeta(db->aDb[0].pBt, meta);
- sqlite_exec(db, "COMMIT", 0, 0, 0);
- }
- if( rc!=SQLITE_OK ){
- sqliteSetString(pzErrMsg,
- "unable to upgrade database to the version 2.6 format",
- zErr ? ": " : 0, zErr, (char*)0);
- }
- sqlite_freemem(zErr);
- }
-
- if( rc!=SQLITE_OK ){
- db->flags &= ~SQLITE_Initialized;
- }
- return rc;
-}
-
-/*
-** The version of the library
-*/
-const char rcsid[] = "@(#) \044Id: SQLite version " SQLITE_VERSION " $";
-const char sqlite_version[] = SQLITE_VERSION;
-
-/*
-** Does the library expect data to be encoded as UTF-8 or iso8859? The
-** following global constant always lets us know.
-*/
-#ifdef SQLITE_UTF8
-const char sqlite_encoding[] = "UTF-8";
-#else
-const char sqlite_encoding[] = "iso8859";
-#endif
-
-/*
-** Open a new SQLite database. Construct an "sqlite" structure to define
-** the state of this database and return a pointer to that structure.
-**
-** An attempt is made to initialize the in-memory data structures that
-** hold the database schema. But if this fails (because the schema file
-** is locked) then that step is deferred until the first call to
-** sqlite_exec().
-*/
-sqlite *sqlite_open(const char *zFilename, int mode, char **pzErrMsg){
- sqlite *db;
- int rc, i;
-
- /* Allocate the sqlite data structure */
- db = sqliteMalloc( sizeof(sqlite) );
- if( pzErrMsg ) *pzErrMsg = 0;
- if( db==0 ) goto no_mem_on_open;
- db->onError = OE_Default;
- db->priorNewRowid = 0;
- db->magic = SQLITE_MAGIC_BUSY;
- db->nDb = 2;
- db->aDb = db->aDbStatic;
- /* db->flags |= SQLITE_ShortColNames; */
- sqliteHashInit(&db->aFunc, SQLITE_HASH_STRING, 1);
- for(i=0; i<db->nDb; i++){
- sqliteHashInit(&db->aDb[i].tblHash, SQLITE_HASH_STRING, 0);
- sqliteHashInit(&db->aDb[i].idxHash, SQLITE_HASH_STRING, 0);
- sqliteHashInit(&db->aDb[i].trigHash, SQLITE_HASH_STRING, 0);
- sqliteHashInit(&db->aDb[i].aFKey, SQLITE_HASH_STRING, 1);
- }
-
- /* Open the backend database driver */
- if( zFilename[0]==':' && strcmp(zFilename,":memory:")==0 ){
- db->temp_store = 2;
- }
- rc = sqliteBtreeFactory(db, zFilename, 0, MAX_PAGES, &db->aDb[0].pBt);
- if( rc!=SQLITE_OK ){
- switch( rc ){
- default: {
- sqliteSetString(pzErrMsg, "unable to open database: ",
- zFilename, (char*)0);
- }
- }
- sqliteFree(db);
- sqliteStrRealloc(pzErrMsg);
- return 0;
- }
- db->aDb[0].zName = "main";
- db->aDb[1].zName = "temp";
-
- /* Attempt to read the schema */
- sqliteRegisterBuiltinFunctions(db);
- rc = sqliteInit(db, pzErrMsg);
- db->magic = SQLITE_MAGIC_OPEN;
- if( sqlite_malloc_failed ){
- sqlite_close(db);
- goto no_mem_on_open;
- }else if( rc!=SQLITE_OK && rc!=SQLITE_BUSY ){
- sqlite_close(db);
- sqliteStrRealloc(pzErrMsg);
- return 0;
- }else if( pzErrMsg ){
- sqliteFree(*pzErrMsg);
- *pzErrMsg = 0;
- }
-
- /* Return a pointer to the newly opened database structure */
- return db;
-
-no_mem_on_open:
- sqliteSetString(pzErrMsg, "out of memory", (char*)0);
- sqliteStrRealloc(pzErrMsg);
- return 0;
-}
-
-/*
-** Return the ROWID of the most recent insert
-*/
-int sqlite_last_insert_rowid(sqlite *db){
- return db->lastRowid;
-}
-
-/*
-** Return the number of changes in the most recent call to sqlite_exec().
-*/
-int sqlite_changes(sqlite *db){
- return db->nChange;
-}
-
-/*
-** Return the number of changes produced by the last INSERT, UPDATE, or
-** DELETE statement to complete execution. The count does not include
-** changes due to SQL statements executed in trigger programs that were
-** triggered by that statement
-*/
-int sqlite_last_statement_changes(sqlite *db){
- return db->lsChange;
-}
-
-/*
-** Close an existing SQLite database
-*/
-void sqlite_close(sqlite *db){
- HashElem *i;
- int j;
- db->want_to_close = 1;
- if( sqliteSafetyCheck(db) || sqliteSafetyOn(db) ){
- /* printf("DID NOT CLOSE\n"); fflush(stdout); */
- return;
- }
- db->magic = SQLITE_MAGIC_CLOSED;
- for(j=0; j<db->nDb; j++){
- struct Db *pDb = &db->aDb[j];
- if( pDb->pBt ){
- sqliteBtreeClose(pDb->pBt);
- pDb->pBt = 0;
- }
- }
- sqliteResetInternalSchema(db, 0);
- assert( db->nDb<=2 );
- assert( db->aDb==db->aDbStatic );
- for(i=sqliteHashFirst(&db->aFunc); i; i=sqliteHashNext(i)){
- FuncDef *pFunc, *pNext;
- for(pFunc = (FuncDef*)sqliteHashData(i); pFunc; pFunc=pNext){
- pNext = pFunc->pNext;
- sqliteFree(pFunc);
- }
- }
- sqliteHashClear(&db->aFunc);
- sqliteFree(db);
-}
-
-/*
-** Rollback all database files.
-*/
-void sqliteRollbackAll(sqlite *db){
- int i;
- for(i=0; i<db->nDb; i++){
- if( db->aDb[i].pBt ){
- sqliteBtreeRollback(db->aDb[i].pBt);
- db->aDb[i].inTrans = 0;
- }
- }
- sqliteResetInternalSchema(db, 0);
- /* sqliteRollbackInternalChanges(db); */
-}
-
-/*
-** Execute SQL code. Return one of the SQLITE_ success/failure
-** codes. Also write an error message into memory obtained from
-** malloc() and make *pzErrMsg point to that message.
-**
-** If the SQL is a query, then for each row in the query result
-** the xCallback() function is called. pArg becomes the first
-** argument to xCallback(). If xCallback=NULL then no callback
-** is invoked, even for queries.
-*/
-int sqlite_exec(
- sqlite *db, /* The database on which the SQL executes */
- const char *zSql, /* The SQL to be executed */
- sqlite_callback xCallback, /* Invoke this callback routine */
- void *pArg, /* First argument to xCallback() */
- char **pzErrMsg /* Write error messages here */
-){
- int rc = SQLITE_OK;
- const char *zLeftover;
- sqlite_vm *pVm;
- int nRetry = 0;
- int nChange = 0;
- int nCallback;
-
- if( zSql==0 ) return SQLITE_OK;
- while( rc==SQLITE_OK && zSql[0] ){
- pVm = 0;
- rc = sqlite_compile(db, zSql, &zLeftover, &pVm, pzErrMsg);
- if( rc!=SQLITE_OK ){
- assert( pVm==0 || sqlite_malloc_failed );
- return rc;
- }
- if( pVm==0 ){
- /* This happens if the zSql input contained only whitespace */
- break;
- }
- db->nChange += nChange;
- nCallback = 0;
- while(1){
- int nArg;
- char **azArg, **azCol;
- rc = sqlite_step(pVm, &nArg, (const char***)&azArg,(const char***)&azCol);
- if( rc==SQLITE_ROW ){
- if( xCallback!=0 && xCallback(pArg, nArg, azArg, azCol) ){
- sqlite_finalize(pVm, 0);
- return SQLITE_ABORT;
- }
- nCallback++;
- }else{
- if( rc==SQLITE_DONE && nCallback==0
- && (db->flags & SQLITE_NullCallback)!=0 && xCallback!=0 ){
- xCallback(pArg, nArg, azArg, azCol);
- }
- rc = sqlite_finalize(pVm, pzErrMsg);
- if( rc==SQLITE_SCHEMA && nRetry<2 ){
- nRetry++;
- rc = SQLITE_OK;
- break;
- }
- if( db->pVdbe==0 ){
- nChange = db->nChange;
- }
- nRetry = 0;
- zSql = zLeftover;
- while( isspace(zSql[0]) ) zSql++;
- break;
- }
- }
- }
- return rc;
-}
-
-
-/*
-** Compile a single statement of SQL into a virtual machine. Return one
-** of the SQLITE_ success/failure codes. Also write an error message into
-** memory obtained from malloc() and make *pzErrMsg point to that message.
-*/
-int sqlite_compile(
- sqlite *db, /* The database on which the SQL executes */
- const char *zSql, /* The SQL to be executed */
- const char **pzTail, /* OUT: Next statement after the first */
- sqlite_vm **ppVm, /* OUT: The virtual machine */
- char **pzErrMsg /* OUT: Write error messages here */
-){
- Parse sParse;
-
- if( pzErrMsg ) *pzErrMsg = 0;
- if( sqliteSafetyOn(db) ) goto exec_misuse;
- if( !db->init.busy ){
- if( (db->flags & SQLITE_Initialized)==0 ){
- int rc, cnt = 1;
- while( (rc = sqliteInit(db, pzErrMsg))==SQLITE_BUSY
- && db->xBusyCallback
- && db->xBusyCallback(db->pBusyArg, "", cnt++)!=0 ){}
- if( rc!=SQLITE_OK ){
- sqliteStrRealloc(pzErrMsg);
- sqliteSafetyOff(db);
- return rc;
- }
- if( pzErrMsg ){
- sqliteFree(*pzErrMsg);
- *pzErrMsg = 0;
- }
- }
- if( db->file_format<3 ){
- sqliteSafetyOff(db);
- sqliteSetString(pzErrMsg, "obsolete database file format", (char*)0);
- return SQLITE_ERROR;
- }
- }
- assert( (db->flags & SQLITE_Initialized)!=0 || db->init.busy );
- if( db->pVdbe==0 ){ db->nChange = 0; }
- memset(&sParse, 0, sizeof(sParse));
- sParse.db = db;
- sqliteRunParser(&sParse, zSql, pzErrMsg);
- if( db->xTrace && !db->init.busy ){
- /* Trace only the statment that was compiled.
- ** Make a copy of that part of the SQL string since zSQL is const
- ** and we must pass a zero terminated string to the trace function
- ** The copy is unnecessary if the tail pointer is pointing at the
- ** beginnig or end of the SQL string.
- */
- if( sParse.zTail && sParse.zTail!=zSql && *sParse.zTail ){
- char *tmpSql = sqliteStrNDup(zSql, sParse.zTail - zSql);
- if( tmpSql ){
- db->xTrace(db->pTraceArg, tmpSql);
- free(tmpSql);
- }else{
- /* If a memory error occurred during the copy,
- ** trace entire SQL string and fall through to the
- ** sqlite_malloc_failed test to report the error.
- */
- db->xTrace(db->pTraceArg, zSql);
- }
- }else{
- db->xTrace(db->pTraceArg, zSql);
- }
- }
- if( sqlite_malloc_failed ){
- sqliteSetString(pzErrMsg, "out of memory", (char*)0);
- sParse.rc = SQLITE_NOMEM;
- sqliteRollbackAll(db);
- sqliteResetInternalSchema(db, 0);
- db->flags &= ~SQLITE_InTrans;
- }
- if( sParse.rc==SQLITE_DONE ) sParse.rc = SQLITE_OK;
- if( sParse.rc!=SQLITE_OK && pzErrMsg && *pzErrMsg==0 ){
- sqliteSetString(pzErrMsg, sqlite_error_string(sParse.rc), (char*)0);
- }
- sqliteStrRealloc(pzErrMsg);
- if( sParse.rc==SQLITE_SCHEMA ){
- sqliteResetInternalSchema(db, 0);
- }
- assert( ppVm );
- *ppVm = (sqlite_vm*)sParse.pVdbe;
- if( pzTail ) *pzTail = sParse.zTail;
- if( sqliteSafetyOff(db) ) goto exec_misuse;
- return sParse.rc;
-
-exec_misuse:
- if( pzErrMsg ){
- *pzErrMsg = 0;
- sqliteSetString(pzErrMsg, sqlite_error_string(SQLITE_MISUSE), (char*)0);
- sqliteStrRealloc(pzErrMsg);
- }
- return SQLITE_MISUSE;
-}
-
-
-/*
-** The following routine destroys a virtual machine that is created by
-** the sqlite_compile() routine.
-**
-** The integer returned is an SQLITE_ success/failure code that describes
-** the result of executing the virtual machine. An error message is
-** written into memory obtained from malloc and *pzErrMsg is made to
-** point to that error if pzErrMsg is not NULL. The calling routine
-** should use sqlite_freemem() to delete the message when it has finished
-** with it.
-*/
-int sqlite_finalize(
- sqlite_vm *pVm, /* The virtual machine to be destroyed */
- char **pzErrMsg /* OUT: Write error messages here */
-){
- int rc = sqliteVdbeFinalize((Vdbe*)pVm, pzErrMsg);
- sqliteStrRealloc(pzErrMsg);
- return rc;
-}
-
-/*
-** Terminate the current execution of a virtual machine then
-** reset the virtual machine back to its starting state so that it
-** can be reused. Any error message resulting from the prior execution
-** is written into *pzErrMsg. A success code from the prior execution
-** is returned.
-*/
-int sqlite_reset(
- sqlite_vm *pVm, /* The virtual machine to be destroyed */
- char **pzErrMsg /* OUT: Write error messages here */
-){
- int rc = sqliteVdbeReset((Vdbe*)pVm, pzErrMsg);
- sqliteVdbeMakeReady((Vdbe*)pVm, -1, 0);
- sqliteStrRealloc(pzErrMsg);
- return rc;
-}
-
-/*
-** Return a static string that describes the kind of error specified in the
-** argument.
-*/
-const char *sqlite_error_string(int rc){
- const char *z;
- switch( rc ){
- case SQLITE_OK: z = "not an error"; break;
- case SQLITE_ERROR: z = "SQL logic error or missing database"; break;
- case SQLITE_INTERNAL: z = "internal SQLite implementation flaw"; break;
- case SQLITE_PERM: z = "access permission denied"; break;
- case SQLITE_ABORT: z = "callback requested query abort"; break;
- case SQLITE_BUSY: z = "database is locked"; break;
- case SQLITE_LOCKED: z = "database table is locked"; break;
- case SQLITE_NOMEM: z = "out of memory"; break;
- case SQLITE_READONLY: z = "attempt to write a readonly database"; break;
- case SQLITE_INTERRUPT: z = "interrupted"; break;
- case SQLITE_IOERR: z = "disk I/O error"; break;
- case SQLITE_CORRUPT: z = "database disk image is malformed"; break;
- case SQLITE_NOTFOUND: z = "table or record not found"; break;
- case SQLITE_FULL: z = "database is full"; break;
- case SQLITE_CANTOPEN: z = "unable to open database file"; break;
- case SQLITE_PROTOCOL: z = "database locking protocol failure"; break;
- case SQLITE_EMPTY: z = "table contains no data"; break;
- case SQLITE_SCHEMA: z = "database schema has changed"; break;
- case SQLITE_TOOBIG: z = "too much data for one table row"; break;
- case SQLITE_CONSTRAINT: z = "constraint failed"; break;
- case SQLITE_MISMATCH: z = "datatype mismatch"; break;
- case SQLITE_MISUSE: z = "library routine called out of sequence";break;
- case SQLITE_NOLFS: z = "kernel lacks large file support"; break;
- case SQLITE_AUTH: z = "authorization denied"; break;
- case SQLITE_FORMAT: z = "auxiliary database format error"; break;
- case SQLITE_RANGE: z = "bind index out of range"; break;
- case SQLITE_NOTADB: z = "file is encrypted or is not a database";break;
- default: z = "unknown error"; break;
- }
- return z;
-}
-
-/*
-** This routine implements a busy callback that sleeps and tries
-** again until a timeout value is reached. The timeout value is
-** an integer number of milliseconds passed in as the first
-** argument.
-*/
-static int sqliteDefaultBusyCallback(
- void *Timeout, /* Maximum amount of time to wait */
- const char *NotUsed, /* The name of the table that is busy */
- int count /* Number of times table has been busy */
-){
-#if SQLITE_MIN_SLEEP_MS==1
- static const char delays[] =
- { 1, 2, 5, 10, 15, 20, 25, 25, 25, 50, 50, 50, 100};
- static const short int totals[] =
- { 0, 1, 3, 8, 18, 33, 53, 78, 103, 128, 178, 228, 287};
-# define NDELAY (sizeof(delays)/sizeof(delays[0]))
- int timeout = (int)(long)Timeout;
- int delay, prior;
-
- if( count <= NDELAY ){
- delay = delays[count-1];
- prior = totals[count-1];
- }else{
- delay = delays[NDELAY-1];
- prior = totals[NDELAY-1] + delay*(count-NDELAY-1);
- }
- if( prior + delay > timeout ){
- delay = timeout - prior;
- if( delay<=0 ) return 0;
- }
- sqliteOsSleep(delay);
- return 1;
-#else
- int timeout = (int)(long)Timeout;
- if( (count+1)*1000 > timeout ){
- return 0;
- }
- sqliteOsSleep(1000);
- return 1;
-#endif
-}
-
-/*
-** This routine sets the busy callback for an Sqlite database to the
-** given callback function with the given argument.
-*/
-void sqlite_busy_handler(
- sqlite *db,
- int (*xBusy)(void*,const char*,int),
- void *pArg
-){
- db->xBusyCallback = xBusy;
- db->pBusyArg = pArg;
-}
-
-#ifndef SQLITE_OMIT_PROGRESS_CALLBACK
-/*
-** This routine sets the progress callback for an Sqlite database to the
-** given callback function with the given argument. The progress callback will
-** be invoked every nOps opcodes.
-*/
-void sqlite_progress_handler(
- sqlite *db,
- int nOps,
- int (*xProgress)(void*),
- void *pArg
-){
- if( nOps>0 ){
- db->xProgress = xProgress;
- db->nProgressOps = nOps;
- db->pProgressArg = pArg;
- }else{
- db->xProgress = 0;
- db->nProgressOps = 0;
- db->pProgressArg = 0;
- }
-}
-#endif
-
-
-/*
-** This routine installs a default busy handler that waits for the
-** specified number of milliseconds before returning 0.
-*/
-void sqlite_busy_timeout(sqlite *db, int ms){
- if( ms>0 ){
- sqlite_busy_handler(db, sqliteDefaultBusyCallback, (void*)(long)ms);
- }else{
- sqlite_busy_handler(db, 0, 0);
- }
-}
-
-/*
-** Cause any pending operation to stop at its earliest opportunity.
-*/
-void sqlite_interrupt(sqlite *db){
- db->flags |= SQLITE_Interrupt;
-}
-
-/*
-** Windows systems should call this routine to free memory that
-** is returned in the in the errmsg parameter of sqlite_open() when
-** SQLite is a DLL. For some reason, it does not work to call free()
-** directly.
-**
-** Note that we need to call free() not sqliteFree() here, since every
-** string that is exported from SQLite should have already passed through
-** sqliteStrRealloc().
-*/
-void sqlite_freemem(void *p){ free(p); }
-
-/*
-** Windows systems need functions to call to return the sqlite_version
-** and sqlite_encoding strings since they are unable to access constants
-** within DLLs.
-*/
-const char *sqlite_libversion(void){ return sqlite_version; }
-const char *sqlite_libencoding(void){ return sqlite_encoding; }
-
-/*
-** Create new user-defined functions. The sqlite_create_function()
-** routine creates a regular function and sqlite_create_aggregate()
-** creates an aggregate function.
-**
-** Passing a NULL xFunc argument or NULL xStep and xFinalize arguments
-** disables the function. Calling sqlite_create_function() with the
-** same name and number of arguments as a prior call to
-** sqlite_create_aggregate() disables the prior call to
-** sqlite_create_aggregate(), and vice versa.
-**
-** If nArg is -1 it means that this function will accept any number
-** of arguments, including 0. The maximum allowed value of nArg is 127.
-*/
-int sqlite_create_function(
- sqlite *db, /* Add the function to this database connection */
- const char *zName, /* Name of the function to add */
- int nArg, /* Number of arguments */
- void (*xFunc)(sqlite_func*,int,const char**), /* The implementation */
- void *pUserData /* User data */
-){
- FuncDef *p;
- int nName;
- if( db==0 || zName==0 || sqliteSafetyCheck(db) ) return 1;
- if( nArg<-1 || nArg>127 ) return 1;
- nName = strlen(zName);
- if( nName>255 ) return 1;
- p = sqliteFindFunction(db, zName, nName, nArg, 1);
- if( p==0 ) return 1;
- p->xFunc = xFunc;
- p->xStep = 0;
- p->xFinalize = 0;
- p->pUserData = pUserData;
- return 0;
-}
-int sqlite_create_aggregate(
- sqlite *db, /* Add the function to this database connection */
- const char *zName, /* Name of the function to add */
- int nArg, /* Number of arguments */
- void (*xStep)(sqlite_func*,int,const char**), /* The step function */
- void (*xFinalize)(sqlite_func*), /* The finalizer */
- void *pUserData /* User data */
-){
- FuncDef *p;
- int nName;
- if( db==0 || zName==0 || sqliteSafetyCheck(db) ) return 1;
- if( nArg<-1 || nArg>127 ) return 1;
- nName = strlen(zName);
- if( nName>255 ) return 1;
- p = sqliteFindFunction(db, zName, nName, nArg, 1);
- if( p==0 ) return 1;
- p->xFunc = 0;
- p->xStep = xStep;
- p->xFinalize = xFinalize;
- p->pUserData = pUserData;
- return 0;
-}
-
-/*
-** Change the datatype for all functions with a given name. See the
-** header comment for the prototype of this function in sqlite.h for
-** additional information.
-*/
-int sqlite_function_type(sqlite *db, const char *zName, int dataType){
- FuncDef *p = (FuncDef*)sqliteHashFind(&db->aFunc, zName, strlen(zName));
- while( p ){
- p->dataType = dataType;
- p = p->pNext;
- }
- return SQLITE_OK;
-}
-
-/*
-** Register a trace function. The pArg from the previously registered trace
-** is returned.
-**
-** A NULL trace function means that no tracing is executes. A non-NULL
-** trace is a pointer to a function that is invoked at the start of each
-** sqlite_exec().
-*/
-void *sqlite_trace(sqlite *db, void (*xTrace)(void*,const char*), void *pArg){
- void *pOld = db->pTraceArg;
- db->xTrace = xTrace;
- db->pTraceArg = pArg;
- return pOld;
-}
-
-/*** EXPERIMENTAL ***
-**
-** Register a function to be invoked when a transaction comments.
-** If either function returns non-zero, then the commit becomes a
-** rollback.
-*/
-void *sqlite_commit_hook(
- sqlite *db, /* Attach the hook to this database */
- int (*xCallback)(void*), /* Function to invoke on each commit */
- void *pArg /* Argument to the function */
-){
- void *pOld = db->pCommitArg;
- db->xCommitCallback = xCallback;
- db->pCommitArg = pArg;
- return pOld;
-}
-
-
-/*
-** This routine is called to create a connection to a database BTree
-** driver. If zFilename is the name of a file, then that file is
-** opened and used. If zFilename is the magic name ":memory:" then
-** the database is stored in memory (and is thus forgotten as soon as
-** the connection is closed.) If zFilename is NULL then the database
-** is for temporary use only and is deleted as soon as the connection
-** is closed.
-**
-** A temporary database can be either a disk file (that is automatically
-** deleted when the file is closed) or a set of red-black trees held in memory,
-** depending on the values of the TEMP_STORE compile-time macro and the
-** db->temp_store variable, according to the following chart:
-**
-** TEMP_STORE db->temp_store Location of temporary database
-** ---------- -------------- ------------------------------
-** 0 any file
-** 1 1 file
-** 1 2 memory
-** 1 0 file
-** 2 1 file
-** 2 2 memory
-** 2 0 memory
-** 3 any memory
-*/
-int sqliteBtreeFactory(
- const sqlite *db, /* Main database when opening aux otherwise 0 */
- const char *zFilename, /* Name of the file containing the BTree database */
- int omitJournal, /* if TRUE then do not journal this file */
- int nCache, /* How many pages in the page cache */
- Btree **ppBtree){ /* Pointer to new Btree object written here */
-
- assert( ppBtree != 0);
-
-#ifndef SQLITE_OMIT_INMEMORYDB
- if( zFilename==0 ){
- if (TEMP_STORE == 0) {
- /* Always use file based temporary DB */
- return sqliteBtreeOpen(0, omitJournal, nCache, ppBtree);
- } else if (TEMP_STORE == 1 || TEMP_STORE == 2) {
- /* Switch depending on compile-time and/or runtime settings. */
- int location = db->temp_store==0 ? TEMP_STORE : db->temp_store;
-
- if (location == 1) {
- return sqliteBtreeOpen(zFilename, omitJournal, nCache, ppBtree);
- } else {
- return sqliteRbtreeOpen(0, 0, 0, ppBtree);
- }
- } else {
- /* Always use in-core DB */
- return sqliteRbtreeOpen(0, 0, 0, ppBtree);
- }
- }else if( zFilename[0]==':' && strcmp(zFilename,":memory:")==0 ){
- return sqliteRbtreeOpen(0, 0, 0, ppBtree);
- }else
-#endif
- {
- return sqliteBtreeOpen(zFilename, omitJournal, nCache, ppBtree);
- }
-}
+++ /dev/null
-/* Automatically generated file. Do not edit */
-char *sqliteOpcodeNames[] = { "???",
- "Goto",
- "Gosub",
- "Return",
- "Halt",
- "Integer",
- "String",
- "Variable",
- "Pop",
- "Dup",
- "Pull",
- "Push",
- "ColumnName",
- "Callback",
- "Concat",
- "Add",
- "Subtract",
- "Multiply",
- "Divide",
- "Remainder",
- "Function",
- "BitAnd",
- "BitOr",
- "ShiftLeft",
- "ShiftRight",
- "AddImm",
- "ForceInt",
- "MustBeInt",
- "Eq",
- "Ne",
- "Lt",
- "Le",
- "Gt",
- "Ge",
- "StrEq",
- "StrNe",
- "StrLt",
- "StrLe",
- "StrGt",
- "StrGe",
- "And",
- "Or",
- "Negative",
- "AbsValue",
- "Not",
- "BitNot",
- "Noop",
- "If",
- "IfNot",
- "IsNull",
- "NotNull",
- "MakeRecord",
- "MakeIdxKey",
- "MakeKey",
- "IncrKey",
- "Checkpoint",
- "Transaction",
- "Commit",
- "Rollback",
- "ReadCookie",
- "SetCookie",
- "VerifyCookie",
- "OpenRead",
- "OpenWrite",
- "OpenTemp",
- "OpenPseudo",
- "Close",
- "MoveLt",
- "MoveTo",
- "Distinct",
- "NotFound",
- "Found",
- "IsUnique",
- "NotExists",
- "NewRecno",
- "PutIntKey",
- "PutStrKey",
- "Delete",
- "SetCounts",
- "KeyAsData",
- "RowKey",
- "RowData",
- "Column",
- "Recno",
- "FullKey",
- "NullRow",
- "Last",
- "Rewind",
- "Prev",
- "Next",
- "IdxPut",
- "IdxDelete",
- "IdxRecno",
- "IdxLT",
- "IdxGT",
- "IdxGE",
- "IdxIsNull",
- "Destroy",
- "Clear",
- "CreateIndex",
- "CreateTable",
- "IntegrityCk",
- "ListWrite",
- "ListRewind",
- "ListRead",
- "ListReset",
- "ListPush",
- "ListPop",
- "ContextPush",
- "ContextPop",
- "SortPut",
- "SortMakeRec",
- "SortMakeKey",
- "Sort",
- "SortNext",
- "SortCallback",
- "SortReset",
- "FileOpen",
- "FileRead",
- "FileColumn",
- "MemStore",
- "MemLoad",
- "MemIncr",
- "AggReset",
- "AggInit",
- "AggFunc",
- "AggFocus",
- "AggSet",
- "AggGet",
- "AggNext",
- "SetInsert",
- "SetFound",
- "SetNotFound",
- "SetFirst",
- "SetNext",
- "Vacuum",
- "StackDepth",
- "StackReset",
-};
+++ /dev/null
-/* Automatically generated file. Do not edit */
-#define OP_Goto 1
-#define OP_Gosub 2
-#define OP_Return 3
-#define OP_Halt 4
-#define OP_Integer 5
-#define OP_String 6
-#define OP_Variable 7
-#define OP_Pop 8
-#define OP_Dup 9
-#define OP_Pull 10
-#define OP_Push 11
-#define OP_ColumnName 12
-#define OP_Callback 13
-#define OP_Concat 14
-#define OP_Add 15
-#define OP_Subtract 16
-#define OP_Multiply 17
-#define OP_Divide 18
-#define OP_Remainder 19
-#define OP_Function 20
-#define OP_BitAnd 21
-#define OP_BitOr 22
-#define OP_ShiftLeft 23
-#define OP_ShiftRight 24
-#define OP_AddImm 25
-#define OP_ForceInt 26
-#define OP_MustBeInt 27
-#define OP_Eq 28
-#define OP_Ne 29
-#define OP_Lt 30
-#define OP_Le 31
-#define OP_Gt 32
-#define OP_Ge 33
-#define OP_StrEq 34
-#define OP_StrNe 35
-#define OP_StrLt 36
-#define OP_StrLe 37
-#define OP_StrGt 38
-#define OP_StrGe 39
-#define OP_And 40
-#define OP_Or 41
-#define OP_Negative 42
-#define OP_AbsValue 43
-#define OP_Not 44
-#define OP_BitNot 45
-#define OP_Noop 46
-#define OP_If 47
-#define OP_IfNot 48
-#define OP_IsNull 49
-#define OP_NotNull 50
-#define OP_MakeRecord 51
-#define OP_MakeIdxKey 52
-#define OP_MakeKey 53
-#define OP_IncrKey 54
-#define OP_Checkpoint 55
-#define OP_Transaction 56
-#define OP_Commit 57
-#define OP_Rollback 58
-#define OP_ReadCookie 59
-#define OP_SetCookie 60
-#define OP_VerifyCookie 61
-#define OP_OpenRead 62
-#define OP_OpenWrite 63
-#define OP_OpenTemp 64
-#define OP_OpenPseudo 65
-#define OP_Close 66
-#define OP_MoveLt 67
-#define OP_MoveTo 68
-#define OP_Distinct 69
-#define OP_NotFound 70
-#define OP_Found 71
-#define OP_IsUnique 72
-#define OP_NotExists 73
-#define OP_NewRecno 74
-#define OP_PutIntKey 75
-#define OP_PutStrKey 76
-#define OP_Delete 77
-#define OP_SetCounts 78
-#define OP_KeyAsData 79
-#define OP_RowKey 80
-#define OP_RowData 81
-#define OP_Column 82
-#define OP_Recno 83
-#define OP_FullKey 84
-#define OP_NullRow 85
-#define OP_Last 86
-#define OP_Rewind 87
-#define OP_Prev 88
-#define OP_Next 89
-#define OP_IdxPut 90
-#define OP_IdxDelete 91
-#define OP_IdxRecno 92
-#define OP_IdxLT 93
-#define OP_IdxGT 94
-#define OP_IdxGE 95
-#define OP_IdxIsNull 96
-#define OP_Destroy 97
-#define OP_Clear 98
-#define OP_CreateIndex 99
-#define OP_CreateTable 100
-#define OP_IntegrityCk 101
-#define OP_ListWrite 102
-#define OP_ListRewind 103
-#define OP_ListRead 104
-#define OP_ListReset 105
-#define OP_ListPush 106
-#define OP_ListPop 107
-#define OP_ContextPush 108
-#define OP_ContextPop 109
-#define OP_SortPut 110
-#define OP_SortMakeRec 111
-#define OP_SortMakeKey 112
-#define OP_Sort 113
-#define OP_SortNext 114
-#define OP_SortCallback 115
-#define OP_SortReset 116
-#define OP_FileOpen 117
-#define OP_FileRead 118
-#define OP_FileColumn 119
-#define OP_MemStore 120
-#define OP_MemLoad 121
-#define OP_MemIncr 122
-#define OP_AggReset 123
-#define OP_AggInit 124
-#define OP_AggFunc 125
-#define OP_AggFocus 126
-#define OP_AggSet 127
-#define OP_AggGet 128
-#define OP_AggNext 129
-#define OP_SetInsert 130
-#define OP_SetFound 131
-#define OP_SetNotFound 132
-#define OP_SetFirst 133
-#define OP_SetNext 134
-#define OP_Vacuum 135
-#define OP_StackDepth 136
-#define OP_StackReset 137
+++ /dev/null
-/*
-** 2001 September 16
-**
-** The author disclaims copyright to this source code. In place of
-** a legal notice, here is a blessing:
-**
-** May you do good and not evil.
-** May you find forgiveness for yourself and forgive others.
-** May you share freely, never taking more than you give.
-**
-******************************************************************************
-**
-** This file contains code that is specific to particular operating
-** systems. The purpose of this file is to provide a uniform abstraction
-** on which the rest of SQLite can operate.
-*/
-#include "os.h" /* Must be first to enable large file support */
-#include "sqliteInt.h"
-
-#if OS_UNIX
-# include <time.h>
-# include <errno.h>
-# include <unistd.h>
-# ifndef O_LARGEFILE
-# define O_LARGEFILE 0
-# endif
-# ifdef SQLITE_DISABLE_LFS
-# undef O_LARGEFILE
-# define O_LARGEFILE 0
-# endif
-# ifndef O_NOFOLLOW
-# define O_NOFOLLOW 0
-# endif
-# ifndef O_BINARY
-# define O_BINARY 0
-# endif
-#endif
-
-
-#if OS_WIN
-# include <winbase.h>
-#endif
-
-#if OS_MAC
-# include <extras.h>
-# include <path2fss.h>
-# include <TextUtils.h>
-# include <FinderRegistry.h>
-# include <Folders.h>
-# include <Timer.h>
-# include <OSUtils.h>
-#endif
-
-/*
-** The DJGPP compiler environment looks mostly like Unix, but it
-** lacks the fcntl() system call. So redefine fcntl() to be something
-** that always succeeds. This means that locking does not occur under
-** DJGPP. But its DOS - what did you expect?
-*/
-#ifdef __DJGPP__
-# define fcntl(A,B,C) 0
-#endif
-
-/*
-** Macros used to determine whether or not to use threads. The
-** SQLITE_UNIX_THREADS macro is defined if we are synchronizing for
-** Posix threads and SQLITE_W32_THREADS is defined if we are
-** synchronizing using Win32 threads.
-*/
-#if OS_UNIX && defined(THREADSAFE) && THREADSAFE
-# include <pthread.h>
-# define SQLITE_UNIX_THREADS 1
-#endif
-#if OS_WIN && defined(THREADSAFE) && THREADSAFE
-# define SQLITE_W32_THREADS 1
-#endif
-#if OS_MAC && defined(THREADSAFE) && THREADSAFE
-# include <Multiprocessing.h>
-# define SQLITE_MACOS_MULTITASKING 1
-#endif
-
-/*
-** Macros for performance tracing. Normally turned off
-*/
-#if 0
-static int last_page = 0;
-__inline__ unsigned long long int hwtime(void){
- unsigned long long int x;
- __asm__("rdtsc\n\t"
- "mov %%edx, %%ecx\n\t"
- :"=A" (x));
- return x;
-}
-static unsigned long long int g_start;
-static unsigned int elapse;
-#define TIMER_START g_start=hwtime()
-#define TIMER_END elapse=hwtime()-g_start
-#define SEEK(X) last_page=(X)
-#define TRACE1(X) fprintf(stderr,X)
-#define TRACE2(X,Y) fprintf(stderr,X,Y)
-#define TRACE3(X,Y,Z) fprintf(stderr,X,Y,Z)
-#define TRACE4(X,Y,Z,A) fprintf(stderr,X,Y,Z,A)
-#define TRACE5(X,Y,Z,A,B) fprintf(stderr,X,Y,Z,A,B)
-#else
-#define TIMER_START
-#define TIMER_END
-#define SEEK(X)
-#define TRACE1(X)
-#define TRACE2(X,Y)
-#define TRACE3(X,Y,Z)
-#define TRACE4(X,Y,Z,A)
-#define TRACE5(X,Y,Z,A,B)
-#endif
-
-
-#if OS_UNIX
-/*
-** Here is the dirt on POSIX advisory locks: ANSI STD 1003.1 (1996)
-** section 6.5.2.2 lines 483 through 490 specify that when a process
-** sets or clears a lock, that operation overrides any prior locks set
-** by the same process. It does not explicitly say so, but this implies
-** that it overrides locks set by the same process using a different
-** file descriptor. Consider this test case:
-**
-** int fd1 = open("./file1", O_RDWR|O_CREAT, 0644);
-** int fd2 = open("./file2", O_RDWR|O_CREAT, 0644);
-**
-** Suppose ./file1 and ./file2 are really the same file (because
-** one is a hard or symbolic link to the other) then if you set
-** an exclusive lock on fd1, then try to get an exclusive lock
-** on fd2, it works. I would have expected the second lock to
-** fail since there was already a lock on the file due to fd1.
-** But not so. Since both locks came from the same process, the
-** second overrides the first, even though they were on different
-** file descriptors opened on different file names.
-**
-** Bummer. If you ask me, this is broken. Badly broken. It means
-** that we cannot use POSIX locks to synchronize file access among
-** competing threads of the same process. POSIX locks will work fine
-** to synchronize access for threads in separate processes, but not
-** threads within the same process.
-**
-** To work around the problem, SQLite has to manage file locks internally
-** on its own. Whenever a new database is opened, we have to find the
-** specific inode of the database file (the inode is determined by the
-** st_dev and st_ino fields of the stat structure that fstat() fills in)
-** and check for locks already existing on that inode. When locks are
-** created or removed, we have to look at our own internal record of the
-** locks to see if another thread has previously set a lock on that same
-** inode.
-**
-** The OsFile structure for POSIX is no longer just an integer file
-** descriptor. It is now a structure that holds the integer file
-** descriptor and a pointer to a structure that describes the internal
-** locks on the corresponding inode. There is one locking structure
-** per inode, so if the same inode is opened twice, both OsFile structures
-** point to the same locking structure. The locking structure keeps
-** a reference count (so we will know when to delete it) and a "cnt"
-** field that tells us its internal lock status. cnt==0 means the
-** file is unlocked. cnt==-1 means the file has an exclusive lock.
-** cnt>0 means there are cnt shared locks on the file.
-**
-** Any attempt to lock or unlock a file first checks the locking
-** structure. The fcntl() system call is only invoked to set a
-** POSIX lock if the internal lock structure transitions between
-** a locked and an unlocked state.
-**
-** 2004-Jan-11:
-** More recent discoveries about POSIX advisory locks. (The more
-** I discover, the more I realize the a POSIX advisory locks are
-** an abomination.)
-**
-** If you close a file descriptor that points to a file that has locks,
-** all locks on that file that are owned by the current process are
-** released. To work around this problem, each OsFile structure contains
-** a pointer to an openCnt structure. There is one openCnt structure
-** per open inode, which means that multiple OsFiles can point to a single
-** openCnt. When an attempt is made to close an OsFile, if there are
-** other OsFiles open on the same inode that are holding locks, the call
-** to close() the file descriptor is deferred until all of the locks clear.
-** The openCnt structure keeps a list of file descriptors that need to
-** be closed and that list is walked (and cleared) when the last lock
-** clears.
-**
-** First, under Linux threads, because each thread has a separate
-** process ID, lock operations in one thread do not override locks
-** to the same file in other threads. Linux threads behave like
-** separate processes in this respect. But, if you close a file
-** descriptor in linux threads, all locks are cleared, even locks
-** on other threads and even though the other threads have different
-** process IDs. Linux threads is inconsistent in this respect.
-** (I'm beginning to think that linux threads is an abomination too.)
-** The consequence of this all is that the hash table for the lockInfo
-** structure has to include the process id as part of its key because
-** locks in different threads are treated as distinct. But the
-** openCnt structure should not include the process id in its
-** key because close() clears lock on all threads, not just the current
-** thread. Were it not for this goofiness in linux threads, we could
-** combine the lockInfo and openCnt structures into a single structure.
-*/
-
-/*
-** An instance of the following structure serves as the key used
-** to locate a particular lockInfo structure given its inode. Note
-** that we have to include the process ID as part of the key. On some
-** threading implementations (ex: linux), each thread has a separate
-** process ID.
-*/
-struct lockKey {
- dev_t dev; /* Device number */
- ino_t ino; /* Inode number */
- pid_t pid; /* Process ID */
-};
-
-/*
-** An instance of the following structure is allocated for each open
-** inode on each thread with a different process ID. (Threads have
-** different process IDs on linux, but not on most other unixes.)
-**
-** A single inode can have multiple file descriptors, so each OsFile
-** structure contains a pointer to an instance of this object and this
-** object keeps a count of the number of OsFiles pointing to it.
-*/
-struct lockInfo {
- struct lockKey key; /* The lookup key */
- int cnt; /* 0: unlocked. -1: write lock. 1...: read lock. */
- int nRef; /* Number of pointers to this structure */
-};
-
-/*
-** An instance of the following structure serves as the key used
-** to locate a particular openCnt structure given its inode. This
-** is the same as the lockKey except that the process ID is omitted.
-*/
-struct openKey {
- dev_t dev; /* Device number */
- ino_t ino; /* Inode number */
-};
-
-/*
-** An instance of the following structure is allocated for each open
-** inode. This structure keeps track of the number of locks on that
-** inode. If a close is attempted against an inode that is holding
-** locks, the close is deferred until all locks clear by adding the
-** file descriptor to be closed to the pending list.
-*/
-struct openCnt {
- struct openKey key; /* The lookup key */
- int nRef; /* Number of pointers to this structure */
- int nLock; /* Number of outstanding locks */
- int nPending; /* Number of pending close() operations */
- int *aPending; /* Malloced space holding fd's awaiting a close() */
-};
-
-/*
-** These hash table maps inodes and process IDs into lockInfo and openCnt
-** structures. Access to these hash tables must be protected by a mutex.
-*/
-static Hash lockHash = { SQLITE_HASH_BINARY, 0, 0, 0, 0, 0 };
-static Hash openHash = { SQLITE_HASH_BINARY, 0, 0, 0, 0, 0 };
-
-/*
-** Release a lockInfo structure previously allocated by findLockInfo().
-*/
-static void releaseLockInfo(struct lockInfo *pLock){
- pLock->nRef--;
- if( pLock->nRef==0 ){
- sqliteHashInsert(&lockHash, &pLock->key, sizeof(pLock->key), 0);
- sqliteFree(pLock);
- }
-}
-
-/*
-** Release a openCnt structure previously allocated by findLockInfo().
-*/
-static void releaseOpenCnt(struct openCnt *pOpen){
- pOpen->nRef--;
- if( pOpen->nRef==0 ){
- sqliteHashInsert(&openHash, &pOpen->key, sizeof(pOpen->key), 0);
- sqliteFree(pOpen->aPending);
- sqliteFree(pOpen);
- }
-}
-
-/*
-** Given a file descriptor, locate lockInfo and openCnt structures that
-** describes that file descriptor. Create a new ones if necessary. The
-** return values might be unset if an error occurs.
-**
-** Return the number of errors.
-*/
-int findLockInfo(
- int fd, /* The file descriptor used in the key */
- struct lockInfo **ppLock, /* Return the lockInfo structure here */
- struct openCnt **ppOpen /* Return the openCnt structure here */
-){
- int rc;
- struct lockKey key1;
- struct openKey key2;
- struct stat statbuf;
- struct lockInfo *pLock;
- struct openCnt *pOpen;
- rc = fstat(fd, &statbuf);
- if( rc!=0 ) return 1;
- memset(&key1, 0, sizeof(key1));
- key1.dev = statbuf.st_dev;
- key1.ino = statbuf.st_ino;
- key1.pid = getpid();
- memset(&key2, 0, sizeof(key2));
- key2.dev = statbuf.st_dev;
- key2.ino = statbuf.st_ino;
- pLock = (struct lockInfo*)sqliteHashFind(&lockHash, &key1, sizeof(key1));
- if( pLock==0 ){
- struct lockInfo *pOld;
- pLock = sqliteMallocRaw( sizeof(*pLock) );
- if( pLock==0 ) return 1;
- pLock->key = key1;
- pLock->nRef = 1;
- pLock->cnt = 0;
- pOld = sqliteHashInsert(&lockHash, &pLock->key, sizeof(key1), pLock);
- if( pOld!=0 ){
- assert( pOld==pLock );
- sqliteFree(pLock);
- return 1;
- }
- }else{
- pLock->nRef++;
- }
- *ppLock = pLock;
- pOpen = (struct openCnt*)sqliteHashFind(&openHash, &key2, sizeof(key2));
- if( pOpen==0 ){
- struct openCnt *pOld;
- pOpen = sqliteMallocRaw( sizeof(*pOpen) );
- if( pOpen==0 ){
- releaseLockInfo(pLock);
- return 1;
- }
- pOpen->key = key2;
- pOpen->nRef = 1;
- pOpen->nLock = 0;
- pOpen->nPending = 0;
- pOpen->aPending = 0;
- pOld = sqliteHashInsert(&openHash, &pOpen->key, sizeof(key2), pOpen);
- if( pOld!=0 ){
- assert( pOld==pOpen );
- sqliteFree(pOpen);
- releaseLockInfo(pLock);
- return 1;
- }
- }else{
- pOpen->nRef++;
- }
- *ppOpen = pOpen;
- return 0;
-}
-
-#endif /** POSIX advisory lock work-around **/
-
-/*
-** If we compile with the SQLITE_TEST macro set, then the following block
-** of code will give us the ability to simulate a disk I/O error. This
-** is used for testing the I/O recovery logic.
-*/
-#ifdef SQLITE_TEST
-int sqlite_io_error_pending = 0;
-#define SimulateIOError(A) \
- if( sqlite_io_error_pending ) \
- if( sqlite_io_error_pending-- == 1 ){ local_ioerr(); return A; }
-static void local_ioerr(){
- sqlite_io_error_pending = 0; /* Really just a place to set a breakpoint */
-}
-#else
-#define SimulateIOError(A)
-#endif
-
-/*
-** When testing, keep a count of the number of open files.
-*/
-#ifdef SQLITE_TEST
-int sqlite_open_file_count = 0;
-#define OpenCounter(X) sqlite_open_file_count+=(X)
-#else
-#define OpenCounter(X)
-#endif
-
-
-/*
-** Delete the named file
-*/
-int sqliteOsDelete(const char *zFilename){
-#if OS_UNIX
- unlink(zFilename);
-#endif
-#if OS_WIN
- DeleteFile(zFilename);
-#endif
-#if OS_MAC
- unlink(zFilename);
-#endif
- return SQLITE_OK;
-}
-
-/*
-** Return TRUE if the named file exists.
-*/
-int sqliteOsFileExists(const char *zFilename){
-#if OS_UNIX
- return access(zFilename, 0)==0;
-#endif
-#if OS_WIN
- return GetFileAttributes(zFilename) != 0xffffffff;
-#endif
-#if OS_MAC
- return access(zFilename, 0)==0;
-#endif
-}
-
-
-#if 0 /* NOT USED */
-/*
-** Change the name of an existing file.
-*/
-int sqliteOsFileRename(const char *zOldName, const char *zNewName){
-#if OS_UNIX
- if( link(zOldName, zNewName) ){
- return SQLITE_ERROR;
- }
- unlink(zOldName);
- return SQLITE_OK;
-#endif
-#if OS_WIN
- if( !MoveFile(zOldName, zNewName) ){
- return SQLITE_ERROR;
- }
- return SQLITE_OK;
-#endif
-#if OS_MAC
- /**** FIX ME ***/
- return SQLITE_ERROR;
-#endif
-}
-#endif /* NOT USED */
-
-/*
-** Attempt to open a file for both reading and writing. If that
-** fails, try opening it read-only. If the file does not exist,
-** try to create it.
-**
-** On success, a handle for the open file is written to *id
-** and *pReadonly is set to 0 if the file was opened for reading and
-** writing or 1 if the file was opened read-only. The function returns
-** SQLITE_OK.
-**
-** On failure, the function returns SQLITE_CANTOPEN and leaves
-** *id and *pReadonly unchanged.
-*/
-int sqliteOsOpenReadWrite(
- const char *zFilename,
- OsFile *id,
- int *pReadonly
-){
-#if OS_UNIX
- int rc;
- id->dirfd = -1;
- id->fd = open(zFilename, O_RDWR|O_CREAT|O_LARGEFILE|O_BINARY, 0644);
- if( id->fd<0 ){
-#ifdef EISDIR
- if( errno==EISDIR ){
- return SQLITE_CANTOPEN;
- }
-#endif
- id->fd = open(zFilename, O_RDONLY|O_LARGEFILE|O_BINARY);
- if( id->fd<0 ){
- return SQLITE_CANTOPEN;
- }
- *pReadonly = 1;
- }else{
- *pReadonly = 0;
- }
- sqliteOsEnterMutex();
- rc = findLockInfo(id->fd, &id->pLock, &id->pOpen);
- sqliteOsLeaveMutex();
- if( rc ){
- close(id->fd);
- return SQLITE_NOMEM;
- }
- id->locked = 0;
- TRACE3("OPEN %-3d %s\n", id->fd, zFilename);
- OpenCounter(+1);
- return SQLITE_OK;
-#endif
-#if OS_WIN
- HANDLE h = CreateFile(zFilename,
- GENERIC_READ | GENERIC_WRITE,
- FILE_SHARE_READ | FILE_SHARE_WRITE,
- NULL,
- OPEN_ALWAYS,
- FILE_ATTRIBUTE_NORMAL | FILE_FLAG_RANDOM_ACCESS,
- NULL
- );
- if( h==INVALID_HANDLE_VALUE ){
- h = CreateFile(zFilename,
- GENERIC_READ,
- FILE_SHARE_READ,
- NULL,
- OPEN_ALWAYS,
- FILE_ATTRIBUTE_NORMAL | FILE_FLAG_RANDOM_ACCESS,
- NULL
- );
- if( h==INVALID_HANDLE_VALUE ){
- return SQLITE_CANTOPEN;
- }
- *pReadonly = 1;
- }else{
- *pReadonly = 0;
- }
- id->h = h;
- id->locked = 0;
- OpenCounter(+1);
- return SQLITE_OK;
-#endif
-#if OS_MAC
- FSSpec fsSpec;
-# ifdef _LARGE_FILE
- HFSUniStr255 dfName;
- FSRef fsRef;
- if( __path2fss(zFilename, &fsSpec) != noErr ){
- if( HCreate(fsSpec.vRefNum, fsSpec.parID, fsSpec.name, 'SQLI', cDocumentFile) != noErr )
- return SQLITE_CANTOPEN;
- }
- if( FSpMakeFSRef(&fsSpec, &fsRef) != noErr )
- return SQLITE_CANTOPEN;
- FSGetDataForkName(&dfName);
- if( FSOpenFork(&fsRef, dfName.length, dfName.unicode,
- fsRdWrShPerm, &(id->refNum)) != noErr ){
- if( FSOpenFork(&fsRef, dfName.length, dfName.unicode,
- fsRdWrPerm, &(id->refNum)) != noErr ){
- if (FSOpenFork(&fsRef, dfName.length, dfName.unicode,
- fsRdPerm, &(id->refNum)) != noErr )
- return SQLITE_CANTOPEN;
- else
- *pReadonly = 1;
- } else
- *pReadonly = 0;
- } else
- *pReadonly = 0;
-# else
- __path2fss(zFilename, &fsSpec);
- if( !sqliteOsFileExists(zFilename) ){
- if( HCreate(fsSpec.vRefNum, fsSpec.parID, fsSpec.name, 'SQLI', cDocumentFile) != noErr )
- return SQLITE_CANTOPEN;
- }
- if( HOpenDF(fsSpec.vRefNum, fsSpec.parID, fsSpec.name, fsRdWrShPerm, &(id->refNum)) != noErr ){
- if( HOpenDF(fsSpec.vRefNum, fsSpec.parID, fsSpec.name, fsRdWrPerm, &(id->refNum)) != noErr ){
- if( HOpenDF(fsSpec.vRefNum, fsSpec.parID, fsSpec.name, fsRdPerm, &(id->refNum)) != noErr )
- return SQLITE_CANTOPEN;
- else
- *pReadonly = 1;
- } else
- *pReadonly = 0;
- } else
- *pReadonly = 0;
-# endif
- if( HOpenRF(fsSpec.vRefNum, fsSpec.parID, fsSpec.name, fsRdWrShPerm, &(id->refNumRF)) != noErr){
- id->refNumRF = -1;
- }
- id->locked = 0;
- id->delOnClose = 0;
- OpenCounter(+1);
- return SQLITE_OK;
-#endif
-}
-
-
-/*
-** Attempt to open a new file for exclusive access by this process.
-** The file will be opened for both reading and writing. To avoid
-** a potential security problem, we do not allow the file to have
-** previously existed. Nor do we allow the file to be a symbolic
-** link.
-**
-** If delFlag is true, then make arrangements to automatically delete
-** the file when it is closed.
-**
-** On success, write the file handle into *id and return SQLITE_OK.
-**
-** On failure, return SQLITE_CANTOPEN.
-*/
-int sqliteOsOpenExclusive(const char *zFilename, OsFile *id, int delFlag){
-#if OS_UNIX
- int rc;
- if( access(zFilename, 0)==0 ){
- return SQLITE_CANTOPEN;
- }
- id->dirfd = -1;
- id->fd = open(zFilename,
- O_RDWR|O_CREAT|O_EXCL|O_NOFOLLOW|O_LARGEFILE|O_BINARY, 0600);
- if( id->fd<0 ){
- return SQLITE_CANTOPEN;
- }
- sqliteOsEnterMutex();
- rc = findLockInfo(id->fd, &id->pLock, &id->pOpen);
- sqliteOsLeaveMutex();
- if( rc ){
- close(id->fd);
- unlink(zFilename);
- return SQLITE_NOMEM;
- }
- id->locked = 0;
- if( delFlag ){
- unlink(zFilename);
- }
- TRACE3("OPEN-EX %-3d %s\n", id->fd, zFilename);
- OpenCounter(+1);
- return SQLITE_OK;
-#endif
-#if OS_WIN
- HANDLE h;
- int fileflags;
- if( delFlag ){
- fileflags = FILE_ATTRIBUTE_TEMPORARY | FILE_FLAG_RANDOM_ACCESS
- | FILE_FLAG_DELETE_ON_CLOSE;
- }else{
- fileflags = FILE_FLAG_RANDOM_ACCESS;
- }
- h = CreateFile(zFilename,
- GENERIC_READ | GENERIC_WRITE,
- 0,
- NULL,
- CREATE_ALWAYS,
- fileflags,
- NULL
- );
- if( h==INVALID_HANDLE_VALUE ){
- return SQLITE_CANTOPEN;
- }
- id->h = h;
- id->locked = 0;
- OpenCounter(+1);
- return SQLITE_OK;
-#endif
-#if OS_MAC
- FSSpec fsSpec;
-# ifdef _LARGE_FILE
- HFSUniStr255 dfName;
- FSRef fsRef;
- __path2fss(zFilename, &fsSpec);
- if( HCreate(fsSpec.vRefNum, fsSpec.parID, fsSpec.name, 'SQLI', cDocumentFile) != noErr )
- return SQLITE_CANTOPEN;
- if( FSpMakeFSRef(&fsSpec, &fsRef) != noErr )
- return SQLITE_CANTOPEN;
- FSGetDataForkName(&dfName);
- if( FSOpenFork(&fsRef, dfName.length, dfName.unicode,
- fsRdWrPerm, &(id->refNum)) != noErr )
- return SQLITE_CANTOPEN;
-# else
- __path2fss(zFilename, &fsSpec);
- if( HCreate(fsSpec.vRefNum, fsSpec.parID, fsSpec.name, 'SQLI', cDocumentFile) != noErr )
- return SQLITE_CANTOPEN;
- if( HOpenDF(fsSpec.vRefNum, fsSpec.parID, fsSpec.name, fsRdWrPerm, &(id->refNum)) != noErr )
- return SQLITE_CANTOPEN;
-# endif
- id->refNumRF = -1;
- id->locked = 0;
- id->delOnClose = delFlag;
- if (delFlag)
- id->pathToDel = sqliteOsFullPathname(zFilename);
- OpenCounter(+1);
- return SQLITE_OK;
-#endif
-}
-
-/*
-** Attempt to open a new file for read-only access.
-**
-** On success, write the file handle into *id and return SQLITE_OK.
-**
-** On failure, return SQLITE_CANTOPEN.
-*/
-int sqliteOsOpenReadOnly(const char *zFilename, OsFile *id){
-#if OS_UNIX
- int rc;
- id->dirfd = -1;
- id->fd = open(zFilename, O_RDONLY|O_LARGEFILE|O_BINARY);
- if( id->fd<0 ){
- return SQLITE_CANTOPEN;
- }
- sqliteOsEnterMutex();
- rc = findLockInfo(id->fd, &id->pLock, &id->pOpen);
- sqliteOsLeaveMutex();
- if( rc ){
- close(id->fd);
- return SQLITE_NOMEM;
- }
- id->locked = 0;
- TRACE3("OPEN-RO %-3d %s\n", id->fd, zFilename);
- OpenCounter(+1);
- return SQLITE_OK;
-#endif
-#if OS_WIN
- HANDLE h = CreateFile(zFilename,
- GENERIC_READ,
- 0,
- NULL,
- OPEN_EXISTING,
- FILE_ATTRIBUTE_NORMAL | FILE_FLAG_RANDOM_ACCESS,
- NULL
- );
- if( h==INVALID_HANDLE_VALUE ){
- return SQLITE_CANTOPEN;
- }
- id->h = h;
- id->locked = 0;
- OpenCounter(+1);
- return SQLITE_OK;
-#endif
-#if OS_MAC
- FSSpec fsSpec;
-# ifdef _LARGE_FILE
- HFSUniStr255 dfName;
- FSRef fsRef;
- if( __path2fss(zFilename, &fsSpec) != noErr )
- return SQLITE_CANTOPEN;
- if( FSpMakeFSRef(&fsSpec, &fsRef) != noErr )
- return SQLITE_CANTOPEN;
- FSGetDataForkName(&dfName);
- if( FSOpenFork(&fsRef, dfName.length, dfName.unicode,
- fsRdPerm, &(id->refNum)) != noErr )
- return SQLITE_CANTOPEN;
-# else
- __path2fss(zFilename, &fsSpec);
- if( HOpenDF(fsSpec.vRefNum, fsSpec.parID, fsSpec.name, fsRdPerm, &(id->refNum)) != noErr )
- return SQLITE_CANTOPEN;
-# endif
- if( HOpenRF(fsSpec.vRefNum, fsSpec.parID, fsSpec.name, fsRdWrShPerm, &(id->refNumRF)) != noErr){
- id->refNumRF = -1;
- }
- id->locked = 0;
- id->delOnClose = 0;
- OpenCounter(+1);
- return SQLITE_OK;
-#endif
-}
-
-/*
-** Attempt to open a file descriptor for the directory that contains a
-** file. This file descriptor can be used to fsync() the directory
-** in order to make sure the creation of a new file is actually written
-** to disk.
-**
-** This routine is only meaningful for Unix. It is a no-op under
-** windows since windows does not support hard links.
-**
-** On success, a handle for a previously open file is at *id is
-** updated with the new directory file descriptor and SQLITE_OK is
-** returned.
-**
-** On failure, the function returns SQLITE_CANTOPEN and leaves
-** *id unchanged.
-*/
-int sqliteOsOpenDirectory(
- const char *zDirname,
- OsFile *id
-){
-#if OS_UNIX
- if( id->fd<0 ){
- /* Do not open the directory if the corresponding file is not already
- ** open. */
- return SQLITE_CANTOPEN;
- }
- assert( id->dirfd<0 );
- id->dirfd = open(zDirname, O_RDONLY|O_BINARY, 0644);
- if( id->dirfd<0 ){
- return SQLITE_CANTOPEN;
- }
- TRACE3("OPENDIR %-3d %s\n", id->dirfd, zDirname);
-#endif
- return SQLITE_OK;
-}
-
-/*
-** If the following global variable points to a string which is the
-** name of a directory, then that directory will be used to store
-** temporary files.
-*/
-const char *sqlite_temp_directory = 0;
-
-/*
-** Create a temporary file name in zBuf. zBuf must be big enough to
-** hold at least SQLITE_TEMPNAME_SIZE characters.
-*/
-int sqliteOsTempFileName(char *zBuf){
-#if OS_UNIX
- static const char *azDirs[] = {
- 0,
- "/var/tmp",
- "/usr/tmp",
- "/tmp",
- ".",
- };
- static unsigned char zChars[] =
- "abcdefghijklmnopqrstuvwxyz"
- "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
- "0123456789";
- int i, j;
- struct stat buf;
- const char *zDir = ".";
- azDirs[0] = sqlite_temp_directory;
- for(i=0; i<sizeof(azDirs)/sizeof(azDirs[0]); i++){
- if( azDirs[i]==0 ) continue;
- if( stat(azDirs[i], &buf) ) continue;
- if( !S_ISDIR(buf.st_mode) ) continue;
- if( access(azDirs[i], 07) ) continue;
- zDir = azDirs[i];
- break;
- }
- do{
- sprintf(zBuf, "%s/"TEMP_FILE_PREFIX, zDir);
- j = strlen(zBuf);
- sqliteRandomness(15, &zBuf[j]);
- for(i=0; i<15; i++, j++){
- zBuf[j] = (char)zChars[ ((unsigned char)zBuf[j])%(sizeof(zChars)-1) ];
- }
- zBuf[j] = 0;
- }while( access(zBuf,0)==0 );
-#endif
-#if OS_WIN
- static char zChars[] =
- "abcdefghijklmnopqrstuvwxyz"
- "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
- "0123456789";
- int i, j;
- const char *zDir;
- char zTempPath[SQLITE_TEMPNAME_SIZE];
- if( sqlite_temp_directory==0 ){
- GetTempPath(SQLITE_TEMPNAME_SIZE-30, zTempPath);
- for(i=strlen(zTempPath); i>0 && zTempPath[i-1]=='\\'; i--){}
- zTempPath[i] = 0;
- zDir = zTempPath;
- }else{
- zDir = sqlite_temp_directory;
- }
- for(;;){
- sprintf(zBuf, "%s\\"TEMP_FILE_PREFIX, zDir);
- j = strlen(zBuf);
- sqliteRandomness(15, &zBuf[j]);
- for(i=0; i<15; i++, j++){
- zBuf[j] = (char)zChars[ ((unsigned char)zBuf[j])%(sizeof(zChars)-1) ];
- }
- zBuf[j] = 0;
- if( !sqliteOsFileExists(zBuf) ) break;
- }
-#endif
-#if OS_MAC
- static char zChars[] =
- "abcdefghijklmnopqrstuvwxyz"
- "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
- "0123456789";
- int i, j;
- char *zDir;
- char zTempPath[SQLITE_TEMPNAME_SIZE];
- char zdirName[32];
- CInfoPBRec infoRec;
- Str31 dirName;
- memset(&infoRec, 0, sizeof(infoRec));
- memset(zTempPath, 0, SQLITE_TEMPNAME_SIZE);
- if( sqlite_temp_directory!=0 ){
- zDir = sqlite_temp_directory;
- }else if( FindFolder(kOnSystemDisk, kTemporaryFolderType, kCreateFolder,
- &(infoRec.dirInfo.ioVRefNum), &(infoRec.dirInfo.ioDrParID)) == noErr ){
- infoRec.dirInfo.ioNamePtr = dirName;
- do{
- infoRec.dirInfo.ioFDirIndex = -1;
- infoRec.dirInfo.ioDrDirID = infoRec.dirInfo.ioDrParID;
- if( PBGetCatInfoSync(&infoRec) == noErr ){
- CopyPascalStringToC(dirName, zdirName);
- i = strlen(zdirName);
- memmove(&(zTempPath[i+1]), zTempPath, strlen(zTempPath));
- strcpy(zTempPath, zdirName);
- zTempPath[i] = ':';
- }else{
- *zTempPath = 0;
- break;
- }
- } while( infoRec.dirInfo.ioDrDirID != fsRtDirID );
- zDir = zTempPath;
- }
- if( zDir[0]==0 ){
- getcwd(zTempPath, SQLITE_TEMPNAME_SIZE-24);
- zDir = zTempPath;
- }
- for(;;){
- sprintf(zBuf, "%s"TEMP_FILE_PREFIX, zDir);
- j = strlen(zBuf);
- sqliteRandomness(15, &zBuf[j]);
- for(i=0; i<15; i++, j++){
- zBuf[j] = (char)zChars[ ((unsigned char)zBuf[j])%(sizeof(zChars)-1) ];
- }
- zBuf[j] = 0;
- if( !sqliteOsFileExists(zBuf) ) break;
- }
-#endif
- return SQLITE_OK;
-}
-
-/*
-** Close a file.
-*/
-int sqliteOsClose(OsFile *id){
-#if OS_UNIX
- sqliteOsUnlock(id);
- if( id->dirfd>=0 ) close(id->dirfd);
- id->dirfd = -1;
- sqliteOsEnterMutex();
- if( id->pOpen->nLock ){
- /* If there are outstanding locks, do not actually close the file just
- ** yet because that would clear those locks. Instead, add the file
- ** descriptor to pOpen->aPending. It will be automatically closed when
- ** the last lock is cleared.
- */
- int *aNew;
- struct openCnt *pOpen = id->pOpen;
- pOpen->nPending++;
- aNew = sqliteRealloc( pOpen->aPending, pOpen->nPending*sizeof(int) );
- if( aNew==0 ){
- /* If a malloc fails, just leak the file descriptor */
- }else{
- pOpen->aPending = aNew;
- pOpen->aPending[pOpen->nPending-1] = id->fd;
- }
- }else{
- /* There are no outstanding locks so we can close the file immediately */
- close(id->fd);
- }
- releaseLockInfo(id->pLock);
- releaseOpenCnt(id->pOpen);
- sqliteOsLeaveMutex();
- TRACE2("CLOSE %-3d\n", id->fd);
- OpenCounter(-1);
- return SQLITE_OK;
-#endif
-#if OS_WIN
- CloseHandle(id->h);
- OpenCounter(-1);
- return SQLITE_OK;
-#endif
-#if OS_MAC
- if( id->refNumRF!=-1 )
- FSClose(id->refNumRF);
-# ifdef _LARGE_FILE
- FSCloseFork(id->refNum);
-# else
- FSClose(id->refNum);
-# endif
- if( id->delOnClose ){
- unlink(id->pathToDel);
- sqliteFree(id->pathToDel);
- }
- OpenCounter(-1);
- return SQLITE_OK;
-#endif
-}
-
-/*
-** Read data from a file into a buffer. Return SQLITE_OK if all
-** bytes were read successfully and SQLITE_IOERR if anything goes
-** wrong.
-*/
-int sqliteOsRead(OsFile *id, void *pBuf, int amt){
-#if OS_UNIX
- int got;
- SimulateIOError(SQLITE_IOERR);
- TIMER_START;
- got = read(id->fd, pBuf, amt);
- TIMER_END;
- TRACE4("READ %-3d %7d %d\n", id->fd, last_page, elapse);
- SEEK(0);
- /* if( got<0 ) got = 0; */
- if( got==amt ){
- return SQLITE_OK;
- }else{
- return SQLITE_IOERR;
- }
-#endif
-#if OS_WIN
- DWORD got;
- SimulateIOError(SQLITE_IOERR);
- TRACE2("READ %d\n", last_page);
- if( !ReadFile(id->h, pBuf, amt, &got, 0) ){
- got = 0;
- }
- if( got==(DWORD)amt ){
- return SQLITE_OK;
- }else{
- return SQLITE_IOERR;
- }
-#endif
-#if OS_MAC
- int got;
- SimulateIOError(SQLITE_IOERR);
- TRACE2("READ %d\n", last_page);
-# ifdef _LARGE_FILE
- FSReadFork(id->refNum, fsAtMark, 0, (ByteCount)amt, pBuf, (ByteCount*)&got);
-# else
- got = amt;
- FSRead(id->refNum, &got, pBuf);
-# endif
- if( got==amt ){
- return SQLITE_OK;
- }else{
- return SQLITE_IOERR;
- }
-#endif
-}
-
-/*
-** Write data from a buffer into a file. Return SQLITE_OK on success
-** or some other error code on failure.
-*/
-int sqliteOsWrite(OsFile *id, const void *pBuf, int amt){
-#if OS_UNIX
- int wrote = 0;
- SimulateIOError(SQLITE_IOERR);
- TIMER_START;
- while( amt>0 && (wrote = write(id->fd, pBuf, amt))>0 ){
- amt -= wrote;
- pBuf = &((char*)pBuf)[wrote];
- }
- TIMER_END;
- TRACE4("WRITE %-3d %7d %d\n", id->fd, last_page, elapse);
- SEEK(0);
- if( amt>0 ){
- return SQLITE_FULL;
- }
- return SQLITE_OK;
-#endif
-#if OS_WIN
- int rc;
- DWORD wrote;
- SimulateIOError(SQLITE_IOERR);
- TRACE2("WRITE %d\n", last_page);
- while( amt>0 && (rc = WriteFile(id->h, pBuf, amt, &wrote, 0))!=0 && wrote>0 ){
- amt -= wrote;
- pBuf = &((char*)pBuf)[wrote];
- }
- if( !rc || amt>(int)wrote ){
- return SQLITE_FULL;
- }
- return SQLITE_OK;
-#endif
-#if OS_MAC
- OSErr oserr;
- int wrote = 0;
- SimulateIOError(SQLITE_IOERR);
- TRACE2("WRITE %d\n", last_page);
- while( amt>0 ){
-# ifdef _LARGE_FILE
- oserr = FSWriteFork(id->refNum, fsAtMark, 0,
- (ByteCount)amt, pBuf, (ByteCount*)&wrote);
-# else
- wrote = amt;
- oserr = FSWrite(id->refNum, &wrote, pBuf);
-# endif
- if( wrote == 0 || oserr != noErr)
- break;
- amt -= wrote;
- pBuf = &((char*)pBuf)[wrote];
- }
- if( oserr != noErr || amt>wrote ){
- return SQLITE_FULL;
- }
- return SQLITE_OK;
-#endif
-}
-
-/*
-** Move the read/write pointer in a file.
-*/
-int sqliteOsSeek(OsFile *id, off_t offset){
- SEEK(offset/1024 + 1);
-#if OS_UNIX
- lseek(id->fd, offset, SEEK_SET);
- return SQLITE_OK;
-#endif
-#if OS_WIN
- {
- LONG upperBits = offset>>32;
- LONG lowerBits = offset & 0xffffffff;
- DWORD rc;
- rc = SetFilePointer(id->h, lowerBits, &upperBits, FILE_BEGIN);
- /* TRACE3("SEEK rc=0x%x upper=0x%x\n", rc, upperBits); */
- }
- return SQLITE_OK;
-#endif
-#if OS_MAC
- {
- off_t curSize;
- if( sqliteOsFileSize(id, &curSize) != SQLITE_OK ){
- return SQLITE_IOERR;
- }
- if( offset >= curSize ){
- if( sqliteOsTruncate(id, offset+1) != SQLITE_OK ){
- return SQLITE_IOERR;
- }
- }
-# ifdef _LARGE_FILE
- if( FSSetForkPosition(id->refNum, fsFromStart, offset) != noErr ){
-# else
- if( SetFPos(id->refNum, fsFromStart, offset) != noErr ){
-# endif
- return SQLITE_IOERR;
- }else{
- return SQLITE_OK;
- }
- }
-#endif
-}
-
-/*
-** Make sure all writes to a particular file are committed to disk.
-**
-** Under Unix, also make sure that the directory entry for the file
-** has been created by fsync-ing the directory that contains the file.
-** If we do not do this and we encounter a power failure, the directory
-** entry for the journal might not exist after we reboot. The next
-** SQLite to access the file will not know that the journal exists (because
-** the directory entry for the journal was never created) and the transaction
-** will not roll back - possibly leading to database corruption.
-*/
-int sqliteOsSync(OsFile *id){
-#if OS_UNIX
- SimulateIOError(SQLITE_IOERR);
- TRACE2("SYNC %-3d\n", id->fd);
- if( fsync(id->fd) ){
- return SQLITE_IOERR;
- }else{
- if( id->dirfd>=0 ){
- TRACE2("DIRSYNC %-3d\n", id->dirfd);
- fsync(id->dirfd);
- close(id->dirfd); /* Only need to sync once, so close the directory */
- id->dirfd = -1; /* when we are done. */
- }
- return SQLITE_OK;
- }
-#endif
-#if OS_WIN
- if( FlushFileBuffers(id->h) ){
- return SQLITE_OK;
- }else{
- return SQLITE_IOERR;
- }
-#endif
-#if OS_MAC
-# ifdef _LARGE_FILE
- if( FSFlushFork(id->refNum) != noErr ){
-# else
- ParamBlockRec params;
- memset(¶ms, 0, sizeof(ParamBlockRec));
- params.ioParam.ioRefNum = id->refNum;
- if( PBFlushFileSync(¶ms) != noErr ){
-# endif
- return SQLITE_IOERR;
- }else{
- return SQLITE_OK;
- }
-#endif
-}
-
-/*
-** Truncate an open file to a specified size
-*/
-int sqliteOsTruncate(OsFile *id, off_t nByte){
- SimulateIOError(SQLITE_IOERR);
-#if OS_UNIX
- return ftruncate(id->fd, nByte)==0 ? SQLITE_OK : SQLITE_IOERR;
-#endif
-#if OS_WIN
- {
- LONG upperBits = nByte>>32;
- SetFilePointer(id->h, nByte, &upperBits, FILE_BEGIN);
- SetEndOfFile(id->h);
- }
- return SQLITE_OK;
-#endif
-#if OS_MAC
-# ifdef _LARGE_FILE
- if( FSSetForkSize(id->refNum, fsFromStart, nByte) != noErr){
-# else
- if( SetEOF(id->refNum, nByte) != noErr ){
-# endif
- return SQLITE_IOERR;
- }else{
- return SQLITE_OK;
- }
-#endif
-}
-
-/*
-** Determine the current size of a file in bytes
-*/
-int sqliteOsFileSize(OsFile *id, off_t *pSize){
-#if OS_UNIX
- struct stat buf;
- SimulateIOError(SQLITE_IOERR);
- if( fstat(id->fd, &buf)!=0 ){
- return SQLITE_IOERR;
- }
- *pSize = buf.st_size;
- return SQLITE_OK;
-#endif
-#if OS_WIN
- DWORD upperBits, lowerBits;
- SimulateIOError(SQLITE_IOERR);
- lowerBits = GetFileSize(id->h, &upperBits);
- *pSize = (((off_t)upperBits)<<32) + lowerBits;
- return SQLITE_OK;
-#endif
-#if OS_MAC
-# ifdef _LARGE_FILE
- if( FSGetForkSize(id->refNum, pSize) != noErr){
-# else
- if( GetEOF(id->refNum, pSize) != noErr ){
-# endif
- return SQLITE_IOERR;
- }else{
- return SQLITE_OK;
- }
-#endif
-}
-
-#if OS_WIN
-/*
-** Return true (non-zero) if we are running under WinNT, Win2K or WinXP.
-** Return false (zero) for Win95, Win98, or WinME.
-**
-** Here is an interesting observation: Win95, Win98, and WinME lack
-** the LockFileEx() API. But we can still statically link against that
-** API as long as we don't call it win running Win95/98/ME. A call to
-** this routine is used to determine if the host is Win95/98/ME or
-** WinNT/2K/XP so that we will know whether or not we can safely call
-** the LockFileEx() API.
-*/
-int isNT(void){
- static int osType = 0; /* 0=unknown 1=win95 2=winNT */
- if( osType==0 ){
- OSVERSIONINFO sInfo;
- sInfo.dwOSVersionInfoSize = sizeof(sInfo);
- GetVersionEx(&sInfo);
- osType = sInfo.dwPlatformId==VER_PLATFORM_WIN32_NT ? 2 : 1;
- }
- return osType==2;
-}
-#endif
-
-/*
-** Windows file locking notes: [similar issues apply to MacOS]
-**
-** We cannot use LockFileEx() or UnlockFileEx() on Win95/98/ME because
-** those functions are not available. So we use only LockFile() and
-** UnlockFile().
-**
-** LockFile() prevents not just writing but also reading by other processes.
-** (This is a design error on the part of Windows, but there is nothing
-** we can do about that.) So the region used for locking is at the
-** end of the file where it is unlikely to ever interfere with an
-** actual read attempt.
-**
-** A database read lock is obtained by locking a single randomly-chosen
-** byte out of a specific range of bytes. The lock byte is obtained at
-** random so two separate readers can probably access the file at the
-** same time, unless they are unlucky and choose the same lock byte.
-** A database write lock is obtained by locking all bytes in the range.
-** There can only be one writer.
-**
-** A lock is obtained on the first byte of the lock range before acquiring
-** either a read lock or a write lock. This prevents two processes from
-** attempting to get a lock at a same time. The semantics of
-** sqliteOsReadLock() require that if there is already a write lock, that
-** lock is converted into a read lock atomically. The lock on the first
-** byte allows us to drop the old write lock and get the read lock without
-** another process jumping into the middle and messing us up. The same
-** argument applies to sqliteOsWriteLock().
-**
-** On WinNT/2K/XP systems, LockFileEx() and UnlockFileEx() are available,
-** which means we can use reader/writer locks. When reader writer locks
-** are used, the lock is placed on the same range of bytes that is used
-** for probabilistic locking in Win95/98/ME. Hence, the locking scheme
-** will support two or more Win95 readers or two or more WinNT readers.
-** But a single Win95 reader will lock out all WinNT readers and a single
-** WinNT reader will lock out all other Win95 readers.
-**
-** Note: On MacOS we use the resource fork for locking.
-**
-** The following #defines specify the range of bytes used for locking.
-** N_LOCKBYTE is the number of bytes available for doing the locking.
-** The first byte used to hold the lock while the lock is changing does
-** not count toward this number. FIRST_LOCKBYTE is the address of
-** the first byte in the range of bytes used for locking.
-*/
-#define N_LOCKBYTE 10239
-#if OS_MAC
-# define FIRST_LOCKBYTE (0x000fffff - N_LOCKBYTE)
-#else
-# define FIRST_LOCKBYTE (0xffffffff - N_LOCKBYTE)
-#endif
-
-/*
-** Change the status of the lock on the file "id" to be a readlock.
-** If the file was write locked, then this reduces the lock to a read.
-** If the file was read locked, then this acquires a new read lock.
-**
-** Return SQLITE_OK on success and SQLITE_BUSY on failure. If this
-** library was compiled with large file support (LFS) but LFS is not
-** available on the host, then an SQLITE_NOLFS is returned.
-*/
-int sqliteOsReadLock(OsFile *id){
-#if OS_UNIX
- int rc;
- sqliteOsEnterMutex();
- if( id->pLock->cnt>0 ){
- if( !id->locked ){
- id->pLock->cnt++;
- id->locked = 1;
- id->pOpen->nLock++;
- }
- rc = SQLITE_OK;
- }else if( id->locked || id->pLock->cnt==0 ){
- struct flock lock;
- int s;
- lock.l_type = F_RDLCK;
- lock.l_whence = SEEK_SET;
- lock.l_start = lock.l_len = 0L;
- s = fcntl(id->fd, F_SETLK, &lock);
- if( s!=0 ){
- rc = (errno==EINVAL) ? SQLITE_NOLFS : SQLITE_BUSY;
- }else{
- rc = SQLITE_OK;
- if( !id->locked ){
- id->pOpen->nLock++;
- id->locked = 1;
- }
- id->pLock->cnt = 1;
- }
- }else{
- rc = SQLITE_BUSY;
- }
- sqliteOsLeaveMutex();
- return rc;
-#endif
-#if OS_WIN
- int rc;
- if( id->locked>0 ){
- rc = SQLITE_OK;
- }else{
- int lk;
- int res;
- int cnt = 100;
- sqliteRandomness(sizeof(lk), &lk);
- lk = (lk & 0x7fffffff)%N_LOCKBYTE + 1;
- while( cnt-->0 && (res = LockFile(id->h, FIRST_LOCKBYTE, 0, 1, 0))==0 ){
- Sleep(1);
- }
- if( res ){
- UnlockFile(id->h, FIRST_LOCKBYTE+1, 0, N_LOCKBYTE, 0);
- if( isNT() ){
- OVERLAPPED ovlp;
- ovlp.Offset = FIRST_LOCKBYTE+1;
- ovlp.OffsetHigh = 0;
- ovlp.hEvent = 0;
- res = LockFileEx(id->h, LOCKFILE_FAIL_IMMEDIATELY,
- 0, N_LOCKBYTE, 0, &ovlp);
- }else{
- res = LockFile(id->h, FIRST_LOCKBYTE+lk, 0, 1, 0);
- }
- UnlockFile(id->h, FIRST_LOCKBYTE, 0, 1, 0);
- }
- if( res ){
- id->locked = lk;
- rc = SQLITE_OK;
- }else{
- rc = SQLITE_BUSY;
- }
- }
- return rc;
-#endif
-#if OS_MAC
- int rc;
- if( id->locked>0 || id->refNumRF == -1 ){
- rc = SQLITE_OK;
- }else{
- int lk;
- OSErr res;
- int cnt = 5;
- ParamBlockRec params;
- sqliteRandomness(sizeof(lk), &lk);
- lk = (lk & 0x7fffffff)%N_LOCKBYTE + 1;
- memset(¶ms, 0, sizeof(params));
- params.ioParam.ioRefNum = id->refNumRF;
- params.ioParam.ioPosMode = fsFromStart;
- params.ioParam.ioPosOffset = FIRST_LOCKBYTE;
- params.ioParam.ioReqCount = 1;
- while( cnt-->0 && (res = PBLockRangeSync(¶ms))!=noErr ){
- UInt32 finalTicks;
- Delay(1, &finalTicks); /* 1/60 sec */
- }
- if( res == noErr ){
- params.ioParam.ioPosOffset = FIRST_LOCKBYTE+1;
- params.ioParam.ioReqCount = N_LOCKBYTE;
- PBUnlockRangeSync(¶ms);
- params.ioParam.ioPosOffset = FIRST_LOCKBYTE+lk;
- params.ioParam.ioReqCount = 1;
- res = PBLockRangeSync(¶ms);
- params.ioParam.ioPosOffset = FIRST_LOCKBYTE;
- params.ioParam.ioReqCount = 1;
- PBUnlockRangeSync(¶ms);
- }
- if( res == noErr ){
- id->locked = lk;
- rc = SQLITE_OK;
- }else{
- rc = SQLITE_BUSY;
- }
- }
- return rc;
-#endif
-}
-
-/*
-** Change the lock status to be an exclusive or write lock. Return
-** SQLITE_OK on success and SQLITE_BUSY on a failure. If this
-** library was compiled with large file support (LFS) but LFS is not
-** available on the host, then an SQLITE_NOLFS is returned.
-*/
-int sqliteOsWriteLock(OsFile *id){
-#if OS_UNIX
- int rc;
- sqliteOsEnterMutex();
- if( id->pLock->cnt==0 || (id->pLock->cnt==1 && id->locked==1) ){
- struct flock lock;
- int s;
- lock.l_type = F_WRLCK;
- lock.l_whence = SEEK_SET;
- lock.l_start = lock.l_len = 0L;
- s = fcntl(id->fd, F_SETLK, &lock);
- if( s!=0 ){
- rc = (errno==EINVAL) ? SQLITE_NOLFS : SQLITE_BUSY;
- }else{
- rc = SQLITE_OK;
- if( !id->locked ){
- id->pOpen->nLock++;
- id->locked = 1;
- }
- id->pLock->cnt = -1;
- }
- }else{
- rc = SQLITE_BUSY;
- }
- sqliteOsLeaveMutex();
- return rc;
-#endif
-#if OS_WIN
- int rc;
- if( id->locked<0 ){
- rc = SQLITE_OK;
- }else{
- int res;
- int cnt = 100;
- while( cnt-->0 && (res = LockFile(id->h, FIRST_LOCKBYTE, 0, 1, 0))==0 ){
- Sleep(1);
- }
- if( res ){
- if( id->locked>0 ){
- if( isNT() ){
- UnlockFile(id->h, FIRST_LOCKBYTE+1, 0, N_LOCKBYTE, 0);
- }else{
- res = UnlockFile(id->h, FIRST_LOCKBYTE + id->locked, 0, 1, 0);
- }
- }
- if( res ){
- res = LockFile(id->h, FIRST_LOCKBYTE+1, 0, N_LOCKBYTE, 0);
- }else{
- res = 0;
- }
- UnlockFile(id->h, FIRST_LOCKBYTE, 0, 1, 0);
- }
- if( res ){
- id->locked = -1;
- rc = SQLITE_OK;
- }else{
- rc = SQLITE_BUSY;
- }
- }
- return rc;
-#endif
-#if OS_MAC
- int rc;
- if( id->locked<0 || id->refNumRF == -1 ){
- rc = SQLITE_OK;
- }else{
- OSErr res;
- int cnt = 5;
- ParamBlockRec params;
- memset(¶ms, 0, sizeof(params));
- params.ioParam.ioRefNum = id->refNumRF;
- params.ioParam.ioPosMode = fsFromStart;
- params.ioParam.ioPosOffset = FIRST_LOCKBYTE;
- params.ioParam.ioReqCount = 1;
- while( cnt-->0 && (res = PBLockRangeSync(¶ms))!=noErr ){
- UInt32 finalTicks;
- Delay(1, &finalTicks); /* 1/60 sec */
- }
- if( res == noErr ){
- params.ioParam.ioPosOffset = FIRST_LOCKBYTE + id->locked;
- params.ioParam.ioReqCount = 1;
- if( id->locked==0
- || PBUnlockRangeSync(¶ms)==noErr ){
- params.ioParam.ioPosOffset = FIRST_LOCKBYTE+1;
- params.ioParam.ioReqCount = N_LOCKBYTE;
- res = PBLockRangeSync(¶ms);
- }else{
- res = afpRangeNotLocked;
- }
- params.ioParam.ioPosOffset = FIRST_LOCKBYTE;
- params.ioParam.ioReqCount = 1;
- PBUnlockRangeSync(¶ms);
- }
- if( res == noErr ){
- id->locked = -1;
- rc = SQLITE_OK;
- }else{
- rc = SQLITE_BUSY;
- }
- }
- return rc;
-#endif
-}
-
-/*
-** Unlock the given file descriptor. If the file descriptor was
-** not previously locked, then this routine is a no-op. If this
-** library was compiled with large file support (LFS) but LFS is not
-** available on the host, then an SQLITE_NOLFS is returned.
-*/
-int sqliteOsUnlock(OsFile *id){
-#if OS_UNIX
- int rc;
- if( !id->locked ) return SQLITE_OK;
- sqliteOsEnterMutex();
- assert( id->pLock->cnt!=0 );
- if( id->pLock->cnt>1 ){
- id->pLock->cnt--;
- rc = SQLITE_OK;
- }else{
- struct flock lock;
- int s;
- lock.l_type = F_UNLCK;
- lock.l_whence = SEEK_SET;
- lock.l_start = lock.l_len = 0L;
- s = fcntl(id->fd, F_SETLK, &lock);
- if( s!=0 ){
- rc = (errno==EINVAL) ? SQLITE_NOLFS : SQLITE_BUSY;
- }else{
- rc = SQLITE_OK;
- id->pLock->cnt = 0;
- }
- }
- if( rc==SQLITE_OK ){
- /* Decrement the count of locks against this same file. When the
- ** count reaches zero, close any other file descriptors whose close
- ** was deferred because of outstanding locks.
- */
- struct openCnt *pOpen = id->pOpen;
- pOpen->nLock--;
- assert( pOpen->nLock>=0 );
- if( pOpen->nLock==0 && pOpen->nPending>0 ){
- int i;
- for(i=0; i<pOpen->nPending; i++){
- close(pOpen->aPending[i]);
- }
- sqliteFree(pOpen->aPending);
- pOpen->nPending = 0;
- pOpen->aPending = 0;
- }
- }
- sqliteOsLeaveMutex();
- id->locked = 0;
- return rc;
-#endif
-#if OS_WIN
- int rc;
- if( id->locked==0 ){
- rc = SQLITE_OK;
- }else if( isNT() || id->locked<0 ){
- UnlockFile(id->h, FIRST_LOCKBYTE+1, 0, N_LOCKBYTE, 0);
- rc = SQLITE_OK;
- id->locked = 0;
- }else{
- UnlockFile(id->h, FIRST_LOCKBYTE+id->locked, 0, 1, 0);
- rc = SQLITE_OK;
- id->locked = 0;
- }
- return rc;
-#endif
-#if OS_MAC
- int rc;
- ParamBlockRec params;
- memset(¶ms, 0, sizeof(params));
- params.ioParam.ioRefNum = id->refNumRF;
- params.ioParam.ioPosMode = fsFromStart;
- if( id->locked==0 || id->refNumRF == -1 ){
- rc = SQLITE_OK;
- }else if( id->locked<0 ){
- params.ioParam.ioPosOffset = FIRST_LOCKBYTE+1;
- params.ioParam.ioReqCount = N_LOCKBYTE;
- PBUnlockRangeSync(¶ms);
- rc = SQLITE_OK;
- id->locked = 0;
- }else{
- params.ioParam.ioPosOffset = FIRST_LOCKBYTE+id->locked;
- params.ioParam.ioReqCount = 1;
- PBUnlockRangeSync(¶ms);
- rc = SQLITE_OK;
- id->locked = 0;
- }
- return rc;
-#endif
-}
-
-/*
-** Get information to seed the random number generator. The seed
-** is written into the buffer zBuf[256]. The calling function must
-** supply a sufficiently large buffer.
-*/
-int sqliteOsRandomSeed(char *zBuf){
- /* We have to initialize zBuf to prevent valgrind from reporting
- ** errors. The reports issued by valgrind are incorrect - we would
- ** prefer that the randomness be increased by making use of the
- ** uninitialized space in zBuf - but valgrind errors tend to worry
- ** some users. Rather than argue, it seems easier just to initialize
- ** the whole array and silence valgrind, even if that means less randomness
- ** in the random seed.
- **
- ** When testing, initializing zBuf[] to zero is all we do. That means
- ** that we always use the same random number sequence.* This makes the
- ** tests repeatable.
- */
- memset(zBuf, 0, 256);
-#if OS_UNIX && !defined(SQLITE_TEST)
- {
- int pid;
- time((time_t*)zBuf);
- pid = getpid();
- memcpy(&zBuf[sizeof(time_t)], &pid, sizeof(pid));
- }
-#endif
-#if OS_WIN && !defined(SQLITE_TEST)
- GetSystemTime((LPSYSTEMTIME)zBuf);
-#endif
-#if OS_MAC
- {
- int pid;
- Microseconds((UnsignedWide*)zBuf);
- pid = getpid();
- memcpy(&zBuf[sizeof(UnsignedWide)], &pid, sizeof(pid));
- }
-#endif
- return SQLITE_OK;
-}
-
-/*
-** Sleep for a little while. Return the amount of time slept.
-*/
-int sqliteOsSleep(int ms){
-#if OS_UNIX
-#if defined(HAVE_USLEEP) && HAVE_USLEEP
- usleep(ms*1000);
- return ms;
-#else
- sleep((ms+999)/1000);
- return 1000*((ms+999)/1000);
-#endif
-#endif
-#if OS_WIN
- Sleep(ms);
- return ms;
-#endif
-#if OS_MAC
- UInt32 finalTicks;
- UInt32 ticks = (((UInt32)ms+16)*3)/50; /* 1/60 sec per tick */
- Delay(ticks, &finalTicks);
- return (int)((ticks*50)/3);
-#endif
-}
-
-/*
-** Static variables used for thread synchronization
-*/
-static int inMutex = 0;
-#ifdef SQLITE_UNIX_THREADS
- static pthread_mutex_t mutex = PTHREAD_MUTEX_INITIALIZER;
-#endif
-#ifdef SQLITE_W32_THREADS
- static CRITICAL_SECTION cs;
-#endif
-#ifdef SQLITE_MACOS_MULTITASKING
- static MPCriticalRegionID criticalRegion;
-#endif
-
-/*
-** The following pair of routine implement mutual exclusion for
-** multi-threaded processes. Only a single thread is allowed to
-** executed code that is surrounded by EnterMutex() and LeaveMutex().
-**
-** SQLite uses only a single Mutex. There is not much critical
-** code and what little there is executes quickly and without blocking.
-*/
-void sqliteOsEnterMutex(){
-#ifdef SQLITE_UNIX_THREADS
- pthread_mutex_lock(&mutex);
-#endif
-#ifdef SQLITE_W32_THREADS
- static int isInit = 0;
- while( !isInit ){
- static long lock = 0;
- if( InterlockedIncrement(&lock)==1 ){
- InitializeCriticalSection(&cs);
- isInit = 1;
- }else{
- Sleep(1);
- }
- }
- EnterCriticalSection(&cs);
-#endif
-#ifdef SQLITE_MACOS_MULTITASKING
- static volatile int notInit = 1;
- if( notInit ){
- if( notInit == 2 ) /* as close as you can get to thread safe init */
- MPYield();
- else{
- notInit = 2;
- MPCreateCriticalRegion(&criticalRegion);
- notInit = 0;
- }
- }
- MPEnterCriticalRegion(criticalRegion, kDurationForever);
-#endif
- assert( !inMutex );
- inMutex = 1;
-}
-void sqliteOsLeaveMutex(){
- assert( inMutex );
- inMutex = 0;
-#ifdef SQLITE_UNIX_THREADS
- pthread_mutex_unlock(&mutex);
-#endif
-#ifdef SQLITE_W32_THREADS
- LeaveCriticalSection(&cs);
-#endif
-#ifdef SQLITE_MACOS_MULTITASKING
- MPExitCriticalRegion(criticalRegion);
-#endif
-}
-
-/*
-** Turn a relative pathname into a full pathname. Return a pointer
-** to the full pathname stored in space obtained from sqliteMalloc().
-** The calling function is responsible for freeing this space once it
-** is no longer needed.
-*/
-char *sqliteOsFullPathname(const char *zRelative){
-#if OS_UNIX
- char *zFull = 0;
- if( zRelative[0]=='/' ){
- sqliteSetString(&zFull, zRelative, (char*)0);
- }else{
- char zBuf[5000];
- sqliteSetString(&zFull, getcwd(zBuf, sizeof(zBuf)), "/", zRelative,
- (char*)0);
- }
- return zFull;
-#endif
-#if OS_WIN
- char *zNotUsed;
- char *zFull;
- int nByte;
- nByte = GetFullPathName(zRelative, 0, 0, &zNotUsed) + 1;
- zFull = sqliteMalloc( nByte );
- if( zFull==0 ) return 0;
- GetFullPathName(zRelative, nByte, zFull, &zNotUsed);
- return zFull;
-#endif
-#if OS_MAC
- char *zFull = 0;
- if( zRelative[0]==':' ){
- char zBuf[_MAX_PATH+1];
- sqliteSetString(&zFull, getcwd(zBuf, sizeof(zBuf)), &(zRelative[1]),
- (char*)0);
- }else{
- if( strchr(zRelative, ':') ){
- sqliteSetString(&zFull, zRelative, (char*)0);
- }else{
- char zBuf[_MAX_PATH+1];
- sqliteSetString(&zFull, getcwd(zBuf, sizeof(zBuf)), zRelative, (char*)0);
- }
- }
- return zFull;
-#endif
-}
-
-/*
-** The following variable, if set to a non-zero value, becomes the result
-** returned from sqliteOsCurrentTime(). This is used for testing.
-*/
-#ifdef SQLITE_TEST
-int sqlite_current_time = 0;
-#endif
-
-/*
-** Find the current time (in Universal Coordinated Time). Write the
-** current time and date as a Julian Day number into *prNow and
-** return 0. Return 1 if the time and date cannot be found.
-*/
-int sqliteOsCurrentTime(double *prNow){
-#if OS_UNIX
- time_t t;
- time(&t);
- *prNow = t/86400.0 + 2440587.5;
-#endif
-#if OS_WIN
- FILETIME ft;
- /* FILETIME structure is a 64-bit value representing the number of
- 100-nanosecond intervals since January 1, 1601 (= JD 2305813.5).
- */
- double now;
- GetSystemTimeAsFileTime( &ft );
- now = ((double)ft.dwHighDateTime) * 4294967296.0;
- *prNow = (now + ft.dwLowDateTime)/864000000000.0 + 2305813.5;
-#endif
-#ifdef SQLITE_TEST
- if( sqlite_current_time ){
- *prNow = sqlite_current_time/86400.0 + 2440587.5;
- }
-#endif
- return 0;
-}
+++ /dev/null
-/*
-** 2001 September 16
-**
-** The author disclaims copyright to this source code. In place of
-** a legal notice, here is a blessing:
-**
-** May you do good and not evil.
-** May you find forgiveness for yourself and forgive others.
-** May you share freely, never taking more than you give.
-**
-******************************************************************************
-**
-** This header file (together with is companion C source-code file
-** "os.c") attempt to abstract the underlying operating system so that
-** the SQLite library will work on both POSIX and windows systems.
-*/
-#ifndef _SQLITE_OS_H_
-#define _SQLITE_OS_H_
-
-/*
-** Helpful hint: To get this to compile on HP/UX, add -D_INCLUDE_POSIX_SOURCE
-** to the compiler command line.
-*/
-
-/*
-** These #defines should enable >2GB file support on Posix if the
-** underlying operating system supports it. If the OS lacks
-** large file support, or if the OS is windows, these should be no-ops.
-**
-** Large file support can be disabled using the -DSQLITE_DISABLE_LFS switch
-** on the compiler command line. This is necessary if you are compiling
-** on a recent machine (ex: RedHat 7.2) but you want your code to work
-** on an older machine (ex: RedHat 6.0). If you compile on RedHat 7.2
-** without this option, LFS is enable. But LFS does not exist in the kernel
-** in RedHat 6.0, so the code won't work. Hence, for maximum binary
-** portability you should omit LFS.
-**
-** Similar is true for MacOS. LFS is only supported on MacOS 9 and later.
-*/
-#ifndef SQLITE_DISABLE_LFS
-# define _LARGE_FILE 1
-# ifndef _FILE_OFFSET_BITS
-# define _FILE_OFFSET_BITS 64
-# endif
-# define _LARGEFILE_SOURCE 1
-#endif
-
-/*
-** Temporary files are named starting with this prefix followed by 16 random
-** alphanumeric characters, and no file extension. They are stored in the
-** OS's standard temporary file directory, and are deleted prior to exit.
-** If sqlite is being embedded in another program, you may wish to change the
-** prefix to reflect your program's name, so that if your program exits
-** prematurely, old temporary files can be easily identified. This can be done
-** using -DTEMP_FILE_PREFIX=myprefix_ on the compiler command line.
-*/
-#ifndef TEMP_FILE_PREFIX
-# define TEMP_FILE_PREFIX "sqlite_"
-#endif
-
-/*
-** Figure out if we are dealing with Unix, Windows or MacOS.
-**
-** N.B. MacOS means Mac Classic (or Carbon). Treat Darwin (OS X) as Unix.
-** The MacOS build is designed to use CodeWarrior (tested with v8)
-*/
-#ifndef OS_UNIX
-# ifndef OS_WIN
-# ifndef OS_MAC
-# if defined(__MACOS__)
-# define OS_MAC 1
-# define OS_WIN 0
-# define OS_UNIX 0
-# elif defined(_WIN32) || defined(WIN32) || defined(__CYGWIN__) || defined(__MINGW32__) || defined(__BORLANDC__)
-# define OS_MAC 0
-# define OS_WIN 1
-# define OS_UNIX 0
-# else
-# define OS_MAC 0
-# define OS_WIN 0
-# define OS_UNIX 1
-# endif
-# else
-# define OS_WIN 0
-# define OS_UNIX 0
-# endif
-# else
-# define OS_MAC 0
-# define OS_UNIX 0
-# endif
-#else
-# define OS_MAC 0
-# ifndef OS_WIN
-# define OS_WIN 0
-# endif
-#endif
-
-/*
-** A handle for an open file is stored in an OsFile object.
-*/
-#if OS_UNIX
-# include <sys/types.h>
-# include <sys/stat.h>
-# include <fcntl.h>
-# include <unistd.h>
- typedef struct OsFile OsFile;
- struct OsFile {
- struct openCnt *pOpen; /* Info about all open fd's on this inode */
- struct lockInfo *pLock; /* Info about locks on this inode */
- int fd; /* The file descriptor */
- int locked; /* True if this instance holds the lock */
- int dirfd; /* File descriptor for the directory */
- };
-# define SQLITE_TEMPNAME_SIZE 200
-# if defined(HAVE_USLEEP) && HAVE_USLEEP
-# define SQLITE_MIN_SLEEP_MS 1
-# else
-# define SQLITE_MIN_SLEEP_MS 1000
-# endif
-#endif
-
-#if OS_WIN
-#include <windows.h>
-#include <winbase.h>
- typedef struct OsFile OsFile;
- struct OsFile {
- HANDLE h; /* Handle for accessing the file */
- int locked; /* 0: unlocked, <0: write lock, >0: read lock */
- };
-# if defined(_MSC_VER) || defined(__BORLANDC__)
- typedef __int64 off_t;
-# else
-# if !defined(_CYGWIN_TYPES_H)
- typedef long long off_t;
-# if defined(__MINGW32__)
-# define _OFF_T_
-# endif
-# endif
-# endif
-# define SQLITE_TEMPNAME_SIZE (MAX_PATH+50)
-# define SQLITE_MIN_SLEEP_MS 1
-#endif
-
-#if OS_MAC
-# include <unistd.h>
-# include <Files.h>
- typedef struct OsFile OsFile;
- struct OsFile {
- SInt16 refNum; /* Data fork/file reference number */
- SInt16 refNumRF; /* Resource fork reference number (for locking) */
- int locked; /* 0: unlocked, <0: write lock, >0: read lock */
- int delOnClose; /* True if file is to be deleted on close */
- char *pathToDel; /* Name of file to delete on close */
- };
-# ifdef _LARGE_FILE
- typedef SInt64 off_t;
-# else
- typedef SInt32 off_t;
-# endif
-# define SQLITE_TEMPNAME_SIZE _MAX_PATH
-# define SQLITE_MIN_SLEEP_MS 17
-#endif
-
-int sqliteOsDelete(const char*);
-int sqliteOsFileExists(const char*);
-int sqliteOsFileRename(const char*, const char*);
-int sqliteOsOpenReadWrite(const char*, OsFile*, int*);
-int sqliteOsOpenExclusive(const char*, OsFile*, int);
-int sqliteOsOpenReadOnly(const char*, OsFile*);
-int sqliteOsOpenDirectory(const char*, OsFile*);
-int sqliteOsTempFileName(char*);
-int sqliteOsClose(OsFile*);
-int sqliteOsRead(OsFile*, void*, int amt);
-int sqliteOsWrite(OsFile*, const void*, int amt);
-int sqliteOsSeek(OsFile*, off_t offset);
-int sqliteOsSync(OsFile*);
-int sqliteOsTruncate(OsFile*, off_t size);
-int sqliteOsFileSize(OsFile*, off_t *pSize);
-int sqliteOsReadLock(OsFile*);
-int sqliteOsWriteLock(OsFile*);
-int sqliteOsUnlock(OsFile*);
-int sqliteOsRandomSeed(char*);
-int sqliteOsSleep(int ms);
-int sqliteOsCurrentTime(double*);
-void sqliteOsEnterMutex(void);
-void sqliteOsLeaveMutex(void);
-char *sqliteOsFullPathname(const char*);
-
-
-
-#endif /* _SQLITE_OS_H_ */
+++ /dev/null
-/*
-** 2001 September 15
-**
-** The author disclaims copyright to this source code. In place of
-** a legal notice, here is a blessing:
-**
-** May you do good and not evil.
-** May you find forgiveness for yourself and forgive others.
-** May you share freely, never taking more than you give.
-**
-*************************************************************************
-** This is the implementation of the page cache subsystem or "pager".
-**
-** The pager is used to access a database disk file. It implements
-** atomic commit and rollback through the use of a journal file that
-** is separate from the database file. The pager also implements file
-** locking to prevent two processes from writing the same database
-** file simultaneously, or one process from reading the database while
-** another is writing.
-**
-** @(#) $Id: pager.c,v 1.1.1.1 2004/08/08 15:03:57 matt Exp $
-*/
-#include "os.h" /* Must be first to enable large file support */
-#include "sqliteInt.h"
-#include "pager.h"
-#include <assert.h>
-#include <string.h>
-
-/*
-** Macros for troubleshooting. Normally turned off
-*/
-#if 0
-static Pager *mainPager = 0;
-#define SET_PAGER(X) if( mainPager==0 ) mainPager = (X)
-#define CLR_PAGER(X) if( mainPager==(X) ) mainPager = 0
-#define TRACE1(X) if( pPager==mainPager ) fprintf(stderr,X)
-#define TRACE2(X,Y) if( pPager==mainPager ) fprintf(stderr,X,Y)
-#define TRACE3(X,Y,Z) if( pPager==mainPager ) fprintf(stderr,X,Y,Z)
-#else
-#define SET_PAGER(X)
-#define CLR_PAGER(X)
-#define TRACE1(X)
-#define TRACE2(X,Y)
-#define TRACE3(X,Y,Z)
-#endif
-
-
-/*
-** The page cache as a whole is always in one of the following
-** states:
-**
-** SQLITE_UNLOCK The page cache is not currently reading or
-** writing the database file. There is no
-** data held in memory. This is the initial
-** state.
-**
-** SQLITE_READLOCK The page cache is reading the database.
-** Writing is not permitted. There can be
-** multiple readers accessing the same database
-** file at the same time.
-**
-** SQLITE_WRITELOCK The page cache is writing the database.
-** Access is exclusive. No other processes or
-** threads can be reading or writing while one
-** process is writing.
-**
-** The page cache comes up in SQLITE_UNLOCK. The first time a
-** sqlite_page_get() occurs, the state transitions to SQLITE_READLOCK.
-** After all pages have been released using sqlite_page_unref(),
-** the state transitions back to SQLITE_UNLOCK. The first time
-** that sqlite_page_write() is called, the state transitions to
-** SQLITE_WRITELOCK. (Note that sqlite_page_write() can only be
-** called on an outstanding page which means that the pager must
-** be in SQLITE_READLOCK before it transitions to SQLITE_WRITELOCK.)
-** The sqlite_page_rollback() and sqlite_page_commit() functions
-** transition the state from SQLITE_WRITELOCK back to SQLITE_READLOCK.
-*/
-#define SQLITE_UNLOCK 0
-#define SQLITE_READLOCK 1
-#define SQLITE_WRITELOCK 2
-
-
-/*
-** Each in-memory image of a page begins with the following header.
-** This header is only visible to this pager module. The client
-** code that calls pager sees only the data that follows the header.
-**
-** Client code should call sqlitepager_write() on a page prior to making
-** any modifications to that page. The first time sqlitepager_write()
-** is called, the original page contents are written into the rollback
-** journal and PgHdr.inJournal and PgHdr.needSync are set. Later, once
-** the journal page has made it onto the disk surface, PgHdr.needSync
-** is cleared. The modified page cannot be written back into the original
-** database file until the journal pages has been synced to disk and the
-** PgHdr.needSync has been cleared.
-**
-** The PgHdr.dirty flag is set when sqlitepager_write() is called and
-** is cleared again when the page content is written back to the original
-** database file.
-*/
-typedef struct PgHdr PgHdr;
-struct PgHdr {
- Pager *pPager; /* The pager to which this page belongs */
- Pgno pgno; /* The page number for this page */
- PgHdr *pNextHash, *pPrevHash; /* Hash collision chain for PgHdr.pgno */
- int nRef; /* Number of users of this page */
- PgHdr *pNextFree, *pPrevFree; /* Freelist of pages where nRef==0 */
- PgHdr *pNextAll, *pPrevAll; /* A list of all pages */
- PgHdr *pNextCkpt, *pPrevCkpt; /* List of pages in the checkpoint journal */
- u8 inJournal; /* TRUE if has been written to journal */
- u8 inCkpt; /* TRUE if written to the checkpoint journal */
- u8 dirty; /* TRUE if we need to write back changes */
- u8 needSync; /* Sync journal before writing this page */
- u8 alwaysRollback; /* Disable dont_rollback() for this page */
- PgHdr *pDirty; /* Dirty pages sorted by PgHdr.pgno */
- /* SQLITE_PAGE_SIZE bytes of page data follow this header */
- /* Pager.nExtra bytes of local data follow the page data */
-};
-
-
-/*
-** A macro used for invoking the codec if there is one
-*/
-#ifdef SQLITE_HAS_CODEC
-# define CODEC(P,D,N,X) if( P->xCodec ){ P->xCodec(P->pCodecArg,D,N,X); }
-#else
-# define CODEC(P,D,N,X)
-#endif
-
-/*
-** Convert a pointer to a PgHdr into a pointer to its data
-** and back again.
-*/
-#define PGHDR_TO_DATA(P) ((void*)(&(P)[1]))
-#define DATA_TO_PGHDR(D) (&((PgHdr*)(D))[-1])
-#define PGHDR_TO_EXTRA(P) ((void*)&((char*)(&(P)[1]))[SQLITE_PAGE_SIZE])
-
-/*
-** How big to make the hash table used for locating in-memory pages
-** by page number.
-*/
-#define N_PG_HASH 2048
-
-/*
-** Hash a page number
-*/
-#define pager_hash(PN) ((PN)&(N_PG_HASH-1))
-
-/*
-** A open page cache is an instance of the following structure.
-*/
-struct Pager {
- char *zFilename; /* Name of the database file */
- char *zJournal; /* Name of the journal file */
- char *zDirectory; /* Directory hold database and journal files */
- OsFile fd, jfd; /* File descriptors for database and journal */
- OsFile cpfd; /* File descriptor for the checkpoint journal */
- int dbSize; /* Number of pages in the file */
- int origDbSize; /* dbSize before the current change */
- int ckptSize; /* Size of database (in pages) at ckpt_begin() */
- off_t ckptJSize; /* Size of journal at ckpt_begin() */
- int nRec; /* Number of pages written to the journal */
- u32 cksumInit; /* Quasi-random value added to every checksum */
- int ckptNRec; /* Number of records in the checkpoint journal */
- int nExtra; /* Add this many bytes to each in-memory page */
- void (*xDestructor)(void*); /* Call this routine when freeing pages */
- int nPage; /* Total number of in-memory pages */
- int nRef; /* Number of in-memory pages with PgHdr.nRef>0 */
- int mxPage; /* Maximum number of pages to hold in cache */
- int nHit, nMiss, nOvfl; /* Cache hits, missing, and LRU overflows */
- void (*xCodec)(void*,void*,Pgno,int); /* Routine for en/decoding data */
- void *pCodecArg; /* First argument to xCodec() */
- u8 journalOpen; /* True if journal file descriptors is valid */
- u8 journalStarted; /* True if header of journal is synced */
- u8 useJournal; /* Use a rollback journal on this file */
- u8 ckptOpen; /* True if the checkpoint journal is open */
- u8 ckptInUse; /* True we are in a checkpoint */
- u8 ckptAutoopen; /* Open ckpt journal when main journal is opened*/
- u8 noSync; /* Do not sync the journal if true */
- u8 fullSync; /* Do extra syncs of the journal for robustness */
- u8 state; /* SQLITE_UNLOCK, _READLOCK or _WRITELOCK */
- u8 errMask; /* One of several kinds of errors */
- u8 tempFile; /* zFilename is a temporary file */
- u8 readOnly; /* True for a read-only database */
- u8 needSync; /* True if an fsync() is needed on the journal */
- u8 dirtyFile; /* True if database file has changed in any way */
- u8 alwaysRollback; /* Disable dont_rollback() for all pages */
- u8 *aInJournal; /* One bit for each page in the database file */
- u8 *aInCkpt; /* One bit for each page in the database */
- PgHdr *pFirst, *pLast; /* List of free pages */
- PgHdr *pFirstSynced; /* First free page with PgHdr.needSync==0 */
- PgHdr *pAll; /* List of all pages */
- PgHdr *pCkpt; /* List of pages in the checkpoint journal */
- PgHdr *aHash[N_PG_HASH]; /* Hash table to map page number of PgHdr */
-};
-
-/*
-** These are bits that can be set in Pager.errMask.
-*/
-#define PAGER_ERR_FULL 0x01 /* a write() failed */
-#define PAGER_ERR_MEM 0x02 /* malloc() failed */
-#define PAGER_ERR_LOCK 0x04 /* error in the locking protocol */
-#define PAGER_ERR_CORRUPT 0x08 /* database or journal corruption */
-#define PAGER_ERR_DISK 0x10 /* general disk I/O error - bad hard drive? */
-
-/*
-** The journal file contains page records in the following
-** format.
-**
-** Actually, this structure is the complete page record for pager
-** formats less than 3. Beginning with format 3, this record is surrounded
-** by two checksums.
-*/
-typedef struct PageRecord PageRecord;
-struct PageRecord {
- Pgno pgno; /* The page number */
- char aData[SQLITE_PAGE_SIZE]; /* Original data for page pgno */
-};
-
-/*
-** Journal files begin with the following magic string. The data
-** was obtained from /dev/random. It is used only as a sanity check.
-**
-** There are three journal formats (so far). The 1st journal format writes
-** 32-bit integers in the byte-order of the host machine. New
-** formats writes integers as big-endian. All new journals use the
-** new format, but we have to be able to read an older journal in order
-** to rollback journals created by older versions of the library.
-**
-** The 3rd journal format (added for 2.8.0) adds additional sanity
-** checking information to the journal. If the power fails while the
-** journal is being written, semi-random garbage data might appear in
-** the journal file after power is restored. If an attempt is then made
-** to roll the journal back, the database could be corrupted. The additional
-** sanity checking data is an attempt to discover the garbage in the
-** journal and ignore it.
-**
-** The sanity checking information for the 3rd journal format consists
-** of a 32-bit checksum on each page of data. The checksum covers both
-** the page number and the SQLITE_PAGE_SIZE bytes of data for the page.
-** This cksum is initialized to a 32-bit random value that appears in the
-** journal file right after the header. The random initializer is important,
-** because garbage data that appears at the end of a journal is likely
-** data that was once in other files that have now been deleted. If the
-** garbage data came from an obsolete journal file, the checksums might
-** be correct. But by initializing the checksum to random value which
-** is different for every journal, we minimize that risk.
-*/
-static const unsigned char aJournalMagic1[] = {
- 0xd9, 0xd5, 0x05, 0xf9, 0x20, 0xa1, 0x63, 0xd4,
-};
-static const unsigned char aJournalMagic2[] = {
- 0xd9, 0xd5, 0x05, 0xf9, 0x20, 0xa1, 0x63, 0xd5,
-};
-static const unsigned char aJournalMagic3[] = {
- 0xd9, 0xd5, 0x05, 0xf9, 0x20, 0xa1, 0x63, 0xd6,
-};
-#define JOURNAL_FORMAT_1 1
-#define JOURNAL_FORMAT_2 2
-#define JOURNAL_FORMAT_3 3
-
-/*
-** The following integer determines what format to use when creating
-** new primary journal files. By default we always use format 3.
-** When testing, we can set this value to older journal formats in order to
-** make sure that newer versions of the library are able to rollback older
-** journal files.
-**
-** Note that checkpoint journals always use format 2 and omit the header.
-*/
-#ifdef SQLITE_TEST
-int journal_format = 3;
-#else
-# define journal_format 3
-#endif
-
-/*
-** The size of the header and of each page in the journal varies according
-** to which journal format is being used. The following macros figure out
-** the sizes based on format numbers.
-*/
-#define JOURNAL_HDR_SZ(X) \
- (sizeof(aJournalMagic1) + sizeof(Pgno) + ((X)>=3)*2*sizeof(u32))
-#define JOURNAL_PG_SZ(X) \
- (SQLITE_PAGE_SIZE + sizeof(Pgno) + ((X)>=3)*sizeof(u32))
-
-/*
-** Enable reference count tracking here:
-*/
-#ifdef SQLITE_TEST
- int pager_refinfo_enable = 0;
- static void pager_refinfo(PgHdr *p){
- static int cnt = 0;
- if( !pager_refinfo_enable ) return;
- printf(
- "REFCNT: %4d addr=0x%08x nRef=%d\n",
- p->pgno, (int)PGHDR_TO_DATA(p), p->nRef
- );
- cnt++; /* Something to set a breakpoint on */
- }
-# define REFINFO(X) pager_refinfo(X)
-#else
-# define REFINFO(X)
-#endif
-
-/*
-** Read a 32-bit integer from the given file descriptor. Store the integer
-** that is read in *pRes. Return SQLITE_OK if everything worked, or an
-** error code is something goes wrong.
-**
-** If the journal format is 2 or 3, read a big-endian integer. If the
-** journal format is 1, read an integer in the native byte-order of the
-** host machine.
-*/
-static int read32bits(int format, OsFile *fd, u32 *pRes){
- u32 res;
- int rc;
- rc = sqliteOsRead(fd, &res, sizeof(res));
- if( rc==SQLITE_OK && format>JOURNAL_FORMAT_1 ){
- unsigned char ac[4];
- memcpy(ac, &res, 4);
- res = (ac[0]<<24) | (ac[1]<<16) | (ac[2]<<8) | ac[3];
- }
- *pRes = res;
- return rc;
-}
-
-/*
-** Write a 32-bit integer into the given file descriptor. Return SQLITE_OK
-** on success or an error code is something goes wrong.
-**
-** If the journal format is 2 or 3, write the integer as 4 big-endian
-** bytes. If the journal format is 1, write the integer in the native
-** byte order. In normal operation, only formats 2 and 3 are used.
-** Journal format 1 is only used for testing.
-*/
-static int write32bits(OsFile *fd, u32 val){
- unsigned char ac[4];
- if( journal_format<=1 ){
- return sqliteOsWrite(fd, &val, 4);
- }
- ac[0] = (val>>24) & 0xff;
- ac[1] = (val>>16) & 0xff;
- ac[2] = (val>>8) & 0xff;
- ac[3] = val & 0xff;
- return sqliteOsWrite(fd, ac, 4);
-}
-
-/*
-** Write a 32-bit integer into a page header right before the
-** page data. This will overwrite the PgHdr.pDirty pointer.
-**
-** The integer is big-endian for formats 2 and 3 and native byte order
-** for journal format 1.
-*/
-static void store32bits(u32 val, PgHdr *p, int offset){
- unsigned char *ac;
- ac = &((unsigned char*)PGHDR_TO_DATA(p))[offset];
- if( journal_format<=1 ){
- memcpy(ac, &val, 4);
- }else{
- ac[0] = (val>>24) & 0xff;
- ac[1] = (val>>16) & 0xff;
- ac[2] = (val>>8) & 0xff;
- ac[3] = val & 0xff;
- }
-}
-
-
-/*
-** Convert the bits in the pPager->errMask into an approprate
-** return code.
-*/
-static int pager_errcode(Pager *pPager){
- int rc = SQLITE_OK;
- if( pPager->errMask & PAGER_ERR_LOCK ) rc = SQLITE_PROTOCOL;
- if( pPager->errMask & PAGER_ERR_DISK ) rc = SQLITE_IOERR;
- if( pPager->errMask & PAGER_ERR_FULL ) rc = SQLITE_FULL;
- if( pPager->errMask & PAGER_ERR_MEM ) rc = SQLITE_NOMEM;
- if( pPager->errMask & PAGER_ERR_CORRUPT ) rc = SQLITE_CORRUPT;
- return rc;
-}
-
-/*
-** Add or remove a page from the list of all pages that are in the
-** checkpoint journal.
-**
-** The Pager keeps a separate list of pages that are currently in
-** the checkpoint journal. This helps the sqlitepager_ckpt_commit()
-** routine run MUCH faster for the common case where there are many
-** pages in memory but only a few are in the checkpoint journal.
-*/
-static void page_add_to_ckpt_list(PgHdr *pPg){
- Pager *pPager = pPg->pPager;
- if( pPg->inCkpt ) return;
- assert( pPg->pPrevCkpt==0 && pPg->pNextCkpt==0 );
- pPg->pPrevCkpt = 0;
- if( pPager->pCkpt ){
- pPager->pCkpt->pPrevCkpt = pPg;
- }
- pPg->pNextCkpt = pPager->pCkpt;
- pPager->pCkpt = pPg;
- pPg->inCkpt = 1;
-}
-static void page_remove_from_ckpt_list(PgHdr *pPg){
- if( !pPg->inCkpt ) return;
- if( pPg->pPrevCkpt ){
- assert( pPg->pPrevCkpt->pNextCkpt==pPg );
- pPg->pPrevCkpt->pNextCkpt = pPg->pNextCkpt;
- }else{
- assert( pPg->pPager->pCkpt==pPg );
- pPg->pPager->pCkpt = pPg->pNextCkpt;
- }
- if( pPg->pNextCkpt ){
- assert( pPg->pNextCkpt->pPrevCkpt==pPg );
- pPg->pNextCkpt->pPrevCkpt = pPg->pPrevCkpt;
- }
- pPg->pNextCkpt = 0;
- pPg->pPrevCkpt = 0;
- pPg->inCkpt = 0;
-}
-
-/*
-** Find a page in the hash table given its page number. Return
-** a pointer to the page or NULL if not found.
-*/
-static PgHdr *pager_lookup(Pager *pPager, Pgno pgno){
- PgHdr *p = pPager->aHash[pager_hash(pgno)];
- while( p && p->pgno!=pgno ){
- p = p->pNextHash;
- }
- return p;
-}
-
-/*
-** Unlock the database and clear the in-memory cache. This routine
-** sets the state of the pager back to what it was when it was first
-** opened. Any outstanding pages are invalidated and subsequent attempts
-** to access those pages will likely result in a coredump.
-*/
-static void pager_reset(Pager *pPager){
- PgHdr *pPg, *pNext;
- for(pPg=pPager->pAll; pPg; pPg=pNext){
- pNext = pPg->pNextAll;
- sqliteFree(pPg);
- }
- pPager->pFirst = 0;
- pPager->pFirstSynced = 0;
- pPager->pLast = 0;
- pPager->pAll = 0;
- memset(pPager->aHash, 0, sizeof(pPager->aHash));
- pPager->nPage = 0;
- if( pPager->state>=SQLITE_WRITELOCK ){
- sqlitepager_rollback(pPager);
- }
- sqliteOsUnlock(&pPager->fd);
- pPager->state = SQLITE_UNLOCK;
- pPager->dbSize = -1;
- pPager->nRef = 0;
- assert( pPager->journalOpen==0 );
-}
-
-/*
-** When this routine is called, the pager has the journal file open and
-** a write lock on the database. This routine releases the database
-** write lock and acquires a read lock in its place. The journal file
-** is deleted and closed.
-**
-** TODO: Consider keeping the journal file open for temporary databases.
-** This might give a performance improvement on windows where opening
-** a file is an expensive operation.
-*/
-static int pager_unwritelock(Pager *pPager){
- int rc;
- PgHdr *pPg;
- if( pPager->state<SQLITE_WRITELOCK ) return SQLITE_OK;
- sqlitepager_ckpt_commit(pPager);
- if( pPager->ckptOpen ){
- sqliteOsClose(&pPager->cpfd);
- pPager->ckptOpen = 0;
- }
- if( pPager->journalOpen ){
- sqliteOsClose(&pPager->jfd);
- pPager->journalOpen = 0;
- sqliteOsDelete(pPager->zJournal);
- sqliteFree( pPager->aInJournal );
- pPager->aInJournal = 0;
- for(pPg=pPager->pAll; pPg; pPg=pPg->pNextAll){
- pPg->inJournal = 0;
- pPg->dirty = 0;
- pPg->needSync = 0;
- }
- }else{
- assert( pPager->dirtyFile==0 || pPager->useJournal==0 );
- }
- rc = sqliteOsReadLock(&pPager->fd);
- if( rc==SQLITE_OK ){
- pPager->state = SQLITE_READLOCK;
- }else{
- /* This can only happen if a process does a BEGIN, then forks and the
- ** child process does the COMMIT. Because of the semantics of unix
- ** file locking, the unlock will fail.
- */
- pPager->state = SQLITE_UNLOCK;
- }
- return rc;
-}
-
-/*
-** Compute and return a checksum for the page of data.
-**
-** This is not a real checksum. It is really just the sum of the
-** random initial value and the page number. We considered do a checksum
-** of the database, but that was found to be too slow.
-*/
-static u32 pager_cksum(Pager *pPager, Pgno pgno, const char *aData){
- u32 cksum = pPager->cksumInit + pgno;
- return cksum;
-}
-
-/*
-** Read a single page from the journal file opened on file descriptor
-** jfd. Playback this one page.
-**
-** There are three different journal formats. The format parameter determines
-** which format is used by the journal that is played back.
-*/
-static int pager_playback_one_page(Pager *pPager, OsFile *jfd, int format){
- int rc;
- PgHdr *pPg; /* An existing page in the cache */
- PageRecord pgRec;
- u32 cksum;
-
- rc = read32bits(format, jfd, &pgRec.pgno);
- if( rc!=SQLITE_OK ) return rc;
- rc = sqliteOsRead(jfd, &pgRec.aData, sizeof(pgRec.aData));
- if( rc!=SQLITE_OK ) return rc;
-
- /* Sanity checking on the page. This is more important that I originally
- ** thought. If a power failure occurs while the journal is being written,
- ** it could cause invalid data to be written into the journal. We need to
- ** detect this invalid data (with high probability) and ignore it.
- */
- if( pgRec.pgno==0 ){
- return SQLITE_DONE;
- }
- if( pgRec.pgno>(unsigned)pPager->dbSize ){
- return SQLITE_OK;
- }
- if( format>=JOURNAL_FORMAT_3 ){
- rc = read32bits(format, jfd, &cksum);
- if( rc ) return rc;
- if( pager_cksum(pPager, pgRec.pgno, pgRec.aData)!=cksum ){
- return SQLITE_DONE;
- }
- }
-
- /* Playback the page. Update the in-memory copy of the page
- ** at the same time, if there is one.
- */
- pPg = pager_lookup(pPager, pgRec.pgno);
- TRACE2("PLAYBACK %d\n", pgRec.pgno);
- sqliteOsSeek(&pPager->fd, (pgRec.pgno-1)*(off_t)SQLITE_PAGE_SIZE);
- rc = sqliteOsWrite(&pPager->fd, pgRec.aData, SQLITE_PAGE_SIZE);
- if( pPg ){
- /* No page should ever be rolled back that is in use, except for page
- ** 1 which is held in use in order to keep the lock on the database
- ** active.
- */
- assert( pPg->nRef==0 || pPg->pgno==1 );
- memcpy(PGHDR_TO_DATA(pPg), pgRec.aData, SQLITE_PAGE_SIZE);
- memset(PGHDR_TO_EXTRA(pPg), 0, pPager->nExtra);
- pPg->dirty = 0;
- pPg->needSync = 0;
- CODEC(pPager, PGHDR_TO_DATA(pPg), pPg->pgno, 3);
- }
- return rc;
-}
-
-/*
-** Playback the journal and thus restore the database file to
-** the state it was in before we started making changes.
-**
-** The journal file format is as follows:
-**
-** * 8 byte prefix. One of the aJournalMagic123 vectors defined
-** above. The format of the journal file is determined by which
-** of the three prefix vectors is seen.
-** * 4 byte big-endian integer which is the number of valid page records
-** in the journal. If this value is 0xffffffff, then compute the
-** number of page records from the journal size. This field appears
-** in format 3 only.
-** * 4 byte big-endian integer which is the initial value for the
-** sanity checksum. This field appears in format 3 only.
-** * 4 byte integer which is the number of pages to truncate the
-** database to during a rollback.
-** * Zero or more pages instances, each as follows:
-** + 4 byte page number.
-** + SQLITE_PAGE_SIZE bytes of data.
-** + 4 byte checksum (format 3 only)
-**
-** When we speak of the journal header, we mean the first 4 bullets above.
-** Each entry in the journal is an instance of the 5th bullet. Note that
-** bullets 2 and 3 only appear in format-3 journals.
-**
-** Call the value from the second bullet "nRec". nRec is the number of
-** valid page entries in the journal. In most cases, you can compute the
-** value of nRec from the size of the journal file. But if a power
-** failure occurred while the journal was being written, it could be the
-** case that the size of the journal file had already been increased but
-** the extra entries had not yet made it safely to disk. In such a case,
-** the value of nRec computed from the file size would be too large. For
-** that reason, we always use the nRec value in the header.
-**
-** If the nRec value is 0xffffffff it means that nRec should be computed
-** from the file size. This value is used when the user selects the
-** no-sync option for the journal. A power failure could lead to corruption
-** in this case. But for things like temporary table (which will be
-** deleted when the power is restored) we don't care.
-**
-** Journal formats 1 and 2 do not have an nRec value in the header so we
-** have to compute nRec from the file size. This has risks (as described
-** above) which is why all persistent tables have been changed to use
-** format 3.
-**
-** If the file opened as the journal file is not a well-formed
-** journal file then the database will likely already be
-** corrupted, so the PAGER_ERR_CORRUPT bit is set in pPager->errMask
-** and SQLITE_CORRUPT is returned. If it all works, then this routine
-** returns SQLITE_OK.
-*/
-static int pager_playback(Pager *pPager, int useJournalSize){
- off_t szJ; /* Size of the journal file in bytes */
- int nRec; /* Number of Records in the journal */
- int i; /* Loop counter */
- Pgno mxPg = 0; /* Size of the original file in pages */
- int format; /* Format of the journal file. */
- unsigned char aMagic[sizeof(aJournalMagic1)];
- int rc;
-
- /* Figure out how many records are in the journal. Abort early if
- ** the journal is empty.
- */
- assert( pPager->journalOpen );
- sqliteOsSeek(&pPager->jfd, 0);
- rc = sqliteOsFileSize(&pPager->jfd, &szJ);
- if( rc!=SQLITE_OK ){
- goto end_playback;
- }
-
- /* If the journal file is too small to contain a complete header,
- ** it must mean that the process that created the journal was just
- ** beginning to write the journal file when it died. In that case,
- ** the database file should have still been completely unchanged.
- ** Nothing needs to be rolled back. We can safely ignore this journal.
- */
- if( szJ < sizeof(aMagic)+sizeof(Pgno) ){
- goto end_playback;
- }
-
- /* Read the beginning of the journal and truncate the
- ** database file back to its original size.
- */
- rc = sqliteOsRead(&pPager->jfd, aMagic, sizeof(aMagic));
- if( rc!=SQLITE_OK ){
- rc = SQLITE_PROTOCOL;
- goto end_playback;
- }
- if( memcmp(aMagic, aJournalMagic3, sizeof(aMagic))==0 ){
- format = JOURNAL_FORMAT_3;
- }else if( memcmp(aMagic, aJournalMagic2, sizeof(aMagic))==0 ){
- format = JOURNAL_FORMAT_2;
- }else if( memcmp(aMagic, aJournalMagic1, sizeof(aMagic))==0 ){
- format = JOURNAL_FORMAT_1;
- }else{
- rc = SQLITE_PROTOCOL;
- goto end_playback;
- }
- if( format>=JOURNAL_FORMAT_3 ){
- if( szJ < sizeof(aMagic) + 3*sizeof(u32) ){
- /* Ignore the journal if it is too small to contain a complete
- ** header. We already did this test once above, but at the prior
- ** test, we did not know the journal format and so we had to assume
- ** the smallest possible header. Now we know the header is bigger
- ** than the minimum so we test again.
- */
- goto end_playback;
- }
- rc = read32bits(format, &pPager->jfd, (u32*)&nRec);
- if( rc ) goto end_playback;
- rc = read32bits(format, &pPager->jfd, &pPager->cksumInit);
- if( rc ) goto end_playback;
- if( nRec==0xffffffff || useJournalSize ){
- nRec = (szJ - JOURNAL_HDR_SZ(3))/JOURNAL_PG_SZ(3);
- }
- }else{
- nRec = (szJ - JOURNAL_HDR_SZ(2))/JOURNAL_PG_SZ(2);
- assert( nRec*JOURNAL_PG_SZ(2)+JOURNAL_HDR_SZ(2)==szJ );
- }
- rc = read32bits(format, &pPager->jfd, &mxPg);
- if( rc!=SQLITE_OK ){
- goto end_playback;
- }
- assert( pPager->origDbSize==0 || pPager->origDbSize==mxPg );
- rc = sqliteOsTruncate(&pPager->fd, SQLITE_PAGE_SIZE*(off_t)mxPg);
- if( rc!=SQLITE_OK ){
- goto end_playback;
- }
- pPager->dbSize = mxPg;
-
- /* Copy original pages out of the journal and back into the database file.
- */
- for(i=0; i<nRec; i++){
- rc = pager_playback_one_page(pPager, &pPager->jfd, format);
- if( rc!=SQLITE_OK ){
- if( rc==SQLITE_DONE ){
- rc = SQLITE_OK;
- }
- break;
- }
- }
-
- /* Pages that have been written to the journal but never synced
- ** where not restored by the loop above. We have to restore those
- ** pages by reading them back from the original database.
- */
- if( rc==SQLITE_OK ){
- PgHdr *pPg;
- for(pPg=pPager->pAll; pPg; pPg=pPg->pNextAll){
- char zBuf[SQLITE_PAGE_SIZE];
- if( !pPg->dirty ) continue;
- if( (int)pPg->pgno <= pPager->origDbSize ){
- sqliteOsSeek(&pPager->fd, SQLITE_PAGE_SIZE*(off_t)(pPg->pgno-1));
- rc = sqliteOsRead(&pPager->fd, zBuf, SQLITE_PAGE_SIZE);
- TRACE2("REFETCH %d\n", pPg->pgno);
- CODEC(pPager, zBuf, pPg->pgno, 2);
- if( rc ) break;
- }else{
- memset(zBuf, 0, SQLITE_PAGE_SIZE);
- }
- if( pPg->nRef==0 || memcmp(zBuf, PGHDR_TO_DATA(pPg), SQLITE_PAGE_SIZE) ){
- memcpy(PGHDR_TO_DATA(pPg), zBuf, SQLITE_PAGE_SIZE);
- memset(PGHDR_TO_EXTRA(pPg), 0, pPager->nExtra);
- }
- pPg->needSync = 0;
- pPg->dirty = 0;
- }
- }
-
-end_playback:
- if( rc!=SQLITE_OK ){
- pager_unwritelock(pPager);
- pPager->errMask |= PAGER_ERR_CORRUPT;
- rc = SQLITE_CORRUPT;
- }else{
- rc = pager_unwritelock(pPager);
- }
- return rc;
-}
-
-/*
-** Playback the checkpoint journal.
-**
-** This is similar to playing back the transaction journal but with
-** a few extra twists.
-**
-** (1) The number of pages in the database file at the start of
-** the checkpoint is stored in pPager->ckptSize, not in the
-** journal file itself.
-**
-** (2) In addition to playing back the checkpoint journal, also
-** playback all pages of the transaction journal beginning
-** at offset pPager->ckptJSize.
-*/
-static int pager_ckpt_playback(Pager *pPager){
- off_t szJ; /* Size of the full journal */
- int nRec; /* Number of Records */
- int i; /* Loop counter */
- int rc;
-
- /* Truncate the database back to its original size.
- */
- rc = sqliteOsTruncate(&pPager->fd, SQLITE_PAGE_SIZE*(off_t)pPager->ckptSize);
- pPager->dbSize = pPager->ckptSize;
-
- /* Figure out how many records are in the checkpoint journal.
- */
- assert( pPager->ckptInUse && pPager->journalOpen );
- sqliteOsSeek(&pPager->cpfd, 0);
- nRec = pPager->ckptNRec;
-
- /* Copy original pages out of the checkpoint journal and back into the
- ** database file. Note that the checkpoint journal always uses format
- ** 2 instead of format 3 since it does not need to be concerned with
- ** power failures corrupting the journal and can thus omit the checksums.
- */
- for(i=nRec-1; i>=0; i--){
- rc = pager_playback_one_page(pPager, &pPager->cpfd, 2);
- assert( rc!=SQLITE_DONE );
- if( rc!=SQLITE_OK ) goto end_ckpt_playback;
- }
-
- /* Figure out how many pages need to be copied out of the transaction
- ** journal.
- */
- rc = sqliteOsSeek(&pPager->jfd, pPager->ckptJSize);
- if( rc!=SQLITE_OK ){
- goto end_ckpt_playback;
- }
- rc = sqliteOsFileSize(&pPager->jfd, &szJ);
- if( rc!=SQLITE_OK ){
- goto end_ckpt_playback;
- }
- nRec = (szJ - pPager->ckptJSize)/JOURNAL_PG_SZ(journal_format);
- for(i=nRec-1; i>=0; i--){
- rc = pager_playback_one_page(pPager, &pPager->jfd, journal_format);
- if( rc!=SQLITE_OK ){
- assert( rc!=SQLITE_DONE );
- goto end_ckpt_playback;
- }
- }
-
-end_ckpt_playback:
- if( rc!=SQLITE_OK ){
- pPager->errMask |= PAGER_ERR_CORRUPT;
- rc = SQLITE_CORRUPT;
- }
- return rc;
-}
-
-/*
-** Change the maximum number of in-memory pages that are allowed.
-**
-** The maximum number is the absolute value of the mxPage parameter.
-** If mxPage is negative, the noSync flag is also set. noSync bypasses
-** calls to sqliteOsSync(). The pager runs much faster with noSync on,
-** but if the operating system crashes or there is an abrupt power
-** failure, the database file might be left in an inconsistent and
-** unrepairable state.
-*/
-void sqlitepager_set_cachesize(Pager *pPager, int mxPage){
- if( mxPage>=0 ){
- pPager->noSync = pPager->tempFile;
- if( pPager->noSync==0 ) pPager->needSync = 0;
- }else{
- pPager->noSync = 1;
- mxPage = -mxPage;
- }
- if( mxPage>10 ){
- pPager->mxPage = mxPage;
- }
-}
-
-/*
-** Adjust the robustness of the database to damage due to OS crashes
-** or power failures by changing the number of syncs()s when writing
-** the rollback journal. There are three levels:
-**
-** OFF sqliteOsSync() is never called. This is the default
-** for temporary and transient files.
-**
-** NORMAL The journal is synced once before writes begin on the
-** database. This is normally adequate protection, but
-** it is theoretically possible, though very unlikely,
-** that an inopertune power failure could leave the journal
-** in a state which would cause damage to the database
-** when it is rolled back.
-**
-** FULL The journal is synced twice before writes begin on the
-** database (with some additional information - the nRec field
-** of the journal header - being written in between the two
-** syncs). If we assume that writing a
-** single disk sector is atomic, then this mode provides
-** assurance that the journal will not be corrupted to the
-** point of causing damage to the database during rollback.
-**
-** Numeric values associated with these states are OFF==1, NORMAL=2,
-** and FULL=3.
-*/
-void sqlitepager_set_safety_level(Pager *pPager, int level){
- pPager->noSync = level==1 || pPager->tempFile;
- pPager->fullSync = level==3 && !pPager->tempFile;
- if( pPager->noSync==0 ) pPager->needSync = 0;
-}
-
-/*
-** Open a temporary file. Write the name of the file into zName
-** (zName must be at least SQLITE_TEMPNAME_SIZE bytes long.) Write
-** the file descriptor into *fd. Return SQLITE_OK on success or some
-** other error code if we fail.
-**
-** The OS will automatically delete the temporary file when it is
-** closed.
-*/
-static int sqlitepager_opentemp(char *zFile, OsFile *fd){
- int cnt = 8;
- int rc;
- do{
- cnt--;
- sqliteOsTempFileName(zFile);
- rc = sqliteOsOpenExclusive(zFile, fd, 1);
- }while( cnt>0 && rc!=SQLITE_OK );
- return rc;
-}
-
-/*
-** Create a new page cache and put a pointer to the page cache in *ppPager.
-** The file to be cached need not exist. The file is not locked until
-** the first call to sqlitepager_get() and is only held open until the
-** last page is released using sqlitepager_unref().
-**
-** If zFilename is NULL then a randomly-named temporary file is created
-** and used as the file to be cached. The file will be deleted
-** automatically when it is closed.
-*/
-int sqlitepager_open(
- Pager **ppPager, /* Return the Pager structure here */
- const char *zFilename, /* Name of the database file to open */
- int mxPage, /* Max number of in-memory cache pages */
- int nExtra, /* Extra bytes append to each in-memory page */
- int useJournal /* TRUE to use a rollback journal on this file */
-){
- Pager *pPager;
- char *zFullPathname;
- int nameLen;
- OsFile fd;
- int rc, i;
- int tempFile;
- int readOnly = 0;
- char zTemp[SQLITE_TEMPNAME_SIZE];
-
- *ppPager = 0;
- if( sqlite_malloc_failed ){
- return SQLITE_NOMEM;
- }
- if( zFilename && zFilename[0] ){
- zFullPathname = sqliteOsFullPathname(zFilename);
- rc = sqliteOsOpenReadWrite(zFullPathname, &fd, &readOnly);
- tempFile = 0;
- }else{
- rc = sqlitepager_opentemp(zTemp, &fd);
- zFilename = zTemp;
- zFullPathname = sqliteOsFullPathname(zFilename);
- tempFile = 1;
- }
- if( sqlite_malloc_failed ){
- return SQLITE_NOMEM;
- }
- if( rc!=SQLITE_OK ){
- sqliteFree(zFullPathname);
- return SQLITE_CANTOPEN;
- }
- nameLen = strlen(zFullPathname);
- pPager = sqliteMalloc( sizeof(*pPager) + nameLen*3 + 30 );
- if( pPager==0 ){
- sqliteOsClose(&fd);
- sqliteFree(zFullPathname);
- return SQLITE_NOMEM;
- }
- SET_PAGER(pPager);
- pPager->zFilename = (char*)&pPager[1];
- pPager->zDirectory = &pPager->zFilename[nameLen+1];
- pPager->zJournal = &pPager->zDirectory[nameLen+1];
- strcpy(pPager->zFilename, zFullPathname);
- strcpy(pPager->zDirectory, zFullPathname);
- for(i=nameLen; i>0 && pPager->zDirectory[i-1]!='/'; i--){}
- if( i>0 ) pPager->zDirectory[i-1] = 0;
- strcpy(pPager->zJournal, zFullPathname);
- sqliteFree(zFullPathname);
- strcpy(&pPager->zJournal[nameLen], "-journal");
- pPager->fd = fd;
- pPager->journalOpen = 0;
- pPager->useJournal = useJournal;
- pPager->ckptOpen = 0;
- pPager->ckptInUse = 0;
- pPager->nRef = 0;
- pPager->dbSize = -1;
- pPager->ckptSize = 0;
- pPager->ckptJSize = 0;
- pPager->nPage = 0;
- pPager->mxPage = mxPage>5 ? mxPage : 10;
- pPager->state = SQLITE_UNLOCK;
- pPager->errMask = 0;
- pPager->tempFile = tempFile;
- pPager->readOnly = readOnly;
- pPager->needSync = 0;
- pPager->noSync = pPager->tempFile || !useJournal;
- pPager->pFirst = 0;
- pPager->pFirstSynced = 0;
- pPager->pLast = 0;
- pPager->nExtra = nExtra;
- memset(pPager->aHash, 0, sizeof(pPager->aHash));
- *ppPager = pPager;
- return SQLITE_OK;
-}
-
-/*
-** Set the destructor for this pager. If not NULL, the destructor is called
-** when the reference count on each page reaches zero. The destructor can
-** be used to clean up information in the extra segment appended to each page.
-**
-** The destructor is not called as a result sqlitepager_close().
-** Destructors are only called by sqlitepager_unref().
-*/
-void sqlitepager_set_destructor(Pager *pPager, void (*xDesc)(void*)){
- pPager->xDestructor = xDesc;
-}
-
-/*
-** Return the total number of pages in the disk file associated with
-** pPager.
-*/
-int sqlitepager_pagecount(Pager *pPager){
- off_t n;
- assert( pPager!=0 );
- if( pPager->dbSize>=0 ){
- return pPager->dbSize;
- }
- if( sqliteOsFileSize(&pPager->fd, &n)!=SQLITE_OK ){
- pPager->errMask |= PAGER_ERR_DISK;
- return 0;
- }
- n /= SQLITE_PAGE_SIZE;
- if( pPager->state!=SQLITE_UNLOCK ){
- pPager->dbSize = n;
- }
- return n;
-}
-
-/*
-** Forward declaration
-*/
-static int syncJournal(Pager*);
-
-/*
-** Truncate the file to the number of pages specified.
-*/
-int sqlitepager_truncate(Pager *pPager, Pgno nPage){
- int rc;
- if( pPager->dbSize<0 ){
- sqlitepager_pagecount(pPager);
- }
- if( pPager->errMask!=0 ){
- rc = pager_errcode(pPager);
- return rc;
- }
- if( nPage>=(unsigned)pPager->dbSize ){
- return SQLITE_OK;
- }
- syncJournal(pPager);
- rc = sqliteOsTruncate(&pPager->fd, SQLITE_PAGE_SIZE*(off_t)nPage);
- if( rc==SQLITE_OK ){
- pPager->dbSize = nPage;
- }
- return rc;
-}
-
-/*
-** Shutdown the page cache. Free all memory and close all files.
-**
-** If a transaction was in progress when this routine is called, that
-** transaction is rolled back. All outstanding pages are invalidated
-** and their memory is freed. Any attempt to use a page associated
-** with this page cache after this function returns will likely
-** result in a coredump.
-*/
-int sqlitepager_close(Pager *pPager){
- PgHdr *pPg, *pNext;
- switch( pPager->state ){
- case SQLITE_WRITELOCK: {
- sqlitepager_rollback(pPager);
- sqliteOsUnlock(&pPager->fd);
- assert( pPager->journalOpen==0 );
- break;
- }
- case SQLITE_READLOCK: {
- sqliteOsUnlock(&pPager->fd);
- break;
- }
- default: {
- /* Do nothing */
- break;
- }
- }
- for(pPg=pPager->pAll; pPg; pPg=pNext){
- pNext = pPg->pNextAll;
- sqliteFree(pPg);
- }
- sqliteOsClose(&pPager->fd);
- assert( pPager->journalOpen==0 );
- /* Temp files are automatically deleted by the OS
- ** if( pPager->tempFile ){
- ** sqliteOsDelete(pPager->zFilename);
- ** }
- */
- CLR_PAGER(pPager);
- if( pPager->zFilename!=(char*)&pPager[1] ){
- assert( 0 ); /* Cannot happen */
- sqliteFree(pPager->zFilename);
- sqliteFree(pPager->zJournal);
- sqliteFree(pPager->zDirectory);
- }
- sqliteFree(pPager);
- return SQLITE_OK;
-}
-
-/*
-** Return the page number for the given page data.
-*/
-Pgno sqlitepager_pagenumber(void *pData){
- PgHdr *p = DATA_TO_PGHDR(pData);
- return p->pgno;
-}
-
-/*
-** Increment the reference count for a page. If the page is
-** currently on the freelist (the reference count is zero) then
-** remove it from the freelist.
-*/
-#define page_ref(P) ((P)->nRef==0?_page_ref(P):(void)(P)->nRef++)
-static void _page_ref(PgHdr *pPg){
- if( pPg->nRef==0 ){
- /* The page is currently on the freelist. Remove it. */
- if( pPg==pPg->pPager->pFirstSynced ){
- PgHdr *p = pPg->pNextFree;
- while( p && p->needSync ){ p = p->pNextFree; }
- pPg->pPager->pFirstSynced = p;
- }
- if( pPg->pPrevFree ){
- pPg->pPrevFree->pNextFree = pPg->pNextFree;
- }else{
- pPg->pPager->pFirst = pPg->pNextFree;
- }
- if( pPg->pNextFree ){
- pPg->pNextFree->pPrevFree = pPg->pPrevFree;
- }else{
- pPg->pPager->pLast = pPg->pPrevFree;
- }
- pPg->pPager->nRef++;
- }
- pPg->nRef++;
- REFINFO(pPg);
-}
-
-/*
-** Increment the reference count for a page. The input pointer is
-** a reference to the page data.
-*/
-int sqlitepager_ref(void *pData){
- PgHdr *pPg = DATA_TO_PGHDR(pData);
- page_ref(pPg);
- return SQLITE_OK;
-}
-
-/*
-** Sync the journal. In other words, make sure all the pages that have
-** been written to the journal have actually reached the surface of the
-** disk. It is not safe to modify the original database file until after
-** the journal has been synced. If the original database is modified before
-** the journal is synced and a power failure occurs, the unsynced journal
-** data would be lost and we would be unable to completely rollback the
-** database changes. Database corruption would occur.
-**
-** This routine also updates the nRec field in the header of the journal.
-** (See comments on the pager_playback() routine for additional information.)
-** If the sync mode is FULL, two syncs will occur. First the whole journal
-** is synced, then the nRec field is updated, then a second sync occurs.
-**
-** For temporary databases, we do not care if we are able to rollback
-** after a power failure, so sync occurs.
-**
-** This routine clears the needSync field of every page current held in
-** memory.
-*/
-static int syncJournal(Pager *pPager){
- PgHdr *pPg;
- int rc = SQLITE_OK;
-
- /* Sync the journal before modifying the main database
- ** (assuming there is a journal and it needs to be synced.)
- */
- if( pPager->needSync ){
- if( !pPager->tempFile ){
- assert( pPager->journalOpen );
- /* assert( !pPager->noSync ); // noSync might be set if synchronous
- ** was turned off after the transaction was started. Ticket #615 */
-#ifndef NDEBUG
- {
- /* Make sure the pPager->nRec counter we are keeping agrees
- ** with the nRec computed from the size of the journal file.
- */
- off_t hdrSz, pgSz, jSz;
- hdrSz = JOURNAL_HDR_SZ(journal_format);
- pgSz = JOURNAL_PG_SZ(journal_format);
- rc = sqliteOsFileSize(&pPager->jfd, &jSz);
- if( rc!=0 ) return rc;
- assert( pPager->nRec*pgSz+hdrSz==jSz );
- }
-#endif
- if( journal_format>=3 ){
- /* Write the nRec value into the journal file header */
- off_t szJ;
- if( pPager->fullSync ){
- TRACE1("SYNC\n");
- rc = sqliteOsSync(&pPager->jfd);
- if( rc!=0 ) return rc;
- }
- sqliteOsSeek(&pPager->jfd, sizeof(aJournalMagic1));
- rc = write32bits(&pPager->jfd, pPager->nRec);
- if( rc ) return rc;
- szJ = JOURNAL_HDR_SZ(journal_format) +
- pPager->nRec*JOURNAL_PG_SZ(journal_format);
- sqliteOsSeek(&pPager->jfd, szJ);
- }
- TRACE1("SYNC\n");
- rc = sqliteOsSync(&pPager->jfd);
- if( rc!=0 ) return rc;
- pPager->journalStarted = 1;
- }
- pPager->needSync = 0;
-
- /* Erase the needSync flag from every page.
- */
- for(pPg=pPager->pAll; pPg; pPg=pPg->pNextAll){
- pPg->needSync = 0;
- }
- pPager->pFirstSynced = pPager->pFirst;
- }
-
-#ifndef NDEBUG
- /* If the Pager.needSync flag is clear then the PgHdr.needSync
- ** flag must also be clear for all pages. Verify that this
- ** invariant is true.
- */
- else{
- for(pPg=pPager->pAll; pPg; pPg=pPg->pNextAll){
- assert( pPg->needSync==0 );
- }
- assert( pPager->pFirstSynced==pPager->pFirst );
- }
-#endif
-
- return rc;
-}
-
-/*
-** Given a list of pages (connected by the PgHdr.pDirty pointer) write
-** every one of those pages out to the database file and mark them all
-** as clean.
-*/
-static int pager_write_pagelist(PgHdr *pList){
- Pager *pPager;
- int rc;
-
- if( pList==0 ) return SQLITE_OK;
- pPager = pList->pPager;
- while( pList ){
- assert( pList->dirty );
- sqliteOsSeek(&pPager->fd, (pList->pgno-1)*(off_t)SQLITE_PAGE_SIZE);
- CODEC(pPager, PGHDR_TO_DATA(pList), pList->pgno, 6);
- TRACE2("STORE %d\n", pList->pgno);
- rc = sqliteOsWrite(&pPager->fd, PGHDR_TO_DATA(pList), SQLITE_PAGE_SIZE);
- CODEC(pPager, PGHDR_TO_DATA(pList), pList->pgno, 0);
- if( rc ) return rc;
- pList->dirty = 0;
- pList = pList->pDirty;
- }
- return SQLITE_OK;
-}
-
-/*
-** Collect every dirty page into a dirty list and
-** return a pointer to the head of that list. All pages are
-** collected even if they are still in use.
-*/
-static PgHdr *pager_get_all_dirty_pages(Pager *pPager){
- PgHdr *p, *pList;
- pList = 0;
- for(p=pPager->pAll; p; p=p->pNextAll){
- if( p->dirty ){
- p->pDirty = pList;
- pList = p;
- }
- }
- return pList;
-}
-
-/*
-** Acquire a page.
-**
-** A read lock on the disk file is obtained when the first page is acquired.
-** This read lock is dropped when the last page is released.
-**
-** A _get works for any page number greater than 0. If the database
-** file is smaller than the requested page, then no actual disk
-** read occurs and the memory image of the page is initialized to
-** all zeros. The extra data appended to a page is always initialized
-** to zeros the first time a page is loaded into memory.
-**
-** The acquisition might fail for several reasons. In all cases,
-** an appropriate error code is returned and *ppPage is set to NULL.
-**
-** See also sqlitepager_lookup(). Both this routine and _lookup() attempt
-** to find a page in the in-memory cache first. If the page is not already
-** in memory, this routine goes to disk to read it in whereas _lookup()
-** just returns 0. This routine acquires a read-lock the first time it
-** has to go to disk, and could also playback an old journal if necessary.
-** Since _lookup() never goes to disk, it never has to deal with locks
-** or journal files.
-*/
-int sqlitepager_get(Pager *pPager, Pgno pgno, void **ppPage){
- PgHdr *pPg;
- int rc;
-
- /* Make sure we have not hit any critical errors.
- */
- assert( pPager!=0 );
- assert( pgno!=0 );
- *ppPage = 0;
- if( pPager->errMask & ~(PAGER_ERR_FULL) ){
- return pager_errcode(pPager);
- }
-
- /* If this is the first page accessed, then get a read lock
- ** on the database file.
- */
- if( pPager->nRef==0 ){
- rc = sqliteOsReadLock(&pPager->fd);
- if( rc!=SQLITE_OK ){
- return rc;
- }
- pPager->state = SQLITE_READLOCK;
-
- /* If a journal file exists, try to play it back.
- */
- if( pPager->useJournal && sqliteOsFileExists(pPager->zJournal) ){
- int rc;
-
- /* Get a write lock on the database
- */
- rc = sqliteOsWriteLock(&pPager->fd);
- if( rc!=SQLITE_OK ){
- if( sqliteOsUnlock(&pPager->fd)!=SQLITE_OK ){
- /* This should never happen! */
- rc = SQLITE_INTERNAL;
- }
- return rc;
- }
- pPager->state = SQLITE_WRITELOCK;
-
- /* Open the journal for reading only. Return SQLITE_BUSY if
- ** we are unable to open the journal file.
- **
- ** The journal file does not need to be locked itself. The
- ** journal file is never open unless the main database file holds
- ** a write lock, so there is never any chance of two or more
- ** processes opening the journal at the same time.
- */
- rc = sqliteOsOpenReadOnly(pPager->zJournal, &pPager->jfd);
- if( rc!=SQLITE_OK ){
- rc = sqliteOsUnlock(&pPager->fd);
- assert( rc==SQLITE_OK );
- return SQLITE_BUSY;
- }
- pPager->journalOpen = 1;
- pPager->journalStarted = 0;
-
- /* Playback and delete the journal. Drop the database write
- ** lock and reacquire the read lock.
- */
- rc = pager_playback(pPager, 0);
- if( rc!=SQLITE_OK ){
- return rc;
- }
- }
- pPg = 0;
- }else{
- /* Search for page in cache */
- pPg = pager_lookup(pPager, pgno);
- }
- if( pPg==0 ){
- /* The requested page is not in the page cache. */
- int h;
- pPager->nMiss++;
- if( pPager->nPage<pPager->mxPage || pPager->pFirst==0 ){
- /* Create a new page */
- pPg = sqliteMallocRaw( sizeof(*pPg) + SQLITE_PAGE_SIZE
- + sizeof(u32) + pPager->nExtra );
- if( pPg==0 ){
- pager_unwritelock(pPager);
- pPager->errMask |= PAGER_ERR_MEM;
- return SQLITE_NOMEM;
- }
- memset(pPg, 0, sizeof(*pPg));
- pPg->pPager = pPager;
- pPg->pNextAll = pPager->pAll;
- if( pPager->pAll ){
- pPager->pAll->pPrevAll = pPg;
- }
- pPg->pPrevAll = 0;
- pPager->pAll = pPg;
- pPager->nPage++;
- }else{
- /* Find a page to recycle. Try to locate a page that does not
- ** require us to do an fsync() on the journal.
- */
- pPg = pPager->pFirstSynced;
-
- /* If we could not find a page that does not require an fsync()
- ** on the journal file then fsync the journal file. This is a
- ** very slow operation, so we work hard to avoid it. But sometimes
- ** it can't be helped.
- */
- if( pPg==0 ){
- int rc = syncJournal(pPager);
- if( rc!=0 ){
- sqlitepager_rollback(pPager);
- return SQLITE_IOERR;
- }
- pPg = pPager->pFirst;
- }
- assert( pPg->nRef==0 );
-
- /* Write the page to the database file if it is dirty.
- */
- if( pPg->dirty ){
- assert( pPg->needSync==0 );
- pPg->pDirty = 0;
- rc = pager_write_pagelist( pPg );
- if( rc!=SQLITE_OK ){
- sqlitepager_rollback(pPager);
- return SQLITE_IOERR;
- }
- }
- assert( pPg->dirty==0 );
-
- /* If the page we are recycling is marked as alwaysRollback, then
- ** set the global alwaysRollback flag, thus disabling the
- ** sqlite_dont_rollback() optimization for the rest of this transaction.
- ** It is necessary to do this because the page marked alwaysRollback
- ** might be reloaded at a later time but at that point we won't remember
- ** that is was marked alwaysRollback. This means that all pages must
- ** be marked as alwaysRollback from here on out.
- */
- if( pPg->alwaysRollback ){
- pPager->alwaysRollback = 1;
- }
-
- /* Unlink the old page from the free list and the hash table
- */
- if( pPg==pPager->pFirstSynced ){
- PgHdr *p = pPg->pNextFree;
- while( p && p->needSync ){ p = p->pNextFree; }
- pPager->pFirstSynced = p;
- }
- if( pPg->pPrevFree ){
- pPg->pPrevFree->pNextFree = pPg->pNextFree;
- }else{
- assert( pPager->pFirst==pPg );
- pPager->pFirst = pPg->pNextFree;
- }
- if( pPg->pNextFree ){
- pPg->pNextFree->pPrevFree = pPg->pPrevFree;
- }else{
- assert( pPager->pLast==pPg );
- pPager->pLast = pPg->pPrevFree;
- }
- pPg->pNextFree = pPg->pPrevFree = 0;
- if( pPg->pNextHash ){
- pPg->pNextHash->pPrevHash = pPg->pPrevHash;
- }
- if( pPg->pPrevHash ){
- pPg->pPrevHash->pNextHash = pPg->pNextHash;
- }else{
- h = pager_hash(pPg->pgno);
- assert( pPager->aHash[h]==pPg );
- pPager->aHash[h] = pPg->pNextHash;
- }
- pPg->pNextHash = pPg->pPrevHash = 0;
- pPager->nOvfl++;
- }
- pPg->pgno = pgno;
- if( pPager->aInJournal && (int)pgno<=pPager->origDbSize ){
- sqliteCheckMemory(pPager->aInJournal, pgno/8);
- assert( pPager->journalOpen );
- pPg->inJournal = (pPager->aInJournal[pgno/8] & (1<<(pgno&7)))!=0;
- pPg->needSync = 0;
- }else{
- pPg->inJournal = 0;
- pPg->needSync = 0;
- }
- if( pPager->aInCkpt && (int)pgno<=pPager->ckptSize
- && (pPager->aInCkpt[pgno/8] & (1<<(pgno&7)))!=0 ){
- page_add_to_ckpt_list(pPg);
- }else{
- page_remove_from_ckpt_list(pPg);
- }
- pPg->dirty = 0;
- pPg->nRef = 1;
- REFINFO(pPg);
- pPager->nRef++;
- h = pager_hash(pgno);
- pPg->pNextHash = pPager->aHash[h];
- pPager->aHash[h] = pPg;
- if( pPg->pNextHash ){
- assert( pPg->pNextHash->pPrevHash==0 );
- pPg->pNextHash->pPrevHash = pPg;
- }
- if( pPager->nExtra>0 ){
- memset(PGHDR_TO_EXTRA(pPg), 0, pPager->nExtra);
- }
- if( pPager->dbSize<0 ) sqlitepager_pagecount(pPager);
- if( pPager->errMask!=0 ){
- sqlitepager_unref(PGHDR_TO_DATA(pPg));
- rc = pager_errcode(pPager);
- return rc;
- }
- if( pPager->dbSize<(int)pgno ){
- memset(PGHDR_TO_DATA(pPg), 0, SQLITE_PAGE_SIZE);
- }else{
- int rc;
- sqliteOsSeek(&pPager->fd, (pgno-1)*(off_t)SQLITE_PAGE_SIZE);
- rc = sqliteOsRead(&pPager->fd, PGHDR_TO_DATA(pPg), SQLITE_PAGE_SIZE);
- TRACE2("FETCH %d\n", pPg->pgno);
- CODEC(pPager, PGHDR_TO_DATA(pPg), pPg->pgno, 3);
- if( rc!=SQLITE_OK ){
- off_t fileSize;
- if( sqliteOsFileSize(&pPager->fd,&fileSize)!=SQLITE_OK
- || fileSize>=pgno*SQLITE_PAGE_SIZE ){
- sqlitepager_unref(PGHDR_TO_DATA(pPg));
- return rc;
- }else{
- memset(PGHDR_TO_DATA(pPg), 0, SQLITE_PAGE_SIZE);
- }
- }
- }
- }else{
- /* The requested page is in the page cache. */
- pPager->nHit++;
- page_ref(pPg);
- }
- *ppPage = PGHDR_TO_DATA(pPg);
- return SQLITE_OK;
-}
-
-/*
-** Acquire a page if it is already in the in-memory cache. Do
-** not read the page from disk. Return a pointer to the page,
-** or 0 if the page is not in cache.
-**
-** See also sqlitepager_get(). The difference between this routine
-** and sqlitepager_get() is that _get() will go to the disk and read
-** in the page if the page is not already in cache. This routine
-** returns NULL if the page is not in cache or if a disk I/O error
-** has ever happened.
-*/
-void *sqlitepager_lookup(Pager *pPager, Pgno pgno){
- PgHdr *pPg;
-
- assert( pPager!=0 );
- assert( pgno!=0 );
- if( pPager->errMask & ~(PAGER_ERR_FULL) ){
- return 0;
- }
- /* if( pPager->nRef==0 ){
- ** return 0;
- ** }
- */
- pPg = pager_lookup(pPager, pgno);
- if( pPg==0 ) return 0;
- page_ref(pPg);
- return PGHDR_TO_DATA(pPg);
-}
-
-/*
-** Release a page.
-**
-** If the number of references to the page drop to zero, then the
-** page is added to the LRU list. When all references to all pages
-** are released, a rollback occurs and the lock on the database is
-** removed.
-*/
-int sqlitepager_unref(void *pData){
- PgHdr *pPg;
-
- /* Decrement the reference count for this page
- */
- pPg = DATA_TO_PGHDR(pData);
- assert( pPg->nRef>0 );
- pPg->nRef--;
- REFINFO(pPg);
-
- /* When the number of references to a page reach 0, call the
- ** destructor and add the page to the freelist.
- */
- if( pPg->nRef==0 ){
- Pager *pPager;
- pPager = pPg->pPager;
- pPg->pNextFree = 0;
- pPg->pPrevFree = pPager->pLast;
- pPager->pLast = pPg;
- if( pPg->pPrevFree ){
- pPg->pPrevFree->pNextFree = pPg;
- }else{
- pPager->pFirst = pPg;
- }
- if( pPg->needSync==0 && pPager->pFirstSynced==0 ){
- pPager->pFirstSynced = pPg;
- }
- if( pPager->xDestructor ){
- pPager->xDestructor(pData);
- }
-
- /* When all pages reach the freelist, drop the read lock from
- ** the database file.
- */
- pPager->nRef--;
- assert( pPager->nRef>=0 );
- if( pPager->nRef==0 ){
- pager_reset(pPager);
- }
- }
- return SQLITE_OK;
-}
-
-/*
-** Create a journal file for pPager. There should already be a write
-** lock on the database file when this routine is called.
-**
-** Return SQLITE_OK if everything. Return an error code and release the
-** write lock if anything goes wrong.
-*/
-static int pager_open_journal(Pager *pPager){
- int rc;
- assert( pPager->state==SQLITE_WRITELOCK );
- assert( pPager->journalOpen==0 );
- assert( pPager->useJournal );
- sqlitepager_pagecount(pPager);
- pPager->aInJournal = sqliteMalloc( pPager->dbSize/8 + 1 );
- if( pPager->aInJournal==0 ){
- sqliteOsReadLock(&pPager->fd);
- pPager->state = SQLITE_READLOCK;
- return SQLITE_NOMEM;
- }
- rc = sqliteOsOpenExclusive(pPager->zJournal, &pPager->jfd,pPager->tempFile);
- if( rc!=SQLITE_OK ){
- sqliteFree(pPager->aInJournal);
- pPager->aInJournal = 0;
- sqliteOsReadLock(&pPager->fd);
- pPager->state = SQLITE_READLOCK;
- return SQLITE_CANTOPEN;
- }
- sqliteOsOpenDirectory(pPager->zDirectory, &pPager->jfd);
- pPager->journalOpen = 1;
- pPager->journalStarted = 0;
- pPager->needSync = 0;
- pPager->alwaysRollback = 0;
- pPager->nRec = 0;
- if( pPager->errMask!=0 ){
- rc = pager_errcode(pPager);
- return rc;
- }
- pPager->origDbSize = pPager->dbSize;
- if( journal_format==JOURNAL_FORMAT_3 ){
- rc = sqliteOsWrite(&pPager->jfd, aJournalMagic3, sizeof(aJournalMagic3));
- if( rc==SQLITE_OK ){
- rc = write32bits(&pPager->jfd, pPager->noSync ? 0xffffffff : 0);
- }
- if( rc==SQLITE_OK ){
- sqliteRandomness(sizeof(pPager->cksumInit), &pPager->cksumInit);
- rc = write32bits(&pPager->jfd, pPager->cksumInit);
- }
- }else if( journal_format==JOURNAL_FORMAT_2 ){
- rc = sqliteOsWrite(&pPager->jfd, aJournalMagic2, sizeof(aJournalMagic2));
- }else{
- assert( journal_format==JOURNAL_FORMAT_1 );
- rc = sqliteOsWrite(&pPager->jfd, aJournalMagic1, sizeof(aJournalMagic1));
- }
- if( rc==SQLITE_OK ){
- rc = write32bits(&pPager->jfd, pPager->dbSize);
- }
- if( pPager->ckptAutoopen && rc==SQLITE_OK ){
- rc = sqlitepager_ckpt_begin(pPager);
- }
- if( rc!=SQLITE_OK ){
- rc = pager_unwritelock(pPager);
- if( rc==SQLITE_OK ){
- rc = SQLITE_FULL;
- }
- }
- return rc;
-}
-
-/*
-** Acquire a write-lock on the database. The lock is removed when
-** the any of the following happen:
-**
-** * sqlitepager_commit() is called.
-** * sqlitepager_rollback() is called.
-** * sqlitepager_close() is called.
-** * sqlitepager_unref() is called to on every outstanding page.
-**
-** The parameter to this routine is a pointer to any open page of the
-** database file. Nothing changes about the page - it is used merely
-** to acquire a pointer to the Pager structure and as proof that there
-** is already a read-lock on the database.
-**
-** A journal file is opened if this is not a temporary file. For
-** temporary files, the opening of the journal file is deferred until
-** there is an actual need to write to the journal.
-**
-** If the database is already write-locked, this routine is a no-op.
-*/
-int sqlitepager_begin(void *pData){
- PgHdr *pPg = DATA_TO_PGHDR(pData);
- Pager *pPager = pPg->pPager;
- int rc = SQLITE_OK;
- assert( pPg->nRef>0 );
- assert( pPager->state!=SQLITE_UNLOCK );
- if( pPager->state==SQLITE_READLOCK ){
- assert( pPager->aInJournal==0 );
- rc = sqliteOsWriteLock(&pPager->fd);
- if( rc!=SQLITE_OK ){
- return rc;
- }
- pPager->state = SQLITE_WRITELOCK;
- pPager->dirtyFile = 0;
- TRACE1("TRANSACTION\n");
- if( pPager->useJournal && !pPager->tempFile ){
- rc = pager_open_journal(pPager);
- }
- }
- return rc;
-}
-
-/*
-** Mark a data page as writeable. The page is written into the journal
-** if it is not there already. This routine must be called before making
-** changes to a page.
-**
-** The first time this routine is called, the pager creates a new
-** journal and acquires a write lock on the database. If the write
-** lock could not be acquired, this routine returns SQLITE_BUSY. The
-** calling routine must check for that return value and be careful not to
-** change any page data until this routine returns SQLITE_OK.
-**
-** If the journal file could not be written because the disk is full,
-** then this routine returns SQLITE_FULL and does an immediate rollback.
-** All subsequent write attempts also return SQLITE_FULL until there
-** is a call to sqlitepager_commit() or sqlitepager_rollback() to
-** reset.
-*/
-int sqlitepager_write(void *pData){
- PgHdr *pPg = DATA_TO_PGHDR(pData);
- Pager *pPager = pPg->pPager;
- int rc = SQLITE_OK;
-
- /* Check for errors
- */
- if( pPager->errMask ){
- return pager_errcode(pPager);
- }
- if( pPager->readOnly ){
- return SQLITE_PERM;
- }
-
- /* Mark the page as dirty. If the page has already been written
- ** to the journal then we can return right away.
- */
- pPg->dirty = 1;
- if( pPg->inJournal && (pPg->inCkpt || pPager->ckptInUse==0) ){
- pPager->dirtyFile = 1;
- return SQLITE_OK;
- }
-
- /* If we get this far, it means that the page needs to be
- ** written to the transaction journal or the ckeckpoint journal
- ** or both.
- **
- ** First check to see that the transaction journal exists and
- ** create it if it does not.
- */
- assert( pPager->state!=SQLITE_UNLOCK );
- rc = sqlitepager_begin(pData);
- if( rc!=SQLITE_OK ){
- return rc;
- }
- assert( pPager->state==SQLITE_WRITELOCK );
- if( !pPager->journalOpen && pPager->useJournal ){
- rc = pager_open_journal(pPager);
- if( rc!=SQLITE_OK ) return rc;
- }
- assert( pPager->journalOpen || !pPager->useJournal );
- pPager->dirtyFile = 1;
-
- /* The transaction journal now exists and we have a write lock on the
- ** main database file. Write the current page to the transaction
- ** journal if it is not there already.
- */
- if( !pPg->inJournal && pPager->useJournal ){
- if( (int)pPg->pgno <= pPager->origDbSize ){
- int szPg;
- u32 saved;
- if( journal_format>=JOURNAL_FORMAT_3 ){
- u32 cksum = pager_cksum(pPager, pPg->pgno, pData);
- saved = *(u32*)PGHDR_TO_EXTRA(pPg);
- store32bits(cksum, pPg, SQLITE_PAGE_SIZE);
- szPg = SQLITE_PAGE_SIZE+8;
- }else{
- szPg = SQLITE_PAGE_SIZE+4;
- }
- store32bits(pPg->pgno, pPg, -4);
- CODEC(pPager, pData, pPg->pgno, 7);
- rc = sqliteOsWrite(&pPager->jfd, &((char*)pData)[-4], szPg);
- TRACE3("JOURNAL %d %d\n", pPg->pgno, pPg->needSync);
- CODEC(pPager, pData, pPg->pgno, 0);
- if( journal_format>=JOURNAL_FORMAT_3 ){
- *(u32*)PGHDR_TO_EXTRA(pPg) = saved;
- }
- if( rc!=SQLITE_OK ){
- sqlitepager_rollback(pPager);
- pPager->errMask |= PAGER_ERR_FULL;
- return rc;
- }
- pPager->nRec++;
- assert( pPager->aInJournal!=0 );
- pPager->aInJournal[pPg->pgno/8] |= 1<<(pPg->pgno&7);
- pPg->needSync = !pPager->noSync;
- pPg->inJournal = 1;
- if( pPager->ckptInUse ){
- pPager->aInCkpt[pPg->pgno/8] |= 1<<(pPg->pgno&7);
- page_add_to_ckpt_list(pPg);
- }
- }else{
- pPg->needSync = !pPager->journalStarted && !pPager->noSync;
- TRACE3("APPEND %d %d\n", pPg->pgno, pPg->needSync);
- }
- if( pPg->needSync ){
- pPager->needSync = 1;
- }
- }
-
- /* If the checkpoint journal is open and the page is not in it,
- ** then write the current page to the checkpoint journal. Note that
- ** the checkpoint journal always uses the simplier format 2 that lacks
- ** checksums. The header is also omitted from the checkpoint journal.
- */
- if( pPager->ckptInUse && !pPg->inCkpt && (int)pPg->pgno<=pPager->ckptSize ){
- assert( pPg->inJournal || (int)pPg->pgno>pPager->origDbSize );
- store32bits(pPg->pgno, pPg, -4);
- CODEC(pPager, pData, pPg->pgno, 7);
- rc = sqliteOsWrite(&pPager->cpfd, &((char*)pData)[-4], SQLITE_PAGE_SIZE+4);
- TRACE2("CKPT-JOURNAL %d\n", pPg->pgno);
- CODEC(pPager, pData, pPg->pgno, 0);
- if( rc!=SQLITE_OK ){
- sqlitepager_rollback(pPager);
- pPager->errMask |= PAGER_ERR_FULL;
- return rc;
- }
- pPager->ckptNRec++;
- assert( pPager->aInCkpt!=0 );
- pPager->aInCkpt[pPg->pgno/8] |= 1<<(pPg->pgno&7);
- page_add_to_ckpt_list(pPg);
- }
-
- /* Update the database size and return.
- */
- if( pPager->dbSize<(int)pPg->pgno ){
- pPager->dbSize = pPg->pgno;
- }
- return rc;
-}
-
-/*
-** Return TRUE if the page given in the argument was previously passed
-** to sqlitepager_write(). In other words, return TRUE if it is ok
-** to change the content of the page.
-*/
-int sqlitepager_iswriteable(void *pData){
- PgHdr *pPg = DATA_TO_PGHDR(pData);
- return pPg->dirty;
-}
-
-/*
-** Replace the content of a single page with the information in the third
-** argument.
-*/
-int sqlitepager_overwrite(Pager *pPager, Pgno pgno, void *pData){
- void *pPage;
- int rc;
-
- rc = sqlitepager_get(pPager, pgno, &pPage);
- if( rc==SQLITE_OK ){
- rc = sqlitepager_write(pPage);
- if( rc==SQLITE_OK ){
- memcpy(pPage, pData, SQLITE_PAGE_SIZE);
- }
- sqlitepager_unref(pPage);
- }
- return rc;
-}
-
-/*
-** A call to this routine tells the pager that it is not necessary to
-** write the information on page "pgno" back to the disk, even though
-** that page might be marked as dirty.
-**
-** The overlying software layer calls this routine when all of the data
-** on the given page is unused. The pager marks the page as clean so
-** that it does not get written to disk.
-**
-** Tests show that this optimization, together with the
-** sqlitepager_dont_rollback() below, more than double the speed
-** of large INSERT operations and quadruple the speed of large DELETEs.
-**
-** When this routine is called, set the alwaysRollback flag to true.
-** Subsequent calls to sqlitepager_dont_rollback() for the same page
-** will thereafter be ignored. This is necessary to avoid a problem
-** where a page with data is added to the freelist during one part of
-** a transaction then removed from the freelist during a later part
-** of the same transaction and reused for some other purpose. When it
-** is first added to the freelist, this routine is called. When reused,
-** the dont_rollback() routine is called. But because the page contains
-** critical data, we still need to be sure it gets rolled back in spite
-** of the dont_rollback() call.
-*/
-void sqlitepager_dont_write(Pager *pPager, Pgno pgno){
- PgHdr *pPg;
-
- pPg = pager_lookup(pPager, pgno);
- pPg->alwaysRollback = 1;
- if( pPg && pPg->dirty ){
- if( pPager->dbSize==(int)pPg->pgno && pPager->origDbSize<pPager->dbSize ){
- /* If this pages is the last page in the file and the file has grown
- ** during the current transaction, then do NOT mark the page as clean.
- ** When the database file grows, we must make sure that the last page
- ** gets written at least once so that the disk file will be the correct
- ** size. If you do not write this page and the size of the file
- ** on the disk ends up being too small, that can lead to database
- ** corruption during the next transaction.
- */
- }else{
- TRACE2("DONT_WRITE %d\n", pgno);
- pPg->dirty = 0;
- }
- }
-}
-
-/*
-** A call to this routine tells the pager that if a rollback occurs,
-** it is not necessary to restore the data on the given page. This
-** means that the pager does not have to record the given page in the
-** rollback journal.
-*/
-void sqlitepager_dont_rollback(void *pData){
- PgHdr *pPg = DATA_TO_PGHDR(pData);
- Pager *pPager = pPg->pPager;
-
- if( pPager->state!=SQLITE_WRITELOCK || pPager->journalOpen==0 ) return;
- if( pPg->alwaysRollback || pPager->alwaysRollback ) return;
- if( !pPg->inJournal && (int)pPg->pgno <= pPager->origDbSize ){
- assert( pPager->aInJournal!=0 );
- pPager->aInJournal[pPg->pgno/8] |= 1<<(pPg->pgno&7);
- pPg->inJournal = 1;
- if( pPager->ckptInUse ){
- pPager->aInCkpt[pPg->pgno/8] |= 1<<(pPg->pgno&7);
- page_add_to_ckpt_list(pPg);
- }
- TRACE2("DONT_ROLLBACK %d\n", pPg->pgno);
- }
- if( pPager->ckptInUse && !pPg->inCkpt && (int)pPg->pgno<=pPager->ckptSize ){
- assert( pPg->inJournal || (int)pPg->pgno>pPager->origDbSize );
- assert( pPager->aInCkpt!=0 );
- pPager->aInCkpt[pPg->pgno/8] |= 1<<(pPg->pgno&7);
- page_add_to_ckpt_list(pPg);
- }
-}
-
-/*
-** Commit all changes to the database and release the write lock.
-**
-** If the commit fails for any reason, a rollback attempt is made
-** and an error code is returned. If the commit worked, SQLITE_OK
-** is returned.
-*/
-int sqlitepager_commit(Pager *pPager){
- int rc;
- PgHdr *pPg;
-
- if( pPager->errMask==PAGER_ERR_FULL ){
- rc = sqlitepager_rollback(pPager);
- if( rc==SQLITE_OK ){
- rc = SQLITE_FULL;
- }
- return rc;
- }
- if( pPager->errMask!=0 ){
- rc = pager_errcode(pPager);
- return rc;
- }
- if( pPager->state!=SQLITE_WRITELOCK ){
- return SQLITE_ERROR;
- }
- TRACE1("COMMIT\n");
- if( pPager->dirtyFile==0 ){
- /* Exit early (without doing the time-consuming sqliteOsSync() calls)
- ** if there have been no changes to the database file. */
- assert( pPager->needSync==0 );
- rc = pager_unwritelock(pPager);
- pPager->dbSize = -1;
- return rc;
- }
- assert( pPager->journalOpen );
- rc = syncJournal(pPager);
- if( rc!=SQLITE_OK ){
- goto commit_abort;
- }
- pPg = pager_get_all_dirty_pages(pPager);
- if( pPg ){
- rc = pager_write_pagelist(pPg);
- if( rc || (!pPager->noSync && sqliteOsSync(&pPager->fd)!=SQLITE_OK) ){
- goto commit_abort;
- }
- }
- rc = pager_unwritelock(pPager);
- pPager->dbSize = -1;
- return rc;
-
- /* Jump here if anything goes wrong during the commit process.
- */
-commit_abort:
- rc = sqlitepager_rollback(pPager);
- if( rc==SQLITE_OK ){
- rc = SQLITE_FULL;
- }
- return rc;
-}
-
-/*
-** Rollback all changes. The database falls back to read-only mode.
-** All in-memory cache pages revert to their original data contents.
-** The journal is deleted.
-**
-** This routine cannot fail unless some other process is not following
-** the correct locking protocol (SQLITE_PROTOCOL) or unless some other
-** process is writing trash into the journal file (SQLITE_CORRUPT) or
-** unless a prior malloc() failed (SQLITE_NOMEM). Appropriate error
-** codes are returned for all these occasions. Otherwise,
-** SQLITE_OK is returned.
-*/
-int sqlitepager_rollback(Pager *pPager){
- int rc;
- TRACE1("ROLLBACK\n");
- if( !pPager->dirtyFile || !pPager->journalOpen ){
- rc = pager_unwritelock(pPager);
- pPager->dbSize = -1;
- return rc;
- }
-
- if( pPager->errMask!=0 && pPager->errMask!=PAGER_ERR_FULL ){
- if( pPager->state>=SQLITE_WRITELOCK ){
- pager_playback(pPager, 1);
- }
- return pager_errcode(pPager);
- }
- if( pPager->state!=SQLITE_WRITELOCK ){
- return SQLITE_OK;
- }
- rc = pager_playback(pPager, 1);
- if( rc!=SQLITE_OK ){
- rc = SQLITE_CORRUPT;
- pPager->errMask |= PAGER_ERR_CORRUPT;
- }
- pPager->dbSize = -1;
- return rc;
-}
-
-/*
-** Return TRUE if the database file is opened read-only. Return FALSE
-** if the database is (in theory) writable.
-*/
-int sqlitepager_isreadonly(Pager *pPager){
- return pPager->readOnly;
-}
-
-/*
-** This routine is used for testing and analysis only.
-*/
-int *sqlitepager_stats(Pager *pPager){
- static int a[9];
- a[0] = pPager->nRef;
- a[1] = pPager->nPage;
- a[2] = pPager->mxPage;
- a[3] = pPager->dbSize;
- a[4] = pPager->state;
- a[5] = pPager->errMask;
- a[6] = pPager->nHit;
- a[7] = pPager->nMiss;
- a[8] = pPager->nOvfl;
- return a;
-}
-
-/*
-** Set the checkpoint.
-**
-** This routine should be called with the transaction journal already
-** open. A new checkpoint journal is created that can be used to rollback
-** changes of a single SQL command within a larger transaction.
-*/
-int sqlitepager_ckpt_begin(Pager *pPager){
- int rc;
- char zTemp[SQLITE_TEMPNAME_SIZE];
- if( !pPager->journalOpen ){
- pPager->ckptAutoopen = 1;
- return SQLITE_OK;
- }
- assert( pPager->journalOpen );
- assert( !pPager->ckptInUse );
- pPager->aInCkpt = sqliteMalloc( pPager->dbSize/8 + 1 );
- if( pPager->aInCkpt==0 ){
- sqliteOsReadLock(&pPager->fd);
- return SQLITE_NOMEM;
- }
-#ifndef NDEBUG
- rc = sqliteOsFileSize(&pPager->jfd, &pPager->ckptJSize);
- if( rc ) goto ckpt_begin_failed;
- assert( pPager->ckptJSize ==
- pPager->nRec*JOURNAL_PG_SZ(journal_format)+JOURNAL_HDR_SZ(journal_format) );
-#endif
- pPager->ckptJSize = pPager->nRec*JOURNAL_PG_SZ(journal_format)
- + JOURNAL_HDR_SZ(journal_format);
- pPager->ckptSize = pPager->dbSize;
- if( !pPager->ckptOpen ){
- rc = sqlitepager_opentemp(zTemp, &pPager->cpfd);
- if( rc ) goto ckpt_begin_failed;
- pPager->ckptOpen = 1;
- pPager->ckptNRec = 0;
- }
- pPager->ckptInUse = 1;
- return SQLITE_OK;
-
-ckpt_begin_failed:
- if( pPager->aInCkpt ){
- sqliteFree(pPager->aInCkpt);
- pPager->aInCkpt = 0;
- }
- return rc;
-}
-
-/*
-** Commit a checkpoint.
-*/
-int sqlitepager_ckpt_commit(Pager *pPager){
- if( pPager->ckptInUse ){
- PgHdr *pPg, *pNext;
- sqliteOsSeek(&pPager->cpfd, 0);
- /* sqliteOsTruncate(&pPager->cpfd, 0); */
- pPager->ckptNRec = 0;
- pPager->ckptInUse = 0;
- sqliteFree( pPager->aInCkpt );
- pPager->aInCkpt = 0;
- for(pPg=pPager->pCkpt; pPg; pPg=pNext){
- pNext = pPg->pNextCkpt;
- assert( pPg->inCkpt );
- pPg->inCkpt = 0;
- pPg->pPrevCkpt = pPg->pNextCkpt = 0;
- }
- pPager->pCkpt = 0;
- }
- pPager->ckptAutoopen = 0;
- return SQLITE_OK;
-}
-
-/*
-** Rollback a checkpoint.
-*/
-int sqlitepager_ckpt_rollback(Pager *pPager){
- int rc;
- if( pPager->ckptInUse ){
- rc = pager_ckpt_playback(pPager);
- sqlitepager_ckpt_commit(pPager);
- }else{
- rc = SQLITE_OK;
- }
- pPager->ckptAutoopen = 0;
- return rc;
-}
-
-/*
-** Return the full pathname of the database file.
-*/
-const char *sqlitepager_filename(Pager *pPager){
- return pPager->zFilename;
-}
-
-/*
-** Set the codec for this pager
-*/
-void sqlitepager_set_codec(
- Pager *pPager,
- void (*xCodec)(void*,void*,Pgno,int),
- void *pCodecArg
-){
- pPager->xCodec = xCodec;
- pPager->pCodecArg = pCodecArg;
-}
-
-#ifdef SQLITE_TEST
-/*
-** Print a listing of all referenced pages and their ref count.
-*/
-void sqlitepager_refdump(Pager *pPager){
- PgHdr *pPg;
- for(pPg=pPager->pAll; pPg; pPg=pPg->pNextAll){
- if( pPg->nRef<=0 ) continue;
- printf("PAGE %3d addr=0x%08x nRef=%d\n",
- pPg->pgno, (int)PGHDR_TO_DATA(pPg), pPg->nRef);
- }
-}
-#endif
+++ /dev/null
-/*
-** 2001 September 15
-**
-** The author disclaims copyright to this source code. In place of
-** a legal notice, here is a blessing:
-**
-** May you do good and not evil.
-** May you find forgiveness for yourself and forgive others.
-** May you share freely, never taking more than you give.
-**
-*************************************************************************
-** This header file defines the interface that the sqlite page cache
-** subsystem. The page cache subsystem reads and writes a file a page
-** at a time and provides a journal for rollback.
-**
-** @(#) $Id: pager.h,v 1.1.1.1 2004/08/08 15:03:57 matt Exp $
-*/
-
-/*
-** The size of one page
-**
-** You can change this value to another (reasonable) value you want.
-** It need not be a power of two, though the interface to the disk
-** will likely be faster if it is.
-**
-** Experiments show that a page size of 1024 gives the best speed
-** for common usages. The speed differences for different sizes
-** such as 512, 2048, 4096, an so forth, is minimal. Note, however,
-** that changing the page size results in a completely imcompatible
-** file format.
-*/
-#ifndef SQLITE_PAGE_SIZE
-#define SQLITE_PAGE_SIZE 1024
-#endif
-
-/*
-** Number of extra bytes of data allocated at the end of each page and
-** stored on disk but not used by the higher level btree layer. Changing
-** this value results in a completely incompatible file format.
-*/
-#ifndef SQLITE_PAGE_RESERVE
-#define SQLITE_PAGE_RESERVE 0
-#endif
-
-/*
-** The total number of usable bytes stored on disk for each page.
-** The usable bytes come at the beginning of the page and the reserve
-** bytes come at the end.
-*/
-#define SQLITE_USABLE_SIZE (SQLITE_PAGE_SIZE-SQLITE_PAGE_RESERVE)
-
-/*
-** Maximum number of pages in one database. (This is a limitation of
-** imposed by 4GB files size limits.)
-*/
-#define SQLITE_MAX_PAGE 1073741823
-
-/*
-** The type used to represent a page number. The first page in a file
-** is called page 1. 0 is used to represent "not a page".
-*/
-typedef unsigned int Pgno;
-
-/*
-** Each open file is managed by a separate instance of the "Pager" structure.
-*/
-typedef struct Pager Pager;
-
-/*
-** See source code comments for a detailed description of the following
-** routines:
-*/
-int sqlitepager_open(Pager **ppPager, const char *zFilename,
- int nPage, int nExtra, int useJournal);
-void sqlitepager_set_destructor(Pager*, void(*)(void*));
-void sqlitepager_set_cachesize(Pager*, int);
-int sqlitepager_close(Pager *pPager);
-int sqlitepager_get(Pager *pPager, Pgno pgno, void **ppPage);
-void *sqlitepager_lookup(Pager *pPager, Pgno pgno);
-int sqlitepager_ref(void*);
-int sqlitepager_unref(void*);
-Pgno sqlitepager_pagenumber(void*);
-int sqlitepager_write(void*);
-int sqlitepager_iswriteable(void*);
-int sqlitepager_overwrite(Pager *pPager, Pgno pgno, void*);
-int sqlitepager_pagecount(Pager*);
-int sqlitepager_truncate(Pager*,Pgno);
-int sqlitepager_begin(void*);
-int sqlitepager_commit(Pager*);
-int sqlitepager_rollback(Pager*);
-int sqlitepager_isreadonly(Pager*);
-int sqlitepager_ckpt_begin(Pager*);
-int sqlitepager_ckpt_commit(Pager*);
-int sqlitepager_ckpt_rollback(Pager*);
-void sqlitepager_dont_rollback(void*);
-void sqlitepager_dont_write(Pager*, Pgno);
-int *sqlitepager_stats(Pager*);
-void sqlitepager_set_safety_level(Pager*,int);
-const char *sqlitepager_filename(Pager*);
-int sqlitepager_rename(Pager*, const char *zNewName);
-void sqlitepager_set_codec(Pager*,void(*)(void*,void*,Pgno,int),void*);
-
-#ifdef SQLITE_TEST
-void sqlitepager_refdump(Pager*);
-int pager_refinfo_enable;
-int journal_format;
-#endif
+++ /dev/null
-/* Driver template for the LEMON parser generator.
-** The author disclaims copyright to this source code.
-*/
-/* First off, code is include which follows the "include" declaration
-** in the input file. */
-#include <stdio.h>
-#line 33 "parse.y"
-
-#include "sqliteInt.h"
-#include "parse.h"
-
-/*
-** An instance of this structure holds information about the
-** LIMIT clause of a SELECT statement.
-*/
-struct LimitVal {
- int limit; /* The LIMIT value. -1 if there is no limit */
- int offset; /* The OFFSET. 0 if there is none */
-};
-
-/*
-** An instance of the following structure describes the event of a
-** TRIGGER. "a" is the event type, one of TK_UPDATE, TK_INSERT,
-** TK_DELETE, or TK_INSTEAD. If the event is of the form
-**
-** UPDATE ON (a,b,c)
-**
-** Then the "b" IdList records the list "a,b,c".
-*/
-struct TrigEvent { int a; IdList * b; };
-
-
-#line 34 "parse.c"
-/* Next is all token values, in a form suitable for use by makeheaders.
-** This section will be null unless lemon is run with the -m switch.
-*/
-/*
-** These constants (all generated automatically by the parser generator)
-** specify the various kinds of tokens (terminals) that the parser
-** understands.
-**
-** Each symbol here is a terminal symbol in the grammar.
-*/
-/* Make sure the INTERFACE macro is defined.
-*/
-#ifndef INTERFACE
-# define INTERFACE 1
-#endif
-/* The next thing included is series of defines which control
-** various aspects of the generated parser.
-** YYCODETYPE is the data type used for storing terminal
-** and nonterminal numbers. "unsigned char" is
-** used if there are fewer than 250 terminals
-** and nonterminals. "int" is used otherwise.
-** YYNOCODE is a number of type YYCODETYPE which corresponds
-** to no legal terminal or nonterminal number. This
-** number is used to fill in empty slots of the hash
-** table.
-** YYFALLBACK If defined, this indicates that one or more tokens
-** have fall-back values which should be used if the
-** original value of the token will not parse.
-** YYACTIONTYPE is the data type used for storing terminal
-** and nonterminal numbers. "unsigned char" is
-** used if there are fewer than 250 rules and
-** states combined. "int" is used otherwise.
-** sqliteParserTOKENTYPE is the data type used for minor tokens given
-** directly to the parser from the tokenizer.
-** YYMINORTYPE is the data type used for all minor tokens.
-** This is typically a union of many types, one of
-** which is sqliteParserTOKENTYPE. The entry in the union
-** for base tokens is called "yy0".
-** YYSTACKDEPTH is the maximum depth of the parser's stack.
-** sqliteParserARG_SDECL A static variable declaration for the %extra_argument
-** sqliteParserARG_PDECL A parameter declaration for the %extra_argument
-** sqliteParserARG_STORE Code to store %extra_argument into yypParser
-** sqliteParserARG_FETCH Code to extract %extra_argument from yypParser
-** YYNSTATE the combined number of states.
-** YYNRULE the number of rules in the grammar
-** YYERRORSYMBOL is the code number of the error symbol. If not
-** defined, then do no error processing.
-*/
-/* \ 1 */
-#define YYCODETYPE unsigned char
-#define YYNOCODE 221
-#define YYACTIONTYPE unsigned short int
-#define sqliteParserTOKENTYPE Token
-typedef union {
- sqliteParserTOKENTYPE yy0;
- TriggerStep * yy19;
- struct LimitVal yy124;
- Select* yy179;
- Expr * yy182;
- Expr* yy242;
- struct TrigEvent yy290;
- Token yy298;
- SrcList* yy307;
- IdList* yy320;
- ExprList* yy322;
- int yy372;
- struct {int value; int mask;} yy407;
- int yy441;
-} YYMINORTYPE;
-#define YYSTACKDEPTH 100
-#define sqliteParserARG_SDECL Parse *pParse;
-#define sqliteParserARG_PDECL ,Parse *pParse
-#define sqliteParserARG_FETCH Parse *pParse = yypParser->pParse
-#define sqliteParserARG_STORE yypParser->pParse = pParse
-#define YYNSTATE 563
-#define YYNRULE 293
-#define YYERRORSYMBOL 131
-#define YYERRSYMDT yy441
-#define YYFALLBACK 1
-#define YY_NO_ACTION (YYNSTATE+YYNRULE+2)
-#define YY_ACCEPT_ACTION (YYNSTATE+YYNRULE+1)
-#define YY_ERROR_ACTION (YYNSTATE+YYNRULE)
-
-/* Next are that tables used to determine what action to take based on the
-** current state and lookahead token. These tables are used to implement
-** functions that take a state number and lookahead value and return an
-** action integer.
-**
-** Suppose the action integer is N. Then the action is determined as
-** follows
-**
-** 0 <= N < YYNSTATE Shift N. That is, push the lookahead
-** token onto the stack and goto state N.
-**
-** YYNSTATE <= N < YYNSTATE+YYNRULE Reduce by rule N-YYNSTATE.
-**
-** N == YYNSTATE+YYNRULE A syntax error has occurred.
-**
-** N == YYNSTATE+YYNRULE+1 The parser accepts its input.
-**
-** N == YYNSTATE+YYNRULE+2 No such action. Denotes unused
-** slots in the yy_action[] table.
-**
-** The action table is constructed as a single large table named yy_action[].
-** Given state S and lookahead X, the action is computed as
-**
-** yy_action[ yy_shift_ofst[S] + X ]
-**
-** If the index value yy_shift_ofst[S]+X is out of range or if the value
-** yy_lookahead[yy_shift_ofst[S]+X] is not equal to X or if yy_shift_ofst[S]
-** is equal to YY_SHIFT_USE_DFLT, it means that the action is not in the table
-** and that yy_default[S] should be used instead.
-**
-** The formula above is for computing the action when the lookahead is
-** a terminal symbol. If the lookahead is a non-terminal (as occurs after
-** a reduce action) then the yy_reduce_ofst[] array is used in place of
-** the yy_shift_ofst[] array and YY_REDUCE_USE_DFLT is used in place of
-** YY_SHIFT_USE_DFLT.
-**
-** The following are the tables generated in this section:
-**
-** yy_action[] A single table containing all actions.
-** yy_lookahead[] A table containing the lookahead for each entry in
-** yy_action. Used to detect hash collisions.
-** yy_shift_ofst[] For each state, the offset into yy_action for
-** shifting terminals.
-** yy_reduce_ofst[] For each state, the offset into yy_action for
-** shifting non-terminals after a reduce.
-** yy_default[] Default action for each state.
-*/
-static YYACTIONTYPE yy_action[] = {
- /* 0 */ 264, 106, 262, 119, 123, 117, 121, 129, 131, 133,
- /* 10 */ 135, 144, 146, 148, 150, 152, 154, 844, 426, 174,
- /* 20 */ 143, 425, 2, 3, 839, 142, 129, 131, 133, 135,
- /* 30 */ 144, 146, 148, 150, 152, 154, 247, 837, 427, 115,
- /* 40 */ 104, 139, 127, 125, 156, 161, 157, 162, 166, 119,
- /* 50 */ 123, 117, 121, 129, 131, 133, 135, 144, 146, 148,
- /* 60 */ 150, 152, 154, 448, 361, 218, 263, 143, 363, 369,
- /* 70 */ 374, 137, 142, 144, 146, 148, 150, 152, 154, 377,
- /* 80 */ 857, 1, 562, 3, 396, 327, 115, 104, 139, 127,
- /* 90 */ 125, 156, 161, 157, 162, 166, 119, 123, 117, 121,
- /* 100 */ 129, 131, 133, 135, 144, 146, 148, 150, 152, 154,
- /* 110 */ 482, 454, 444, 106, 143, 169, 20, 171, 172, 142,
- /* 120 */ 310, 73, 4, 6, 402, 68, 398, 29, 248, 64,
- /* 130 */ 46, 174, 497, 115, 104, 139, 127, 125, 156, 161,
- /* 140 */ 157, 162, 166, 119, 123, 117, 121, 129, 131, 133,
- /* 150 */ 135, 144, 146, 148, 150, 152, 154, 69, 193, 65,
- /* 160 */ 101, 44, 54, 60, 62, 308, 331, 244, 175, 106,
- /* 170 */ 20, 357, 333, 173, 640, 70, 359, 219, 36, 37,
- /* 180 */ 21, 22, 510, 143, 181, 179, 303, 299, 142, 31,
- /* 190 */ 20, 392, 177, 66, 67, 111, 358, 390, 112, 105,
- /* 200 */ 69, 191, 115, 104, 139, 127, 125, 156, 161, 157,
- /* 210 */ 162, 166, 119, 123, 117, 121, 129, 131, 133, 135,
- /* 220 */ 144, 146, 148, 150, 152, 154, 388, 312, 73, 688,
- /* 230 */ 306, 113, 183, 387, 21, 22, 230, 361, 52, 106,
- /* 240 */ 20, 363, 369, 374, 361, 544, 542, 53, 363, 369,
- /* 250 */ 374, 143, 377, 591, 21, 22, 142, 212, 338, 377,
- /* 260 */ 169, 38, 171, 172, 356, 348, 535, 46, 534, 792,
- /* 270 */ 115, 104, 139, 127, 125, 156, 161, 157, 162, 166,
- /* 280 */ 119, 123, 117, 121, 129, 131, 133, 135, 144, 146,
- /* 290 */ 148, 150, 152, 154, 790, 41, 336, 298, 44, 54,
- /* 300 */ 60, 62, 308, 331, 21, 22, 197, 167, 20, 333,
- /* 310 */ 58, 20, 395, 340, 343, 201, 169, 809, 171, 172,
- /* 320 */ 59, 143, 337, 311, 339, 281, 142, 346, 347, 20,
- /* 330 */ 205, 20, 639, 195, 35, 536, 537, 538, 842, 45,
- /* 340 */ 115, 104, 139, 127, 125, 156, 161, 157, 162, 166,
- /* 350 */ 119, 123, 117, 121, 129, 131, 133, 135, 144, 146,
- /* 360 */ 148, 150, 152, 154, 300, 276, 148, 150, 152, 154,
- /* 370 */ 71, 106, 21, 22, 430, 21, 22, 20, 443, 791,
- /* 380 */ 441, 106, 40, 335, 169, 143, 171, 172, 330, 305,
- /* 390 */ 142, 84, 86, 21, 22, 21, 22, 10, 572, 174,
- /* 400 */ 254, 18, 83, 69, 115, 104, 139, 127, 125, 156,
- /* 410 */ 161, 157, 162, 166, 119, 123, 117, 121, 129, 131,
- /* 420 */ 133, 135, 144, 146, 148, 150, 152, 154, 467, 106,
- /* 430 */ 661, 275, 143, 720, 295, 301, 169, 142, 171, 172,
- /* 440 */ 539, 21, 22, 487, 449, 219, 459, 103, 232, 451,
- /* 450 */ 282, 115, 104, 139, 127, 125, 156, 161, 157, 162,
- /* 460 */ 166, 119, 123, 117, 121, 129, 131, 133, 135, 144,
- /* 470 */ 146, 148, 150, 152, 154, 69, 417, 419, 418, 143,
- /* 480 */ 95, 237, 312, 494, 142, 489, 47, 283, 259, 75,
- /* 490 */ 10, 68, 189, 284, 209, 64, 289, 49, 115, 104,
- /* 500 */ 139, 127, 125, 156, 161, 157, 162, 166, 119, 123,
- /* 510 */ 117, 121, 129, 131, 133, 135, 144, 146, 148, 150,
- /* 520 */ 152, 154, 196, 297, 193, 357, 429, 296, 169, 32,
- /* 530 */ 171, 172, 391, 37, 175, 169, 276, 171, 172, 313,
- /* 540 */ 316, 323, 325, 663, 106, 689, 245, 251, 143, 651,
- /* 550 */ 181, 179, 292, 142, 386, 583, 491, 690, 177, 66,
- /* 560 */ 67, 111, 184, 437, 112, 105, 213, 115, 164, 139,
- /* 570 */ 127, 125, 156, 161, 157, 162, 166, 119, 123, 117,
- /* 580 */ 121, 129, 131, 133, 135, 144, 146, 148, 150, 152,
- /* 590 */ 154, 315, 726, 20, 106, 143, 333, 113, 183, 563,
- /* 600 */ 142, 43, 278, 440, 170, 185, 330, 666, 560, 561,
- /* 610 */ 249, 259, 103, 253, 115, 104, 139, 127, 125, 156,
- /* 620 */ 161, 157, 162, 166, 119, 123, 117, 121, 129, 131,
- /* 630 */ 133, 135, 144, 146, 148, 150, 152, 154, 800, 10,
- /* 640 */ 252, 169, 143, 171, 172, 445, 97, 142, 560, 561,
- /* 650 */ 216, 221, 217, 169, 313, 171, 172, 21, 22, 42,
- /* 660 */ 159, 115, 227, 139, 127, 125, 156, 161, 157, 162,
- /* 670 */ 166, 119, 123, 117, 121, 129, 131, 133, 135, 144,
- /* 680 */ 146, 148, 150, 152, 154, 256, 73, 106, 816, 143,
- /* 690 */ 169, 158, 171, 172, 142, 234, 397, 217, 545, 475,
- /* 700 */ 273, 302, 274, 217, 266, 481, 315, 96, 653, 104,
- /* 710 */ 139, 127, 125, 156, 161, 157, 162, 166, 119, 123,
- /* 720 */ 117, 121, 129, 131, 133, 135, 144, 146, 148, 150,
- /* 730 */ 152, 154, 106, 349, 291, 262, 143, 262, 264, 74,
- /* 740 */ 262, 142, 533, 464, 320, 477, 319, 329, 341, 274,
- /* 750 */ 481, 342, 137, 415, 416, 321, 266, 139, 127, 125,
- /* 760 */ 156, 161, 157, 162, 166, 119, 123, 117, 121, 129,
- /* 770 */ 131, 133, 135, 144, 146, 148, 150, 152, 154, 7,
- /* 780 */ 322, 23, 25, 27, 394, 68, 267, 13, 393, 64,
- /* 790 */ 518, 251, 106, 836, 344, 548, 14, 345, 458, 263,
- /* 800 */ 520, 263, 106, 91, 263, 557, 266, 314, 168, 106,
- /* 810 */ 462, 15, 443, 69, 16, 231, 276, 106, 193, 531,
- /* 820 */ 174, 448, 276, 106, 276, 17, 529, 174, 175, 318,
- /* 830 */ 106, 89, 106, 69, 276, 114, 286, 69, 68, 399,
- /* 840 */ 69, 116, 64, 328, 181, 179, 106, 106, 118, 366,
- /* 850 */ 163, 272, 177, 66, 67, 111, 215, 253, 112, 105,
- /* 860 */ 276, 371, 467, 233, 120, 375, 219, 143, 498, 503,
- /* 870 */ 444, 193, 142, 219, 486, 720, 401, 73, 453, 73,
- /* 880 */ 420, 175, 278, 451, 252, 400, 106, 380, 278, 68,
- /* 890 */ 278, 113, 183, 64, 225, 229, 106, 181, 179, 106,
- /* 900 */ 278, 69, 106, 106, 122, 177, 66, 67, 111, 411,
- /* 910 */ 106, 112, 105, 106, 124, 106, 106, 126, 106, 224,
- /* 920 */ 128, 130, 193, 106, 106, 106, 278, 351, 132, 352,
- /* 930 */ 831, 134, 175, 136, 138, 422, 141, 106, 367, 376,
- /* 940 */ 274, 145, 147, 149, 113, 183, 793, 690, 181, 179,
- /* 950 */ 106, 424, 106, 106, 424, 151, 177, 66, 67, 111,
- /* 960 */ 106, 106, 112, 105, 106, 106, 808, 106, 153, 106,
- /* 970 */ 155, 165, 106, 106, 106, 106, 106, 464, 176, 178,
- /* 980 */ 852, 106, 180, 182, 106, 190, 293, 192, 245, 106,
- /* 990 */ 210, 214, 226, 228, 241, 113, 183, 106, 474, 246,
- /* 1000 */ 137, 690, 280, 372, 290, 274, 381, 412, 274, 106,
- /* 1010 */ 471, 221, 832, 421, 438, 466, 274, 472, 480, 422,
- /* 1020 */ 478, 73, 515, 69, 519, 255, 478, 479, 221, 690,
- /* 1030 */ 540, 527, 508, 541, 516, 85, 39, 403, 406, 257,
- /* 1040 */ 317, 404, 198, 407, 405, 221, 408, 69, 413, 5,
- /* 1050 */ 824, 221, 211, 409, 817, 410, 546, 582, 258, 414,
- /* 1060 */ 90, 547, 199, 260, 223, 829, 830, 261, 324, 200,
- /* 1070 */ 815, 72, 34, 526, 222, 186, 423, 326, 94, 57,
- /* 1080 */ 428, 56, 187, 188, 265, 202, 431, 554, 332, 88,
- /* 1090 */ 33, 432, 433, 434, 279, 268, 436, 556, 435, 51,
- /* 1100 */ 578, 30, 549, 270, 439, 798, 334, 269, 799, 203,
- /* 1110 */ 442, 577, 204, 271, 28, 550, 447, 812, 446, 98,
- /* 1120 */ 532, 450, 727, 728, 823, 452, 819, 576, 26, 81,
- /* 1130 */ 82, 445, 235, 838, 80, 457, 575, 463, 461, 455,
- /* 1140 */ 24, 456, 551, 93, 813, 460, 277, 840, 465, 528,
- /* 1150 */ 79, 206, 807, 468, 469, 593, 470, 55, 552, 473,
- /* 1160 */ 350, 820, 355, 850, 592, 476, 250, 19, 207, 553,
- /* 1170 */ 353, 354, 841, 285, 236, 814, 484, 555, 287, 483,
- /* 1180 */ 843, 208, 660, 485, 488, 389, 63, 490, 662, 360,
- /* 1190 */ 492, 288, 851, 100, 806, 849, 495, 493, 362, 496,
- /* 1200 */ 92, 499, 719, 364, 240, 238, 500, 365, 501, 502,
- /* 1210 */ 239, 294, 504, 505, 507, 506, 568, 61, 11, 722,
- /* 1220 */ 108, 368, 571, 511, 12, 517, 512, 9, 8, 559,
- /* 1230 */ 370, 514, 725, 509, 50, 558, 373, 78, 243, 217,
- /* 1240 */ 18, 242, 818, 521, 77, 513, 110, 543, 855, 109,
- /* 1250 */ 522, 154, 245, 524, 107, 379, 378, 160, 523, 87,
- /* 1260 */ 194, 385, 48, 304, 530, 383, 382, 140, 76, 811,
- /* 1270 */ 99, 384, 525, 220, 810, 515, 49, 102, 515, 307,
- /* 1280 */ 515, 515, 309, 515, 515, 667, 668, 669,
-};
-static YYCODETYPE yy_lookahead[] = {
- /* 0 */ 21, 140, 23, 70, 71, 72, 73, 74, 75, 76,
- /* 10 */ 77, 78, 79, 80, 81, 82, 83, 9, 25, 158,
- /* 20 */ 41, 28, 134, 135, 14, 46, 74, 75, 76, 77,
- /* 30 */ 78, 79, 80, 81, 82, 83, 22, 11, 45, 60,
- /* 40 */ 61, 62, 63, 64, 65, 66, 67, 68, 69, 70,
- /* 50 */ 71, 72, 73, 74, 75, 76, 77, 78, 79, 80,
- /* 60 */ 81, 82, 83, 53, 90, 204, 87, 41, 94, 95,
- /* 70 */ 96, 200, 46, 78, 79, 80, 81, 82, 83, 105,
- /* 80 */ 132, 133, 134, 135, 17, 19, 60, 61, 62, 63,
- /* 90 */ 64, 65, 66, 67, 68, 69, 70, 71, 72, 73,
- /* 100 */ 74, 75, 76, 77, 78, 79, 80, 81, 82, 83,
- /* 110 */ 100, 101, 102, 140, 41, 107, 23, 109, 110, 46,
- /* 120 */ 159, 111, 136, 137, 57, 19, 59, 141, 114, 23,
- /* 130 */ 62, 158, 146, 60, 61, 62, 63, 64, 65, 66,
- /* 140 */ 67, 68, 69, 70, 71, 72, 73, 74, 75, 76,
- /* 150 */ 77, 78, 79, 80, 81, 82, 83, 171, 52, 19,
- /* 160 */ 23, 93, 94, 95, 96, 97, 98, 194, 62, 140,
- /* 170 */ 23, 140, 104, 20, 20, 146, 22, 204, 147, 148,
- /* 180 */ 87, 88, 196, 41, 78, 79, 80, 158, 46, 19,
- /* 190 */ 23, 21, 86, 87, 88, 89, 165, 166, 92, 93,
- /* 200 */ 171, 128, 60, 61, 62, 63, 64, 65, 66, 67,
- /* 210 */ 68, 69, 70, 71, 72, 73, 74, 75, 76, 77,
- /* 220 */ 78, 79, 80, 81, 82, 83, 161, 162, 111, 20,
- /* 230 */ 20, 125, 126, 168, 87, 88, 19, 90, 34, 140,
- /* 240 */ 23, 94, 95, 96, 90, 78, 79, 43, 94, 95,
- /* 250 */ 96, 41, 105, 113, 87, 88, 46, 158, 23, 105,
- /* 260 */ 107, 149, 109, 110, 152, 153, 99, 62, 140, 127,
- /* 270 */ 60, 61, 62, 63, 64, 65, 66, 67, 68, 69,
- /* 280 */ 70, 71, 72, 73, 74, 75, 76, 77, 78, 79,
- /* 290 */ 80, 81, 82, 83, 14, 90, 91, 20, 93, 94,
- /* 300 */ 95, 96, 97, 98, 87, 88, 15, 19, 23, 104,
- /* 310 */ 26, 23, 143, 78, 79, 24, 107, 9, 109, 110,
- /* 320 */ 36, 41, 87, 160, 89, 19, 46, 92, 93, 23,
- /* 330 */ 39, 23, 20, 42, 22, 207, 208, 209, 9, 139,
- /* 340 */ 60, 61, 62, 63, 64, 65, 66, 67, 68, 69,
- /* 350 */ 70, 71, 72, 73, 74, 75, 76, 77, 78, 79,
- /* 360 */ 80, 81, 82, 83, 20, 140, 80, 81, 82, 83,
- /* 370 */ 172, 140, 87, 88, 205, 87, 88, 23, 146, 14,
- /* 380 */ 211, 140, 155, 156, 107, 41, 109, 110, 161, 158,
- /* 390 */ 46, 78, 79, 87, 88, 87, 88, 99, 9, 158,
- /* 400 */ 115, 12, 89, 171, 60, 61, 62, 63, 64, 65,
- /* 410 */ 66, 67, 68, 69, 70, 71, 72, 73, 74, 75,
- /* 420 */ 76, 77, 78, 79, 80, 81, 82, 83, 196, 140,
- /* 430 */ 9, 206, 41, 9, 80, 194, 107, 46, 109, 110,
- /* 440 */ 210, 87, 88, 17, 212, 204, 22, 158, 20, 217,
- /* 450 */ 146, 60, 61, 62, 63, 64, 65, 66, 67, 68,
- /* 460 */ 69, 70, 71, 72, 73, 74, 75, 76, 77, 78,
- /* 470 */ 79, 80, 81, 82, 83, 171, 100, 101, 102, 41,
- /* 480 */ 191, 192, 162, 57, 46, 59, 93, 183, 184, 174,
- /* 490 */ 99, 19, 127, 189, 129, 23, 181, 104, 60, 61,
- /* 500 */ 62, 63, 64, 65, 66, 67, 68, 69, 70, 71,
- /* 510 */ 72, 73, 74, 75, 76, 77, 78, 79, 80, 81,
- /* 520 */ 82, 83, 20, 108, 52, 140, 18, 112, 107, 144,
- /* 530 */ 109, 110, 147, 148, 62, 107, 140, 109, 110, 47,
- /* 540 */ 100, 101, 102, 9, 140, 20, 122, 22, 41, 9,
- /* 550 */ 78, 79, 80, 46, 62, 9, 130, 19, 86, 87,
- /* 560 */ 88, 89, 158, 167, 92, 93, 128, 60, 61, 62,
- /* 570 */ 63, 64, 65, 66, 67, 68, 69, 70, 71, 72,
- /* 580 */ 73, 74, 75, 76, 77, 78, 79, 80, 81, 82,
- /* 590 */ 83, 99, 9, 23, 140, 41, 104, 125, 126, 0,
- /* 600 */ 46, 156, 206, 95, 108, 201, 161, 111, 9, 10,
- /* 610 */ 183, 184, 158, 88, 60, 61, 62, 63, 64, 65,
- /* 620 */ 66, 67, 68, 69, 70, 71, 72, 73, 74, 75,
- /* 630 */ 76, 77, 78, 79, 80, 81, 82, 83, 130, 99,
- /* 640 */ 115, 107, 41, 109, 110, 60, 192, 46, 9, 10,
- /* 650 */ 20, 113, 22, 107, 47, 109, 110, 87, 88, 140,
- /* 660 */ 62, 60, 61, 62, 63, 64, 65, 66, 67, 68,
- /* 670 */ 69, 70, 71, 72, 73, 74, 75, 76, 77, 78,
- /* 680 */ 79, 80, 81, 82, 83, 115, 111, 140, 9, 41,
- /* 690 */ 107, 93, 109, 110, 46, 20, 140, 22, 19, 124,
- /* 700 */ 20, 20, 22, 22, 152, 158, 99, 22, 123, 61,
- /* 710 */ 62, 63, 64, 65, 66, 67, 68, 69, 70, 71,
- /* 720 */ 72, 73, 74, 75, 76, 77, 78, 79, 80, 81,
- /* 730 */ 82, 83, 140, 19, 182, 23, 41, 23, 21, 173,
- /* 740 */ 23, 46, 63, 140, 91, 198, 93, 20, 89, 22,
- /* 750 */ 158, 92, 200, 55, 56, 29, 152, 62, 63, 64,
- /* 760 */ 65, 66, 67, 68, 69, 70, 71, 72, 73, 74,
- /* 770 */ 75, 76, 77, 78, 79, 80, 81, 82, 83, 11,
- /* 780 */ 54, 13, 14, 15, 16, 19, 182, 15, 146, 23,
- /* 790 */ 198, 22, 140, 11, 89, 27, 24, 92, 195, 87,
- /* 800 */ 32, 87, 140, 22, 87, 37, 152, 140, 146, 140,
- /* 810 */ 158, 39, 146, 171, 42, 146, 140, 140, 52, 51,
- /* 820 */ 158, 53, 140, 140, 140, 53, 58, 158, 62, 103,
- /* 830 */ 140, 50, 140, 171, 140, 158, 182, 171, 19, 140,
- /* 840 */ 171, 158, 23, 167, 78, 79, 140, 140, 158, 167,
- /* 850 */ 158, 167, 86, 87, 88, 89, 194, 88, 92, 93,
- /* 860 */ 140, 167, 196, 194, 158, 158, 204, 41, 100, 101,
- /* 870 */ 102, 52, 46, 204, 106, 9, 146, 111, 212, 111,
- /* 880 */ 49, 62, 206, 217, 115, 21, 140, 167, 206, 19,
- /* 890 */ 206, 125, 126, 23, 68, 69, 140, 78, 79, 140,
- /* 900 */ 206, 171, 140, 140, 158, 86, 87, 88, 89, 127,
- /* 910 */ 140, 92, 93, 140, 158, 140, 140, 158, 140, 93,
- /* 920 */ 158, 158, 52, 140, 140, 140, 206, 20, 158, 22,
- /* 930 */ 99, 158, 62, 158, 158, 22, 158, 140, 20, 139,
- /* 940 */ 22, 158, 158, 158, 125, 126, 127, 9, 78, 79,
- /* 950 */ 140, 140, 140, 140, 140, 158, 86, 87, 88, 89,
- /* 960 */ 140, 140, 92, 93, 140, 140, 9, 140, 158, 140,
- /* 970 */ 158, 158, 140, 140, 140, 140, 140, 140, 158, 158,
- /* 980 */ 9, 140, 158, 158, 140, 158, 140, 158, 122, 140,
- /* 990 */ 158, 158, 158, 158, 158, 125, 126, 140, 146, 158,
- /* 1000 */ 200, 103, 158, 20, 158, 22, 20, 158, 22, 140,
- /* 1010 */ 199, 113, 99, 199, 20, 158, 22, 20, 20, 22,
- /* 1020 */ 22, 111, 146, 171, 20, 140, 22, 158, 113, 114,
- /* 1030 */ 89, 35, 195, 92, 124, 89, 150, 140, 99, 140,
- /* 1040 */ 163, 213, 22, 140, 214, 113, 186, 171, 40, 9,
- /* 1050 */ 11, 113, 127, 215, 9, 216, 140, 9, 115, 38,
- /* 1060 */ 154, 20, 140, 140, 186, 99, 99, 186, 163, 20,
- /* 1070 */ 9, 171, 20, 116, 140, 202, 140, 163, 118, 139,
- /* 1080 */ 49, 157, 203, 14, 140, 22, 130, 116, 151, 154,
- /* 1090 */ 145, 140, 99, 140, 99, 187, 19, 33, 186, 44,
- /* 1100 */ 9, 142, 218, 116, 139, 9, 164, 188, 130, 140,
- /* 1110 */ 11, 9, 20, 19, 138, 152, 169, 9, 170, 193,
- /* 1120 */ 152, 14, 123, 123, 9, 9, 9, 9, 138, 180,
- /* 1130 */ 121, 60, 140, 14, 179, 103, 9, 176, 63, 169,
- /* 1140 */ 138, 140, 21, 117, 9, 140, 157, 9, 63, 87,
- /* 1150 */ 178, 22, 9, 123, 140, 113, 19, 48, 140, 197,
- /* 1160 */ 154, 9, 152, 9, 113, 19, 185, 140, 140, 219,
- /* 1170 */ 154, 20, 9, 20, 186, 9, 140, 152, 187, 114,
- /* 1180 */ 9, 20, 9, 176, 140, 166, 19, 140, 9, 166,
- /* 1190 */ 140, 188, 9, 98, 9, 9, 140, 186, 140, 186,
- /* 1200 */ 154, 114, 9, 48, 120, 193, 140, 19, 186, 176,
- /* 1210 */ 157, 113, 169, 140, 103, 186, 9, 139, 31, 9,
- /* 1220 */ 140, 139, 9, 123, 170, 19, 140, 139, 138, 140,
- /* 1230 */ 19, 197, 9, 176, 164, 218, 139, 177, 118, 22,
- /* 1240 */ 12, 119, 9, 169, 176, 186, 140, 210, 9, 113,
- /* 1250 */ 140, 83, 122, 114, 113, 19, 48, 93, 186, 89,
- /* 1260 */ 19, 160, 139, 20, 140, 140, 97, 200, 175, 9,
- /* 1270 */ 157, 159, 140, 140, 9, 220, 104, 151, 220, 139,
- /* 1280 */ 220, 220, 140, 220, 220, 111, 111, 111,
-};
-#define YY_SHIFT_USE_DFLT (-68)
-static short yy_shift_ofst[] = {
- /* 0 */ 639, 599, -68, 768, 1040, -68, 1207, 1228, 540, 1213,
- /* 10 */ 1187, 772, -68, -68, -68, -68, -68, -68, 93, -68,
- /* 20 */ -68, -68, -68, 389, 1127, 389, 1118, 389, 1102, 170,
- /* 30 */ 1091, 93, 312, 1052, 1048, 147, -68, 712, -68, 205,
- /* 40 */ -68, 93, 68, -68, 298, -68, 393, 298, -68, 1055,
- /* 50 */ -68, 204, -68, -68, 1109, 284, 298, -68, -68, -68,
- /* 60 */ 298, -68, 1167, 870, 140, 106, 1051, 1042, 766, -68,
- /* 70 */ 277, 117, -68, 415, -68, 14, 1130, 1122, 1084, 1026,
- /* 80 */ 1009, -68, 313, -68, 946, -68, 1170, -68, 781, 313,
- /* 90 */ -68, 313, -68, 960, 870, 685, 870, 1095, 284, -68,
- /* 100 */ 137, -68, -68, 554, 870, -68, 1141, 93, 1136, 93,
- /* 110 */ -68, -68, -68, -68, 695, 870, 648, 870, -48, 870,
- /* 120 */ -48, 870, -48, 870, -48, 870, -67, 870, -67, 870,
- /* 130 */ -5, 870, -5, 870, -5, 870, -5, 870, -67, 826,
- /* 140 */ 870, -67, -68, -68, 870, 286, 870, 286, 870, 1168,
- /* 150 */ 870, 1168, 870, 1168, 870, -68, -68, 598, -68, 1164,
- /* 160 */ -68, -68, 870, 507, 870, -67, 288, 766, 153, 496,
- /* 170 */ 1174, 1175, 1176, -68, 554, 870, 695, 870, -68, 870,
- /* 180 */ -68, 870, -68, 819, 142, 925, 365, 1069, -68, 870,
- /* 190 */ 73, 870, 554, 1241, 291, 502, -68, 1020, 93, 1049,
- /* 200 */ -68, 1063, 93, 1092, -68, 1129, 93, 1161, -68, 870,
- /* 210 */ 280, 870, 438, 870, 554, 630, -68, 870, -68, -68,
- /* 220 */ 932, 93, -68, -68, -68, 870, 601, 870, 695, 217,
- /* 230 */ 766, 428, -68, 675, -68, 932, -68, 1095, 284, -68,
- /* 240 */ 870, 554, 1120, 870, 1217, 870, 554, -68, -68, 769,
- /* 250 */ -68, -68, -68, 285, -68, 570, -68, 943, -68, 306,
- /* 260 */ 932, 717, -68, -68, 93, -68, -68, 995, 987, -68,
- /* 270 */ 1094, 93, 680, -68, 93, -68, 284, -68, -68, 870,
- /* 280 */ 554, 117, 209, 525, 1153, 717, 995, 987, -68, 472,
- /* 290 */ -21, -68, -68, 1098, 354, -68, -68, -68, -68, 344,
- /* 300 */ -68, 681, -68, 1243, -68, 210, 298, -68, 93, 66,
- /* 310 */ -68, 607, -68, 93, -68, 440, 726, -68, 653, -68,
- /* 320 */ -68, -68, -68, 726, -68, 726, -68, 93, 727, -68,
- /* 330 */ -68, 137, -68, 1055, -68, -68, 235, -68, -68, -68,
- /* 340 */ 659, -68, -68, 705, -68, -68, -68, -68, 714, 313,
- /* 350 */ 907, -68, 313, 1151, -68, -68, -68, -68, 154, -26,
- /* 360 */ -68, 93, -68, 1155, 1188, 93, 918, 298, -68, 1211,
- /* 370 */ 93, 983, 298, -68, 870, 391, -68, 1208, 1236, 93,
- /* 380 */ 986, 1169, 93, 66, -68, 492, 1172, -68, -68, -68,
- /* 390 */ -68, -68, 117, 546, 508, 67, 93, -68, 93, 864,
- /* 400 */ 117, 421, 93, -7, 376, 939, 93, 932, 1008, 782,
- /* 410 */ 1039, 870, 26, 1021, 698, -68, -68, 966, 967, 831,
- /* 420 */ 93, 913, 93, -68, -68, -68, -68, 1031, -68, -68,
- /* 430 */ 956, 93, 993, 93, 538, 1077, 93, 994, 540, 1096,
- /* 440 */ 978, 1099, 10, 8, 585, 772, -68, 999, 1000, 1107,
- /* 450 */ 1115, 1116, 10, 1119, 1071, 93, 1032, 93, 424, 93,
- /* 460 */ 1075, 870, 554, 1138, 1085, 870, 554, 1030, 93, 1137,
- /* 470 */ 93, 997, -68, 575, 329, 1146, 870, 998, 870, 554,
- /* 480 */ 1163, 554, 1065, 93, 866, 1171, 426, 93, 1173, 93,
- /* 490 */ 1179, 93, 938, 1185, 93, 938, 1186, 534, 1087, 93,
- /* 500 */ 932, 866, 1193, 1071, 93, 898, 1111, 93, 424, 1210,
- /* 510 */ 1100, 93, 932, 1137, 910, 583, 1206, 870, 1004, 1223,
- /* 520 */ 1071, 93, 915, 1139, 93, 957, 996, 1062, 1143, 308,
- /* 530 */ 1265, 712, 679, 167, 1260, 1108, 1135, 1166, 941, 1045,
- /* 540 */ 1117, 1152, 941, 1233, -68, 93, 1041, 1061, 1064, 712,
- /* 550 */ 1121, 93, 971, 1154, 712, 1183, -68, 1064, 93, 1239,
- /* 560 */ -68, -68, -68,
-};
-#define YY_REDUCE_USE_DFLT (-140)
-static short yy_reduce_ofst[] = {
- /* 0 */ -52, -112, -140, -14, -140, -140, -140, 1090, 1088, -140,
- /* 10 */ -140, 1054, -140, -140, -140, -140, -140, -140, 1027, -140,
- /* 20 */ -140, -140, -140, 1002, -140, 990, -140, 976, -140, 959,
- /* 30 */ -140, 385, 945, -140, -140, 31, -140, 112, 886, 227,
- /* 40 */ -140, 519, 445, -140, 200, -140, -140, 1123, -140, 1070,
- /* 50 */ -140, -140, -140, -140, -140, 924, 940, -140, -140, -140,
- /* 60 */ 1078, -140, -140, 231, -140, 241, -140, -140, 29, -140,
- /* 70 */ 198, 900, -140, 566, 315, 1093, 1068, 1060, 972, 955,
- /* 80 */ 949, -140, 935, -140, -140, -140, -140, -140, -140, 906,
- /* 90 */ -140, 1046, -140, -140, 289, -140, 454, 926, 1113, -140,
- /* 100 */ 1126, -140, -140, -129, 677, -140, -140, 1080, -140, 1106,
- /* 110 */ -140, -140, -140, -140, -129, 683, -129, 690, -129, 706,
- /* 120 */ -129, 746, -129, 756, -129, 759, -129, 762, -129, 763,
- /* 130 */ -129, 770, -129, 773, -129, 775, -129, 776, -129, 1067,
- /* 140 */ 778, -129, -140, -140, 783, -129, 784, -129, 785, -129,
- /* 150 */ 797, -129, 810, -129, 812, -129, -140, -140, -140, -140,
- /* 160 */ -140, -140, 692, -129, 813, -129, 1133, 662, 198, -140,
- /* 170 */ -140, -140, -140, -140, -129, 820, -129, 821, -129, 824,
- /* 180 */ -129, 825, -129, 404, -129, 873, 879, -140, -140, 827,
- /* 190 */ -129, 829, -129, -140, -140, -140, -140, -140, 922, -140,
- /* 200 */ -140, -140, 969, -140, -140, -140, 1028, -140, -140, 832,
- /* 210 */ -129, 99, -129, 833, -129, -140, -140, -139, -140, -140,
- /* 220 */ 878, 934, -140, -140, -140, 834, -129, 835, -129, 992,
- /* 230 */ 669, 198, -140, -140, -140, 988, -140, 1012, 1053, -140,
- /* 240 */ 836, -129, -140, -27, -140, 841, -129, -140, 427, 981,
- /* 250 */ -140, -140, -140, 885, -140, 899, -140, -140, -140, 923,
- /* 260 */ 881, 604, -140, -140, 944, -140, -140, 908, 919, -140,
- /* 270 */ -140, 684, -140, -140, 225, -140, 989, -140, -140, 844,
- /* 280 */ -129, 304, 198, 981, -140, 654, 991, 1003, -140, 846,
- /* 290 */ 552, -140, -140, -140, 1080, -140, -140, -140, -140, -129,
- /* 300 */ -140, -140, -140, -140, -140, -129, 1140, -140, 1142, -39,
- /* 310 */ 163, 320, -140, 667, -140, -140, 877, -140, -140, -140,
- /* 320 */ -140, -140, -140, 905, -140, 914, -140, 676, -140, -140,
- /* 330 */ -140, 937, -140, 942, -140, -140, -140, -140, -140, -140,
- /* 340 */ -140, -140, -140, -140, -140, -140, -140, -140, 1010, 1006,
- /* 350 */ -140, -140, 1016, -140, -140, -140, -140, -140, 1019, 1023,
- /* 360 */ -140, 1058, -140, -140, -140, 682, -140, 1082, -140, -140,
- /* 370 */ 694, -140, 1097, -140, 707, 800, -140, -140, -140, 720,
- /* 380 */ -140, -140, 1125, 1112, 1101, 65, -140, -140, -140, -140,
- /* 390 */ -140, -140, 642, 198, 169, -140, 556, -140, 699, -140,
- /* 400 */ 730, 198, 897, 828, 830, -140, 903, 860, 838, 839,
- /* 410 */ -140, 849, -129, -140, -140, -140, -140, -140, -140, -140,
- /* 420 */ 814, -140, 936, -140, -140, -140, -140, -140, -140, -140,
- /* 430 */ -140, 951, -140, 953, 912, -140, 396, -140, 965, -140,
- /* 440 */ -140, -140, 232, 198, 947, 948, -140, -140, -140, -140,
- /* 450 */ -140, -140, 666, -140, 970, 1001, -140, 603, 961, 1005,
- /* 460 */ -140, 652, -129, -140, -140, 857, -129, -140, 1014, 962,
- /* 470 */ 811, -140, -140, 852, 198, -140, 547, -140, 869, -129,
- /* 480 */ -140, -129, -140, 1036, 1007, -140, -140, 1044, -140, 1047,
- /* 490 */ -140, 1050, 1011, -140, 1056, 1013, -140, 198, -140, 1066,
- /* 500 */ 1022, 1033, -140, 1043, 1073, 1029, -140, 837, 1057, -140,
- /* 510 */ -140, 1086, 1059, 1034, 876, 198, -140, 592, -140, -140,
- /* 520 */ 1074, 1110, 1072, -140, 1132, -140, -140, -140, -140, 1124,
- /* 530 */ -140, 968, -140, 128, -140, -140, -140, -140, 230, -140,
- /* 540 */ -140, -140, 1037, -140, -140, 916, -140, -140, 884, 963,
- /* 550 */ -140, 1018, 950, -140, 1025, -140, -140, 1017, 1089, -140,
- /* 560 */ -140, -140, -140,
-};
-static YYACTIONTYPE yy_default[] = {
- /* 0 */ 570, 570, 564, 856, 856, 566, 856, 572, 856, 856,
- /* 10 */ 856, 856, 652, 655, 656, 657, 658, 659, 573, 574,
- /* 20 */ 591, 592, 593, 856, 856, 856, 856, 856, 856, 856,
- /* 30 */ 856, 856, 856, 856, 856, 856, 584, 594, 604, 586,
- /* 40 */ 603, 856, 856, 605, 651, 616, 856, 651, 617, 636,
- /* 50 */ 634, 856, 637, 638, 856, 708, 651, 618, 706, 707,
- /* 60 */ 651, 619, 856, 856, 737, 797, 743, 738, 856, 664,
- /* 70 */ 856, 856, 665, 673, 675, 682, 720, 711, 713, 701,
- /* 80 */ 715, 670, 856, 600, 856, 601, 856, 602, 716, 856,
- /* 90 */ 717, 856, 718, 856, 856, 702, 856, 709, 708, 703,
- /* 100 */ 856, 588, 710, 705, 856, 736, 856, 856, 739, 856,
- /* 110 */ 740, 741, 742, 744, 747, 856, 748, 856, 749, 856,
- /* 120 */ 750, 856, 751, 856, 752, 856, 753, 856, 754, 856,
- /* 130 */ 755, 856, 756, 856, 757, 856, 758, 856, 759, 856,
- /* 140 */ 856, 760, 761, 762, 856, 763, 856, 764, 856, 765,
- /* 150 */ 856, 766, 856, 767, 856, 768, 769, 856, 770, 856,
- /* 160 */ 773, 771, 856, 856, 856, 779, 856, 797, 856, 856,
- /* 170 */ 856, 856, 856, 782, 796, 856, 774, 856, 775, 856,
- /* 180 */ 776, 856, 777, 856, 856, 856, 856, 856, 787, 856,
- /* 190 */ 856, 856, 788, 856, 856, 856, 845, 856, 856, 856,
- /* 200 */ 846, 856, 856, 856, 847, 856, 856, 856, 848, 856,
- /* 210 */ 856, 856, 856, 856, 789, 856, 781, 797, 794, 795,
- /* 220 */ 690, 856, 691, 785, 772, 856, 856, 856, 780, 856,
- /* 230 */ 797, 856, 784, 856, 783, 690, 786, 709, 708, 704,
- /* 240 */ 856, 714, 856, 797, 712, 856, 721, 674, 685, 683,
- /* 250 */ 684, 692, 693, 856, 694, 856, 695, 856, 696, 856,
- /* 260 */ 690, 681, 589, 590, 856, 679, 680, 698, 700, 686,
- /* 270 */ 856, 856, 856, 699, 856, 803, 708, 805, 804, 856,
- /* 280 */ 697, 685, 856, 856, 856, 681, 698, 700, 687, 856,
- /* 290 */ 681, 676, 677, 856, 856, 678, 671, 672, 778, 856,
- /* 300 */ 735, 856, 745, 856, 746, 856, 651, 620, 856, 801,
- /* 310 */ 624, 621, 625, 856, 626, 856, 856, 627, 856, 630,
- /* 320 */ 631, 632, 633, 856, 628, 856, 629, 856, 856, 802,
- /* 330 */ 622, 856, 623, 636, 635, 606, 856, 607, 608, 609,
- /* 340 */ 856, 610, 613, 856, 611, 614, 612, 615, 595, 856,
- /* 350 */ 856, 596, 856, 856, 597, 599, 598, 587, 856, 856,
- /* 360 */ 641, 856, 644, 856, 856, 856, 856, 651, 645, 856,
- /* 370 */ 856, 856, 651, 646, 856, 651, 647, 856, 856, 856,
- /* 380 */ 856, 856, 856, 801, 624, 649, 856, 648, 650, 642,
- /* 390 */ 643, 585, 856, 856, 581, 856, 856, 579, 856, 856,
- /* 400 */ 856, 856, 856, 828, 856, 856, 856, 690, 833, 856,
- /* 410 */ 856, 856, 856, 856, 856, 834, 835, 856, 856, 856,
- /* 420 */ 856, 856, 856, 733, 734, 825, 826, 856, 827, 580,
- /* 430 */ 856, 856, 856, 856, 856, 856, 856, 856, 856, 856,
- /* 440 */ 856, 856, 856, 856, 856, 856, 654, 856, 856, 856,
- /* 450 */ 856, 856, 856, 856, 653, 856, 856, 856, 856, 856,
- /* 460 */ 856, 856, 723, 856, 856, 856, 724, 856, 856, 731,
- /* 470 */ 856, 856, 732, 856, 856, 856, 856, 856, 856, 729,
- /* 480 */ 856, 730, 856, 856, 856, 856, 856, 856, 856, 856,
- /* 490 */ 856, 856, 856, 856, 856, 856, 856, 856, 856, 856,
- /* 500 */ 690, 856, 856, 653, 856, 856, 856, 856, 856, 856,
- /* 510 */ 856, 856, 690, 731, 856, 856, 856, 856, 856, 856,
- /* 520 */ 653, 856, 856, 856, 856, 856, 856, 856, 856, 856,
- /* 530 */ 856, 856, 856, 822, 856, 856, 856, 856, 856, 856,
- /* 540 */ 856, 856, 856, 856, 821, 856, 856, 856, 854, 856,
- /* 550 */ 856, 856, 856, 856, 856, 856, 853, 854, 856, 856,
- /* 560 */ 567, 569, 565,
-};
-#define YY_SZ_ACTTAB (sizeof(yy_action)/sizeof(yy_action[0]))
-
-/* The next table maps tokens into fallback tokens. If a construct
-** like the following:
-**
-** %fallback ID X Y Z.
-**
-** appears in the grammer, then ID becomes a fallback token for X, Y,
-** and Z. Whenever one of the tokens X, Y, or Z is input to the parser
-** but it does not parse, the type of the token is changed to ID and
-** the parse is retried before an error is thrown.
-*/
-#ifdef YYFALLBACK
-static const YYCODETYPE yyFallback[] = {
- 0, /* $ => nothing */
- 0, /* END_OF_FILE => nothing */
- 0, /* ILLEGAL => nothing */
- 0, /* SPACE => nothing */
- 0, /* UNCLOSED_STRING => nothing */
- 0, /* COMMENT => nothing */
- 0, /* FUNCTION => nothing */
- 0, /* COLUMN => nothing */
- 0, /* AGG_FUNCTION => nothing */
- 0, /* SEMI => nothing */
- 23, /* EXPLAIN => ID */
- 23, /* BEGIN => ID */
- 0, /* TRANSACTION => nothing */
- 0, /* COMMIT => nothing */
- 23, /* END => ID */
- 0, /* ROLLBACK => nothing */
- 0, /* CREATE => nothing */
- 0, /* TABLE => nothing */
- 23, /* TEMP => ID */
- 0, /* LP => nothing */
- 0, /* RP => nothing */
- 0, /* AS => nothing */
- 0, /* COMMA => nothing */
- 0, /* ID => nothing */
- 23, /* ABORT => ID */
- 23, /* AFTER => ID */
- 23, /* ASC => ID */
- 23, /* ATTACH => ID */
- 23, /* BEFORE => ID */
- 23, /* CASCADE => ID */
- 23, /* CLUSTER => ID */
- 23, /* CONFLICT => ID */
- 23, /* COPY => ID */
- 23, /* DATABASE => ID */
- 23, /* DEFERRED => ID */
- 23, /* DELIMITERS => ID */
- 23, /* DESC => ID */
- 23, /* DETACH => ID */
- 23, /* EACH => ID */
- 23, /* FAIL => ID */
- 23, /* FOR => ID */
- 23, /* GLOB => ID */
- 23, /* IGNORE => ID */
- 23, /* IMMEDIATE => ID */
- 23, /* INITIALLY => ID */
- 23, /* INSTEAD => ID */
- 23, /* LIKE => ID */
- 23, /* MATCH => ID */
- 23, /* KEY => ID */
- 23, /* OF => ID */
- 23, /* OFFSET => ID */
- 23, /* PRAGMA => ID */
- 23, /* RAISE => ID */
- 23, /* REPLACE => ID */
- 23, /* RESTRICT => ID */
- 23, /* ROW => ID */
- 23, /* STATEMENT => ID */
- 23, /* TRIGGER => ID */
- 23, /* VACUUM => ID */
- 23, /* VIEW => ID */
- 0, /* OR => nothing */
- 0, /* AND => nothing */
- 0, /* NOT => nothing */
- 0, /* EQ => nothing */
- 0, /* NE => nothing */
- 0, /* ISNULL => nothing */
- 0, /* NOTNULL => nothing */
- 0, /* IS => nothing */
- 0, /* BETWEEN => nothing */
- 0, /* IN => nothing */
- 0, /* GT => nothing */
- 0, /* GE => nothing */
- 0, /* LT => nothing */
- 0, /* LE => nothing */
- 0, /* BITAND => nothing */
- 0, /* BITOR => nothing */
- 0, /* LSHIFT => nothing */
- 0, /* RSHIFT => nothing */
- 0, /* PLUS => nothing */
- 0, /* MINUS => nothing */
- 0, /* STAR => nothing */
- 0, /* SLASH => nothing */
- 0, /* REM => nothing */
- 0, /* CONCAT => nothing */
- 0, /* UMINUS => nothing */
- 0, /* UPLUS => nothing */
- 0, /* BITNOT => nothing */
- 0, /* STRING => nothing */
- 0, /* JOIN_KW => nothing */
- 0, /* INTEGER => nothing */
- 0, /* CONSTRAINT => nothing */
- 0, /* DEFAULT => nothing */
- 0, /* FLOAT => nothing */
- 0, /* NULL => nothing */
- 0, /* PRIMARY => nothing */
- 0, /* UNIQUE => nothing */
- 0, /* CHECK => nothing */
- 0, /* REFERENCES => nothing */
- 0, /* COLLATE => nothing */
- 0, /* ON => nothing */
- 0, /* DELETE => nothing */
- 0, /* UPDATE => nothing */
- 0, /* INSERT => nothing */
- 0, /* SET => nothing */
- 0, /* DEFERRABLE => nothing */
- 0, /* FOREIGN => nothing */
- 0, /* DROP => nothing */
- 0, /* UNION => nothing */
- 0, /* ALL => nothing */
- 0, /* INTERSECT => nothing */
- 0, /* EXCEPT => nothing */
- 0, /* SELECT => nothing */
- 0, /* DISTINCT => nothing */
- 0, /* DOT => nothing */
- 0, /* FROM => nothing */
- 0, /* JOIN => nothing */
- 0, /* USING => nothing */
- 0, /* ORDER => nothing */
- 0, /* BY => nothing */
- 0, /* GROUP => nothing */
- 0, /* HAVING => nothing */
- 0, /* LIMIT => nothing */
- 0, /* WHERE => nothing */
- 0, /* INTO => nothing */
- 0, /* VALUES => nothing */
- 0, /* VARIABLE => nothing */
- 0, /* CASE => nothing */
- 0, /* WHEN => nothing */
- 0, /* THEN => nothing */
- 0, /* ELSE => nothing */
- 0, /* INDEX => nothing */
-};
-#endif /* YYFALLBACK */
-
-/* The following structure represents a single element of the
-** parser's stack. Information stored includes:
-**
-** + The state number for the parser at this level of the stack.
-**
-** + The value of the token stored at this level of the stack.
-** (In other words, the "major" token.)
-**
-** + The semantic value stored at this level of the stack. This is
-** the information used by the action routines in the grammar.
-** It is sometimes called the "minor" token.
-*/
-struct yyStackEntry {
- int stateno; /* The state-number */
- int major; /* The major token value. This is the code
- ** number for the token at this stack level */
- YYMINORTYPE minor; /* The user-supplied minor token value. This
- ** is the value of the token */
-};
-typedef struct yyStackEntry yyStackEntry;
-
-/* The state of the parser is completely contained in an instance of
-** the following structure */
-struct yyParser {
- int yyidx; /* Index of top element in stack */
- int yyerrcnt; /* Shifts left before out of the error */
- sqliteParserARG_SDECL /* A place to hold %extra_argument */
- yyStackEntry yystack[YYSTACKDEPTH]; /* The parser's stack */
-};
-typedef struct yyParser yyParser;
-
-#ifndef NDEBUG
-#include <stdio.h>
-static FILE *yyTraceFILE = 0;
-static char *yyTracePrompt = 0;
-#endif /* NDEBUG */
-
-#ifndef NDEBUG
-/*
-** Turn parser tracing on by giving a stream to which to write the trace
-** and a prompt to preface each trace message. Tracing is turned off
-** by making either argument NULL
-**
-** Inputs:
-** <ul>
-** <li> A FILE* to which trace output should be written.
-** If NULL, then tracing is turned off.
-** <li> A prefix string written at the beginning of every
-** line of trace output. If NULL, then tracing is
-** turned off.
-** </ul>
-**
-** Outputs:
-** None.
-*/
-void sqliteParserTrace(FILE *TraceFILE, char *zTracePrompt){
- yyTraceFILE = TraceFILE;
- yyTracePrompt = zTracePrompt;
- if( yyTraceFILE==0 ) yyTracePrompt = 0;
- else if( yyTracePrompt==0 ) yyTraceFILE = 0;
-}
-#endif /* NDEBUG */
-
-#ifndef NDEBUG
-/* For tracing shifts, the names of all terminals and nonterminals
-** are required. The following table supplies these names */
-static const char *yyTokenName[] = {
- "$", "END_OF_FILE", "ILLEGAL", "SPACE",
- "UNCLOSED_STRING", "COMMENT", "FUNCTION", "COLUMN",
- "AGG_FUNCTION", "SEMI", "EXPLAIN", "BEGIN",
- "TRANSACTION", "COMMIT", "END", "ROLLBACK",
- "CREATE", "TABLE", "TEMP", "LP",
- "RP", "AS", "COMMA", "ID",
- "ABORT", "AFTER", "ASC", "ATTACH",
- "BEFORE", "CASCADE", "CLUSTER", "CONFLICT",
- "COPY", "DATABASE", "DEFERRED", "DELIMITERS",
- "DESC", "DETACH", "EACH", "FAIL",
- "FOR", "GLOB", "IGNORE", "IMMEDIATE",
- "INITIALLY", "INSTEAD", "LIKE", "MATCH",
- "KEY", "OF", "OFFSET", "PRAGMA",
- "RAISE", "REPLACE", "RESTRICT", "ROW",
- "STATEMENT", "TRIGGER", "VACUUM", "VIEW",
- "OR", "AND", "NOT", "EQ",
- "NE", "ISNULL", "NOTNULL", "IS",
- "BETWEEN", "IN", "GT", "GE",
- "LT", "LE", "BITAND", "BITOR",
- "LSHIFT", "RSHIFT", "PLUS", "MINUS",
- "STAR", "SLASH", "REM", "CONCAT",
- "UMINUS", "UPLUS", "BITNOT", "STRING",
- "JOIN_KW", "INTEGER", "CONSTRAINT", "DEFAULT",
- "FLOAT", "NULL", "PRIMARY", "UNIQUE",
- "CHECK", "REFERENCES", "COLLATE", "ON",
- "DELETE", "UPDATE", "INSERT", "SET",
- "DEFERRABLE", "FOREIGN", "DROP", "UNION",
- "ALL", "INTERSECT", "EXCEPT", "SELECT",
- "DISTINCT", "DOT", "FROM", "JOIN",
- "USING", "ORDER", "BY", "GROUP",
- "HAVING", "LIMIT", "WHERE", "INTO",
- "VALUES", "VARIABLE", "CASE", "WHEN",
- "THEN", "ELSE", "INDEX", "error",
- "input", "cmdlist", "ecmd", "explain",
- "cmdx", "cmd", "trans_opt", "onconf",
- "nm", "create_table", "create_table_args", "temp",
- "columnlist", "conslist_opt", "select", "column",
- "columnid", "type", "carglist", "id",
- "ids", "typename", "signed", "carg",
- "ccons", "sortorder", "expr", "idxlist_opt",
- "refargs", "defer_subclause", "refarg", "refact",
- "init_deferred_pred_opt", "conslist", "tcons", "idxlist",
- "defer_subclause_opt", "orconf", "resolvetype", "oneselect",
- "multiselect_op", "distinct", "selcollist", "from",
- "where_opt", "groupby_opt", "having_opt", "orderby_opt",
- "limit_opt", "sclp", "as", "seltablist",
- "stl_prefix", "joinop", "dbnm", "on_opt",
- "using_opt", "seltablist_paren", "joinop2", "sortlist",
- "sortitem", "collate", "exprlist", "setlist",
- "insert_cmd", "inscollist_opt", "itemlist", "inscollist",
- "likeop", "case_operand", "case_exprlist", "case_else",
- "expritem", "uniqueflag", "idxitem", "plus_num",
- "minus_num", "plus_opt", "number", "trigger_decl",
- "trigger_cmd_list", "trigger_time", "trigger_event", "foreach_clause",
- "when_clause", "trigger_cmd", "database_kw_opt", "key_opt",
-};
-#endif /* NDEBUG */
-
-#ifndef NDEBUG
-/* For tracing reduce actions, the names of all rules are required.
-*/
-static const char *yyRuleName[] = {
- /* 0 */ "input ::= cmdlist",
- /* 1 */ "cmdlist ::= cmdlist ecmd",
- /* 2 */ "cmdlist ::= ecmd",
- /* 3 */ "ecmd ::= explain cmdx SEMI",
- /* 4 */ "ecmd ::= SEMI",
- /* 5 */ "cmdx ::= cmd",
- /* 6 */ "explain ::= EXPLAIN",
- /* 7 */ "explain ::=",
- /* 8 */ "cmd ::= BEGIN trans_opt onconf",
- /* 9 */ "trans_opt ::=",
- /* 10 */ "trans_opt ::= TRANSACTION",
- /* 11 */ "trans_opt ::= TRANSACTION nm",
- /* 12 */ "cmd ::= COMMIT trans_opt",
- /* 13 */ "cmd ::= END trans_opt",
- /* 14 */ "cmd ::= ROLLBACK trans_opt",
- /* 15 */ "cmd ::= create_table create_table_args",
- /* 16 */ "create_table ::= CREATE temp TABLE nm",
- /* 17 */ "temp ::= TEMP",
- /* 18 */ "temp ::=",
- /* 19 */ "create_table_args ::= LP columnlist conslist_opt RP",
- /* 20 */ "create_table_args ::= AS select",
- /* 21 */ "columnlist ::= columnlist COMMA column",
- /* 22 */ "columnlist ::= column",
- /* 23 */ "column ::= columnid type carglist",
- /* 24 */ "columnid ::= nm",
- /* 25 */ "id ::= ID",
- /* 26 */ "ids ::= ID",
- /* 27 */ "ids ::= STRING",
- /* 28 */ "nm ::= ID",
- /* 29 */ "nm ::= STRING",
- /* 30 */ "nm ::= JOIN_KW",
- /* 31 */ "type ::=",
- /* 32 */ "type ::= typename",
- /* 33 */ "type ::= typename LP signed RP",
- /* 34 */ "type ::= typename LP signed COMMA signed RP",
- /* 35 */ "typename ::= ids",
- /* 36 */ "typename ::= typename ids",
- /* 37 */ "signed ::= INTEGER",
- /* 38 */ "signed ::= PLUS INTEGER",
- /* 39 */ "signed ::= MINUS INTEGER",
- /* 40 */ "carglist ::= carglist carg",
- /* 41 */ "carglist ::=",
- /* 42 */ "carg ::= CONSTRAINT nm ccons",
- /* 43 */ "carg ::= ccons",
- /* 44 */ "carg ::= DEFAULT STRING",
- /* 45 */ "carg ::= DEFAULT ID",
- /* 46 */ "carg ::= DEFAULT INTEGER",
- /* 47 */ "carg ::= DEFAULT PLUS INTEGER",
- /* 48 */ "carg ::= DEFAULT MINUS INTEGER",
- /* 49 */ "carg ::= DEFAULT FLOAT",
- /* 50 */ "carg ::= DEFAULT PLUS FLOAT",
- /* 51 */ "carg ::= DEFAULT MINUS FLOAT",
- /* 52 */ "carg ::= DEFAULT NULL",
- /* 53 */ "ccons ::= NULL onconf",
- /* 54 */ "ccons ::= NOT NULL onconf",
- /* 55 */ "ccons ::= PRIMARY KEY sortorder onconf",
- /* 56 */ "ccons ::= UNIQUE onconf",
- /* 57 */ "ccons ::= CHECK LP expr RP onconf",
- /* 58 */ "ccons ::= REFERENCES nm idxlist_opt refargs",
- /* 59 */ "ccons ::= defer_subclause",
- /* 60 */ "ccons ::= COLLATE id",
- /* 61 */ "refargs ::=",
- /* 62 */ "refargs ::= refargs refarg",
- /* 63 */ "refarg ::= MATCH nm",
- /* 64 */ "refarg ::= ON DELETE refact",
- /* 65 */ "refarg ::= ON UPDATE refact",
- /* 66 */ "refarg ::= ON INSERT refact",
- /* 67 */ "refact ::= SET NULL",
- /* 68 */ "refact ::= SET DEFAULT",
- /* 69 */ "refact ::= CASCADE",
- /* 70 */ "refact ::= RESTRICT",
- /* 71 */ "defer_subclause ::= NOT DEFERRABLE init_deferred_pred_opt",
- /* 72 */ "defer_subclause ::= DEFERRABLE init_deferred_pred_opt",
- /* 73 */ "init_deferred_pred_opt ::=",
- /* 74 */ "init_deferred_pred_opt ::= INITIALLY DEFERRED",
- /* 75 */ "init_deferred_pred_opt ::= INITIALLY IMMEDIATE",
- /* 76 */ "conslist_opt ::=",
- /* 77 */ "conslist_opt ::= COMMA conslist",
- /* 78 */ "conslist ::= conslist COMMA tcons",
- /* 79 */ "conslist ::= conslist tcons",
- /* 80 */ "conslist ::= tcons",
- /* 81 */ "tcons ::= CONSTRAINT nm",
- /* 82 */ "tcons ::= PRIMARY KEY LP idxlist RP onconf",
- /* 83 */ "tcons ::= UNIQUE LP idxlist RP onconf",
- /* 84 */ "tcons ::= CHECK expr onconf",
- /* 85 */ "tcons ::= FOREIGN KEY LP idxlist RP REFERENCES nm idxlist_opt refargs defer_subclause_opt",
- /* 86 */ "defer_subclause_opt ::=",
- /* 87 */ "defer_subclause_opt ::= defer_subclause",
- /* 88 */ "onconf ::=",
- /* 89 */ "onconf ::= ON CONFLICT resolvetype",
- /* 90 */ "orconf ::=",
- /* 91 */ "orconf ::= OR resolvetype",
- /* 92 */ "resolvetype ::= ROLLBACK",
- /* 93 */ "resolvetype ::= ABORT",
- /* 94 */ "resolvetype ::= FAIL",
- /* 95 */ "resolvetype ::= IGNORE",
- /* 96 */ "resolvetype ::= REPLACE",
- /* 97 */ "cmd ::= DROP TABLE nm",
- /* 98 */ "cmd ::= CREATE temp VIEW nm AS select",
- /* 99 */ "cmd ::= DROP VIEW nm",
- /* 100 */ "cmd ::= select",
- /* 101 */ "select ::= oneselect",
- /* 102 */ "select ::= select multiselect_op oneselect",
- /* 103 */ "multiselect_op ::= UNION",
- /* 104 */ "multiselect_op ::= UNION ALL",
- /* 105 */ "multiselect_op ::= INTERSECT",
- /* 106 */ "multiselect_op ::= EXCEPT",
- /* 107 */ "oneselect ::= SELECT distinct selcollist from where_opt groupby_opt having_opt orderby_opt limit_opt",
- /* 108 */ "distinct ::= DISTINCT",
- /* 109 */ "distinct ::= ALL",
- /* 110 */ "distinct ::=",
- /* 111 */ "sclp ::= selcollist COMMA",
- /* 112 */ "sclp ::=",
- /* 113 */ "selcollist ::= sclp expr as",
- /* 114 */ "selcollist ::= sclp STAR",
- /* 115 */ "selcollist ::= sclp nm DOT STAR",
- /* 116 */ "as ::= AS nm",
- /* 117 */ "as ::= ids",
- /* 118 */ "as ::=",
- /* 119 */ "from ::=",
- /* 120 */ "from ::= FROM seltablist",
- /* 121 */ "stl_prefix ::= seltablist joinop",
- /* 122 */ "stl_prefix ::=",
- /* 123 */ "seltablist ::= stl_prefix nm dbnm as on_opt using_opt",
- /* 124 */ "seltablist ::= stl_prefix LP seltablist_paren RP as on_opt using_opt",
- /* 125 */ "seltablist_paren ::= select",
- /* 126 */ "seltablist_paren ::= seltablist",
- /* 127 */ "dbnm ::=",
- /* 128 */ "dbnm ::= DOT nm",
- /* 129 */ "joinop ::= COMMA",
- /* 130 */ "joinop ::= JOIN",
- /* 131 */ "joinop ::= JOIN_KW JOIN",
- /* 132 */ "joinop ::= JOIN_KW nm JOIN",
- /* 133 */ "joinop ::= JOIN_KW nm nm JOIN",
- /* 134 */ "on_opt ::= ON expr",
- /* 135 */ "on_opt ::=",
- /* 136 */ "using_opt ::= USING LP idxlist RP",
- /* 137 */ "using_opt ::=",
- /* 138 */ "orderby_opt ::=",
- /* 139 */ "orderby_opt ::= ORDER BY sortlist",
- /* 140 */ "sortlist ::= sortlist COMMA sortitem collate sortorder",
- /* 141 */ "sortlist ::= sortitem collate sortorder",
- /* 142 */ "sortitem ::= expr",
- /* 143 */ "sortorder ::= ASC",
- /* 144 */ "sortorder ::= DESC",
- /* 145 */ "sortorder ::=",
- /* 146 */ "collate ::=",
- /* 147 */ "collate ::= COLLATE id",
- /* 148 */ "groupby_opt ::=",
- /* 149 */ "groupby_opt ::= GROUP BY exprlist",
- /* 150 */ "having_opt ::=",
- /* 151 */ "having_opt ::= HAVING expr",
- /* 152 */ "limit_opt ::=",
- /* 153 */ "limit_opt ::= LIMIT signed",
- /* 154 */ "limit_opt ::= LIMIT signed OFFSET signed",
- /* 155 */ "limit_opt ::= LIMIT signed COMMA signed",
- /* 156 */ "cmd ::= DELETE FROM nm dbnm where_opt",
- /* 157 */ "where_opt ::=",
- /* 158 */ "where_opt ::= WHERE expr",
- /* 159 */ "cmd ::= UPDATE orconf nm dbnm SET setlist where_opt",
- /* 160 */ "setlist ::= setlist COMMA nm EQ expr",
- /* 161 */ "setlist ::= nm EQ expr",
- /* 162 */ "cmd ::= insert_cmd INTO nm dbnm inscollist_opt VALUES LP itemlist RP",
- /* 163 */ "cmd ::= insert_cmd INTO nm dbnm inscollist_opt select",
- /* 164 */ "insert_cmd ::= INSERT orconf",
- /* 165 */ "insert_cmd ::= REPLACE",
- /* 166 */ "itemlist ::= itemlist COMMA expr",
- /* 167 */ "itemlist ::= expr",
- /* 168 */ "inscollist_opt ::=",
- /* 169 */ "inscollist_opt ::= LP inscollist RP",
- /* 170 */ "inscollist ::= inscollist COMMA nm",
- /* 171 */ "inscollist ::= nm",
- /* 172 */ "expr ::= LP expr RP",
- /* 173 */ "expr ::= NULL",
- /* 174 */ "expr ::= ID",
- /* 175 */ "expr ::= JOIN_KW",
- /* 176 */ "expr ::= nm DOT nm",
- /* 177 */ "expr ::= nm DOT nm DOT nm",
- /* 178 */ "expr ::= INTEGER",
- /* 179 */ "expr ::= FLOAT",
- /* 180 */ "expr ::= STRING",
- /* 181 */ "expr ::= VARIABLE",
- /* 182 */ "expr ::= ID LP exprlist RP",
- /* 183 */ "expr ::= ID LP STAR RP",
- /* 184 */ "expr ::= expr AND expr",
- /* 185 */ "expr ::= expr OR expr",
- /* 186 */ "expr ::= expr LT expr",
- /* 187 */ "expr ::= expr GT expr",
- /* 188 */ "expr ::= expr LE expr",
- /* 189 */ "expr ::= expr GE expr",
- /* 190 */ "expr ::= expr NE expr",
- /* 191 */ "expr ::= expr EQ expr",
- /* 192 */ "expr ::= expr BITAND expr",
- /* 193 */ "expr ::= expr BITOR expr",
- /* 194 */ "expr ::= expr LSHIFT expr",
- /* 195 */ "expr ::= expr RSHIFT expr",
- /* 196 */ "expr ::= expr likeop expr",
- /* 197 */ "expr ::= expr NOT likeop expr",
- /* 198 */ "likeop ::= LIKE",
- /* 199 */ "likeop ::= GLOB",
- /* 200 */ "expr ::= expr PLUS expr",
- /* 201 */ "expr ::= expr MINUS expr",
- /* 202 */ "expr ::= expr STAR expr",
- /* 203 */ "expr ::= expr SLASH expr",
- /* 204 */ "expr ::= expr REM expr",
- /* 205 */ "expr ::= expr CONCAT expr",
- /* 206 */ "expr ::= expr ISNULL",
- /* 207 */ "expr ::= expr IS NULL",
- /* 208 */ "expr ::= expr NOTNULL",
- /* 209 */ "expr ::= expr NOT NULL",
- /* 210 */ "expr ::= expr IS NOT NULL",
- /* 211 */ "expr ::= NOT expr",
- /* 212 */ "expr ::= BITNOT expr",
- /* 213 */ "expr ::= MINUS expr",
- /* 214 */ "expr ::= PLUS expr",
- /* 215 */ "expr ::= LP select RP",
- /* 216 */ "expr ::= expr BETWEEN expr AND expr",
- /* 217 */ "expr ::= expr NOT BETWEEN expr AND expr",
- /* 218 */ "expr ::= expr IN LP exprlist RP",
- /* 219 */ "expr ::= expr IN LP select RP",
- /* 220 */ "expr ::= expr NOT IN LP exprlist RP",
- /* 221 */ "expr ::= expr NOT IN LP select RP",
- /* 222 */ "expr ::= expr IN nm dbnm",
- /* 223 */ "expr ::= expr NOT IN nm dbnm",
- /* 224 */ "expr ::= CASE case_operand case_exprlist case_else END",
- /* 225 */ "case_exprlist ::= case_exprlist WHEN expr THEN expr",
- /* 226 */ "case_exprlist ::= WHEN expr THEN expr",
- /* 227 */ "case_else ::= ELSE expr",
- /* 228 */ "case_else ::=",
- /* 229 */ "case_operand ::= expr",
- /* 230 */ "case_operand ::=",
- /* 231 */ "exprlist ::= exprlist COMMA expritem",
- /* 232 */ "exprlist ::= expritem",
- /* 233 */ "expritem ::= expr",
- /* 234 */ "expritem ::=",
- /* 235 */ "cmd ::= CREATE uniqueflag INDEX nm ON nm dbnm LP idxlist RP onconf",
- /* 236 */ "uniqueflag ::= UNIQUE",
- /* 237 */ "uniqueflag ::=",
- /* 238 */ "idxlist_opt ::=",
- /* 239 */ "idxlist_opt ::= LP idxlist RP",
- /* 240 */ "idxlist ::= idxlist COMMA idxitem",
- /* 241 */ "idxlist ::= idxitem",
- /* 242 */ "idxitem ::= nm sortorder",
- /* 243 */ "cmd ::= DROP INDEX nm dbnm",
- /* 244 */ "cmd ::= COPY orconf nm dbnm FROM nm USING DELIMITERS STRING",
- /* 245 */ "cmd ::= COPY orconf nm dbnm FROM nm",
- /* 246 */ "cmd ::= VACUUM",
- /* 247 */ "cmd ::= VACUUM nm",
- /* 248 */ "cmd ::= PRAGMA ids EQ nm",
- /* 249 */ "cmd ::= PRAGMA ids EQ ON",
- /* 250 */ "cmd ::= PRAGMA ids EQ plus_num",
- /* 251 */ "cmd ::= PRAGMA ids EQ minus_num",
- /* 252 */ "cmd ::= PRAGMA ids LP nm RP",
- /* 253 */ "cmd ::= PRAGMA ids",
- /* 254 */ "plus_num ::= plus_opt number",
- /* 255 */ "minus_num ::= MINUS number",
- /* 256 */ "number ::= INTEGER",
- /* 257 */ "number ::= FLOAT",
- /* 258 */ "plus_opt ::= PLUS",
- /* 259 */ "plus_opt ::=",
- /* 260 */ "cmd ::= CREATE trigger_decl BEGIN trigger_cmd_list END",
- /* 261 */ "trigger_decl ::= temp TRIGGER nm trigger_time trigger_event ON nm dbnm foreach_clause when_clause",
- /* 262 */ "trigger_time ::= BEFORE",
- /* 263 */ "trigger_time ::= AFTER",
- /* 264 */ "trigger_time ::= INSTEAD OF",
- /* 265 */ "trigger_time ::=",
- /* 266 */ "trigger_event ::= DELETE",
- /* 267 */ "trigger_event ::= INSERT",
- /* 268 */ "trigger_event ::= UPDATE",
- /* 269 */ "trigger_event ::= UPDATE OF inscollist",
- /* 270 */ "foreach_clause ::=",
- /* 271 */ "foreach_clause ::= FOR EACH ROW",
- /* 272 */ "foreach_clause ::= FOR EACH STATEMENT",
- /* 273 */ "when_clause ::=",
- /* 274 */ "when_clause ::= WHEN expr",
- /* 275 */ "trigger_cmd_list ::= trigger_cmd SEMI trigger_cmd_list",
- /* 276 */ "trigger_cmd_list ::=",
- /* 277 */ "trigger_cmd ::= UPDATE orconf nm SET setlist where_opt",
- /* 278 */ "trigger_cmd ::= insert_cmd INTO nm inscollist_opt VALUES LP itemlist RP",
- /* 279 */ "trigger_cmd ::= insert_cmd INTO nm inscollist_opt select",
- /* 280 */ "trigger_cmd ::= DELETE FROM nm where_opt",
- /* 281 */ "trigger_cmd ::= select",
- /* 282 */ "expr ::= RAISE LP IGNORE RP",
- /* 283 */ "expr ::= RAISE LP ROLLBACK COMMA nm RP",
- /* 284 */ "expr ::= RAISE LP ABORT COMMA nm RP",
- /* 285 */ "expr ::= RAISE LP FAIL COMMA nm RP",
- /* 286 */ "cmd ::= DROP TRIGGER nm dbnm",
- /* 287 */ "cmd ::= ATTACH database_kw_opt ids AS nm key_opt",
- /* 288 */ "key_opt ::= USING ids",
- /* 289 */ "key_opt ::=",
- /* 290 */ "database_kw_opt ::= DATABASE",
- /* 291 */ "database_kw_opt ::=",
- /* 292 */ "cmd ::= DETACH database_kw_opt nm",
-};
-#endif /* NDEBUG */
-
-/*
-** This function returns the symbolic name associated with a token
-** value.
-*/
-const char *sqliteParserTokenName(int tokenType){
-#ifndef NDEBUG
- if( tokenType>0 && tokenType<(sizeof(yyTokenName)/sizeof(yyTokenName[0])) ){
- return yyTokenName[tokenType];
- }else{
- return "Unknown";
- }
-#else
- return "";
-#endif
-}
-
-/*
-** This function allocates a new parser.
-** The only argument is a pointer to a function which works like
-** malloc.
-**
-** Inputs:
-** A pointer to the function used to allocate memory.
-**
-** Outputs:
-** A pointer to a parser. This pointer is used in subsequent calls
-** to sqliteParser and sqliteParserFree.
-*/
-void *sqliteParserAlloc(void *(*mallocProc)(size_t)){
- yyParser *pParser;
- pParser = (yyParser*)(*mallocProc)( (size_t)sizeof(yyParser) );
- if( pParser ){
- pParser->yyidx = -1;
- }
- return pParser;
-}
-
-/* The following function deletes the value associated with a
-** symbol. The symbol can be either a terminal or nonterminal.
-** "yymajor" is the symbol code, and "yypminor" is a pointer to
-** the value.
-*/
-static void yy_destructor(YYCODETYPE yymajor, YYMINORTYPE *yypminor){
- switch( yymajor ){
- /* Here is inserted the actions which take place when a
- ** terminal or non-terminal is destroyed. This can happen
- ** when the symbol is popped from the stack during a
- ** reduce or during error processing or when a parser is
- ** being destroyed before it is finished parsing.
- **
- ** Note: during a reduce, the only symbols destroyed are those
- ** which appear on the RHS of the rule, but which are not used
- ** inside the C code.
- */
- case 146:
-#line 286 "parse.y"
-{sqliteSelectDelete((yypminor->yy179));}
-#line 1235 "parse.c"
- break;
- case 158:
-#line 533 "parse.y"
-{sqliteExprDelete((yypminor->yy242));}
-#line 1240 "parse.c"
- break;
- case 159:
-#line 746 "parse.y"
-{sqliteIdListDelete((yypminor->yy320));}
-#line 1245 "parse.c"
- break;
- case 167:
-#line 744 "parse.y"
-{sqliteIdListDelete((yypminor->yy320));}
-#line 1250 "parse.c"
- break;
- case 171:
-#line 288 "parse.y"
-{sqliteSelectDelete((yypminor->yy179));}
-#line 1255 "parse.c"
- break;
- case 174:
-#line 322 "parse.y"
-{sqliteExprListDelete((yypminor->yy322));}
-#line 1260 "parse.c"
- break;
- case 175:
-#line 353 "parse.y"
-{sqliteSrcListDelete((yypminor->yy307));}
-#line 1265 "parse.c"
- break;
- case 176:
-#line 483 "parse.y"
-{sqliteExprDelete((yypminor->yy242));}
-#line 1270 "parse.c"
- break;
- case 177:
-#line 459 "parse.y"
-{sqliteExprListDelete((yypminor->yy322));}
-#line 1275 "parse.c"
- break;
- case 178:
-#line 464 "parse.y"
-{sqliteExprDelete((yypminor->yy242));}
-#line 1280 "parse.c"
- break;
- case 179:
-#line 431 "parse.y"
-{sqliteExprListDelete((yypminor->yy322));}
-#line 1285 "parse.c"
- break;
- case 181:
-#line 324 "parse.y"
-{sqliteExprListDelete((yypminor->yy322));}
-#line 1290 "parse.c"
- break;
- case 183:
-#line 349 "parse.y"
-{sqliteSrcListDelete((yypminor->yy307));}
-#line 1295 "parse.c"
- break;
- case 184:
-#line 351 "parse.y"
-{sqliteSrcListDelete((yypminor->yy307));}
-#line 1300 "parse.c"
- break;
- case 187:
-#line 420 "parse.y"
-{sqliteExprDelete((yypminor->yy242));}
-#line 1305 "parse.c"
- break;
- case 188:
-#line 425 "parse.y"
-{sqliteIdListDelete((yypminor->yy320));}
-#line 1310 "parse.c"
- break;
- case 189:
-#line 400 "parse.y"
-{sqliteSelectDelete((yypminor->yy179));}
-#line 1315 "parse.c"
- break;
- case 191:
-#line 433 "parse.y"
-{sqliteExprListDelete((yypminor->yy322));}
-#line 1320 "parse.c"
- break;
- case 192:
-#line 435 "parse.y"
-{sqliteExprDelete((yypminor->yy242));}
-#line 1325 "parse.c"
- break;
- case 194:
-#line 719 "parse.y"
-{sqliteExprListDelete((yypminor->yy322));}
-#line 1330 "parse.c"
- break;
- case 195:
-#line 489 "parse.y"
-{sqliteExprListDelete((yypminor->yy322));}
-#line 1335 "parse.c"
- break;
- case 197:
-#line 520 "parse.y"
-{sqliteIdListDelete((yypminor->yy320));}
-#line 1340 "parse.c"
- break;
- case 198:
-#line 514 "parse.y"
-{sqliteExprListDelete((yypminor->yy322));}
-#line 1345 "parse.c"
- break;
- case 199:
-#line 522 "parse.y"
-{sqliteIdListDelete((yypminor->yy320));}
-#line 1350 "parse.c"
- break;
- case 202:
-#line 702 "parse.y"
-{sqliteExprListDelete((yypminor->yy322));}
-#line 1355 "parse.c"
- break;
- case 204:
-#line 721 "parse.y"
-{sqliteExprDelete((yypminor->yy242));}
-#line 1360 "parse.c"
- break;
- case 212:
-#line 828 "parse.y"
-{sqliteDeleteTriggerStep((yypminor->yy19));}
-#line 1365 "parse.c"
- break;
- case 214:
-#line 812 "parse.y"
-{sqliteIdListDelete((yypminor->yy290).b);}
-#line 1370 "parse.c"
- break;
- case 217:
-#line 836 "parse.y"
-{sqliteDeleteTriggerStep((yypminor->yy19));}
-#line 1375 "parse.c"
- break;
- default: break; /* If no destructor action specified: do nothing */
- }
-}
-
-/*
-** Pop the parser's stack once.
-**
-** If there is a destructor routine associated with the token which
-** is popped from the stack, then call it.
-**
-** Return the major token number for the symbol popped.
-*/
-static int yy_pop_parser_stack(yyParser *pParser){
- YYCODETYPE yymajor;
- yyStackEntry *yytos = &pParser->yystack[pParser->yyidx];
-
- if( pParser->yyidx<0 ) return 0;
-#ifndef NDEBUG
- if( yyTraceFILE && pParser->yyidx>=0 ){
- fprintf(yyTraceFILE,"%sPopping %s\n",
- yyTracePrompt,
- yyTokenName[yytos->major]);
- }
-#endif
- yymajor = yytos->major;
- yy_destructor( yymajor, &yytos->minor);
- pParser->yyidx--;
- return yymajor;
-}
-
-/*
-** Deallocate and destroy a parser. Destructors are all called for
-** all stack elements before shutting the parser down.
-**
-** Inputs:
-** <ul>
-** <li> A pointer to the parser. This should be a pointer
-** obtained from sqliteParserAlloc.
-** <li> A pointer to a function used to reclaim memory obtained
-** from malloc.
-** </ul>
-*/
-void sqliteParserFree(
- void *p, /* The parser to be deleted */
- void (*freeProc)(void*) /* Function used to reclaim memory */
-){
- yyParser *pParser = (yyParser*)p;
- if( pParser==0 ) return;
- while( pParser->yyidx>=0 ) yy_pop_parser_stack(pParser);
- (*freeProc)((void*)pParser);
-}
-
-/*
-** Find the appropriate action for a parser given the terminal
-** look-ahead token iLookAhead.
-**
-** If the look-ahead token is YYNOCODE, then check to see if the action is
-** independent of the look-ahead. If it is, return the action, otherwise
-** return YY_NO_ACTION.
-*/
-static int yy_find_shift_action(
- yyParser *pParser, /* The parser */
- int iLookAhead /* The look-ahead token */
-){
- int i;
- int stateno = pParser->yystack[pParser->yyidx].stateno;
-
- /* if( pParser->yyidx<0 ) return YY_NO_ACTION; */
- i = yy_shift_ofst[stateno];
- if( i==YY_SHIFT_USE_DFLT ){
- return yy_default[stateno];
- }
- if( iLookAhead==YYNOCODE ){
- return YY_NO_ACTION;
- }
- i += iLookAhead;
- if( i<0 || i>=YY_SZ_ACTTAB || yy_lookahead[i]!=iLookAhead ){
-#ifdef YYFALLBACK
- int iFallback; /* Fallback token */
- if( iLookAhead<sizeof(yyFallback)/sizeof(yyFallback[0])
- && (iFallback = yyFallback[iLookAhead])!=0 ){
-#ifndef NDEBUG
- if( yyTraceFILE ){
- fprintf(yyTraceFILE, "%sFALLBACK %s => %s\n",
- yyTracePrompt, yyTokenName[iLookAhead], yyTokenName[iFallback]);
- }
-#endif
- return yy_find_shift_action(pParser, iFallback);
- }
-#endif
- return yy_default[stateno];
- }else{
- return yy_action[i];
- }
-}
-
-/*
-** Find the appropriate action for a parser given the non-terminal
-** look-ahead token iLookAhead.
-**
-** If the look-ahead token is YYNOCODE, then check to see if the action is
-** independent of the look-ahead. If it is, return the action, otherwise
-** return YY_NO_ACTION.
-*/
-static int yy_find_reduce_action(
- yyParser *pParser, /* The parser */
- int iLookAhead /* The look-ahead token */
-){
- int i;
- int stateno = pParser->yystack[pParser->yyidx].stateno;
-
- i = yy_reduce_ofst[stateno];
- if( i==YY_REDUCE_USE_DFLT ){
- return yy_default[stateno];
- }
- if( iLookAhead==YYNOCODE ){
- return YY_NO_ACTION;
- }
- i += iLookAhead;
- if( i<0 || i>=YY_SZ_ACTTAB || yy_lookahead[i]!=iLookAhead ){
- return yy_default[stateno];
- }else{
- return yy_action[i];
- }
-}
-
-/*
-** Perform a shift action.
-*/
-static void yy_shift(
- yyParser *yypParser, /* The parser to be shifted */
- int yyNewState, /* The new state to shift in */
- int yyMajor, /* The major token to shift in */
- YYMINORTYPE *yypMinor /* Pointer ot the minor token to shift in */
-){
- yyStackEntry *yytos;
- yypParser->yyidx++;
- if( yypParser->yyidx>=YYSTACKDEPTH ){
- sqliteParserARG_FETCH;
- yypParser->yyidx--;
-#ifndef NDEBUG
- if( yyTraceFILE ){
- fprintf(yyTraceFILE,"%sStack Overflow!\n",yyTracePrompt);
- }
-#endif
- while( yypParser->yyidx>=0 ) yy_pop_parser_stack(yypParser);
- /* Here code is inserted which will execute if the parser
- ** stack every overflows */
- sqliteParserARG_STORE; /* Suppress warning about unused %extra_argument var */
- return;
- }
- yytos = &yypParser->yystack[yypParser->yyidx];
- yytos->stateno = yyNewState;
- yytos->major = yyMajor;
- yytos->minor = *yypMinor;
-#ifndef NDEBUG
- if( yyTraceFILE && yypParser->yyidx>0 ){
- int i;
- fprintf(yyTraceFILE,"%sShift %d\n",yyTracePrompt,yyNewState);
- fprintf(yyTraceFILE,"%sStack:",yyTracePrompt);
- for(i=1; i<=yypParser->yyidx; i++)
- fprintf(yyTraceFILE," %s",yyTokenName[yypParser->yystack[i].major]);
- fprintf(yyTraceFILE,"\n");
- }
-#endif
-}
-
-/* The following table contains information about every rule that
-** is used during the reduce.
-*/
-static struct {
- YYCODETYPE lhs; /* Symbol on the left-hand side of the rule */
- unsigned char nrhs; /* Number of right-hand side symbols in the rule */
-} yyRuleInfo[] = {
- { 132, 1 },
- { 133, 2 },
- { 133, 1 },
- { 134, 3 },
- { 134, 1 },
- { 136, 1 },
- { 135, 1 },
- { 135, 0 },
- { 137, 3 },
- { 138, 0 },
- { 138, 1 },
- { 138, 2 },
- { 137, 2 },
- { 137, 2 },
- { 137, 2 },
- { 137, 2 },
- { 141, 4 },
- { 143, 1 },
- { 143, 0 },
- { 142, 4 },
- { 142, 2 },
- { 144, 3 },
- { 144, 1 },
- { 147, 3 },
- { 148, 1 },
- { 151, 1 },
- { 152, 1 },
- { 152, 1 },
- { 140, 1 },
- { 140, 1 },
- { 140, 1 },
- { 149, 0 },
- { 149, 1 },
- { 149, 4 },
- { 149, 6 },
- { 153, 1 },
- { 153, 2 },
- { 154, 1 },
- { 154, 2 },
- { 154, 2 },
- { 150, 2 },
- { 150, 0 },
- { 155, 3 },
- { 155, 1 },
- { 155, 2 },
- { 155, 2 },
- { 155, 2 },
- { 155, 3 },
- { 155, 3 },
- { 155, 2 },
- { 155, 3 },
- { 155, 3 },
- { 155, 2 },
- { 156, 2 },
- { 156, 3 },
- { 156, 4 },
- { 156, 2 },
- { 156, 5 },
- { 156, 4 },
- { 156, 1 },
- { 156, 2 },
- { 160, 0 },
- { 160, 2 },
- { 162, 2 },
- { 162, 3 },
- { 162, 3 },
- { 162, 3 },
- { 163, 2 },
- { 163, 2 },
- { 163, 1 },
- { 163, 1 },
- { 161, 3 },
- { 161, 2 },
- { 164, 0 },
- { 164, 2 },
- { 164, 2 },
- { 145, 0 },
- { 145, 2 },
- { 165, 3 },
- { 165, 2 },
- { 165, 1 },
- { 166, 2 },
- { 166, 6 },
- { 166, 5 },
- { 166, 3 },
- { 166, 10 },
- { 168, 0 },
- { 168, 1 },
- { 139, 0 },
- { 139, 3 },
- { 169, 0 },
- { 169, 2 },
- { 170, 1 },
- { 170, 1 },
- { 170, 1 },
- { 170, 1 },
- { 170, 1 },
- { 137, 3 },
- { 137, 6 },
- { 137, 3 },
- { 137, 1 },
- { 146, 1 },
- { 146, 3 },
- { 172, 1 },
- { 172, 2 },
- { 172, 1 },
- { 172, 1 },
- { 171, 9 },
- { 173, 1 },
- { 173, 1 },
- { 173, 0 },
- { 181, 2 },
- { 181, 0 },
- { 174, 3 },
- { 174, 2 },
- { 174, 4 },
- { 182, 2 },
- { 182, 1 },
- { 182, 0 },
- { 175, 0 },
- { 175, 2 },
- { 184, 2 },
- { 184, 0 },
- { 183, 6 },
- { 183, 7 },
- { 189, 1 },
- { 189, 1 },
- { 186, 0 },
- { 186, 2 },
- { 185, 1 },
- { 185, 1 },
- { 185, 2 },
- { 185, 3 },
- { 185, 4 },
- { 187, 2 },
- { 187, 0 },
- { 188, 4 },
- { 188, 0 },
- { 179, 0 },
- { 179, 3 },
- { 191, 5 },
- { 191, 3 },
- { 192, 1 },
- { 157, 1 },
- { 157, 1 },
- { 157, 0 },
- { 193, 0 },
- { 193, 2 },
- { 177, 0 },
- { 177, 3 },
- { 178, 0 },
- { 178, 2 },
- { 180, 0 },
- { 180, 2 },
- { 180, 4 },
- { 180, 4 },
- { 137, 5 },
- { 176, 0 },
- { 176, 2 },
- { 137, 7 },
- { 195, 5 },
- { 195, 3 },
- { 137, 9 },
- { 137, 6 },
- { 196, 2 },
- { 196, 1 },
- { 198, 3 },
- { 198, 1 },
- { 197, 0 },
- { 197, 3 },
- { 199, 3 },
- { 199, 1 },
- { 158, 3 },
- { 158, 1 },
- { 158, 1 },
- { 158, 1 },
- { 158, 3 },
- { 158, 5 },
- { 158, 1 },
- { 158, 1 },
- { 158, 1 },
- { 158, 1 },
- { 158, 4 },
- { 158, 4 },
- { 158, 3 },
- { 158, 3 },
- { 158, 3 },
- { 158, 3 },
- { 158, 3 },
- { 158, 3 },
- { 158, 3 },
- { 158, 3 },
- { 158, 3 },
- { 158, 3 },
- { 158, 3 },
- { 158, 3 },
- { 158, 3 },
- { 158, 4 },
- { 200, 1 },
- { 200, 1 },
- { 158, 3 },
- { 158, 3 },
- { 158, 3 },
- { 158, 3 },
- { 158, 3 },
- { 158, 3 },
- { 158, 2 },
- { 158, 3 },
- { 158, 2 },
- { 158, 3 },
- { 158, 4 },
- { 158, 2 },
- { 158, 2 },
- { 158, 2 },
- { 158, 2 },
- { 158, 3 },
- { 158, 5 },
- { 158, 6 },
- { 158, 5 },
- { 158, 5 },
- { 158, 6 },
- { 158, 6 },
- { 158, 4 },
- { 158, 5 },
- { 158, 5 },
- { 202, 5 },
- { 202, 4 },
- { 203, 2 },
- { 203, 0 },
- { 201, 1 },
- { 201, 0 },
- { 194, 3 },
- { 194, 1 },
- { 204, 1 },
- { 204, 0 },
- { 137, 11 },
- { 205, 1 },
- { 205, 0 },
- { 159, 0 },
- { 159, 3 },
- { 167, 3 },
- { 167, 1 },
- { 206, 2 },
- { 137, 4 },
- { 137, 9 },
- { 137, 6 },
- { 137, 1 },
- { 137, 2 },
- { 137, 4 },
- { 137, 4 },
- { 137, 4 },
- { 137, 4 },
- { 137, 5 },
- { 137, 2 },
- { 207, 2 },
- { 208, 2 },
- { 210, 1 },
- { 210, 1 },
- { 209, 1 },
- { 209, 0 },
- { 137, 5 },
- { 211, 10 },
- { 213, 1 },
- { 213, 1 },
- { 213, 2 },
- { 213, 0 },
- { 214, 1 },
- { 214, 1 },
- { 214, 1 },
- { 214, 3 },
- { 215, 0 },
- { 215, 3 },
- { 215, 3 },
- { 216, 0 },
- { 216, 2 },
- { 212, 3 },
- { 212, 0 },
- { 217, 6 },
- { 217, 8 },
- { 217, 5 },
- { 217, 4 },
- { 217, 1 },
- { 158, 4 },
- { 158, 6 },
- { 158, 6 },
- { 158, 6 },
- { 137, 4 },
- { 137, 6 },
- { 219, 2 },
- { 219, 0 },
- { 218, 1 },
- { 218, 0 },
- { 137, 3 },
-};
-
-static void yy_accept(yyParser*); /* Forward Declaration */
-
-/*
-** Perform a reduce action and the shift that must immediately
-** follow the reduce.
-*/
-static void yy_reduce(
- yyParser *yypParser, /* The parser */
- int yyruleno /* Number of the rule by which to reduce */
-){
- int yygoto; /* The next state */
- int yyact; /* The next action */
- YYMINORTYPE yygotominor; /* The LHS of the rule reduced */
- yyStackEntry *yymsp; /* The top of the parser's stack */
- int yysize; /* Amount to pop the stack */
- sqliteParserARG_FETCH;
- yymsp = &yypParser->yystack[yypParser->yyidx];
-#ifndef NDEBUG
- if( yyTraceFILE && yyruleno>=0
- && yyruleno<sizeof(yyRuleName)/sizeof(yyRuleName[0]) ){
- fprintf(yyTraceFILE, "%sReduce [%s].\n", yyTracePrompt,
- yyRuleName[yyruleno]);
- }
-#endif /* NDEBUG */
-
- switch( yyruleno ){
- /* Beginning here are the reduction cases. A typical example
- ** follows:
- ** case 0:
- ** #line <lineno> <grammarfile>
- ** { ... } // User supplied code
- ** #line <lineno> <thisfile>
- ** break;
- */
- case 0:
- /* No destructor defined for cmdlist */
- break;
- case 1:
- /* No destructor defined for cmdlist */
- /* No destructor defined for ecmd */
- break;
- case 2:
- /* No destructor defined for ecmd */
- break;
- case 3:
- /* No destructor defined for explain */
- /* No destructor defined for cmdx */
- /* No destructor defined for SEMI */
- break;
- case 4:
- /* No destructor defined for SEMI */
- break;
- case 5:
-#line 72 "parse.y"
-{ sqliteExec(pParse); }
-#line 1901 "parse.c"
- /* No destructor defined for cmd */
- break;
- case 6:
-#line 73 "parse.y"
-{ sqliteBeginParse(pParse, 1); }
-#line 1907 "parse.c"
- /* No destructor defined for EXPLAIN */
- break;
- case 7:
-#line 74 "parse.y"
-{ sqliteBeginParse(pParse, 0); }
-#line 1913 "parse.c"
- break;
- case 8:
-#line 79 "parse.y"
-{sqliteBeginTransaction(pParse,yymsp[0].minor.yy372);}
-#line 1918 "parse.c"
- /* No destructor defined for BEGIN */
- /* No destructor defined for trans_opt */
- break;
- case 9:
- break;
- case 10:
- /* No destructor defined for TRANSACTION */
- break;
- case 11:
- /* No destructor defined for TRANSACTION */
- /* No destructor defined for nm */
- break;
- case 12:
-#line 83 "parse.y"
-{sqliteCommitTransaction(pParse);}
-#line 1934 "parse.c"
- /* No destructor defined for COMMIT */
- /* No destructor defined for trans_opt */
- break;
- case 13:
-#line 84 "parse.y"
-{sqliteCommitTransaction(pParse);}
-#line 1941 "parse.c"
- /* No destructor defined for END */
- /* No destructor defined for trans_opt */
- break;
- case 14:
-#line 85 "parse.y"
-{sqliteRollbackTransaction(pParse);}
-#line 1948 "parse.c"
- /* No destructor defined for ROLLBACK */
- /* No destructor defined for trans_opt */
- break;
- case 15:
- /* No destructor defined for create_table */
- /* No destructor defined for create_table_args */
- break;
- case 16:
-#line 90 "parse.y"
-{
- sqliteStartTable(pParse,&yymsp[-3].minor.yy0,&yymsp[0].minor.yy298,yymsp[-2].minor.yy372,0);
-}
-#line 1961 "parse.c"
- /* No destructor defined for TABLE */
- break;
- case 17:
-#line 94 "parse.y"
-{yygotominor.yy372 = 1;}
-#line 1967 "parse.c"
- /* No destructor defined for TEMP */
- break;
- case 18:
-#line 95 "parse.y"
-{yygotominor.yy372 = 0;}
-#line 1973 "parse.c"
- break;
- case 19:
-#line 96 "parse.y"
-{
- sqliteEndTable(pParse,&yymsp[0].minor.yy0,0);
-}
-#line 1980 "parse.c"
- /* No destructor defined for LP */
- /* No destructor defined for columnlist */
- /* No destructor defined for conslist_opt */
- break;
- case 20:
-#line 99 "parse.y"
-{
- sqliteEndTable(pParse,0,yymsp[0].minor.yy179);
- sqliteSelectDelete(yymsp[0].minor.yy179);
-}
-#line 1991 "parse.c"
- /* No destructor defined for AS */
- break;
- case 21:
- /* No destructor defined for columnlist */
- /* No destructor defined for COMMA */
- /* No destructor defined for column */
- break;
- case 22:
- /* No destructor defined for column */
- break;
- case 23:
- /* No destructor defined for columnid */
- /* No destructor defined for type */
- /* No destructor defined for carglist */
- break;
- case 24:
-#line 111 "parse.y"
-{sqliteAddColumn(pParse,&yymsp[0].minor.yy298);}
-#line 2010 "parse.c"
- break;
- case 25:
-#line 117 "parse.y"
-{yygotominor.yy298 = yymsp[0].minor.yy0;}
-#line 2015 "parse.c"
- break;
- case 26:
-#line 149 "parse.y"
-{yygotominor.yy298 = yymsp[0].minor.yy0;}
-#line 2020 "parse.c"
- break;
- case 27:
-#line 150 "parse.y"
-{yygotominor.yy298 = yymsp[0].minor.yy0;}
-#line 2025 "parse.c"
- break;
- case 28:
-#line 155 "parse.y"
-{yygotominor.yy298 = yymsp[0].minor.yy0;}
-#line 2030 "parse.c"
- break;
- case 29:
-#line 156 "parse.y"
-{yygotominor.yy298 = yymsp[0].minor.yy0;}
-#line 2035 "parse.c"
- break;
- case 30:
-#line 157 "parse.y"
-{yygotominor.yy298 = yymsp[0].minor.yy0;}
-#line 2040 "parse.c"
- break;
- case 31:
- break;
- case 32:
-#line 160 "parse.y"
-{sqliteAddColumnType(pParse,&yymsp[0].minor.yy298,&yymsp[0].minor.yy298);}
-#line 2047 "parse.c"
- break;
- case 33:
-#line 161 "parse.y"
-{sqliteAddColumnType(pParse,&yymsp[-3].minor.yy298,&yymsp[0].minor.yy0);}
-#line 2052 "parse.c"
- /* No destructor defined for LP */
- /* No destructor defined for signed */
- break;
- case 34:
-#line 163 "parse.y"
-{sqliteAddColumnType(pParse,&yymsp[-5].minor.yy298,&yymsp[0].minor.yy0);}
-#line 2059 "parse.c"
- /* No destructor defined for LP */
- /* No destructor defined for signed */
- /* No destructor defined for COMMA */
- /* No destructor defined for signed */
- break;
- case 35:
-#line 165 "parse.y"
-{yygotominor.yy298 = yymsp[0].minor.yy298;}
-#line 2068 "parse.c"
- break;
- case 36:
-#line 166 "parse.y"
-{yygotominor.yy298 = yymsp[-1].minor.yy298;}
-#line 2073 "parse.c"
- /* No destructor defined for ids */
- break;
- case 37:
-#line 168 "parse.y"
-{ yygotominor.yy372 = atoi(yymsp[0].minor.yy0.z); }
-#line 2079 "parse.c"
- break;
- case 38:
-#line 169 "parse.y"
-{ yygotominor.yy372 = atoi(yymsp[0].minor.yy0.z); }
-#line 2084 "parse.c"
- /* No destructor defined for PLUS */
- break;
- case 39:
-#line 170 "parse.y"
-{ yygotominor.yy372 = -atoi(yymsp[0].minor.yy0.z); }
-#line 2090 "parse.c"
- /* No destructor defined for MINUS */
- break;
- case 40:
- /* No destructor defined for carglist */
- /* No destructor defined for carg */
- break;
- case 41:
- break;
- case 42:
- /* No destructor defined for CONSTRAINT */
- /* No destructor defined for nm */
- /* No destructor defined for ccons */
- break;
- case 43:
- /* No destructor defined for ccons */
- break;
- case 44:
-#line 175 "parse.y"
-{sqliteAddDefaultValue(pParse,&yymsp[0].minor.yy0,0);}
-#line 2110 "parse.c"
- /* No destructor defined for DEFAULT */
- break;
- case 45:
-#line 176 "parse.y"
-{sqliteAddDefaultValue(pParse,&yymsp[0].minor.yy0,0);}
-#line 2116 "parse.c"
- /* No destructor defined for DEFAULT */
- break;
- case 46:
-#line 177 "parse.y"
-{sqliteAddDefaultValue(pParse,&yymsp[0].minor.yy0,0);}
-#line 2122 "parse.c"
- /* No destructor defined for DEFAULT */
- break;
- case 47:
-#line 178 "parse.y"
-{sqliteAddDefaultValue(pParse,&yymsp[0].minor.yy0,0);}
-#line 2128 "parse.c"
- /* No destructor defined for DEFAULT */
- /* No destructor defined for PLUS */
- break;
- case 48:
-#line 179 "parse.y"
-{sqliteAddDefaultValue(pParse,&yymsp[0].minor.yy0,1);}
-#line 2135 "parse.c"
- /* No destructor defined for DEFAULT */
- /* No destructor defined for MINUS */
- break;
- case 49:
-#line 180 "parse.y"
-{sqliteAddDefaultValue(pParse,&yymsp[0].minor.yy0,0);}
-#line 2142 "parse.c"
- /* No destructor defined for DEFAULT */
- break;
- case 50:
-#line 181 "parse.y"
-{sqliteAddDefaultValue(pParse,&yymsp[0].minor.yy0,0);}
-#line 2148 "parse.c"
- /* No destructor defined for DEFAULT */
- /* No destructor defined for PLUS */
- break;
- case 51:
-#line 182 "parse.y"
-{sqliteAddDefaultValue(pParse,&yymsp[0].minor.yy0,1);}
-#line 2155 "parse.c"
- /* No destructor defined for DEFAULT */
- /* No destructor defined for MINUS */
- break;
- case 52:
- /* No destructor defined for DEFAULT */
- /* No destructor defined for NULL */
- break;
- case 53:
- /* No destructor defined for NULL */
- /* No destructor defined for onconf */
- break;
- case 54:
-#line 189 "parse.y"
-{sqliteAddNotNull(pParse, yymsp[0].minor.yy372);}
-#line 2170 "parse.c"
- /* No destructor defined for NOT */
- /* No destructor defined for NULL */
- break;
- case 55:
-#line 190 "parse.y"
-{sqliteAddPrimaryKey(pParse,0,yymsp[0].minor.yy372);}
-#line 2177 "parse.c"
- /* No destructor defined for PRIMARY */
- /* No destructor defined for KEY */
- /* No destructor defined for sortorder */
- break;
- case 56:
-#line 191 "parse.y"
-{sqliteCreateIndex(pParse,0,0,0,yymsp[0].minor.yy372,0,0);}
-#line 2185 "parse.c"
- /* No destructor defined for UNIQUE */
- break;
- case 57:
- /* No destructor defined for CHECK */
- /* No destructor defined for LP */
- yy_destructor(158,&yymsp[-2].minor);
- /* No destructor defined for RP */
- /* No destructor defined for onconf */
- break;
- case 58:
-#line 194 "parse.y"
-{sqliteCreateForeignKey(pParse,0,&yymsp[-2].minor.yy298,yymsp[-1].minor.yy320,yymsp[0].minor.yy372);}
-#line 2198 "parse.c"
- /* No destructor defined for REFERENCES */
- break;
- case 59:
-#line 195 "parse.y"
-{sqliteDeferForeignKey(pParse,yymsp[0].minor.yy372);}
-#line 2204 "parse.c"
- break;
- case 60:
-#line 196 "parse.y"
-{
- sqliteAddCollateType(pParse, sqliteCollateType(yymsp[0].minor.yy298.z, yymsp[0].minor.yy298.n));
-}
-#line 2211 "parse.c"
- /* No destructor defined for COLLATE */
- break;
- case 61:
-#line 206 "parse.y"
-{ yygotominor.yy372 = OE_Restrict * 0x010101; }
-#line 2217 "parse.c"
- break;
- case 62:
-#line 207 "parse.y"
-{ yygotominor.yy372 = (yymsp[-1].minor.yy372 & yymsp[0].minor.yy407.mask) | yymsp[0].minor.yy407.value; }
-#line 2222 "parse.c"
- break;
- case 63:
-#line 209 "parse.y"
-{ yygotominor.yy407.value = 0; yygotominor.yy407.mask = 0x000000; }
-#line 2227 "parse.c"
- /* No destructor defined for MATCH */
- /* No destructor defined for nm */
- break;
- case 64:
-#line 210 "parse.y"
-{ yygotominor.yy407.value = yymsp[0].minor.yy372; yygotominor.yy407.mask = 0x0000ff; }
-#line 2234 "parse.c"
- /* No destructor defined for ON */
- /* No destructor defined for DELETE */
- break;
- case 65:
-#line 211 "parse.y"
-{ yygotominor.yy407.value = yymsp[0].minor.yy372<<8; yygotominor.yy407.mask = 0x00ff00; }
-#line 2241 "parse.c"
- /* No destructor defined for ON */
- /* No destructor defined for UPDATE */
- break;
- case 66:
-#line 212 "parse.y"
-{ yygotominor.yy407.value = yymsp[0].minor.yy372<<16; yygotominor.yy407.mask = 0xff0000; }
-#line 2248 "parse.c"
- /* No destructor defined for ON */
- /* No destructor defined for INSERT */
- break;
- case 67:
-#line 214 "parse.y"
-{ yygotominor.yy372 = OE_SetNull; }
-#line 2255 "parse.c"
- /* No destructor defined for SET */
- /* No destructor defined for NULL */
- break;
- case 68:
-#line 215 "parse.y"
-{ yygotominor.yy372 = OE_SetDflt; }
-#line 2262 "parse.c"
- /* No destructor defined for SET */
- /* No destructor defined for DEFAULT */
- break;
- case 69:
-#line 216 "parse.y"
-{ yygotominor.yy372 = OE_Cascade; }
-#line 2269 "parse.c"
- /* No destructor defined for CASCADE */
- break;
- case 70:
-#line 217 "parse.y"
-{ yygotominor.yy372 = OE_Restrict; }
-#line 2275 "parse.c"
- /* No destructor defined for RESTRICT */
- break;
- case 71:
-#line 219 "parse.y"
-{yygotominor.yy372 = yymsp[0].minor.yy372;}
-#line 2281 "parse.c"
- /* No destructor defined for NOT */
- /* No destructor defined for DEFERRABLE */
- break;
- case 72:
-#line 220 "parse.y"
-{yygotominor.yy372 = yymsp[0].minor.yy372;}
-#line 2288 "parse.c"
- /* No destructor defined for DEFERRABLE */
- break;
- case 73:
-#line 222 "parse.y"
-{yygotominor.yy372 = 0;}
-#line 2294 "parse.c"
- break;
- case 74:
-#line 223 "parse.y"
-{yygotominor.yy372 = 1;}
-#line 2299 "parse.c"
- /* No destructor defined for INITIALLY */
- /* No destructor defined for DEFERRED */
- break;
- case 75:
-#line 224 "parse.y"
-{yygotominor.yy372 = 0;}
-#line 2306 "parse.c"
- /* No destructor defined for INITIALLY */
- /* No destructor defined for IMMEDIATE */
- break;
- case 76:
- break;
- case 77:
- /* No destructor defined for COMMA */
- /* No destructor defined for conslist */
- break;
- case 78:
- /* No destructor defined for conslist */
- /* No destructor defined for COMMA */
- /* No destructor defined for tcons */
- break;
- case 79:
- /* No destructor defined for conslist */
- /* No destructor defined for tcons */
- break;
- case 80:
- /* No destructor defined for tcons */
- break;
- case 81:
- /* No destructor defined for CONSTRAINT */
- /* No destructor defined for nm */
- break;
- case 82:
-#line 236 "parse.y"
-{sqliteAddPrimaryKey(pParse,yymsp[-2].minor.yy320,yymsp[0].minor.yy372);}
-#line 2335 "parse.c"
- /* No destructor defined for PRIMARY */
- /* No destructor defined for KEY */
- /* No destructor defined for LP */
- /* No destructor defined for RP */
- break;
- case 83:
-#line 238 "parse.y"
-{sqliteCreateIndex(pParse,0,0,yymsp[-2].minor.yy320,yymsp[0].minor.yy372,0,0);}
-#line 2344 "parse.c"
- /* No destructor defined for UNIQUE */
- /* No destructor defined for LP */
- /* No destructor defined for RP */
- break;
- case 84:
- /* No destructor defined for CHECK */
- yy_destructor(158,&yymsp[-1].minor);
- /* No destructor defined for onconf */
- break;
- case 85:
-#line 241 "parse.y"
-{
- sqliteCreateForeignKey(pParse, yymsp[-6].minor.yy320, &yymsp[-3].minor.yy298, yymsp[-2].minor.yy320, yymsp[-1].minor.yy372);
- sqliteDeferForeignKey(pParse, yymsp[0].minor.yy372);
-}
-#line 2360 "parse.c"
- /* No destructor defined for FOREIGN */
- /* No destructor defined for KEY */
- /* No destructor defined for LP */
- /* No destructor defined for RP */
- /* No destructor defined for REFERENCES */
- break;
- case 86:
-#line 246 "parse.y"
-{yygotominor.yy372 = 0;}
-#line 2370 "parse.c"
- break;
- case 87:
-#line 247 "parse.y"
-{yygotominor.yy372 = yymsp[0].minor.yy372;}
-#line 2375 "parse.c"
- break;
- case 88:
-#line 255 "parse.y"
-{ yygotominor.yy372 = OE_Default; }
-#line 2380 "parse.c"
- break;
- case 89:
-#line 256 "parse.y"
-{ yygotominor.yy372 = yymsp[0].minor.yy372; }
-#line 2385 "parse.c"
- /* No destructor defined for ON */
- /* No destructor defined for CONFLICT */
- break;
- case 90:
-#line 257 "parse.y"
-{ yygotominor.yy372 = OE_Default; }
-#line 2392 "parse.c"
- break;
- case 91:
-#line 258 "parse.y"
-{ yygotominor.yy372 = yymsp[0].minor.yy372; }
-#line 2397 "parse.c"
- /* No destructor defined for OR */
- break;
- case 92:
-#line 259 "parse.y"
-{ yygotominor.yy372 = OE_Rollback; }
-#line 2403 "parse.c"
- /* No destructor defined for ROLLBACK */
- break;
- case 93:
-#line 260 "parse.y"
-{ yygotominor.yy372 = OE_Abort; }
-#line 2409 "parse.c"
- /* No destructor defined for ABORT */
- break;
- case 94:
-#line 261 "parse.y"
-{ yygotominor.yy372 = OE_Fail; }
-#line 2415 "parse.c"
- /* No destructor defined for FAIL */
- break;
- case 95:
-#line 262 "parse.y"
-{ yygotominor.yy372 = OE_Ignore; }
-#line 2421 "parse.c"
- /* No destructor defined for IGNORE */
- break;
- case 96:
-#line 263 "parse.y"
-{ yygotominor.yy372 = OE_Replace; }
-#line 2427 "parse.c"
- /* No destructor defined for REPLACE */
- break;
- case 97:
-#line 267 "parse.y"
-{sqliteDropTable(pParse,&yymsp[0].minor.yy298,0);}
-#line 2433 "parse.c"
- /* No destructor defined for DROP */
- /* No destructor defined for TABLE */
- break;
- case 98:
-#line 271 "parse.y"
-{
- sqliteCreateView(pParse, &yymsp[-5].minor.yy0, &yymsp[-2].minor.yy298, yymsp[0].minor.yy179, yymsp[-4].minor.yy372);
-}
-#line 2442 "parse.c"
- /* No destructor defined for VIEW */
- /* No destructor defined for AS */
- break;
- case 99:
-#line 274 "parse.y"
-{
- sqliteDropTable(pParse, &yymsp[0].minor.yy298, 1);
-}
-#line 2451 "parse.c"
- /* No destructor defined for DROP */
- /* No destructor defined for VIEW */
- break;
- case 100:
-#line 280 "parse.y"
-{
- sqliteSelect(pParse, yymsp[0].minor.yy179, SRT_Callback, 0, 0, 0, 0);
- sqliteSelectDelete(yymsp[0].minor.yy179);
-}
-#line 2461 "parse.c"
- break;
- case 101:
-#line 290 "parse.y"
-{yygotominor.yy179 = yymsp[0].minor.yy179;}
-#line 2466 "parse.c"
- break;
- case 102:
-#line 291 "parse.y"
-{
- if( yymsp[0].minor.yy179 ){
- yymsp[0].minor.yy179->op = yymsp[-1].minor.yy372;
- yymsp[0].minor.yy179->pPrior = yymsp[-2].minor.yy179;
- }
- yygotominor.yy179 = yymsp[0].minor.yy179;
-}
-#line 2477 "parse.c"
- break;
- case 103:
-#line 299 "parse.y"
-{yygotominor.yy372 = TK_UNION;}
-#line 2482 "parse.c"
- /* No destructor defined for UNION */
- break;
- case 104:
-#line 300 "parse.y"
-{yygotominor.yy372 = TK_ALL;}
-#line 2488 "parse.c"
- /* No destructor defined for UNION */
- /* No destructor defined for ALL */
- break;
- case 105:
-#line 301 "parse.y"
-{yygotominor.yy372 = TK_INTERSECT;}
-#line 2495 "parse.c"
- /* No destructor defined for INTERSECT */
- break;
- case 106:
-#line 302 "parse.y"
-{yygotominor.yy372 = TK_EXCEPT;}
-#line 2501 "parse.c"
- /* No destructor defined for EXCEPT */
- break;
- case 107:
-#line 304 "parse.y"
-{
- yygotominor.yy179 = sqliteSelectNew(yymsp[-6].minor.yy322,yymsp[-5].minor.yy307,yymsp[-4].minor.yy242,yymsp[-3].minor.yy322,yymsp[-2].minor.yy242,yymsp[-1].minor.yy322,yymsp[-7].minor.yy372,yymsp[0].minor.yy124.limit,yymsp[0].minor.yy124.offset);
-}
-#line 2509 "parse.c"
- /* No destructor defined for SELECT */
- break;
- case 108:
-#line 312 "parse.y"
-{yygotominor.yy372 = 1;}
-#line 2515 "parse.c"
- /* No destructor defined for DISTINCT */
- break;
- case 109:
-#line 313 "parse.y"
-{yygotominor.yy372 = 0;}
-#line 2521 "parse.c"
- /* No destructor defined for ALL */
- break;
- case 110:
-#line 314 "parse.y"
-{yygotominor.yy372 = 0;}
-#line 2527 "parse.c"
- break;
- case 111:
-#line 325 "parse.y"
-{yygotominor.yy322 = yymsp[-1].minor.yy322;}
-#line 2532 "parse.c"
- /* No destructor defined for COMMA */
- break;
- case 112:
-#line 326 "parse.y"
-{yygotominor.yy322 = 0;}
-#line 2538 "parse.c"
- break;
- case 113:
-#line 327 "parse.y"
-{
- yygotominor.yy322 = sqliteExprListAppend(yymsp[-2].minor.yy322,yymsp[-1].minor.yy242,yymsp[0].minor.yy298.n?&yymsp[0].minor.yy298:0);
-}
-#line 2545 "parse.c"
- break;
- case 114:
-#line 330 "parse.y"
-{
- yygotominor.yy322 = sqliteExprListAppend(yymsp[-1].minor.yy322, sqliteExpr(TK_ALL, 0, 0, 0), 0);
-}
-#line 2552 "parse.c"
- /* No destructor defined for STAR */
- break;
- case 115:
-#line 333 "parse.y"
-{
- Expr *pRight = sqliteExpr(TK_ALL, 0, 0, 0);
- Expr *pLeft = sqliteExpr(TK_ID, 0, 0, &yymsp[-2].minor.yy298);
- yygotominor.yy322 = sqliteExprListAppend(yymsp[-3].minor.yy322, sqliteExpr(TK_DOT, pLeft, pRight, 0), 0);
-}
-#line 2562 "parse.c"
- /* No destructor defined for DOT */
- /* No destructor defined for STAR */
- break;
- case 116:
-#line 343 "parse.y"
-{ yygotominor.yy298 = yymsp[0].minor.yy298; }
-#line 2569 "parse.c"
- /* No destructor defined for AS */
- break;
- case 117:
-#line 344 "parse.y"
-{ yygotominor.yy298 = yymsp[0].minor.yy298; }
-#line 2575 "parse.c"
- break;
- case 118:
-#line 345 "parse.y"
-{ yygotominor.yy298.n = 0; }
-#line 2580 "parse.c"
- break;
- case 119:
-#line 357 "parse.y"
-{yygotominor.yy307 = sqliteMalloc(sizeof(*yygotominor.yy307));}
-#line 2585 "parse.c"
- break;
- case 120:
-#line 358 "parse.y"
-{yygotominor.yy307 = yymsp[0].minor.yy307;}
-#line 2590 "parse.c"
- /* No destructor defined for FROM */
- break;
- case 121:
-#line 363 "parse.y"
-{
- yygotominor.yy307 = yymsp[-1].minor.yy307;
- if( yygotominor.yy307 && yygotominor.yy307->nSrc>0 ) yygotominor.yy307->a[yygotominor.yy307->nSrc-1].jointype = yymsp[0].minor.yy372;
-}
-#line 2599 "parse.c"
- break;
- case 122:
-#line 367 "parse.y"
-{yygotominor.yy307 = 0;}
-#line 2604 "parse.c"
- break;
- case 123:
-#line 368 "parse.y"
-{
- yygotominor.yy307 = sqliteSrcListAppend(yymsp[-5].minor.yy307,&yymsp[-4].minor.yy298,&yymsp[-3].minor.yy298);
- if( yymsp[-2].minor.yy298.n ) sqliteSrcListAddAlias(yygotominor.yy307,&yymsp[-2].minor.yy298);
- if( yymsp[-1].minor.yy242 ){
- if( yygotominor.yy307 && yygotominor.yy307->nSrc>1 ){ yygotominor.yy307->a[yygotominor.yy307->nSrc-2].pOn = yymsp[-1].minor.yy242; }
- else { sqliteExprDelete(yymsp[-1].minor.yy242); }
- }
- if( yymsp[0].minor.yy320 ){
- if( yygotominor.yy307 && yygotominor.yy307->nSrc>1 ){ yygotominor.yy307->a[yygotominor.yy307->nSrc-2].pUsing = yymsp[0].minor.yy320; }
- else { sqliteIdListDelete(yymsp[0].minor.yy320); }
- }
-}
-#line 2620 "parse.c"
- break;
- case 124:
-#line 381 "parse.y"
-{
- yygotominor.yy307 = sqliteSrcListAppend(yymsp[-6].minor.yy307,0,0);
- yygotominor.yy307->a[yygotominor.yy307->nSrc-1].pSelect = yymsp[-4].minor.yy179;
- if( yymsp[-2].minor.yy298.n ) sqliteSrcListAddAlias(yygotominor.yy307,&yymsp[-2].minor.yy298);
- if( yymsp[-1].minor.yy242 ){
- if( yygotominor.yy307 && yygotominor.yy307->nSrc>1 ){ yygotominor.yy307->a[yygotominor.yy307->nSrc-2].pOn = yymsp[-1].minor.yy242; }
- else { sqliteExprDelete(yymsp[-1].minor.yy242); }
- }
- if( yymsp[0].minor.yy320 ){
- if( yygotominor.yy307 && yygotominor.yy307->nSrc>1 ){ yygotominor.yy307->a[yygotominor.yy307->nSrc-2].pUsing = yymsp[0].minor.yy320; }
- else { sqliteIdListDelete(yymsp[0].minor.yy320); }
- }
-}
-#line 2637 "parse.c"
- /* No destructor defined for LP */
- /* No destructor defined for RP */
- break;
- case 125:
-#line 401 "parse.y"
-{yygotominor.yy179 = yymsp[0].minor.yy179;}
-#line 2644 "parse.c"
- break;
- case 126:
-#line 402 "parse.y"
-{
- yygotominor.yy179 = sqliteSelectNew(0,yymsp[0].minor.yy307,0,0,0,0,0,-1,0);
-}
-#line 2651 "parse.c"
- break;
- case 127:
-#line 407 "parse.y"
-{yygotominor.yy298.z=0; yygotominor.yy298.n=0;}
-#line 2656 "parse.c"
- break;
- case 128:
-#line 408 "parse.y"
-{yygotominor.yy298 = yymsp[0].minor.yy298;}
-#line 2661 "parse.c"
- /* No destructor defined for DOT */
- break;
- case 129:
-#line 412 "parse.y"
-{ yygotominor.yy372 = JT_INNER; }
-#line 2667 "parse.c"
- /* No destructor defined for COMMA */
- break;
- case 130:
-#line 413 "parse.y"
-{ yygotominor.yy372 = JT_INNER; }
-#line 2673 "parse.c"
- /* No destructor defined for JOIN */
- break;
- case 131:
-#line 414 "parse.y"
-{ yygotominor.yy372 = sqliteJoinType(pParse,&yymsp[-1].minor.yy0,0,0); }
-#line 2679 "parse.c"
- /* No destructor defined for JOIN */
- break;
- case 132:
-#line 415 "parse.y"
-{ yygotominor.yy372 = sqliteJoinType(pParse,&yymsp[-2].minor.yy0,&yymsp[-1].minor.yy298,0); }
-#line 2685 "parse.c"
- /* No destructor defined for JOIN */
- break;
- case 133:
-#line 417 "parse.y"
-{ yygotominor.yy372 = sqliteJoinType(pParse,&yymsp[-3].minor.yy0,&yymsp[-2].minor.yy298,&yymsp[-1].minor.yy298); }
-#line 2691 "parse.c"
- /* No destructor defined for JOIN */
- break;
- case 134:
-#line 421 "parse.y"
-{yygotominor.yy242 = yymsp[0].minor.yy242;}
-#line 2697 "parse.c"
- /* No destructor defined for ON */
- break;
- case 135:
-#line 422 "parse.y"
-{yygotominor.yy242 = 0;}
-#line 2703 "parse.c"
- break;
- case 136:
-#line 426 "parse.y"
-{yygotominor.yy320 = yymsp[-1].minor.yy320;}
-#line 2708 "parse.c"
- /* No destructor defined for USING */
- /* No destructor defined for LP */
- /* No destructor defined for RP */
- break;
- case 137:
-#line 427 "parse.y"
-{yygotominor.yy320 = 0;}
-#line 2716 "parse.c"
- break;
- case 138:
-#line 437 "parse.y"
-{yygotominor.yy322 = 0;}
-#line 2721 "parse.c"
- break;
- case 139:
-#line 438 "parse.y"
-{yygotominor.yy322 = yymsp[0].minor.yy322;}
-#line 2726 "parse.c"
- /* No destructor defined for ORDER */
- /* No destructor defined for BY */
- break;
- case 140:
-#line 439 "parse.y"
-{
- yygotominor.yy322 = sqliteExprListAppend(yymsp[-4].minor.yy322,yymsp[-2].minor.yy242,0);
- if( yygotominor.yy322 ) yygotominor.yy322->a[yygotominor.yy322->nExpr-1].sortOrder = yymsp[-1].minor.yy372+yymsp[0].minor.yy372;
-}
-#line 2736 "parse.c"
- /* No destructor defined for COMMA */
- break;
- case 141:
-#line 443 "parse.y"
-{
- yygotominor.yy322 = sqliteExprListAppend(0,yymsp[-2].minor.yy242,0);
- if( yygotominor.yy322 ) yygotominor.yy322->a[0].sortOrder = yymsp[-1].minor.yy372+yymsp[0].minor.yy372;
-}
-#line 2745 "parse.c"
- break;
- case 142:
-#line 447 "parse.y"
-{yygotominor.yy242 = yymsp[0].minor.yy242;}
-#line 2750 "parse.c"
- break;
- case 143:
-#line 452 "parse.y"
-{yygotominor.yy372 = SQLITE_SO_ASC;}
-#line 2755 "parse.c"
- /* No destructor defined for ASC */
- break;
- case 144:
-#line 453 "parse.y"
-{yygotominor.yy372 = SQLITE_SO_DESC;}
-#line 2761 "parse.c"
- /* No destructor defined for DESC */
- break;
- case 145:
-#line 454 "parse.y"
-{yygotominor.yy372 = SQLITE_SO_ASC;}
-#line 2767 "parse.c"
- break;
- case 146:
-#line 455 "parse.y"
-{yygotominor.yy372 = SQLITE_SO_UNK;}
-#line 2772 "parse.c"
- break;
- case 147:
-#line 456 "parse.y"
-{yygotominor.yy372 = sqliteCollateType(yymsp[0].minor.yy298.z, yymsp[0].minor.yy298.n);}
-#line 2777 "parse.c"
- /* No destructor defined for COLLATE */
- break;
- case 148:
-#line 460 "parse.y"
-{yygotominor.yy322 = 0;}
-#line 2783 "parse.c"
- break;
- case 149:
-#line 461 "parse.y"
-{yygotominor.yy322 = yymsp[0].minor.yy322;}
-#line 2788 "parse.c"
- /* No destructor defined for GROUP */
- /* No destructor defined for BY */
- break;
- case 150:
-#line 465 "parse.y"
-{yygotominor.yy242 = 0;}
-#line 2795 "parse.c"
- break;
- case 151:
-#line 466 "parse.y"
-{yygotominor.yy242 = yymsp[0].minor.yy242;}
-#line 2800 "parse.c"
- /* No destructor defined for HAVING */
- break;
- case 152:
-#line 469 "parse.y"
-{yygotominor.yy124.limit = -1; yygotominor.yy124.offset = 0;}
-#line 2806 "parse.c"
- break;
- case 153:
-#line 470 "parse.y"
-{yygotominor.yy124.limit = yymsp[0].minor.yy372; yygotominor.yy124.offset = 0;}
-#line 2811 "parse.c"
- /* No destructor defined for LIMIT */
- break;
- case 154:
-#line 472 "parse.y"
-{yygotominor.yy124.limit = yymsp[-2].minor.yy372; yygotominor.yy124.offset = yymsp[0].minor.yy372;}
-#line 2817 "parse.c"
- /* No destructor defined for LIMIT */
- /* No destructor defined for OFFSET */
- break;
- case 155:
-#line 474 "parse.y"
-{yygotominor.yy124.limit = yymsp[0].minor.yy372; yygotominor.yy124.offset = yymsp[-2].minor.yy372;}
-#line 2824 "parse.c"
- /* No destructor defined for LIMIT */
- /* No destructor defined for COMMA */
- break;
- case 156:
-#line 478 "parse.y"
-{
- sqliteDeleteFrom(pParse, sqliteSrcListAppend(0,&yymsp[-2].minor.yy298,&yymsp[-1].minor.yy298), yymsp[0].minor.yy242);
-}
-#line 2833 "parse.c"
- /* No destructor defined for DELETE */
- /* No destructor defined for FROM */
- break;
- case 157:
-#line 485 "parse.y"
-{yygotominor.yy242 = 0;}
-#line 2840 "parse.c"
- break;
- case 158:
-#line 486 "parse.y"
-{yygotominor.yy242 = yymsp[0].minor.yy242;}
-#line 2845 "parse.c"
- /* No destructor defined for WHERE */
- break;
- case 159:
-#line 494 "parse.y"
-{sqliteUpdate(pParse,sqliteSrcListAppend(0,&yymsp[-4].minor.yy298,&yymsp[-3].minor.yy298),yymsp[-1].minor.yy322,yymsp[0].minor.yy242,yymsp[-5].minor.yy372);}
-#line 2851 "parse.c"
- /* No destructor defined for UPDATE */
- /* No destructor defined for SET */
- break;
- case 160:
-#line 497 "parse.y"
-{yygotominor.yy322 = sqliteExprListAppend(yymsp[-4].minor.yy322,yymsp[0].minor.yy242,&yymsp[-2].minor.yy298);}
-#line 2858 "parse.c"
- /* No destructor defined for COMMA */
- /* No destructor defined for EQ */
- break;
- case 161:
-#line 498 "parse.y"
-{yygotominor.yy322 = sqliteExprListAppend(0,yymsp[0].minor.yy242,&yymsp[-2].minor.yy298);}
-#line 2865 "parse.c"
- /* No destructor defined for EQ */
- break;
- case 162:
-#line 504 "parse.y"
-{sqliteInsert(pParse, sqliteSrcListAppend(0,&yymsp[-6].minor.yy298,&yymsp[-5].minor.yy298), yymsp[-1].minor.yy322, 0, yymsp[-4].minor.yy320, yymsp[-8].minor.yy372);}
-#line 2871 "parse.c"
- /* No destructor defined for INTO */
- /* No destructor defined for VALUES */
- /* No destructor defined for LP */
- /* No destructor defined for RP */
- break;
- case 163:
-#line 506 "parse.y"
-{sqliteInsert(pParse, sqliteSrcListAppend(0,&yymsp[-3].minor.yy298,&yymsp[-2].minor.yy298), 0, yymsp[0].minor.yy179, yymsp[-1].minor.yy320, yymsp[-5].minor.yy372);}
-#line 2880 "parse.c"
- /* No destructor defined for INTO */
- break;
- case 164:
-#line 509 "parse.y"
-{yygotominor.yy372 = yymsp[0].minor.yy372;}
-#line 2886 "parse.c"
- /* No destructor defined for INSERT */
- break;
- case 165:
-#line 510 "parse.y"
-{yygotominor.yy372 = OE_Replace;}
-#line 2892 "parse.c"
- /* No destructor defined for REPLACE */
- break;
- case 166:
-#line 516 "parse.y"
-{yygotominor.yy322 = sqliteExprListAppend(yymsp[-2].minor.yy322,yymsp[0].minor.yy242,0);}
-#line 2898 "parse.c"
- /* No destructor defined for COMMA */
- break;
- case 167:
-#line 517 "parse.y"
-{yygotominor.yy322 = sqliteExprListAppend(0,yymsp[0].minor.yy242,0);}
-#line 2904 "parse.c"
- break;
- case 168:
-#line 524 "parse.y"
-{yygotominor.yy320 = 0;}
-#line 2909 "parse.c"
- break;
- case 169:
-#line 525 "parse.y"
-{yygotominor.yy320 = yymsp[-1].minor.yy320;}
-#line 2914 "parse.c"
- /* No destructor defined for LP */
- /* No destructor defined for RP */
- break;
- case 170:
-#line 526 "parse.y"
-{yygotominor.yy320 = sqliteIdListAppend(yymsp[-2].minor.yy320,&yymsp[0].minor.yy298);}
-#line 2921 "parse.c"
- /* No destructor defined for COMMA */
- break;
- case 171:
-#line 527 "parse.y"
-{yygotominor.yy320 = sqliteIdListAppend(0,&yymsp[0].minor.yy298);}
-#line 2927 "parse.c"
- break;
- case 172:
-#line 535 "parse.y"
-{yygotominor.yy242 = yymsp[-1].minor.yy242; sqliteExprSpan(yygotominor.yy242,&yymsp[-2].minor.yy0,&yymsp[0].minor.yy0); }
-#line 2932 "parse.c"
- break;
- case 173:
-#line 536 "parse.y"
-{yygotominor.yy242 = sqliteExpr(TK_NULL, 0, 0, &yymsp[0].minor.yy0);}
-#line 2937 "parse.c"
- break;
- case 174:
-#line 537 "parse.y"
-{yygotominor.yy242 = sqliteExpr(TK_ID, 0, 0, &yymsp[0].minor.yy0);}
-#line 2942 "parse.c"
- break;
- case 175:
-#line 538 "parse.y"
-{yygotominor.yy242 = sqliteExpr(TK_ID, 0, 0, &yymsp[0].minor.yy0);}
-#line 2947 "parse.c"
- break;
- case 176:
-#line 539 "parse.y"
-{
- Expr *temp1 = sqliteExpr(TK_ID, 0, 0, &yymsp[-2].minor.yy298);
- Expr *temp2 = sqliteExpr(TK_ID, 0, 0, &yymsp[0].minor.yy298);
- yygotominor.yy242 = sqliteExpr(TK_DOT, temp1, temp2, 0);
-}
-#line 2956 "parse.c"
- /* No destructor defined for DOT */
- break;
- case 177:
-#line 544 "parse.y"
-{
- Expr *temp1 = sqliteExpr(TK_ID, 0, 0, &yymsp[-4].minor.yy298);
- Expr *temp2 = sqliteExpr(TK_ID, 0, 0, &yymsp[-2].minor.yy298);
- Expr *temp3 = sqliteExpr(TK_ID, 0, 0, &yymsp[0].minor.yy298);
- Expr *temp4 = sqliteExpr(TK_DOT, temp2, temp3, 0);
- yygotominor.yy242 = sqliteExpr(TK_DOT, temp1, temp4, 0);
-}
-#line 2968 "parse.c"
- /* No destructor defined for DOT */
- /* No destructor defined for DOT */
- break;
- case 178:
-#line 551 "parse.y"
-{yygotominor.yy242 = sqliteExpr(TK_INTEGER, 0, 0, &yymsp[0].minor.yy0);}
-#line 2975 "parse.c"
- break;
- case 179:
-#line 552 "parse.y"
-{yygotominor.yy242 = sqliteExpr(TK_FLOAT, 0, 0, &yymsp[0].minor.yy0);}
-#line 2980 "parse.c"
- break;
- case 180:
-#line 553 "parse.y"
-{yygotominor.yy242 = sqliteExpr(TK_STRING, 0, 0, &yymsp[0].minor.yy0);}
-#line 2985 "parse.c"
- break;
- case 181:
-#line 554 "parse.y"
-{
- yygotominor.yy242 = sqliteExpr(TK_VARIABLE, 0, 0, &yymsp[0].minor.yy0);
- if( yygotominor.yy242 ) yygotominor.yy242->iTable = ++pParse->nVar;
-}
-#line 2993 "parse.c"
- break;
- case 182:
-#line 558 "parse.y"
-{
- yygotominor.yy242 = sqliteExprFunction(yymsp[-1].minor.yy322, &yymsp[-3].minor.yy0);
- sqliteExprSpan(yygotominor.yy242,&yymsp[-3].minor.yy0,&yymsp[0].minor.yy0);
-}
-#line 3001 "parse.c"
- /* No destructor defined for LP */
- break;
- case 183:
-#line 562 "parse.y"
-{
- yygotominor.yy242 = sqliteExprFunction(0, &yymsp[-3].minor.yy0);
- sqliteExprSpan(yygotominor.yy242,&yymsp[-3].minor.yy0,&yymsp[0].minor.yy0);
-}
-#line 3010 "parse.c"
- /* No destructor defined for LP */
- /* No destructor defined for STAR */
- break;
- case 184:
-#line 566 "parse.y"
-{yygotominor.yy242 = sqliteExpr(TK_AND, yymsp[-2].minor.yy242, yymsp[0].minor.yy242, 0);}
-#line 3017 "parse.c"
- /* No destructor defined for AND */
- break;
- case 185:
-#line 567 "parse.y"
-{yygotominor.yy242 = sqliteExpr(TK_OR, yymsp[-2].minor.yy242, yymsp[0].minor.yy242, 0);}
-#line 3023 "parse.c"
- /* No destructor defined for OR */
- break;
- case 186:
-#line 568 "parse.y"
-{yygotominor.yy242 = sqliteExpr(TK_LT, yymsp[-2].minor.yy242, yymsp[0].minor.yy242, 0);}
-#line 3029 "parse.c"
- /* No destructor defined for LT */
- break;
- case 187:
-#line 569 "parse.y"
-{yygotominor.yy242 = sqliteExpr(TK_GT, yymsp[-2].minor.yy242, yymsp[0].minor.yy242, 0);}
-#line 3035 "parse.c"
- /* No destructor defined for GT */
- break;
- case 188:
-#line 570 "parse.y"
-{yygotominor.yy242 = sqliteExpr(TK_LE, yymsp[-2].minor.yy242, yymsp[0].minor.yy242, 0);}
-#line 3041 "parse.c"
- /* No destructor defined for LE */
- break;
- case 189:
-#line 571 "parse.y"
-{yygotominor.yy242 = sqliteExpr(TK_GE, yymsp[-2].minor.yy242, yymsp[0].minor.yy242, 0);}
-#line 3047 "parse.c"
- /* No destructor defined for GE */
- break;
- case 190:
-#line 572 "parse.y"
-{yygotominor.yy242 = sqliteExpr(TK_NE, yymsp[-2].minor.yy242, yymsp[0].minor.yy242, 0);}
-#line 3053 "parse.c"
- /* No destructor defined for NE */
- break;
- case 191:
-#line 573 "parse.y"
-{yygotominor.yy242 = sqliteExpr(TK_EQ, yymsp[-2].minor.yy242, yymsp[0].minor.yy242, 0);}
-#line 3059 "parse.c"
- /* No destructor defined for EQ */
- break;
- case 192:
-#line 574 "parse.y"
-{yygotominor.yy242 = sqliteExpr(TK_BITAND, yymsp[-2].minor.yy242, yymsp[0].minor.yy242, 0);}
-#line 3065 "parse.c"
- /* No destructor defined for BITAND */
- break;
- case 193:
-#line 575 "parse.y"
-{yygotominor.yy242 = sqliteExpr(TK_BITOR, yymsp[-2].minor.yy242, yymsp[0].minor.yy242, 0);}
-#line 3071 "parse.c"
- /* No destructor defined for BITOR */
- break;
- case 194:
-#line 576 "parse.y"
-{yygotominor.yy242 = sqliteExpr(TK_LSHIFT, yymsp[-2].minor.yy242, yymsp[0].minor.yy242, 0);}
-#line 3077 "parse.c"
- /* No destructor defined for LSHIFT */
- break;
- case 195:
-#line 577 "parse.y"
-{yygotominor.yy242 = sqliteExpr(TK_RSHIFT, yymsp[-2].minor.yy242, yymsp[0].minor.yy242, 0);}
-#line 3083 "parse.c"
- /* No destructor defined for RSHIFT */
- break;
- case 196:
-#line 578 "parse.y"
-{
- ExprList *pList = sqliteExprListAppend(0, yymsp[0].minor.yy242, 0);
- pList = sqliteExprListAppend(pList, yymsp[-2].minor.yy242, 0);
- yygotominor.yy242 = sqliteExprFunction(pList, 0);
- if( yygotominor.yy242 ) yygotominor.yy242->op = yymsp[-1].minor.yy372;
- sqliteExprSpan(yygotominor.yy242, &yymsp[-2].minor.yy242->span, &yymsp[0].minor.yy242->span);
-}
-#line 3095 "parse.c"
- break;
- case 197:
-#line 585 "parse.y"
-{
- ExprList *pList = sqliteExprListAppend(0, yymsp[0].minor.yy242, 0);
- pList = sqliteExprListAppend(pList, yymsp[-3].minor.yy242, 0);
- yygotominor.yy242 = sqliteExprFunction(pList, 0);
- if( yygotominor.yy242 ) yygotominor.yy242->op = yymsp[-1].minor.yy372;
- yygotominor.yy242 = sqliteExpr(TK_NOT, yygotominor.yy242, 0, 0);
- sqliteExprSpan(yygotominor.yy242,&yymsp[-3].minor.yy242->span,&yymsp[0].minor.yy242->span);
-}
-#line 3107 "parse.c"
- /* No destructor defined for NOT */
- break;
- case 198:
-#line 594 "parse.y"
-{yygotominor.yy372 = TK_LIKE;}
-#line 3113 "parse.c"
- /* No destructor defined for LIKE */
- break;
- case 199:
-#line 595 "parse.y"
-{yygotominor.yy372 = TK_GLOB;}
-#line 3119 "parse.c"
- /* No destructor defined for GLOB */
- break;
- case 200:
-#line 596 "parse.y"
-{yygotominor.yy242 = sqliteExpr(TK_PLUS, yymsp[-2].minor.yy242, yymsp[0].minor.yy242, 0);}
-#line 3125 "parse.c"
- /* No destructor defined for PLUS */
- break;
- case 201:
-#line 597 "parse.y"
-{yygotominor.yy242 = sqliteExpr(TK_MINUS, yymsp[-2].minor.yy242, yymsp[0].minor.yy242, 0);}
-#line 3131 "parse.c"
- /* No destructor defined for MINUS */
- break;
- case 202:
-#line 598 "parse.y"
-{yygotominor.yy242 = sqliteExpr(TK_STAR, yymsp[-2].minor.yy242, yymsp[0].minor.yy242, 0);}
-#line 3137 "parse.c"
- /* No destructor defined for STAR */
- break;
- case 203:
-#line 599 "parse.y"
-{yygotominor.yy242 = sqliteExpr(TK_SLASH, yymsp[-2].minor.yy242, yymsp[0].minor.yy242, 0);}
-#line 3143 "parse.c"
- /* No destructor defined for SLASH */
- break;
- case 204:
-#line 600 "parse.y"
-{yygotominor.yy242 = sqliteExpr(TK_REM, yymsp[-2].minor.yy242, yymsp[0].minor.yy242, 0);}
-#line 3149 "parse.c"
- /* No destructor defined for REM */
- break;
- case 205:
-#line 601 "parse.y"
-{yygotominor.yy242 = sqliteExpr(TK_CONCAT, yymsp[-2].minor.yy242, yymsp[0].minor.yy242, 0);}
-#line 3155 "parse.c"
- /* No destructor defined for CONCAT */
- break;
- case 206:
-#line 602 "parse.y"
-{
- yygotominor.yy242 = sqliteExpr(TK_ISNULL, yymsp[-1].minor.yy242, 0, 0);
- sqliteExprSpan(yygotominor.yy242,&yymsp[-1].minor.yy242->span,&yymsp[0].minor.yy0);
-}
-#line 3164 "parse.c"
- break;
- case 207:
-#line 606 "parse.y"
-{
- yygotominor.yy242 = sqliteExpr(TK_ISNULL, yymsp[-2].minor.yy242, 0, 0);
- sqliteExprSpan(yygotominor.yy242,&yymsp[-2].minor.yy242->span,&yymsp[0].minor.yy0);
-}
-#line 3172 "parse.c"
- /* No destructor defined for IS */
- break;
- case 208:
-#line 610 "parse.y"
-{
- yygotominor.yy242 = sqliteExpr(TK_NOTNULL, yymsp[-1].minor.yy242, 0, 0);
- sqliteExprSpan(yygotominor.yy242,&yymsp[-1].minor.yy242->span,&yymsp[0].minor.yy0);
-}
-#line 3181 "parse.c"
- break;
- case 209:
-#line 614 "parse.y"
-{
- yygotominor.yy242 = sqliteExpr(TK_NOTNULL, yymsp[-2].minor.yy242, 0, 0);
- sqliteExprSpan(yygotominor.yy242,&yymsp[-2].minor.yy242->span,&yymsp[0].minor.yy0);
-}
-#line 3189 "parse.c"
- /* No destructor defined for NOT */
- break;
- case 210:
-#line 618 "parse.y"
-{
- yygotominor.yy242 = sqliteExpr(TK_NOTNULL, yymsp[-3].minor.yy242, 0, 0);
- sqliteExprSpan(yygotominor.yy242,&yymsp[-3].minor.yy242->span,&yymsp[0].minor.yy0);
-}
-#line 3198 "parse.c"
- /* No destructor defined for IS */
- /* No destructor defined for NOT */
- break;
- case 211:
-#line 622 "parse.y"
-{
- yygotominor.yy242 = sqliteExpr(TK_NOT, yymsp[0].minor.yy242, 0, 0);
- sqliteExprSpan(yygotominor.yy242,&yymsp[-1].minor.yy0,&yymsp[0].minor.yy242->span);
-}
-#line 3208 "parse.c"
- break;
- case 212:
-#line 626 "parse.y"
-{
- yygotominor.yy242 = sqliteExpr(TK_BITNOT, yymsp[0].minor.yy242, 0, 0);
- sqliteExprSpan(yygotominor.yy242,&yymsp[-1].minor.yy0,&yymsp[0].minor.yy242->span);
-}
-#line 3216 "parse.c"
- break;
- case 213:
-#line 630 "parse.y"
-{
- yygotominor.yy242 = sqliteExpr(TK_UMINUS, yymsp[0].minor.yy242, 0, 0);
- sqliteExprSpan(yygotominor.yy242,&yymsp[-1].minor.yy0,&yymsp[0].minor.yy242->span);
-}
-#line 3224 "parse.c"
- break;
- case 214:
-#line 634 "parse.y"
-{
- yygotominor.yy242 = sqliteExpr(TK_UPLUS, yymsp[0].minor.yy242, 0, 0);
- sqliteExprSpan(yygotominor.yy242,&yymsp[-1].minor.yy0,&yymsp[0].minor.yy242->span);
-}
-#line 3232 "parse.c"
- break;
- case 215:
-#line 638 "parse.y"
-{
- yygotominor.yy242 = sqliteExpr(TK_SELECT, 0, 0, 0);
- if( yygotominor.yy242 ) yygotominor.yy242->pSelect = yymsp[-1].minor.yy179;
- sqliteExprSpan(yygotominor.yy242,&yymsp[-2].minor.yy0,&yymsp[0].minor.yy0);
-}
-#line 3241 "parse.c"
- break;
- case 216:
-#line 643 "parse.y"
-{
- ExprList *pList = sqliteExprListAppend(0, yymsp[-2].minor.yy242, 0);
- pList = sqliteExprListAppend(pList, yymsp[0].minor.yy242, 0);
- yygotominor.yy242 = sqliteExpr(TK_BETWEEN, yymsp[-4].minor.yy242, 0, 0);
- if( yygotominor.yy242 ) yygotominor.yy242->pList = pList;
- sqliteExprSpan(yygotominor.yy242,&yymsp[-4].minor.yy242->span,&yymsp[0].minor.yy242->span);
-}
-#line 3252 "parse.c"
- /* No destructor defined for BETWEEN */
- /* No destructor defined for AND */
- break;
- case 217:
-#line 650 "parse.y"
-{
- ExprList *pList = sqliteExprListAppend(0, yymsp[-2].minor.yy242, 0);
- pList = sqliteExprListAppend(pList, yymsp[0].minor.yy242, 0);
- yygotominor.yy242 = sqliteExpr(TK_BETWEEN, yymsp[-5].minor.yy242, 0, 0);
- if( yygotominor.yy242 ) yygotominor.yy242->pList = pList;
- yygotominor.yy242 = sqliteExpr(TK_NOT, yygotominor.yy242, 0, 0);
- sqliteExprSpan(yygotominor.yy242,&yymsp[-5].minor.yy242->span,&yymsp[0].minor.yy242->span);
-}
-#line 3266 "parse.c"
- /* No destructor defined for NOT */
- /* No destructor defined for BETWEEN */
- /* No destructor defined for AND */
- break;
- case 218:
-#line 658 "parse.y"
-{
- yygotominor.yy242 = sqliteExpr(TK_IN, yymsp[-4].minor.yy242, 0, 0);
- if( yygotominor.yy242 ) yygotominor.yy242->pList = yymsp[-1].minor.yy322;
- sqliteExprSpan(yygotominor.yy242,&yymsp[-4].minor.yy242->span,&yymsp[0].minor.yy0);
-}
-#line 3278 "parse.c"
- /* No destructor defined for IN */
- /* No destructor defined for LP */
- break;
- case 219:
-#line 663 "parse.y"
-{
- yygotominor.yy242 = sqliteExpr(TK_IN, yymsp[-4].minor.yy242, 0, 0);
- if( yygotominor.yy242 ) yygotominor.yy242->pSelect = yymsp[-1].minor.yy179;
- sqliteExprSpan(yygotominor.yy242,&yymsp[-4].minor.yy242->span,&yymsp[0].minor.yy0);
-}
-#line 3289 "parse.c"
- /* No destructor defined for IN */
- /* No destructor defined for LP */
- break;
- case 220:
-#line 668 "parse.y"
-{
- yygotominor.yy242 = sqliteExpr(TK_IN, yymsp[-5].minor.yy242, 0, 0);
- if( yygotominor.yy242 ) yygotominor.yy242->pList = yymsp[-1].minor.yy322;
- yygotominor.yy242 = sqliteExpr(TK_NOT, yygotominor.yy242, 0, 0);
- sqliteExprSpan(yygotominor.yy242,&yymsp[-5].minor.yy242->span,&yymsp[0].minor.yy0);
-}
-#line 3301 "parse.c"
- /* No destructor defined for NOT */
- /* No destructor defined for IN */
- /* No destructor defined for LP */
- break;
- case 221:
-#line 674 "parse.y"
-{
- yygotominor.yy242 = sqliteExpr(TK_IN, yymsp[-5].minor.yy242, 0, 0);
- if( yygotominor.yy242 ) yygotominor.yy242->pSelect = yymsp[-1].minor.yy179;
- yygotominor.yy242 = sqliteExpr(TK_NOT, yygotominor.yy242, 0, 0);
- sqliteExprSpan(yygotominor.yy242,&yymsp[-5].minor.yy242->span,&yymsp[0].minor.yy0);
-}
-#line 3314 "parse.c"
- /* No destructor defined for NOT */
- /* No destructor defined for IN */
- /* No destructor defined for LP */
- break;
- case 222:
-#line 680 "parse.y"
-{
- SrcList *pSrc = sqliteSrcListAppend(0, &yymsp[-1].minor.yy298, &yymsp[0].minor.yy298);
- yygotominor.yy242 = sqliteExpr(TK_IN, yymsp[-3].minor.yy242, 0, 0);
- if( yygotominor.yy242 ) yygotominor.yy242->pSelect = sqliteSelectNew(0,pSrc,0,0,0,0,0,-1,0);
- sqliteExprSpan(yygotominor.yy242,&yymsp[-3].minor.yy242->span,yymsp[0].minor.yy298.z?&yymsp[0].minor.yy298:&yymsp[-1].minor.yy298);
-}
-#line 3327 "parse.c"
- /* No destructor defined for IN */
- break;
- case 223:
-#line 686 "parse.y"
-{
- SrcList *pSrc = sqliteSrcListAppend(0, &yymsp[-1].minor.yy298, &yymsp[0].minor.yy298);
- yygotominor.yy242 = sqliteExpr(TK_IN, yymsp[-4].minor.yy242, 0, 0);
- if( yygotominor.yy242 ) yygotominor.yy242->pSelect = sqliteSelectNew(0,pSrc,0,0,0,0,0,-1,0);
- yygotominor.yy242 = sqliteExpr(TK_NOT, yygotominor.yy242, 0, 0);
- sqliteExprSpan(yygotominor.yy242,&yymsp[-4].minor.yy242->span,yymsp[0].minor.yy298.z?&yymsp[0].minor.yy298:&yymsp[-1].minor.yy298);
-}
-#line 3339 "parse.c"
- /* No destructor defined for NOT */
- /* No destructor defined for IN */
- break;
- case 224:
-#line 696 "parse.y"
-{
- yygotominor.yy242 = sqliteExpr(TK_CASE, yymsp[-3].minor.yy242, yymsp[-1].minor.yy242, 0);
- if( yygotominor.yy242 ) yygotominor.yy242->pList = yymsp[-2].minor.yy322;
- sqliteExprSpan(yygotominor.yy242, &yymsp[-4].minor.yy0, &yymsp[0].minor.yy0);
-}
-#line 3350 "parse.c"
- break;
- case 225:
-#line 703 "parse.y"
-{
- yygotominor.yy322 = sqliteExprListAppend(yymsp[-4].minor.yy322, yymsp[-2].minor.yy242, 0);
- yygotominor.yy322 = sqliteExprListAppend(yygotominor.yy322, yymsp[0].minor.yy242, 0);
-}
-#line 3358 "parse.c"
- /* No destructor defined for WHEN */
- /* No destructor defined for THEN */
- break;
- case 226:
-#line 707 "parse.y"
-{
- yygotominor.yy322 = sqliteExprListAppend(0, yymsp[-2].minor.yy242, 0);
- yygotominor.yy322 = sqliteExprListAppend(yygotominor.yy322, yymsp[0].minor.yy242, 0);
-}
-#line 3368 "parse.c"
- /* No destructor defined for WHEN */
- /* No destructor defined for THEN */
- break;
- case 227:
-#line 712 "parse.y"
-{yygotominor.yy242 = yymsp[0].minor.yy242;}
-#line 3375 "parse.c"
- /* No destructor defined for ELSE */
- break;
- case 228:
-#line 713 "parse.y"
-{yygotominor.yy242 = 0;}
-#line 3381 "parse.c"
- break;
- case 229:
-#line 715 "parse.y"
-{yygotominor.yy242 = yymsp[0].minor.yy242;}
-#line 3386 "parse.c"
- break;
- case 230:
-#line 716 "parse.y"
-{yygotominor.yy242 = 0;}
-#line 3391 "parse.c"
- break;
- case 231:
-#line 724 "parse.y"
-{yygotominor.yy322 = sqliteExprListAppend(yymsp[-2].minor.yy322,yymsp[0].minor.yy242,0);}
-#line 3396 "parse.c"
- /* No destructor defined for COMMA */
- break;
- case 232:
-#line 725 "parse.y"
-{yygotominor.yy322 = sqliteExprListAppend(0,yymsp[0].minor.yy242,0);}
-#line 3402 "parse.c"
- break;
- case 233:
-#line 726 "parse.y"
-{yygotominor.yy242 = yymsp[0].minor.yy242;}
-#line 3407 "parse.c"
- break;
- case 234:
-#line 727 "parse.y"
-{yygotominor.yy242 = 0;}
-#line 3412 "parse.c"
- break;
- case 235:
-#line 732 "parse.y"
-{
- SrcList *pSrc = sqliteSrcListAppend(0, &yymsp[-5].minor.yy298, &yymsp[-4].minor.yy298);
- if( yymsp[-9].minor.yy372!=OE_None ) yymsp[-9].minor.yy372 = yymsp[0].minor.yy372;
- if( yymsp[-9].minor.yy372==OE_Default) yymsp[-9].minor.yy372 = OE_Abort;
- sqliteCreateIndex(pParse, &yymsp[-7].minor.yy298, pSrc, yymsp[-2].minor.yy320, yymsp[-9].minor.yy372, &yymsp[-10].minor.yy0, &yymsp[-1].minor.yy0);
-}
-#line 3422 "parse.c"
- /* No destructor defined for INDEX */
- /* No destructor defined for ON */
- /* No destructor defined for LP */
- break;
- case 236:
-#line 740 "parse.y"
-{ yygotominor.yy372 = OE_Abort; }
-#line 3430 "parse.c"
- /* No destructor defined for UNIQUE */
- break;
- case 237:
-#line 741 "parse.y"
-{ yygotominor.yy372 = OE_None; }
-#line 3436 "parse.c"
- break;
- case 238:
-#line 749 "parse.y"
-{yygotominor.yy320 = 0;}
-#line 3441 "parse.c"
- break;
- case 239:
-#line 750 "parse.y"
-{yygotominor.yy320 = yymsp[-1].minor.yy320;}
-#line 3446 "parse.c"
- /* No destructor defined for LP */
- /* No destructor defined for RP */
- break;
- case 240:
-#line 751 "parse.y"
-{yygotominor.yy320 = sqliteIdListAppend(yymsp[-2].minor.yy320,&yymsp[0].minor.yy298);}
-#line 3453 "parse.c"
- /* No destructor defined for COMMA */
- break;
- case 241:
-#line 752 "parse.y"
-{yygotominor.yy320 = sqliteIdListAppend(0,&yymsp[0].minor.yy298);}
-#line 3459 "parse.c"
- break;
- case 242:
-#line 753 "parse.y"
-{yygotominor.yy298 = yymsp[-1].minor.yy298;}
-#line 3464 "parse.c"
- /* No destructor defined for sortorder */
- break;
- case 243:
-#line 758 "parse.y"
-{
- sqliteDropIndex(pParse, sqliteSrcListAppend(0,&yymsp[-1].minor.yy298,&yymsp[0].minor.yy298));
-}
-#line 3472 "parse.c"
- /* No destructor defined for DROP */
- /* No destructor defined for INDEX */
- break;
- case 244:
-#line 766 "parse.y"
-{sqliteCopy(pParse,sqliteSrcListAppend(0,&yymsp[-6].minor.yy298,&yymsp[-5].minor.yy298),&yymsp[-3].minor.yy298,&yymsp[0].minor.yy0,yymsp[-7].minor.yy372);}
-#line 3479 "parse.c"
- /* No destructor defined for COPY */
- /* No destructor defined for FROM */
- /* No destructor defined for USING */
- /* No destructor defined for DELIMITERS */
- break;
- case 245:
-#line 768 "parse.y"
-{sqliteCopy(pParse,sqliteSrcListAppend(0,&yymsp[-3].minor.yy298,&yymsp[-2].minor.yy298),&yymsp[0].minor.yy298,0,yymsp[-4].minor.yy372);}
-#line 3488 "parse.c"
- /* No destructor defined for COPY */
- /* No destructor defined for FROM */
- break;
- case 246:
-#line 772 "parse.y"
-{sqliteVacuum(pParse,0);}
-#line 3495 "parse.c"
- /* No destructor defined for VACUUM */
- break;
- case 247:
-#line 773 "parse.y"
-{sqliteVacuum(pParse,&yymsp[0].minor.yy298);}
-#line 3501 "parse.c"
- /* No destructor defined for VACUUM */
- break;
- case 248:
-#line 777 "parse.y"
-{sqlitePragma(pParse,&yymsp[-2].minor.yy298,&yymsp[0].minor.yy298,0);}
-#line 3507 "parse.c"
- /* No destructor defined for PRAGMA */
- /* No destructor defined for EQ */
- break;
- case 249:
-#line 778 "parse.y"
-{sqlitePragma(pParse,&yymsp[-2].minor.yy298,&yymsp[0].minor.yy0,0);}
-#line 3514 "parse.c"
- /* No destructor defined for PRAGMA */
- /* No destructor defined for EQ */
- break;
- case 250:
-#line 779 "parse.y"
-{sqlitePragma(pParse,&yymsp[-2].minor.yy298,&yymsp[0].minor.yy298,0);}
-#line 3521 "parse.c"
- /* No destructor defined for PRAGMA */
- /* No destructor defined for EQ */
- break;
- case 251:
-#line 780 "parse.y"
-{sqlitePragma(pParse,&yymsp[-2].minor.yy298,&yymsp[0].minor.yy298,1);}
-#line 3528 "parse.c"
- /* No destructor defined for PRAGMA */
- /* No destructor defined for EQ */
- break;
- case 252:
-#line 781 "parse.y"
-{sqlitePragma(pParse,&yymsp[-3].minor.yy298,&yymsp[-1].minor.yy298,0);}
-#line 3535 "parse.c"
- /* No destructor defined for PRAGMA */
- /* No destructor defined for LP */
- /* No destructor defined for RP */
- break;
- case 253:
-#line 782 "parse.y"
-{sqlitePragma(pParse,&yymsp[0].minor.yy298,&yymsp[0].minor.yy298,0);}
-#line 3543 "parse.c"
- /* No destructor defined for PRAGMA */
- break;
- case 254:
-#line 783 "parse.y"
-{yygotominor.yy298 = yymsp[0].minor.yy298;}
-#line 3549 "parse.c"
- /* No destructor defined for plus_opt */
- break;
- case 255:
-#line 784 "parse.y"
-{yygotominor.yy298 = yymsp[0].minor.yy298;}
-#line 3555 "parse.c"
- /* No destructor defined for MINUS */
- break;
- case 256:
-#line 785 "parse.y"
-{yygotominor.yy298 = yymsp[0].minor.yy0;}
-#line 3561 "parse.c"
- break;
- case 257:
-#line 786 "parse.y"
-{yygotominor.yy298 = yymsp[0].minor.yy0;}
-#line 3566 "parse.c"
- break;
- case 258:
- /* No destructor defined for PLUS */
- break;
- case 259:
- break;
- case 260:
-#line 792 "parse.y"
-{
- Token all;
- all.z = yymsp[-4].minor.yy0.z;
- all.n = (yymsp[0].minor.yy0.z - yymsp[-4].minor.yy0.z) + yymsp[0].minor.yy0.n;
- sqliteFinishTrigger(pParse, yymsp[-1].minor.yy19, &all);
-}
-#line 3581 "parse.c"
- /* No destructor defined for trigger_decl */
- /* No destructor defined for BEGIN */
- break;
- case 261:
-#line 800 "parse.y"
-{
- SrcList *pTab = sqliteSrcListAppend(0, &yymsp[-3].minor.yy298, &yymsp[-2].minor.yy298);
- sqliteBeginTrigger(pParse, &yymsp[-7].minor.yy298, yymsp[-6].minor.yy372, yymsp[-5].minor.yy290.a, yymsp[-5].minor.yy290.b, pTab, yymsp[-1].minor.yy372, yymsp[0].minor.yy182, yymsp[-9].minor.yy372);
-}
-#line 3591 "parse.c"
- /* No destructor defined for TRIGGER */
- /* No destructor defined for ON */
- break;
- case 262:
-#line 806 "parse.y"
-{ yygotominor.yy372 = TK_BEFORE; }
-#line 3598 "parse.c"
- /* No destructor defined for BEFORE */
- break;
- case 263:
-#line 807 "parse.y"
-{ yygotominor.yy372 = TK_AFTER; }
-#line 3604 "parse.c"
- /* No destructor defined for AFTER */
- break;
- case 264:
-#line 808 "parse.y"
-{ yygotominor.yy372 = TK_INSTEAD;}
-#line 3610 "parse.c"
- /* No destructor defined for INSTEAD */
- /* No destructor defined for OF */
- break;
- case 265:
-#line 809 "parse.y"
-{ yygotominor.yy372 = TK_BEFORE; }
-#line 3617 "parse.c"
- break;
- case 266:
-#line 813 "parse.y"
-{ yygotominor.yy290.a = TK_DELETE; yygotominor.yy290.b = 0; }
-#line 3622 "parse.c"
- /* No destructor defined for DELETE */
- break;
- case 267:
-#line 814 "parse.y"
-{ yygotominor.yy290.a = TK_INSERT; yygotominor.yy290.b = 0; }
-#line 3628 "parse.c"
- /* No destructor defined for INSERT */
- break;
- case 268:
-#line 815 "parse.y"
-{ yygotominor.yy290.a = TK_UPDATE; yygotominor.yy290.b = 0;}
-#line 3634 "parse.c"
- /* No destructor defined for UPDATE */
- break;
- case 269:
-#line 816 "parse.y"
-{yygotominor.yy290.a = TK_UPDATE; yygotominor.yy290.b = yymsp[0].minor.yy320; }
-#line 3640 "parse.c"
- /* No destructor defined for UPDATE */
- /* No destructor defined for OF */
- break;
- case 270:
-#line 819 "parse.y"
-{ yygotominor.yy372 = TK_ROW; }
-#line 3647 "parse.c"
- break;
- case 271:
-#line 820 "parse.y"
-{ yygotominor.yy372 = TK_ROW; }
-#line 3652 "parse.c"
- /* No destructor defined for FOR */
- /* No destructor defined for EACH */
- /* No destructor defined for ROW */
- break;
- case 272:
-#line 821 "parse.y"
-{ yygotominor.yy372 = TK_STATEMENT; }
-#line 3660 "parse.c"
- /* No destructor defined for FOR */
- /* No destructor defined for EACH */
- /* No destructor defined for STATEMENT */
- break;
- case 273:
-#line 824 "parse.y"
-{ yygotominor.yy182 = 0; }
-#line 3668 "parse.c"
- break;
- case 274:
-#line 825 "parse.y"
-{ yygotominor.yy182 = yymsp[0].minor.yy242; }
-#line 3673 "parse.c"
- /* No destructor defined for WHEN */
- break;
- case 275:
-#line 829 "parse.y"
-{
- yymsp[-2].minor.yy19->pNext = yymsp[0].minor.yy19;
- yygotominor.yy19 = yymsp[-2].minor.yy19;
-}
-#line 3682 "parse.c"
- /* No destructor defined for SEMI */
- break;
- case 276:
-#line 833 "parse.y"
-{ yygotominor.yy19 = 0; }
-#line 3688 "parse.c"
- break;
- case 277:
-#line 839 "parse.y"
-{ yygotominor.yy19 = sqliteTriggerUpdateStep(&yymsp[-3].minor.yy298, yymsp[-1].minor.yy322, yymsp[0].minor.yy242, yymsp[-4].minor.yy372); }
-#line 3693 "parse.c"
- /* No destructor defined for UPDATE */
- /* No destructor defined for SET */
- break;
- case 278:
-#line 844 "parse.y"
-{yygotominor.yy19 = sqliteTriggerInsertStep(&yymsp[-5].minor.yy298, yymsp[-4].minor.yy320, yymsp[-1].minor.yy322, 0, yymsp[-7].minor.yy372);}
-#line 3700 "parse.c"
- /* No destructor defined for INTO */
- /* No destructor defined for VALUES */
- /* No destructor defined for LP */
- /* No destructor defined for RP */
- break;
- case 279:
-#line 847 "parse.y"
-{yygotominor.yy19 = sqliteTriggerInsertStep(&yymsp[-2].minor.yy298, yymsp[-1].minor.yy320, 0, yymsp[0].minor.yy179, yymsp[-4].minor.yy372);}
-#line 3709 "parse.c"
- /* No destructor defined for INTO */
- break;
- case 280:
-#line 851 "parse.y"
-{yygotominor.yy19 = sqliteTriggerDeleteStep(&yymsp[-1].minor.yy298, yymsp[0].minor.yy242);}
-#line 3715 "parse.c"
- /* No destructor defined for DELETE */
- /* No destructor defined for FROM */
- break;
- case 281:
-#line 854 "parse.y"
-{yygotominor.yy19 = sqliteTriggerSelectStep(yymsp[0].minor.yy179); }
-#line 3722 "parse.c"
- break;
- case 282:
-#line 857 "parse.y"
-{
- yygotominor.yy242 = sqliteExpr(TK_RAISE, 0, 0, 0);
- yygotominor.yy242->iColumn = OE_Ignore;
- sqliteExprSpan(yygotominor.yy242, &yymsp[-3].minor.yy0, &yymsp[0].minor.yy0);
-}
-#line 3731 "parse.c"
- /* No destructor defined for LP */
- /* No destructor defined for IGNORE */
- break;
- case 283:
-#line 862 "parse.y"
-{
- yygotominor.yy242 = sqliteExpr(TK_RAISE, 0, 0, &yymsp[-1].minor.yy298);
- yygotominor.yy242->iColumn = OE_Rollback;
- sqliteExprSpan(yygotominor.yy242, &yymsp[-5].minor.yy0, &yymsp[0].minor.yy0);
-}
-#line 3742 "parse.c"
- /* No destructor defined for LP */
- /* No destructor defined for ROLLBACK */
- /* No destructor defined for COMMA */
- break;
- case 284:
-#line 867 "parse.y"
-{
- yygotominor.yy242 = sqliteExpr(TK_RAISE, 0, 0, &yymsp[-1].minor.yy298);
- yygotominor.yy242->iColumn = OE_Abort;
- sqliteExprSpan(yygotominor.yy242, &yymsp[-5].minor.yy0, &yymsp[0].minor.yy0);
-}
-#line 3754 "parse.c"
- /* No destructor defined for LP */
- /* No destructor defined for ABORT */
- /* No destructor defined for COMMA */
- break;
- case 285:
-#line 872 "parse.y"
-{
- yygotominor.yy242 = sqliteExpr(TK_RAISE, 0, 0, &yymsp[-1].minor.yy298);
- yygotominor.yy242->iColumn = OE_Fail;
- sqliteExprSpan(yygotominor.yy242, &yymsp[-5].minor.yy0, &yymsp[0].minor.yy0);
-}
-#line 3766 "parse.c"
- /* No destructor defined for LP */
- /* No destructor defined for FAIL */
- /* No destructor defined for COMMA */
- break;
- case 286:
-#line 879 "parse.y"
-{
- sqliteDropTrigger(pParse,sqliteSrcListAppend(0,&yymsp[-1].minor.yy298,&yymsp[0].minor.yy298));
-}
-#line 3776 "parse.c"
- /* No destructor defined for DROP */
- /* No destructor defined for TRIGGER */
- break;
- case 287:
-#line 884 "parse.y"
-{
- sqliteAttach(pParse, &yymsp[-3].minor.yy298, &yymsp[-1].minor.yy298, &yymsp[0].minor.yy298);
-}
-#line 3785 "parse.c"
- /* No destructor defined for ATTACH */
- /* No destructor defined for database_kw_opt */
- /* No destructor defined for AS */
- break;
- case 288:
-#line 888 "parse.y"
-{ yygotominor.yy298 = yymsp[0].minor.yy298; }
-#line 3793 "parse.c"
- /* No destructor defined for USING */
- break;
- case 289:
-#line 889 "parse.y"
-{ yygotominor.yy298.z = 0; yygotominor.yy298.n = 0; }
-#line 3799 "parse.c"
- break;
- case 290:
- /* No destructor defined for DATABASE */
- break;
- case 291:
- break;
- case 292:
-#line 895 "parse.y"
-{
- sqliteDetach(pParse, &yymsp[0].minor.yy298);
-}
-#line 3811 "parse.c"
- /* No destructor defined for DETACH */
- /* No destructor defined for database_kw_opt */
- break;
- };
- yygoto = yyRuleInfo[yyruleno].lhs;
- yysize = yyRuleInfo[yyruleno].nrhs;
- yypParser->yyidx -= yysize;
- yyact = yy_find_reduce_action(yypParser,yygoto);
- if( yyact < YYNSTATE ){
- yy_shift(yypParser,yyact,yygoto,&yygotominor);
- }else if( yyact == YYNSTATE + YYNRULE + 1 ){
- yy_accept(yypParser);
- }
-}
-
-/*
-** The following code executes when the parse fails
-*/
-static void yy_parse_failed(
- yyParser *yypParser /* The parser */
-){
- sqliteParserARG_FETCH;
-#ifndef NDEBUG
- if( yyTraceFILE ){
- fprintf(yyTraceFILE,"%sFail!\n",yyTracePrompt);
- }
-#endif
- while( yypParser->yyidx>=0 ) yy_pop_parser_stack(yypParser);
- /* Here code is inserted which will be executed whenever the
- ** parser fails */
- sqliteParserARG_STORE; /* Suppress warning about unused %extra_argument variable */
-}
-
-/*
-** The following code executes when a syntax error first occurs.
-*/
-static void yy_syntax_error(
- yyParser *yypParser, /* The parser */
- int yymajor, /* The major type of the error token */
- YYMINORTYPE yyminor /* The minor type of the error token */
-){
- sqliteParserARG_FETCH;
-#define TOKEN (yyminor.yy0)
-#line 23 "parse.y"
-
- if( pParse->zErrMsg==0 ){
- if( TOKEN.z[0] ){
- sqliteErrorMsg(pParse, "near \"%T\": syntax error", &TOKEN);
- }else{
- sqliteErrorMsg(pParse, "incomplete SQL statement");
- }
- }
-
-#line 3865 "parse.c"
- sqliteParserARG_STORE; /* Suppress warning about unused %extra_argument variable */
-}
-
-/*
-** The following is executed when the parser accepts
-*/
-static void yy_accept(
- yyParser *yypParser /* The parser */
-){
- sqliteParserARG_FETCH;
-#ifndef NDEBUG
- if( yyTraceFILE ){
- fprintf(yyTraceFILE,"%sAccept!\n",yyTracePrompt);
- }
-#endif
- while( yypParser->yyidx>=0 ) yy_pop_parser_stack(yypParser);
- /* Here code is inserted which will be executed whenever the
- ** parser accepts */
- sqliteParserARG_STORE; /* Suppress warning about unused %extra_argument variable */
-}
-
-/* The main parser program.
-** The first argument is a pointer to a structure obtained from
-** "sqliteParserAlloc" which describes the current state of the parser.
-** The second argument is the major token number. The third is
-** the minor token. The fourth optional argument is whatever the
-** user wants (and specified in the grammar) and is available for
-** use by the action routines.
-**
-** Inputs:
-** <ul>
-** <li> A pointer to the parser (an opaque structure.)
-** <li> The major token number.
-** <li> The minor token number.
-** <li> An option argument of a grammar-specified type.
-** </ul>
-**
-** Outputs:
-** None.
-*/
-void sqliteParser(
- void *yyp, /* The parser */
- int yymajor, /* The major token code number */
- sqliteParserTOKENTYPE yyminor /* The value for the token */
- sqliteParserARG_PDECL /* Optional %extra_argument parameter */
-){
- YYMINORTYPE yyminorunion;
- int yyact; /* The parser action. */
- int yyendofinput; /* True if we are at the end of input */
- int yyerrorhit = 0; /* True if yymajor has invoked an error */
- yyParser *yypParser; /* The parser */
-
- /* (re)initialize the parser, if necessary */
- yypParser = (yyParser*)yyp;
- if( yypParser->yyidx<0 ){
- if( yymajor==0 ) return;
- yypParser->yyidx = 0;
- yypParser->yyerrcnt = -1;
- yypParser->yystack[0].stateno = 0;
- yypParser->yystack[0].major = 0;
- }
- yyminorunion.yy0 = yyminor;
- yyendofinput = (yymajor==0);
- sqliteParserARG_STORE;
-
-#ifndef NDEBUG
- if( yyTraceFILE ){
- fprintf(yyTraceFILE,"%sInput %s\n",yyTracePrompt,yyTokenName[yymajor]);
- }
-#endif
-
- do{
- yyact = yy_find_shift_action(yypParser,yymajor);
- if( yyact<YYNSTATE ){
- yy_shift(yypParser,yyact,yymajor,&yyminorunion);
- yypParser->yyerrcnt--;
- if( yyendofinput && yypParser->yyidx>=0 ){
- yymajor = 0;
- }else{
- yymajor = YYNOCODE;
- }
- }else if( yyact < YYNSTATE + YYNRULE ){
- yy_reduce(yypParser,yyact-YYNSTATE);
- }else if( yyact == YY_ERROR_ACTION ){
- int yymx;
-#ifndef NDEBUG
- if( yyTraceFILE ){
- fprintf(yyTraceFILE,"%sSyntax Error!\n",yyTracePrompt);
- }
-#endif
-#ifdef YYERRORSYMBOL
- /* A syntax error has occurred.
- ** The response to an error depends upon whether or not the
- ** grammar defines an error token "ERROR".
- **
- ** This is what we do if the grammar does define ERROR:
- **
- ** * Call the %syntax_error function.
- **
- ** * Begin popping the stack until we enter a state where
- ** it is legal to shift the error symbol, then shift
- ** the error symbol.
- **
- ** * Set the error count to three.
- **
- ** * Begin accepting and shifting new tokens. No new error
- ** processing will occur until three tokens have been
- ** shifted successfully.
- **
- */
- if( yypParser->yyerrcnt<0 ){
- yy_syntax_error(yypParser,yymajor,yyminorunion);
- }
- yymx = yypParser->yystack[yypParser->yyidx].major;
- if( yymx==YYERRORSYMBOL || yyerrorhit ){
-#ifndef NDEBUG
- if( yyTraceFILE ){
- fprintf(yyTraceFILE,"%sDiscard input token %s\n",
- yyTracePrompt,yyTokenName[yymajor]);
- }
-#endif
- yy_destructor(yymajor,&yyminorunion);
- yymajor = YYNOCODE;
- }else{
- while(
- yypParser->yyidx >= 0 &&
- yymx != YYERRORSYMBOL &&
- (yyact = yy_find_shift_action(yypParser,YYERRORSYMBOL)) >= YYNSTATE
- ){
- yy_pop_parser_stack(yypParser);
- }
- if( yypParser->yyidx < 0 || yymajor==0 ){
- yy_destructor(yymajor,&yyminorunion);
- yy_parse_failed(yypParser);
- yymajor = YYNOCODE;
- }else if( yymx!=YYERRORSYMBOL ){
- YYMINORTYPE u2;
- u2.YYERRSYMDT = 0;
- yy_shift(yypParser,yyact,YYERRORSYMBOL,&u2);
- }
- }
- yypParser->yyerrcnt = 3;
- yyerrorhit = 1;
-#else /* YYERRORSYMBOL is not defined */
- /* This is what we do if the grammar does not define ERROR:
- **
- ** * Report an error message, and throw away the input token.
- **
- ** * If the input token is $, then fail the parse.
- **
- ** As before, subsequent error messages are suppressed until
- ** three input tokens have been successfully shifted.
- */
- if( yypParser->yyerrcnt<=0 ){
- yy_syntax_error(yypParser,yymajor,yyminorunion);
- }
- yypParser->yyerrcnt = 3;
- yy_destructor(yymajor,&yyminorunion);
- if( yyendofinput ){
- yy_parse_failed(yypParser);
- }
- yymajor = YYNOCODE;
-#endif
- }else{
- yy_accept(yypParser);
- yymajor = YYNOCODE;
- }
- }while( yymajor!=YYNOCODE && yypParser->yyidx>=0 );
- return;
-}
+++ /dev/null
-#define TK_END_OF_FILE 1
-#define TK_ILLEGAL 2
-#define TK_SPACE 3
-#define TK_UNCLOSED_STRING 4
-#define TK_COMMENT 5
-#define TK_FUNCTION 6
-#define TK_COLUMN 7
-#define TK_AGG_FUNCTION 8
-#define TK_SEMI 9
-#define TK_EXPLAIN 10
-#define TK_BEGIN 11
-#define TK_TRANSACTION 12
-#define TK_COMMIT 13
-#define TK_END 14
-#define TK_ROLLBACK 15
-#define TK_CREATE 16
-#define TK_TABLE 17
-#define TK_TEMP 18
-#define TK_LP 19
-#define TK_RP 20
-#define TK_AS 21
-#define TK_COMMA 22
-#define TK_ID 23
-#define TK_ABORT 24
-#define TK_AFTER 25
-#define TK_ASC 26
-#define TK_ATTACH 27
-#define TK_BEFORE 28
-#define TK_CASCADE 29
-#define TK_CLUSTER 30
-#define TK_CONFLICT 31
-#define TK_COPY 32
-#define TK_DATABASE 33
-#define TK_DEFERRED 34
-#define TK_DELIMITERS 35
-#define TK_DESC 36
-#define TK_DETACH 37
-#define TK_EACH 38
-#define TK_FAIL 39
-#define TK_FOR 40
-#define TK_GLOB 41
-#define TK_IGNORE 42
-#define TK_IMMEDIATE 43
-#define TK_INITIALLY 44
-#define TK_INSTEAD 45
-#define TK_LIKE 46
-#define TK_MATCH 47
-#define TK_KEY 48
-#define TK_OF 49
-#define TK_OFFSET 50
-#define TK_PRAGMA 51
-#define TK_RAISE 52
-#define TK_REPLACE 53
-#define TK_RESTRICT 54
-#define TK_ROW 55
-#define TK_STATEMENT 56
-#define TK_TRIGGER 57
-#define TK_VACUUM 58
-#define TK_VIEW 59
-#define TK_OR 60
-#define TK_AND 61
-#define TK_NOT 62
-#define TK_EQ 63
-#define TK_NE 64
-#define TK_ISNULL 65
-#define TK_NOTNULL 66
-#define TK_IS 67
-#define TK_BETWEEN 68
-#define TK_IN 69
-#define TK_GT 70
-#define TK_GE 71
-#define TK_LT 72
-#define TK_LE 73
-#define TK_BITAND 74
-#define TK_BITOR 75
-#define TK_LSHIFT 76
-#define TK_RSHIFT 77
-#define TK_PLUS 78
-#define TK_MINUS 79
-#define TK_STAR 80
-#define TK_SLASH 81
-#define TK_REM 82
-#define TK_CONCAT 83
-#define TK_UMINUS 84
-#define TK_UPLUS 85
-#define TK_BITNOT 86
-#define TK_STRING 87
-#define TK_JOIN_KW 88
-#define TK_INTEGER 89
-#define TK_CONSTRAINT 90
-#define TK_DEFAULT 91
-#define TK_FLOAT 92
-#define TK_NULL 93
-#define TK_PRIMARY 94
-#define TK_UNIQUE 95
-#define TK_CHECK 96
-#define TK_REFERENCES 97
-#define TK_COLLATE 98
-#define TK_ON 99
-#define TK_DELETE 100
-#define TK_UPDATE 101
-#define TK_INSERT 102
-#define TK_SET 103
-#define TK_DEFERRABLE 104
-#define TK_FOREIGN 105
-#define TK_DROP 106
-#define TK_UNION 107
-#define TK_ALL 108
-#define TK_INTERSECT 109
-#define TK_EXCEPT 110
-#define TK_SELECT 111
-#define TK_DISTINCT 112
-#define TK_DOT 113
-#define TK_FROM 114
-#define TK_JOIN 115
-#define TK_USING 116
-#define TK_ORDER 117
-#define TK_BY 118
-#define TK_GROUP 119
-#define TK_HAVING 120
-#define TK_LIMIT 121
-#define TK_WHERE 122
-#define TK_INTO 123
-#define TK_VALUES 124
-#define TK_VARIABLE 125
-#define TK_CASE 126
-#define TK_WHEN 127
-#define TK_THEN 128
-#define TK_ELSE 129
-#define TK_INDEX 130
+++ /dev/null
-/*
-** 2003 April 6
-**
-** The author disclaims copyright to this source code. In place of
-** a legal notice, here is a blessing:
-**
-** May you do good and not evil.
-** May you find forgiveness for yourself and forgive others.
-** May you share freely, never taking more than you give.
-**
-*************************************************************************
-** This file contains code used to implement the PRAGMA command.
-**
-** $Id: pragma.c,v 1.1.1.1 2004/08/08 15:03:57 matt Exp $
-*/
-#include "sqliteInt.h"
-#include <ctype.h>
-
-/*
-** Interpret the given string as a boolean value.
-*/
-static int getBoolean(const char *z){
- static char *azTrue[] = { "yes", "on", "true" };
- int i;
- if( z[0]==0 ) return 0;
- if( isdigit(z[0]) || (z[0]=='-' && isdigit(z[1])) ){
- return atoi(z);
- }
- for(i=0; i<sizeof(azTrue)/sizeof(azTrue[0]); i++){
- if( sqliteStrICmp(z,azTrue[i])==0 ) return 1;
- }
- return 0;
-}
-
-/*
-** Interpret the given string as a safety level. Return 0 for OFF,
-** 1 for ON or NORMAL and 2 for FULL. Return 1 for an empty or
-** unrecognized string argument.
-**
-** Note that the values returned are one less that the values that
-** should be passed into sqliteBtreeSetSafetyLevel(). The is done
-** to support legacy SQL code. The safety level used to be boolean
-** and older scripts may have used numbers 0 for OFF and 1 for ON.
-*/
-static int getSafetyLevel(char *z){
- static const struct {
- const char *zWord;
- int val;
- } aKey[] = {
- { "no", 0 },
- { "off", 0 },
- { "false", 0 },
- { "yes", 1 },
- { "on", 1 },
- { "true", 1 },
- { "full", 2 },
- };
- int i;
- if( z[0]==0 ) return 1;
- if( isdigit(z[0]) || (z[0]=='-' && isdigit(z[1])) ){
- return atoi(z);
- }
- for(i=0; i<sizeof(aKey)/sizeof(aKey[0]); i++){
- if( sqliteStrICmp(z,aKey[i].zWord)==0 ) return aKey[i].val;
- }
- return 1;
-}
-
-/*
-** Interpret the given string as a temp db location. Return 1 for file
-** backed temporary databases, 2 for the Red-Black tree in memory database
-** and 0 to use the compile-time default.
-*/
-static int getTempStore(const char *z){
- if( z[0]>='0' && z[0]<='2' ){
- return z[0] - '0';
- }else if( sqliteStrICmp(z, "file")==0 ){
- return 1;
- }else if( sqliteStrICmp(z, "memory")==0 ){
- return 2;
- }else{
- return 0;
- }
-}
-
-/*
-** If the TEMP database is open, close it and mark the database schema
-** as needing reloading. This must be done when using the TEMP_STORE
-** or DEFAULT_TEMP_STORE pragmas.
-*/
-static int changeTempStorage(Parse *pParse, const char *zStorageType){
- int ts = getTempStore(zStorageType);
- sqlite *db = pParse->db;
- if( db->temp_store==ts ) return SQLITE_OK;
- if( db->aDb[1].pBt!=0 ){
- if( db->flags & SQLITE_InTrans ){
- sqliteErrorMsg(pParse, "temporary storage cannot be changed "
- "from within a transaction");
- return SQLITE_ERROR;
- }
- sqliteBtreeClose(db->aDb[1].pBt);
- db->aDb[1].pBt = 0;
- sqliteResetInternalSchema(db, 0);
- }
- db->temp_store = ts;
- return SQLITE_OK;
-}
-
-/*
-** Check to see if zRight and zLeft refer to a pragma that queries
-** or changes one of the flags in db->flags. Return 1 if so and 0 if not.
-** Also, implement the pragma.
-*/
-static int flagPragma(Parse *pParse, const char *zLeft, const char *zRight){
- static const struct {
- const char *zName; /* Name of the pragma */
- int mask; /* Mask for the db->flags value */
- } aPragma[] = {
- { "vdbe_trace", SQLITE_VdbeTrace },
- { "full_column_names", SQLITE_FullColNames },
- { "short_column_names", SQLITE_ShortColNames },
- { "show_datatypes", SQLITE_ReportTypes },
- { "count_changes", SQLITE_CountRows },
- { "empty_result_callbacks", SQLITE_NullCallback },
- };
- int i;
- for(i=0; i<sizeof(aPragma)/sizeof(aPragma[0]); i++){
- if( sqliteStrICmp(zLeft, aPragma[i].zName)==0 ){
- sqlite *db = pParse->db;
- Vdbe *v;
- if( strcmp(zLeft,zRight)==0 && (v = sqliteGetVdbe(pParse))!=0 ){
- sqliteVdbeOp3(v, OP_ColumnName, 0, 1, aPragma[i].zName, P3_STATIC);
- sqliteVdbeOp3(v, OP_ColumnName, 1, 0, "boolean", P3_STATIC);
- sqliteVdbeCode(v, OP_Integer, (db->flags & aPragma[i].mask)!=0, 0,
- OP_Callback, 1, 0,
- 0);
- }else if( getBoolean(zRight) ){
- db->flags |= aPragma[i].mask;
- }else{
- db->flags &= ~aPragma[i].mask;
- }
- return 1;
- }
- }
- return 0;
-}
-
-/*
-** Process a pragma statement.
-**
-** Pragmas are of this form:
-**
-** PRAGMA id = value
-**
-** The identifier might also be a string. The value is a string, and
-** identifier, or a number. If minusFlag is true, then the value is
-** a number that was preceded by a minus sign.
-*/
-void sqlitePragma(Parse *pParse, Token *pLeft, Token *pRight, int minusFlag){
- char *zLeft = 0;
- char *zRight = 0;
- sqlite *db = pParse->db;
- Vdbe *v = sqliteGetVdbe(pParse);
- if( v==0 ) return;
-
- zLeft = sqliteStrNDup(pLeft->z, pLeft->n);
- sqliteDequote(zLeft);
- if( minusFlag ){
- zRight = 0;
- sqliteSetNString(&zRight, "-", 1, pRight->z, pRight->n, 0);
- }else{
- zRight = sqliteStrNDup(pRight->z, pRight->n);
- sqliteDequote(zRight);
- }
- if( sqliteAuthCheck(pParse, SQLITE_PRAGMA, zLeft, zRight, 0) ){
- sqliteFree(zLeft);
- sqliteFree(zRight);
- return;
- }
-
- /*
- ** PRAGMA default_cache_size
- ** PRAGMA default_cache_size=N
- **
- ** The first form reports the current persistent setting for the
- ** page cache size. The value returned is the maximum number of
- ** pages in the page cache. The second form sets both the current
- ** page cache size value and the persistent page cache size value
- ** stored in the database file.
- **
- ** The default cache size is stored in meta-value 2 of page 1 of the
- ** database file. The cache size is actually the absolute value of
- ** this memory location. The sign of meta-value 2 determines the
- ** synchronous setting. A negative value means synchronous is off
- ** and a positive value means synchronous is on.
- */
- if( sqliteStrICmp(zLeft,"default_cache_size")==0 ){
- static VdbeOpList getCacheSize[] = {
- { OP_ReadCookie, 0, 2, 0},
- { OP_AbsValue, 0, 0, 0},
- { OP_Dup, 0, 0, 0},
- { OP_Integer, 0, 0, 0},
- { OP_Ne, 0, 6, 0},
- { OP_Integer, 0, 0, 0}, /* 5 */
- { OP_ColumnName, 0, 1, "cache_size"},
- { OP_Callback, 1, 0, 0},
- };
- int addr;
- if( pRight->z==pLeft->z ){
- addr = sqliteVdbeAddOpList(v, ArraySize(getCacheSize), getCacheSize);
- sqliteVdbeChangeP1(v, addr+5, MAX_PAGES);
- }else{
- int size = atoi(zRight);
- if( size<0 ) size = -size;
- sqliteBeginWriteOperation(pParse, 0, 0);
- sqliteVdbeAddOp(v, OP_Integer, size, 0);
- sqliteVdbeAddOp(v, OP_ReadCookie, 0, 2);
- addr = sqliteVdbeAddOp(v, OP_Integer, 0, 0);
- sqliteVdbeAddOp(v, OP_Ge, 0, addr+3);
- sqliteVdbeAddOp(v, OP_Negative, 0, 0);
- sqliteVdbeAddOp(v, OP_SetCookie, 0, 2);
- sqliteEndWriteOperation(pParse);
- db->cache_size = db->cache_size<0 ? -size : size;
- sqliteBtreeSetCacheSize(db->aDb[0].pBt, db->cache_size);
- }
- }else
-
- /*
- ** PRAGMA cache_size
- ** PRAGMA cache_size=N
- **
- ** The first form reports the current local setting for the
- ** page cache size. The local setting can be different from
- ** the persistent cache size value that is stored in the database
- ** file itself. The value returned is the maximum number of
- ** pages in the page cache. The second form sets the local
- ** page cache size value. It does not change the persistent
- ** cache size stored on the disk so the cache size will revert
- ** to its default value when the database is closed and reopened.
- ** N should be a positive integer.
- */
- if( sqliteStrICmp(zLeft,"cache_size")==0 ){
- static VdbeOpList getCacheSize[] = {
- { OP_ColumnName, 0, 1, "cache_size"},
- { OP_Callback, 1, 0, 0},
- };
- if( pRight->z==pLeft->z ){
- int size = db->cache_size;;
- if( size<0 ) size = -size;
- sqliteVdbeAddOp(v, OP_Integer, size, 0);
- sqliteVdbeAddOpList(v, ArraySize(getCacheSize), getCacheSize);
- }else{
- int size = atoi(zRight);
- if( size<0 ) size = -size;
- if( db->cache_size<0 ) size = -size;
- db->cache_size = size;
- sqliteBtreeSetCacheSize(db->aDb[0].pBt, db->cache_size);
- }
- }else
-
- /*
- ** PRAGMA default_synchronous
- ** PRAGMA default_synchronous=ON|OFF|NORMAL|FULL
- **
- ** The first form returns the persistent value of the "synchronous" setting
- ** that is stored in the database. This is the synchronous setting that
- ** is used whenever the database is opened unless overridden by a separate
- ** "synchronous" pragma. The second form changes the persistent and the
- ** local synchronous setting to the value given.
- **
- ** If synchronous is OFF, SQLite does not attempt any fsync() systems calls
- ** to make sure data is committed to disk. Write operations are very fast,
- ** but a power failure can leave the database in an inconsistent state.
- ** If synchronous is ON or NORMAL, SQLite will do an fsync() system call to
- ** make sure data is being written to disk. The risk of corruption due to
- ** a power loss in this mode is negligible but non-zero. If synchronous
- ** is FULL, extra fsync()s occur to reduce the risk of corruption to near
- ** zero, but with a write performance penalty. The default mode is NORMAL.
- */
- if( sqliteStrICmp(zLeft,"default_synchronous")==0 ){
- static VdbeOpList getSync[] = {
- { OP_ColumnName, 0, 1, "synchronous"},
- { OP_ReadCookie, 0, 3, 0},
- { OP_Dup, 0, 0, 0},
- { OP_If, 0, 0, 0}, /* 3 */
- { OP_ReadCookie, 0, 2, 0},
- { OP_Integer, 0, 0, 0},
- { OP_Lt, 0, 5, 0},
- { OP_AddImm, 1, 0, 0},
- { OP_Callback, 1, 0, 0},
- { OP_Halt, 0, 0, 0},
- { OP_AddImm, -1, 0, 0}, /* 10 */
- { OP_Callback, 1, 0, 0}
- };
- if( pRight->z==pLeft->z ){
- int addr = sqliteVdbeAddOpList(v, ArraySize(getSync), getSync);
- sqliteVdbeChangeP2(v, addr+3, addr+10);
- }else{
- int addr;
- int size = db->cache_size;
- if( size<0 ) size = -size;
- sqliteBeginWriteOperation(pParse, 0, 0);
- sqliteVdbeAddOp(v, OP_ReadCookie, 0, 2);
- sqliteVdbeAddOp(v, OP_Dup, 0, 0);
- addr = sqliteVdbeAddOp(v, OP_Integer, 0, 0);
- sqliteVdbeAddOp(v, OP_Ne, 0, addr+3);
- sqliteVdbeAddOp(v, OP_AddImm, MAX_PAGES, 0);
- sqliteVdbeAddOp(v, OP_AbsValue, 0, 0);
- db->safety_level = getSafetyLevel(zRight)+1;
- if( db->safety_level==1 ){
- sqliteVdbeAddOp(v, OP_Negative, 0, 0);
- size = -size;
- }
- sqliteVdbeAddOp(v, OP_SetCookie, 0, 2);
- sqliteVdbeAddOp(v, OP_Integer, db->safety_level, 0);
- sqliteVdbeAddOp(v, OP_SetCookie, 0, 3);
- sqliteEndWriteOperation(pParse);
- db->cache_size = size;
- sqliteBtreeSetCacheSize(db->aDb[0].pBt, db->cache_size);
- sqliteBtreeSetSafetyLevel(db->aDb[0].pBt, db->safety_level);
- }
- }else
-
- /*
- ** PRAGMA synchronous
- ** PRAGMA synchronous=OFF|ON|NORMAL|FULL
- **
- ** Return or set the local value of the synchronous flag. Changing
- ** the local value does not make changes to the disk file and the
- ** default value will be restored the next time the database is
- ** opened.
- */
- if( sqliteStrICmp(zLeft,"synchronous")==0 ){
- static VdbeOpList getSync[] = {
- { OP_ColumnName, 0, 1, "synchronous"},
- { OP_Callback, 1, 0, 0},
- };
- if( pRight->z==pLeft->z ){
- sqliteVdbeAddOp(v, OP_Integer, db->safety_level-1, 0);
- sqliteVdbeAddOpList(v, ArraySize(getSync), getSync);
- }else{
- int size = db->cache_size;
- if( size<0 ) size = -size;
- db->safety_level = getSafetyLevel(zRight)+1;
- if( db->safety_level==1 ) size = -size;
- db->cache_size = size;
- sqliteBtreeSetCacheSize(db->aDb[0].pBt, db->cache_size);
- sqliteBtreeSetSafetyLevel(db->aDb[0].pBt, db->safety_level);
- }
- }else
-
-#ifndef NDEBUG
- if( sqliteStrICmp(zLeft, "trigger_overhead_test")==0 ){
- if( getBoolean(zRight) ){
- always_code_trigger_setup = 1;
- }else{
- always_code_trigger_setup = 0;
- }
- }else
-#endif
-
- if( flagPragma(pParse, zLeft, zRight) ){
- /* The flagPragma() call also generates any necessary code */
- }else
-
- if( sqliteStrICmp(zLeft, "table_info")==0 ){
- Table *pTab;
- pTab = sqliteFindTable(db, zRight, 0);
- if( pTab ){
- static VdbeOpList tableInfoPreface[] = {
- { OP_ColumnName, 0, 0, "cid"},
- { OP_ColumnName, 1, 0, "name"},
- { OP_ColumnName, 2, 0, "type"},
- { OP_ColumnName, 3, 0, "notnull"},
- { OP_ColumnName, 4, 0, "dflt_value"},
- { OP_ColumnName, 5, 1, "pk"},
- };
- int i;
- sqliteVdbeAddOpList(v, ArraySize(tableInfoPreface), tableInfoPreface);
- sqliteViewGetColumnNames(pParse, pTab);
- for(i=0; i<pTab->nCol; i++){
- sqliteVdbeAddOp(v, OP_Integer, i, 0);
- sqliteVdbeOp3(v, OP_String, 0, 0, pTab->aCol[i].zName, 0);
- sqliteVdbeOp3(v, OP_String, 0, 0,
- pTab->aCol[i].zType ? pTab->aCol[i].zType : "numeric", 0);
- sqliteVdbeAddOp(v, OP_Integer, pTab->aCol[i].notNull, 0);
- sqliteVdbeOp3(v, OP_String, 0, 0,
- pTab->aCol[i].zDflt, P3_STATIC);
- sqliteVdbeAddOp(v, OP_Integer, pTab->aCol[i].isPrimKey, 0);
- sqliteVdbeAddOp(v, OP_Callback, 6, 0);
- }
- }
- }else
-
- if( sqliteStrICmp(zLeft, "index_info")==0 ){
- Index *pIdx;
- Table *pTab;
- pIdx = sqliteFindIndex(db, zRight, 0);
- if( pIdx ){
- static VdbeOpList tableInfoPreface[] = {
- { OP_ColumnName, 0, 0, "seqno"},
- { OP_ColumnName, 1, 0, "cid"},
- { OP_ColumnName, 2, 1, "name"},
- };
- int i;
- pTab = pIdx->pTable;
- sqliteVdbeAddOpList(v, ArraySize(tableInfoPreface), tableInfoPreface);
- for(i=0; i<pIdx->nColumn; i++){
- int cnum = pIdx->aiColumn[i];
- sqliteVdbeAddOp(v, OP_Integer, i, 0);
- sqliteVdbeAddOp(v, OP_Integer, cnum, 0);
- assert( pTab->nCol>cnum );
- sqliteVdbeOp3(v, OP_String, 0, 0, pTab->aCol[cnum].zName, 0);
- sqliteVdbeAddOp(v, OP_Callback, 3, 0);
- }
- }
- }else
-
- if( sqliteStrICmp(zLeft, "index_list")==0 ){
- Index *pIdx;
- Table *pTab;
- pTab = sqliteFindTable(db, zRight, 0);
- if( pTab ){
- v = sqliteGetVdbe(pParse);
- pIdx = pTab->pIndex;
- }
- if( pTab && pIdx ){
- int i = 0;
- static VdbeOpList indexListPreface[] = {
- { OP_ColumnName, 0, 0, "seq"},
- { OP_ColumnName, 1, 0, "name"},
- { OP_ColumnName, 2, 1, "unique"},
- };
-
- sqliteVdbeAddOpList(v, ArraySize(indexListPreface), indexListPreface);
- while(pIdx){
- sqliteVdbeAddOp(v, OP_Integer, i, 0);
- sqliteVdbeOp3(v, OP_String, 0, 0, pIdx->zName, 0);
- sqliteVdbeAddOp(v, OP_Integer, pIdx->onError!=OE_None, 0);
- sqliteVdbeAddOp(v, OP_Callback, 3, 0);
- ++i;
- pIdx = pIdx->pNext;
- }
- }
- }else
-
- if( sqliteStrICmp(zLeft, "foreign_key_list")==0 ){
- FKey *pFK;
- Table *pTab;
- pTab = sqliteFindTable(db, zRight, 0);
- if( pTab ){
- v = sqliteGetVdbe(pParse);
- pFK = pTab->pFKey;
- }
- if( pTab && pFK ){
- int i = 0;
- static VdbeOpList indexListPreface[] = {
- { OP_ColumnName, 0, 0, "id"},
- { OP_ColumnName, 1, 0, "seq"},
- { OP_ColumnName, 2, 0, "table"},
- { OP_ColumnName, 3, 0, "from"},
- { OP_ColumnName, 4, 1, "to"},
- };
-
- sqliteVdbeAddOpList(v, ArraySize(indexListPreface), indexListPreface);
- while(pFK){
- int j;
- for(j=0; j<pFK->nCol; j++){
- sqliteVdbeAddOp(v, OP_Integer, i, 0);
- sqliteVdbeAddOp(v, OP_Integer, j, 0);
- sqliteVdbeOp3(v, OP_String, 0, 0, pFK->zTo, 0);
- sqliteVdbeOp3(v, OP_String, 0, 0,
- pTab->aCol[pFK->aCol[j].iFrom].zName, 0);
- sqliteVdbeOp3(v, OP_String, 0, 0, pFK->aCol[j].zCol, 0);
- sqliteVdbeAddOp(v, OP_Callback, 5, 0);
- }
- ++i;
- pFK = pFK->pNextFrom;
- }
- }
- }else
-
- if( sqliteStrICmp(zLeft, "database_list")==0 ){
- int i;
- static VdbeOpList indexListPreface[] = {
- { OP_ColumnName, 0, 0, "seq"},
- { OP_ColumnName, 1, 0, "name"},
- { OP_ColumnName, 2, 1, "file"},
- };
-
- sqliteVdbeAddOpList(v, ArraySize(indexListPreface), indexListPreface);
- for(i=0; i<db->nDb; i++){
- if( db->aDb[i].pBt==0 ) continue;
- assert( db->aDb[i].zName!=0 );
- sqliteVdbeAddOp(v, OP_Integer, i, 0);
- sqliteVdbeOp3(v, OP_String, 0, 0, db->aDb[i].zName, 0);
- sqliteVdbeOp3(v, OP_String, 0, 0,
- sqliteBtreeGetFilename(db->aDb[i].pBt), 0);
- sqliteVdbeAddOp(v, OP_Callback, 3, 0);
- }
- }else
-
-
- /*
- ** PRAGMA temp_store
- ** PRAGMA temp_store = "default"|"memory"|"file"
- **
- ** Return or set the local value of the temp_store flag. Changing
- ** the local value does not make changes to the disk file and the default
- ** value will be restored the next time the database is opened.
- **
- ** Note that it is possible for the library compile-time options to
- ** override this setting
- */
- if( sqliteStrICmp(zLeft, "temp_store")==0 ){
- static VdbeOpList getTmpDbLoc[] = {
- { OP_ColumnName, 0, 1, "temp_store"},
- { OP_Callback, 1, 0, 0},
- };
- if( pRight->z==pLeft->z ){
- sqliteVdbeAddOp(v, OP_Integer, db->temp_store, 0);
- sqliteVdbeAddOpList(v, ArraySize(getTmpDbLoc), getTmpDbLoc);
- }else{
- changeTempStorage(pParse, zRight);
- }
- }else
-
- /*
- ** PRAGMA default_temp_store
- ** PRAGMA default_temp_store = "default"|"memory"|"file"
- **
- ** Return or set the value of the persistent temp_store flag. Any
- ** change does not take effect until the next time the database is
- ** opened.
- **
- ** Note that it is possible for the library compile-time options to
- ** override this setting
- */
- if( sqliteStrICmp(zLeft, "default_temp_store")==0 ){
- static VdbeOpList getTmpDbLoc[] = {
- { OP_ColumnName, 0, 1, "temp_store"},
- { OP_ReadCookie, 0, 5, 0},
- { OP_Callback, 1, 0, 0}};
- if( pRight->z==pLeft->z ){
- sqliteVdbeAddOpList(v, ArraySize(getTmpDbLoc), getTmpDbLoc);
- }else{
- sqliteBeginWriteOperation(pParse, 0, 0);
- sqliteVdbeAddOp(v, OP_Integer, getTempStore(zRight), 0);
- sqliteVdbeAddOp(v, OP_SetCookie, 0, 5);
- sqliteEndWriteOperation(pParse);
- }
- }else
-
-#ifndef NDEBUG
- if( sqliteStrICmp(zLeft, "parser_trace")==0 ){
- extern void sqliteParserTrace(FILE*, char *);
- if( getBoolean(zRight) ){
- sqliteParserTrace(stdout, "parser: ");
- }else{
- sqliteParserTrace(0, 0);
- }
- }else
-#endif
-
- if( sqliteStrICmp(zLeft, "integrity_check")==0 ){
- int i, j, addr;
-
- /* Code that initializes the integrity check program. Set the
- ** error count 0
- */
- static VdbeOpList initCode[] = {
- { OP_Integer, 0, 0, 0},
- { OP_MemStore, 0, 1, 0},
- { OP_ColumnName, 0, 1, "integrity_check"},
- };
-
- /* Code to do an BTree integrity check on a single database file.
- */
- static VdbeOpList checkDb[] = {
- { OP_SetInsert, 0, 0, "2"},
- { OP_Integer, 0, 0, 0}, /* 1 */
- { OP_OpenRead, 0, 2, 0},
- { OP_Rewind, 0, 7, 0}, /* 3 */
- { OP_Column, 0, 3, 0}, /* 4 */
- { OP_SetInsert, 0, 0, 0},
- { OP_Next, 0, 4, 0}, /* 6 */
- { OP_IntegrityCk, 0, 0, 0}, /* 7 */
- { OP_Dup, 0, 1, 0},
- { OP_String, 0, 0, "ok"},
- { OP_StrEq, 0, 12, 0}, /* 10 */
- { OP_MemIncr, 0, 0, 0},
- { OP_String, 0, 0, "*** in database "},
- { OP_String, 0, 0, 0}, /* 13 */
- { OP_String, 0, 0, " ***\n"},
- { OP_Pull, 3, 0, 0},
- { OP_Concat, 4, 1, 0},
- { OP_Callback, 1, 0, 0},
- };
-
- /* Code that appears at the end of the integrity check. If no error
- ** messages have been generated, output OK. Otherwise output the
- ** error message
- */
- static VdbeOpList endCode[] = {
- { OP_MemLoad, 0, 0, 0},
- { OP_Integer, 0, 0, 0},
- { OP_Ne, 0, 0, 0}, /* 2 */
- { OP_String, 0, 0, "ok"},
- { OP_Callback, 1, 0, 0},
- };
-
- /* Initialize the VDBE program */
- sqliteVdbeAddOpList(v, ArraySize(initCode), initCode);
-
- /* Do an integrity check on each database file */
- for(i=0; i<db->nDb; i++){
- HashElem *x;
-
- /* Do an integrity check of the B-Tree
- */
- addr = sqliteVdbeAddOpList(v, ArraySize(checkDb), checkDb);
- sqliteVdbeChangeP1(v, addr+1, i);
- sqliteVdbeChangeP2(v, addr+3, addr+7);
- sqliteVdbeChangeP2(v, addr+6, addr+4);
- sqliteVdbeChangeP2(v, addr+7, i);
- sqliteVdbeChangeP2(v, addr+10, addr+ArraySize(checkDb));
- sqliteVdbeChangeP3(v, addr+13, db->aDb[i].zName, P3_STATIC);
-
- /* Make sure all the indices are constructed correctly.
- */
- sqliteCodeVerifySchema(pParse, i);
- for(x=sqliteHashFirst(&db->aDb[i].tblHash); x; x=sqliteHashNext(x)){
- Table *pTab = sqliteHashData(x);
- Index *pIdx;
- int loopTop;
-
- if( pTab->pIndex==0 ) continue;
- sqliteVdbeAddOp(v, OP_Integer, i, 0);
- sqliteVdbeOp3(v, OP_OpenRead, 1, pTab->tnum, pTab->zName, 0);
- for(j=0, pIdx=pTab->pIndex; pIdx; pIdx=pIdx->pNext, j++){
- if( pIdx->tnum==0 ) continue;
- sqliteVdbeAddOp(v, OP_Integer, pIdx->iDb, 0);
- sqliteVdbeOp3(v, OP_OpenRead, j+2, pIdx->tnum, pIdx->zName, 0);
- }
- sqliteVdbeAddOp(v, OP_Integer, 0, 0);
- sqliteVdbeAddOp(v, OP_MemStore, 1, 1);
- loopTop = sqliteVdbeAddOp(v, OP_Rewind, 1, 0);
- sqliteVdbeAddOp(v, OP_MemIncr, 1, 0);
- for(j=0, pIdx=pTab->pIndex; pIdx; pIdx=pIdx->pNext, j++){
- int k, jmp2;
- static VdbeOpList idxErr[] = {
- { OP_MemIncr, 0, 0, 0},
- { OP_String, 0, 0, "rowid "},
- { OP_Recno, 1, 0, 0},
- { OP_String, 0, 0, " missing from index "},
- { OP_String, 0, 0, 0}, /* 4 */
- { OP_Concat, 4, 0, 0},
- { OP_Callback, 1, 0, 0},
- };
- sqliteVdbeAddOp(v, OP_Recno, 1, 0);
- for(k=0; k<pIdx->nColumn; k++){
- int idx = pIdx->aiColumn[k];
- if( idx==pTab->iPKey ){
- sqliteVdbeAddOp(v, OP_Recno, 1, 0);
- }else{
- sqliteVdbeAddOp(v, OP_Column, 1, idx);
- }
- }
- sqliteVdbeAddOp(v, OP_MakeIdxKey, pIdx->nColumn, 0);
- if( db->file_format>=4 ) sqliteAddIdxKeyType(v, pIdx);
- jmp2 = sqliteVdbeAddOp(v, OP_Found, j+2, 0);
- addr = sqliteVdbeAddOpList(v, ArraySize(idxErr), idxErr);
- sqliteVdbeChangeP3(v, addr+4, pIdx->zName, P3_STATIC);
- sqliteVdbeChangeP2(v, jmp2, sqliteVdbeCurrentAddr(v));
- }
- sqliteVdbeAddOp(v, OP_Next, 1, loopTop+1);
- sqliteVdbeChangeP2(v, loopTop, sqliteVdbeCurrentAddr(v));
- for(j=0, pIdx=pTab->pIndex; pIdx; pIdx=pIdx->pNext, j++){
- static VdbeOpList cntIdx[] = {
- { OP_Integer, 0, 0, 0},
- { OP_MemStore, 2, 1, 0},
- { OP_Rewind, 0, 0, 0}, /* 2 */
- { OP_MemIncr, 2, 0, 0},
- { OP_Next, 0, 0, 0}, /* 4 */
- { OP_MemLoad, 1, 0, 0},
- { OP_MemLoad, 2, 0, 0},
- { OP_Eq, 0, 0, 0}, /* 7 */
- { OP_MemIncr, 0, 0, 0},
- { OP_String, 0, 0, "wrong # of entries in index "},
- { OP_String, 0, 0, 0}, /* 10 */
- { OP_Concat, 2, 0, 0},
- { OP_Callback, 1, 0, 0},
- };
- if( pIdx->tnum==0 ) continue;
- addr = sqliteVdbeAddOpList(v, ArraySize(cntIdx), cntIdx);
- sqliteVdbeChangeP1(v, addr+2, j+2);
- sqliteVdbeChangeP2(v, addr+2, addr+5);
- sqliteVdbeChangeP1(v, addr+4, j+2);
- sqliteVdbeChangeP2(v, addr+4, addr+3);
- sqliteVdbeChangeP2(v, addr+7, addr+ArraySize(cntIdx));
- sqliteVdbeChangeP3(v, addr+10, pIdx->zName, P3_STATIC);
- }
- }
- }
- addr = sqliteVdbeAddOpList(v, ArraySize(endCode), endCode);
- sqliteVdbeChangeP2(v, addr+2, addr+ArraySize(endCode));
- }else
-
- {}
- sqliteFree(zLeft);
- sqliteFree(zRight);
-}
+++ /dev/null
-/*
-** The "printf" code that follows dates from the 1980's. It is in
-** the public domain. The original comments are included here for
-** completeness. They are very out-of-date but might be useful as
-** an historical reference. Most of the "enhancements" have been backed
-** out so that the functionality is now the same as standard printf().
-**
-**************************************************************************
-**
-** The following modules is an enhanced replacement for the "printf" subroutines
-** found in the standard C library. The following enhancements are
-** supported:
-**
-** + Additional functions. The standard set of "printf" functions
-** includes printf, fprintf, sprintf, vprintf, vfprintf, and
-** vsprintf. This module adds the following:
-**
-** * snprintf -- Works like sprintf, but has an extra argument
-** which is the size of the buffer written to.
-**
-** * mprintf -- Similar to sprintf. Writes output to memory
-** obtained from malloc.
-**
-** * xprintf -- Calls a function to dispose of output.
-**
-** * nprintf -- No output, but returns the number of characters
-** that would have been output by printf.
-**
-** * A v- version (ex: vsnprintf) of every function is also
-** supplied.
-**
-** + A few extensions to the formatting notation are supported:
-**
-** * The "=" flag (similar to "-") causes the output to be
-** be centered in the appropriately sized field.
-**
-** * The %b field outputs an integer in binary notation.
-**
-** * The %c field now accepts a precision. The character output
-** is repeated by the number of times the precision specifies.
-**
-** * The %' field works like %c, but takes as its character the
-** next character of the format string, instead of the next
-** argument. For example, printf("%.78'-") prints 78 minus
-** signs, the same as printf("%.78c",'-').
-**
-** + When compiled using GCC on a SPARC, this version of printf is
-** faster than the library printf for SUN OS 4.1.
-**
-** + All functions are fully reentrant.
-**
-*/
-#include "sqliteInt.h"
-
-/*
-** Conversion types fall into various categories as defined by the
-** following enumeration.
-*/
-#define etRADIX 1 /* Integer types. %d, %x, %o, and so forth */
-#define etFLOAT 2 /* Floating point. %f */
-#define etEXP 3 /* Exponentional notation. %e and %E */
-#define etGENERIC 4 /* Floating or exponential, depending on exponent. %g */
-#define etSIZE 5 /* Return number of characters processed so far. %n */
-#define etSTRING 6 /* Strings. %s */
-#define etDYNSTRING 7 /* Dynamically allocated strings. %z */
-#define etPERCENT 8 /* Percent symbol. %% */
-#define etCHARX 9 /* Characters. %c */
-#define etERROR 10 /* Used to indicate no such conversion type */
-/* The rest are extensions, not normally found in printf() */
-#define etCHARLIT 11 /* Literal characters. %' */
-#define etSQLESCAPE 12 /* Strings with '\'' doubled. %q */
-#define etSQLESCAPE2 13 /* Strings with '\'' doubled and enclosed in '',
- NULL pointers replaced by SQL NULL. %Q */
-#define etTOKEN 14 /* a pointer to a Token structure */
-#define etSRCLIST 15 /* a pointer to a SrcList */
-
-
-/*
-** An "etByte" is an 8-bit unsigned value.
-*/
-typedef unsigned char etByte;
-
-/*
-** Each builtin conversion character (ex: the 'd' in "%d") is described
-** by an instance of the following structure
-*/
-typedef struct et_info { /* Information about each format field */
- char fmttype; /* The format field code letter */
- etByte base; /* The base for radix conversion */
- etByte flags; /* One or more of FLAG_ constants below */
- etByte type; /* Conversion paradigm */
- char *charset; /* The character set for conversion */
- char *prefix; /* Prefix on non-zero values in alt format */
-} et_info;
-
-/*
-** Allowed values for et_info.flags
-*/
-#define FLAG_SIGNED 1 /* True if the value to convert is signed */
-#define FLAG_INTERN 2 /* True if for internal use only */
-
-
-/*
-** The following table is searched linearly, so it is good to put the
-** most frequently used conversion types first.
-*/
-static et_info fmtinfo[] = {
- { 'd', 10, 1, etRADIX, "0123456789", 0 },
- { 's', 0, 0, etSTRING, 0, 0 },
- { 'z', 0, 2, etDYNSTRING, 0, 0 },
- { 'q', 0, 0, etSQLESCAPE, 0, 0 },
- { 'Q', 0, 0, etSQLESCAPE2, 0, 0 },
- { 'c', 0, 0, etCHARX, 0, 0 },
- { 'o', 8, 0, etRADIX, "01234567", "0" },
- { 'u', 10, 0, etRADIX, "0123456789", 0 },
- { 'x', 16, 0, etRADIX, "0123456789abcdef", "x0" },
- { 'X', 16, 0, etRADIX, "0123456789ABCDEF", "X0" },
- { 'f', 0, 1, etFLOAT, 0, 0 },
- { 'e', 0, 1, etEXP, "e", 0 },
- { 'E', 0, 1, etEXP, "E", 0 },
- { 'g', 0, 1, etGENERIC, "e", 0 },
- { 'G', 0, 1, etGENERIC, "E", 0 },
- { 'i', 10, 1, etRADIX, "0123456789", 0 },
- { 'n', 0, 0, etSIZE, 0, 0 },
- { '%', 0, 0, etPERCENT, 0, 0 },
- { 'p', 10, 0, etRADIX, "0123456789", 0 },
- { 'T', 0, 2, etTOKEN, 0, 0 },
- { 'S', 0, 2, etSRCLIST, 0, 0 },
-};
-#define etNINFO (sizeof(fmtinfo)/sizeof(fmtinfo[0]))
-
-/*
-** If NOFLOATINGPOINT is defined, then none of the floating point
-** conversions will work.
-*/
-#ifndef etNOFLOATINGPOINT
-/*
-** "*val" is a double such that 0.1 <= *val < 10.0
-** Return the ascii code for the leading digit of *val, then
-** multiply "*val" by 10.0 to renormalize.
-**
-** Example:
-** input: *val = 3.14159
-** output: *val = 1.4159 function return = '3'
-**
-** The counter *cnt is incremented each time. After counter exceeds
-** 16 (the number of significant digits in a 64-bit float) '0' is
-** always returned.
-*/
-static int et_getdigit(LONGDOUBLE_TYPE *val, int *cnt){
- int digit;
- LONGDOUBLE_TYPE d;
- if( (*cnt)++ >= 16 ) return '0';
- digit = (int)*val;
- d = digit;
- digit += '0';
- *val = (*val - d)*10.0;
- return digit;
-}
-#endif
-
-#define etBUFSIZE 1000 /* Size of the output buffer */
-
-/*
-** The root program. All variations call this core.
-**
-** INPUTS:
-** func This is a pointer to a function taking three arguments
-** 1. A pointer to anything. Same as the "arg" parameter.
-** 2. A pointer to the list of characters to be output
-** (Note, this list is NOT null terminated.)
-** 3. An integer number of characters to be output.
-** (Note: This number might be zero.)
-**
-** arg This is the pointer to anything which will be passed as the
-** first argument to "func". Use it for whatever you like.
-**
-** fmt This is the format string, as in the usual print.
-**
-** ap This is a pointer to a list of arguments. Same as in
-** vfprint.
-**
-** OUTPUTS:
-** The return value is the total number of characters sent to
-** the function "func". Returns -1 on a error.
-**
-** Note that the order in which automatic variables are declared below
-** seems to make a big difference in determining how fast this beast
-** will run.
-*/
-static int vxprintf(
- void (*func)(void*,const char*,int), /* Consumer of text */
- void *arg, /* First argument to the consumer */
- int useExtended, /* Allow extended %-conversions */
- const char *fmt, /* Format string */
- va_list ap /* arguments */
-){
- int c; /* Next character in the format string */
- char *bufpt; /* Pointer to the conversion buffer */
- int precision; /* Precision of the current field */
- int length; /* Length of the field */
- int idx; /* A general purpose loop counter */
- int count; /* Total number of characters output */
- int width; /* Width of the current field */
- etByte flag_leftjustify; /* True if "-" flag is present */
- etByte flag_plussign; /* True if "+" flag is present */
- etByte flag_blanksign; /* True if " " flag is present */
- etByte flag_alternateform; /* True if "#" flag is present */
- etByte flag_zeropad; /* True if field width constant starts with zero */
- etByte flag_long; /* True if "l" flag is present */
- unsigned long longvalue; /* Value for integer types */
- LONGDOUBLE_TYPE realvalue; /* Value for real types */
- et_info *infop; /* Pointer to the appropriate info structure */
- char buf[etBUFSIZE]; /* Conversion buffer */
- char prefix; /* Prefix character. "+" or "-" or " " or '\0'. */
- etByte errorflag = 0; /* True if an error is encountered */
- etByte xtype; /* Conversion paradigm */
- char *zExtra; /* Extra memory used for etTCLESCAPE conversions */
- static char spaces[] = " ";
-#define etSPACESIZE (sizeof(spaces)-1)
-#ifndef etNOFLOATINGPOINT
- int exp; /* exponent of real numbers */
- double rounder; /* Used for rounding floating point values */
- etByte flag_dp; /* True if decimal point should be shown */
- etByte flag_rtz; /* True if trailing zeros should be removed */
- etByte flag_exp; /* True to force display of the exponent */
- int nsd; /* Number of significant digits returned */
-#endif
-
- func(arg,"",0);
- count = length = 0;
- bufpt = 0;
- for(; (c=(*fmt))!=0; ++fmt){
- if( c!='%' ){
- int amt;
- bufpt = (char *)fmt;
- amt = 1;
- while( (c=(*++fmt))!='%' && c!=0 ) amt++;
- (*func)(arg,bufpt,amt);
- count += amt;
- if( c==0 ) break;
- }
- if( (c=(*++fmt))==0 ){
- errorflag = 1;
- (*func)(arg,"%",1);
- count++;
- break;
- }
- /* Find out what flags are present */
- flag_leftjustify = flag_plussign = flag_blanksign =
- flag_alternateform = flag_zeropad = 0;
- do{
- switch( c ){
- case '-': flag_leftjustify = 1; c = 0; break;
- case '+': flag_plussign = 1; c = 0; break;
- case ' ': flag_blanksign = 1; c = 0; break;
- case '#': flag_alternateform = 1; c = 0; break;
- case '0': flag_zeropad = 1; c = 0; break;
- default: break;
- }
- }while( c==0 && (c=(*++fmt))!=0 );
- /* Get the field width */
- width = 0;
- if( c=='*' ){
- width = va_arg(ap,int);
- if( width<0 ){
- flag_leftjustify = 1;
- width = -width;
- }
- c = *++fmt;
- }else{
- while( c>='0' && c<='9' ){
- width = width*10 + c - '0';
- c = *++fmt;
- }
- }
- if( width > etBUFSIZE-10 ){
- width = etBUFSIZE-10;
- }
- /* Get the precision */
- if( c=='.' ){
- precision = 0;
- c = *++fmt;
- if( c=='*' ){
- precision = va_arg(ap,int);
- if( precision<0 ) precision = -precision;
- c = *++fmt;
- }else{
- while( c>='0' && c<='9' ){
- precision = precision*10 + c - '0';
- c = *++fmt;
- }
- }
- /* Limit the precision to prevent overflowing buf[] during conversion */
- if( precision>etBUFSIZE-40 ) precision = etBUFSIZE-40;
- }else{
- precision = -1;
- }
- /* Get the conversion type modifier */
- if( c=='l' ){
- flag_long = 1;
- c = *++fmt;
- }else{
- flag_long = 0;
- }
- /* Fetch the info entry for the field */
- infop = 0;
- xtype = etERROR;
- for(idx=0; idx<etNINFO; idx++){
- if( c==fmtinfo[idx].fmttype ){
- infop = &fmtinfo[idx];
- if( useExtended || (infop->flags & FLAG_INTERN)==0 ){
- xtype = infop->type;
- }
- break;
- }
- }
- zExtra = 0;
-
- /*
- ** At this point, variables are initialized as follows:
- **
- ** flag_alternateform TRUE if a '#' is present.
- ** flag_plussign TRUE if a '+' is present.
- ** flag_leftjustify TRUE if a '-' is present or if the
- ** field width was negative.
- ** flag_zeropad TRUE if the width began with 0.
- ** flag_long TRUE if the letter 'l' (ell) prefixed
- ** the conversion character.
- ** flag_blanksign TRUE if a ' ' is present.
- ** width The specified field width. This is
- ** always non-negative. Zero is the default.
- ** precision The specified precision. The default
- ** is -1.
- ** xtype The class of the conversion.
- ** infop Pointer to the appropriate info struct.
- */
- switch( xtype ){
- case etRADIX:
- if( flag_long ) longvalue = va_arg(ap,long);
- else longvalue = va_arg(ap,int);
-#if 1
- /* For the format %#x, the value zero is printed "0" not "0x0".
- ** I think this is stupid. */
- if( longvalue==0 ) flag_alternateform = 0;
-#else
- /* More sensible: turn off the prefix for octal (to prevent "00"),
- ** but leave the prefix for hex. */
- if( longvalue==0 && infop->base==8 ) flag_alternateform = 0;
-#endif
- if( infop->flags & FLAG_SIGNED ){
- if( *(long*)&longvalue<0 ){
- longvalue = -*(long*)&longvalue;
- prefix = '-';
- }else if( flag_plussign ) prefix = '+';
- else if( flag_blanksign ) prefix = ' ';
- else prefix = 0;
- }else prefix = 0;
- if( flag_zeropad && precision<width-(prefix!=0) ){
- precision = width-(prefix!=0);
- }
- bufpt = &buf[etBUFSIZE-1];
- {
- register char *cset; /* Use registers for speed */
- register int base;
- cset = infop->charset;
- base = infop->base;
- do{ /* Convert to ascii */
- *(--bufpt) = cset[longvalue%base];
- longvalue = longvalue/base;
- }while( longvalue>0 );
- }
- length = &buf[etBUFSIZE-1]-bufpt;
- for(idx=precision-length; idx>0; idx--){
- *(--bufpt) = '0'; /* Zero pad */
- }
- if( prefix ) *(--bufpt) = prefix; /* Add sign */
- if( flag_alternateform && infop->prefix ){ /* Add "0" or "0x" */
- char *pre, x;
- pre = infop->prefix;
- if( *bufpt!=pre[0] ){
- for(pre=infop->prefix; (x=(*pre))!=0; pre++) *(--bufpt) = x;
- }
- }
- length = &buf[etBUFSIZE-1]-bufpt;
- break;
- case etFLOAT:
- case etEXP:
- case etGENERIC:
- realvalue = va_arg(ap,double);
-#ifndef etNOFLOATINGPOINT
- if( precision<0 ) precision = 6; /* Set default precision */
- if( precision>etBUFSIZE-10 ) precision = etBUFSIZE-10;
- if( realvalue<0.0 ){
- realvalue = -realvalue;
- prefix = '-';
- }else{
- if( flag_plussign ) prefix = '+';
- else if( flag_blanksign ) prefix = ' ';
- else prefix = 0;
- }
- if( infop->type==etGENERIC && precision>0 ) precision--;
- rounder = 0.0;
-#if 0
- /* Rounding works like BSD when the constant 0.4999 is used. Wierd! */
- for(idx=precision, rounder=0.4999; idx>0; idx--, rounder*=0.1);
-#else
- /* It makes more sense to use 0.5 */
- for(idx=precision, rounder=0.5; idx>0; idx--, rounder*=0.1);
-#endif
- if( infop->type==etFLOAT ) realvalue += rounder;
- /* Normalize realvalue to within 10.0 > realvalue >= 1.0 */
- exp = 0;
- if( realvalue>0.0 ){
- while( realvalue>=1e8 && exp<=350 ){ realvalue *= 1e-8; exp+=8; }
- while( realvalue>=10.0 && exp<=350 ){ realvalue *= 0.1; exp++; }
- while( realvalue<1e-8 && exp>=-350 ){ realvalue *= 1e8; exp-=8; }
- while( realvalue<1.0 && exp>=-350 ){ realvalue *= 10.0; exp--; }
- if( exp>350 || exp<-350 ){
- bufpt = "NaN";
- length = 3;
- break;
- }
- }
- bufpt = buf;
- /*
- ** If the field type is etGENERIC, then convert to either etEXP
- ** or etFLOAT, as appropriate.
- */
- flag_exp = xtype==etEXP;
- if( xtype!=etFLOAT ){
- realvalue += rounder;
- if( realvalue>=10.0 ){ realvalue *= 0.1; exp++; }
- }
- if( xtype==etGENERIC ){
- flag_rtz = !flag_alternateform;
- if( exp<-4 || exp>precision ){
- xtype = etEXP;
- }else{
- precision = precision - exp;
- xtype = etFLOAT;
- }
- }else{
- flag_rtz = 0;
- }
- /*
- ** The "exp+precision" test causes output to be of type etEXP if
- ** the precision is too large to fit in buf[].
- */
- nsd = 0;
- if( xtype==etFLOAT && exp+precision<etBUFSIZE-30 ){
- flag_dp = (precision>0 || flag_alternateform);
- if( prefix ) *(bufpt++) = prefix; /* Sign */
- if( exp<0 ) *(bufpt++) = '0'; /* Digits before "." */
- else for(; exp>=0; exp--) *(bufpt++) = et_getdigit(&realvalue,&nsd);
- if( flag_dp ) *(bufpt++) = '.'; /* The decimal point */
- for(exp++; exp<0 && precision>0; precision--, exp++){
- *(bufpt++) = '0';
- }
- while( (precision--)>0 ) *(bufpt++) = et_getdigit(&realvalue,&nsd);
- *(bufpt--) = 0; /* Null terminate */
- if( flag_rtz && flag_dp ){ /* Remove trailing zeros and "." */
- while( bufpt>=buf && *bufpt=='0' ) *(bufpt--) = 0;
- if( bufpt>=buf && *bufpt=='.' ) *(bufpt--) = 0;
- }
- bufpt++; /* point to next free slot */
- }else{ /* etEXP or etGENERIC */
- flag_dp = (precision>0 || flag_alternateform);
- if( prefix ) *(bufpt++) = prefix; /* Sign */
- *(bufpt++) = et_getdigit(&realvalue,&nsd); /* First digit */
- if( flag_dp ) *(bufpt++) = '.'; /* Decimal point */
- while( (precision--)>0 ) *(bufpt++) = et_getdigit(&realvalue,&nsd);
- bufpt--; /* point to last digit */
- if( flag_rtz && flag_dp ){ /* Remove tail zeros */
- while( bufpt>=buf && *bufpt=='0' ) *(bufpt--) = 0;
- if( bufpt>=buf && *bufpt=='.' ) *(bufpt--) = 0;
- }
- bufpt++; /* point to next free slot */
- if( exp || flag_exp ){
- *(bufpt++) = infop->charset[0];
- if( exp<0 ){ *(bufpt++) = '-'; exp = -exp; } /* sign of exp */
- else { *(bufpt++) = '+'; }
- if( exp>=100 ){
- *(bufpt++) = (exp/100)+'0'; /* 100's digit */
- exp %= 100;
- }
- *(bufpt++) = exp/10+'0'; /* 10's digit */
- *(bufpt++) = exp%10+'0'; /* 1's digit */
- }
- }
- /* The converted number is in buf[] and zero terminated. Output it.
- ** Note that the number is in the usual order, not reversed as with
- ** integer conversions. */
- length = bufpt-buf;
- bufpt = buf;
-
- /* Special case: Add leading zeros if the flag_zeropad flag is
- ** set and we are not left justified */
- if( flag_zeropad && !flag_leftjustify && length < width){
- int i;
- int nPad = width - length;
- for(i=width; i>=nPad; i--){
- bufpt[i] = bufpt[i-nPad];
- }
- i = prefix!=0;
- while( nPad-- ) bufpt[i++] = '0';
- length = width;
- }
-#endif
- break;
- case etSIZE:
- *(va_arg(ap,int*)) = count;
- length = width = 0;
- break;
- case etPERCENT:
- buf[0] = '%';
- bufpt = buf;
- length = 1;
- break;
- case etCHARLIT:
- case etCHARX:
- c = buf[0] = (xtype==etCHARX ? va_arg(ap,int) : *++fmt);
- if( precision>=0 ){
- for(idx=1; idx<precision; idx++) buf[idx] = c;
- length = precision;
- }else{
- length =1;
- }
- bufpt = buf;
- break;
- case etSTRING:
- case etDYNSTRING:
- bufpt = va_arg(ap,char*);
- if( bufpt==0 ){
- bufpt = "";
- }else if( xtype==etDYNSTRING ){
- zExtra = bufpt;
- }
- length = strlen(bufpt);
- if( precision>=0 && precision<length ) length = precision;
- break;
- case etSQLESCAPE:
- case etSQLESCAPE2:
- {
- int i, j, n, c, isnull;
- char *arg = va_arg(ap,char*);
- isnull = arg==0;
- if( isnull ) arg = (xtype==etSQLESCAPE2 ? "NULL" : "(NULL)");
- for(i=n=0; (c=arg[i])!=0; i++){
- if( c=='\'' ) n++;
- }
- n += i + 1 + ((!isnull && xtype==etSQLESCAPE2) ? 2 : 0);
- if( n>etBUFSIZE ){
- bufpt = zExtra = sqliteMalloc( n );
- if( bufpt==0 ) return -1;
- }else{
- bufpt = buf;
- }
- j = 0;
- if( !isnull && xtype==etSQLESCAPE2 ) bufpt[j++] = '\'';
- for(i=0; (c=arg[i])!=0; i++){
- bufpt[j++] = c;
- if( c=='\'' ) bufpt[j++] = c;
- }
- if( !isnull && xtype==etSQLESCAPE2 ) bufpt[j++] = '\'';
- bufpt[j] = 0;
- length = j;
- if( precision>=0 && precision<length ) length = precision;
- }
- break;
- case etTOKEN: {
- Token *pToken = va_arg(ap, Token*);
- (*func)(arg, pToken->z, pToken->n);
- length = width = 0;
- break;
- }
- case etSRCLIST: {
- SrcList *pSrc = va_arg(ap, SrcList*);
- int k = va_arg(ap, int);
- struct SrcList_item *pItem = &pSrc->a[k];
- assert( k>=0 && k<pSrc->nSrc );
- if( pItem->zDatabase && pItem->zDatabase[0] ){
- (*func)(arg, pItem->zDatabase, strlen(pItem->zDatabase));
- (*func)(arg, ".", 1);
- }
- (*func)(arg, pItem->zName, strlen(pItem->zName));
- length = width = 0;
- break;
- }
- case etERROR:
- buf[0] = '%';
- buf[1] = c;
- errorflag = 0;
- idx = 1+(c!=0);
- (*func)(arg,"%",idx);
- count += idx;
- if( c==0 ) fmt--;
- break;
- }/* End switch over the format type */
- /*
- ** The text of the conversion is pointed to by "bufpt" and is
- ** "length" characters long. The field width is "width". Do
- ** the output.
- */
- if( !flag_leftjustify ){
- register int nspace;
- nspace = width-length;
- if( nspace>0 ){
- count += nspace;
- while( nspace>=etSPACESIZE ){
- (*func)(arg,spaces,etSPACESIZE);
- nspace -= etSPACESIZE;
- }
- if( nspace>0 ) (*func)(arg,spaces,nspace);
- }
- }
- if( length>0 ){
- (*func)(arg,bufpt,length);
- count += length;
- }
- if( flag_leftjustify ){
- register int nspace;
- nspace = width-length;
- if( nspace>0 ){
- count += nspace;
- while( nspace>=etSPACESIZE ){
- (*func)(arg,spaces,etSPACESIZE);
- nspace -= etSPACESIZE;
- }
- if( nspace>0 ) (*func)(arg,spaces,nspace);
- }
- }
- if( zExtra ){
- sqliteFree(zExtra);
- }
- }/* End for loop over the format string */
- return errorflag ? -1 : count;
-} /* End of function */
-
-
-/* This structure is used to store state information about the
-** write to memory that is currently in progress.
-*/
-struct sgMprintf {
- char *zBase; /* A base allocation */
- char *zText; /* The string collected so far */
- int nChar; /* Length of the string so far */
- int nTotal; /* Output size if unconstrained */
- int nAlloc; /* Amount of space allocated in zText */
- void *(*xRealloc)(void*,int); /* Function used to realloc memory */
-};
-
-/*
-** This function implements the callback from vxprintf.
-**
-** This routine add nNewChar characters of text in zNewText to
-** the sgMprintf structure pointed to by "arg".
-*/
-static void mout(void *arg, const char *zNewText, int nNewChar){
- struct sgMprintf *pM = (struct sgMprintf*)arg;
- pM->nTotal += nNewChar;
- if( pM->nChar + nNewChar + 1 > pM->nAlloc ){
- if( pM->xRealloc==0 ){
- nNewChar = pM->nAlloc - pM->nChar - 1;
- }else{
- pM->nAlloc = pM->nChar + nNewChar*2 + 1;
- if( pM->zText==pM->zBase ){
- pM->zText = pM->xRealloc(0, pM->nAlloc);
- if( pM->zText && pM->nChar ){
- memcpy(pM->zText, pM->zBase, pM->nChar);
- }
- }else{
- pM->zText = pM->xRealloc(pM->zText, pM->nAlloc);
- }
- }
- }
- if( pM->zText ){
- if( nNewChar>0 ){
- memcpy(&pM->zText[pM->nChar], zNewText, nNewChar);
- pM->nChar += nNewChar;
- }
- pM->zText[pM->nChar] = 0;
- }
-}
-
-/*
-** This routine is a wrapper around xprintf() that invokes mout() as
-** the consumer.
-*/
-static char *base_vprintf(
- void *(*xRealloc)(void*,int), /* Routine to realloc memory. May be NULL */
- int useInternal, /* Use internal %-conversions if true */
- char *zInitBuf, /* Initially write here, before mallocing */
- int nInitBuf, /* Size of zInitBuf[] */
- const char *zFormat, /* format string */
- va_list ap /* arguments */
-){
- struct sgMprintf sM;
- sM.zBase = sM.zText = zInitBuf;
- sM.nChar = sM.nTotal = 0;
- sM.nAlloc = nInitBuf;
- sM.xRealloc = xRealloc;
- vxprintf(mout, &sM, useInternal, zFormat, ap);
- if( xRealloc ){
- if( sM.zText==sM.zBase ){
- sM.zText = xRealloc(0, sM.nChar+1);
- memcpy(sM.zText, sM.zBase, sM.nChar+1);
- }else if( sM.nAlloc>sM.nChar+10 ){
- sM.zText = xRealloc(sM.zText, sM.nChar+1);
- }
- }
- return sM.zText;
-}
-
-/*
-** Realloc that is a real function, not a macro.
-*/
-static void *printf_realloc(void *old, int size){
- return sqliteRealloc(old,size);
-}
-
-/*
-** Print into memory obtained from sqliteMalloc(). Use the internal
-** %-conversion extensions.
-*/
-char *sqliteVMPrintf(const char *zFormat, va_list ap){
- char zBase[1000];
- return base_vprintf(printf_realloc, 1, zBase, sizeof(zBase), zFormat, ap);
-}
-
-/*
-** Print into memory obtained from sqliteMalloc(). Use the internal
-** %-conversion extensions.
-*/
-char *sqliteMPrintf(const char *zFormat, ...){
- va_list ap;
- char *z;
- char zBase[1000];
- va_start(ap, zFormat);
- z = base_vprintf(printf_realloc, 1, zBase, sizeof(zBase), zFormat, ap);
- va_end(ap);
- return z;
-}
-
-/*
-** Print into memory obtained from malloc(). Do not use the internal
-** %-conversion extensions. This routine is for use by external users.
-*/
-char *sqlite_mprintf(const char *zFormat, ...){
- va_list ap;
- char *z;
- char zBuf[200];
-
- va_start(ap,zFormat);
- z = base_vprintf((void*(*)(void*,int))realloc, 0,
- zBuf, sizeof(zBuf), zFormat, ap);
- va_end(ap);
- return z;
-}
-
-/* This is the varargs version of sqlite_mprintf.
-*/
-char *sqlite_vmprintf(const char *zFormat, va_list ap){
- char zBuf[200];
- return base_vprintf((void*(*)(void*,int))realloc, 0,
- zBuf, sizeof(zBuf), zFormat, ap);
-}
-
-/*
-** sqlite_snprintf() works like snprintf() except that it ignores the
-** current locale settings. This is important for SQLite because we
-** are not able to use a "," as the decimal point in place of "." as
-** specified by some locales.
-*/
-char *sqlite_snprintf(int n, char *zBuf, const char *zFormat, ...){
- char *z;
- va_list ap;
-
- va_start(ap,zFormat);
- z = base_vprintf(0, 0, zBuf, n, zFormat, ap);
- va_end(ap);
- return z;
-}
-
-/*
-** The following four routines implement the varargs versions of the
-** sqlite_exec() and sqlite_get_table() interfaces. See the sqlite.h
-** header files for a more detailed description of how these interfaces
-** work.
-**
-** These routines are all just simple wrappers.
-*/
-int sqlite_exec_printf(
- sqlite *db, /* An open database */
- const char *sqlFormat, /* printf-style format string for the SQL */
- sqlite_callback xCallback, /* Callback function */
- void *pArg, /* 1st argument to callback function */
- char **errmsg, /* Error msg written here */
- ... /* Arguments to the format string. */
-){
- va_list ap;
- int rc;
-
- va_start(ap, errmsg);
- rc = sqlite_exec_vprintf(db, sqlFormat, xCallback, pArg, errmsg, ap);
- va_end(ap);
- return rc;
-}
-int sqlite_exec_vprintf(
- sqlite *db, /* An open database */
- const char *sqlFormat, /* printf-style format string for the SQL */
- sqlite_callback xCallback, /* Callback function */
- void *pArg, /* 1st argument to callback function */
- char **errmsg, /* Error msg written here */
- va_list ap /* Arguments to the format string. */
-){
- char *zSql;
- int rc;
-
- zSql = sqlite_vmprintf(sqlFormat, ap);
- rc = sqlite_exec(db, zSql, xCallback, pArg, errmsg);
- free(zSql);
- return rc;
-}
-int sqlite_get_table_printf(
- sqlite *db, /* An open database */
- const char *sqlFormat, /* printf-style format string for the SQL */
- char ***resultp, /* Result written to a char *[] that this points to */
- int *nrow, /* Number of result rows written here */
- int *ncol, /* Number of result columns written here */
- char **errmsg, /* Error msg written here */
- ... /* Arguments to the format string */
-){
- va_list ap;
- int rc;
-
- va_start(ap, errmsg);
- rc = sqlite_get_table_vprintf(db, sqlFormat, resultp, nrow, ncol, errmsg, ap);
- va_end(ap);
- return rc;
-}
-int sqlite_get_table_vprintf(
- sqlite *db, /* An open database */
- const char *sqlFormat, /* printf-style format string for the SQL */
- char ***resultp, /* Result written to a char *[] that this points to */
- int *nrow, /* Number of result rows written here */
- int *ncolumn, /* Number of result columns written here */
- char **errmsg, /* Error msg written here */
- va_list ap /* Arguments to the format string */
-){
- char *zSql;
- int rc;
-
- zSql = sqlite_vmprintf(sqlFormat, ap);
- rc = sqlite_get_table(db, zSql, resultp, nrow, ncolumn, errmsg);
- free(zSql);
- return rc;
-}
+++ /dev/null
-/*
-** 2001 September 15
-**
-** The author disclaims copyright to this source code. In place of
-** a legal notice, here is a blessing:
-**
-** May you do good and not evil.
-** May you find forgiveness for yourself and forgive others.
-** May you share freely, never taking more than you give.
-**
-*************************************************************************
-** This file contains code to implement a pseudo-random number
-** generator (PRNG) for SQLite.
-**
-** Random numbers are used by some of the database backends in order
-** to generate random integer keys for tables or random filenames.
-**
-** $Id: random.c,v 1.1.1.1 2004/08/08 15:03:58 matt Exp $
-*/
-#include "sqliteInt.h"
-#include "os.h"
-
-
-/*
-** Get a single 8-bit random value from the RC4 PRNG. The Mutex
-** must be held while executing this routine.
-**
-** Why not just use a library random generator like lrand48() for this?
-** Because the OP_NewRecno opcode in the VDBE depends on having a very
-** good source of random numbers. The lrand48() library function may
-** well be good enough. But maybe not. Or maybe lrand48() has some
-** subtle problems on some systems that could cause problems. It is hard
-** to know. To minimize the risk of problems due to bad lrand48()
-** implementations, SQLite uses this random number generator based
-** on RC4, which we know works very well.
-*/
-static int randomByte(){
- unsigned char t;
-
- /* All threads share a single random number generator.
- ** This structure is the current state of the generator.
- */
- static struct {
- unsigned char isInit; /* True if initialized */
- unsigned char i, j; /* State variables */
- unsigned char s[256]; /* State variables */
- } prng;
-
- /* Initialize the state of the random number generator once,
- ** the first time this routine is called. The seed value does
- ** not need to contain a lot of randomness since we are not
- ** trying to do secure encryption or anything like that...
- **
- ** Nothing in this file or anywhere else in SQLite does any kind of
- ** encryption. The RC4 algorithm is being used as a PRNG (pseudo-random
- ** number generator) not as an encryption device.
- */
- if( !prng.isInit ){
- int i;
- char k[256];
- prng.j = 0;
- prng.i = 0;
- sqliteOsRandomSeed(k);
- for(i=0; i<256; i++){
- prng.s[i] = i;
- }
- for(i=0; i<256; i++){
- prng.j += prng.s[i] + k[i];
- t = prng.s[prng.j];
- prng.s[prng.j] = prng.s[i];
- prng.s[i] = t;
- }
- prng.isInit = 1;
- }
-
- /* Generate and return single random byte
- */
- prng.i++;
- t = prng.s[prng.i];
- prng.j += t;
- prng.s[prng.i] = prng.s[prng.j];
- prng.s[prng.j] = t;
- t += prng.s[prng.i];
- return prng.s[t];
-}
-
-/*
-** Return N random bytes.
-*/
-void sqliteRandomness(int N, void *pBuf){
- unsigned char *zBuf = pBuf;
- sqliteOsEnterMutex();
- while( N-- ){
- *(zBuf++) = randomByte();
- }
- sqliteOsLeaveMutex();
-}
+++ /dev/null
-/*
-** 2001 September 15
-**
-** The author disclaims copyright to this source code. In place of
-** a legal notice, here is a blessing:
-**
-** May you do good and not evil.
-** May you find forgiveness for yourself and forgive others.
-** May you share freely, never taking more than you give.
-**
-*************************************************************************
-** This file contains C code routines that are called by the parser
-** to handle SELECT statements in SQLite.
-**
-** $Id: select.c,v 1.1.1.1 2004/08/08 15:03:58 matt Exp $
-*/
-#include "sqliteInt.h"
-
-
-/*
-** Allocate a new Select structure and return a pointer to that
-** structure.
-*/
-Select *sqliteSelectNew(
- ExprList *pEList, /* which columns to include in the result */
- SrcList *pSrc, /* the FROM clause -- which tables to scan */
- Expr *pWhere, /* the WHERE clause */
- ExprList *pGroupBy, /* the GROUP BY clause */
- Expr *pHaving, /* the HAVING clause */
- ExprList *pOrderBy, /* the ORDER BY clause */
- int isDistinct, /* true if the DISTINCT keyword is present */
- int nLimit, /* LIMIT value. -1 means not used */
- int nOffset /* OFFSET value. 0 means no offset */
-){
- Select *pNew;
- pNew = sqliteMalloc( sizeof(*pNew) );
- if( pNew==0 ){
- sqliteExprListDelete(pEList);
- sqliteSrcListDelete(pSrc);
- sqliteExprDelete(pWhere);
- sqliteExprListDelete(pGroupBy);
- sqliteExprDelete(pHaving);
- sqliteExprListDelete(pOrderBy);
- }else{
- if( pEList==0 ){
- pEList = sqliteExprListAppend(0, sqliteExpr(TK_ALL,0,0,0), 0);
- }
- pNew->pEList = pEList;
- pNew->pSrc = pSrc;
- pNew->pWhere = pWhere;
- pNew->pGroupBy = pGroupBy;
- pNew->pHaving = pHaving;
- pNew->pOrderBy = pOrderBy;
- pNew->isDistinct = isDistinct;
- pNew->op = TK_SELECT;
- pNew->nLimit = nLimit;
- pNew->nOffset = nOffset;
- pNew->iLimit = -1;
- pNew->iOffset = -1;
- }
- return pNew;
-}
-
-/*
-** Given 1 to 3 identifiers preceeding the JOIN keyword, determine the
-** type of join. Return an integer constant that expresses that type
-** in terms of the following bit values:
-**
-** JT_INNER
-** JT_OUTER
-** JT_NATURAL
-** JT_LEFT
-** JT_RIGHT
-**
-** A full outer join is the combination of JT_LEFT and JT_RIGHT.
-**
-** If an illegal or unsupported join type is seen, then still return
-** a join type, but put an error in the pParse structure.
-*/
-int sqliteJoinType(Parse *pParse, Token *pA, Token *pB, Token *pC){
- int jointype = 0;
- Token *apAll[3];
- Token *p;
- static struct {
- const char *zKeyword;
- int nChar;
- int code;
- } keywords[] = {
- { "natural", 7, JT_NATURAL },
- { "left", 4, JT_LEFT|JT_OUTER },
- { "right", 5, JT_RIGHT|JT_OUTER },
- { "full", 4, JT_LEFT|JT_RIGHT|JT_OUTER },
- { "outer", 5, JT_OUTER },
- { "inner", 5, JT_INNER },
- { "cross", 5, JT_INNER },
- };
- int i, j;
- apAll[0] = pA;
- apAll[1] = pB;
- apAll[2] = pC;
- for(i=0; i<3 && apAll[i]; i++){
- p = apAll[i];
- for(j=0; j<sizeof(keywords)/sizeof(keywords[0]); j++){
- if( p->n==keywords[j].nChar
- && sqliteStrNICmp(p->z, keywords[j].zKeyword, p->n)==0 ){
- jointype |= keywords[j].code;
- break;
- }
- }
- if( j>=sizeof(keywords)/sizeof(keywords[0]) ){
- jointype |= JT_ERROR;
- break;
- }
- }
- if(
- (jointype & (JT_INNER|JT_OUTER))==(JT_INNER|JT_OUTER) ||
- (jointype & JT_ERROR)!=0
- ){
- static Token dummy = { 0, 0 };
- char *zSp1 = " ", *zSp2 = " ";
- if( pB==0 ){ pB = &dummy; zSp1 = 0; }
- if( pC==0 ){ pC = &dummy; zSp2 = 0; }
- sqliteSetNString(&pParse->zErrMsg, "unknown or unsupported join type: ", 0,
- pA->z, pA->n, zSp1, 1, pB->z, pB->n, zSp2, 1, pC->z, pC->n, 0);
- pParse->nErr++;
- jointype = JT_INNER;
- }else if( jointype & JT_RIGHT ){
- sqliteErrorMsg(pParse,
- "RIGHT and FULL OUTER JOINs are not currently supported");
- jointype = JT_INNER;
- }
- return jointype;
-}
-
-/*
-** Return the index of a column in a table. Return -1 if the column
-** is not contained in the table.
-*/
-static int columnIndex(Table *pTab, const char *zCol){
- int i;
- for(i=0; i<pTab->nCol; i++){
- if( sqliteStrICmp(pTab->aCol[i].zName, zCol)==0 ) return i;
- }
- return -1;
-}
-
-/*
-** Add a term to the WHERE expression in *ppExpr that requires the
-** zCol column to be equal in the two tables pTab1 and pTab2.
-*/
-static void addWhereTerm(
- const char *zCol, /* Name of the column */
- const Table *pTab1, /* First table */
- const Table *pTab2, /* Second table */
- Expr **ppExpr /* Add the equality term to this expression */
-){
- Token dummy;
- Expr *pE1a, *pE1b, *pE1c;
- Expr *pE2a, *pE2b, *pE2c;
- Expr *pE;
-
- dummy.z = zCol;
- dummy.n = strlen(zCol);
- dummy.dyn = 0;
- pE1a = sqliteExpr(TK_ID, 0, 0, &dummy);
- pE2a = sqliteExpr(TK_ID, 0, 0, &dummy);
- dummy.z = pTab1->zName;
- dummy.n = strlen(dummy.z);
- pE1b = sqliteExpr(TK_ID, 0, 0, &dummy);
- dummy.z = pTab2->zName;
- dummy.n = strlen(dummy.z);
- pE2b = sqliteExpr(TK_ID, 0, 0, &dummy);
- pE1c = sqliteExpr(TK_DOT, pE1b, pE1a, 0);
- pE2c = sqliteExpr(TK_DOT, pE2b, pE2a, 0);
- pE = sqliteExpr(TK_EQ, pE1c, pE2c, 0);
- ExprSetProperty(pE, EP_FromJoin);
- if( *ppExpr ){
- *ppExpr = sqliteExpr(TK_AND, *ppExpr, pE, 0);
- }else{
- *ppExpr = pE;
- }
-}
-
-/*
-** Set the EP_FromJoin property on all terms of the given expression.
-**
-** The EP_FromJoin property is used on terms of an expression to tell
-** the LEFT OUTER JOIN processing logic that this term is part of the
-** join restriction specified in the ON or USING clause and not a part
-** of the more general WHERE clause. These terms are moved over to the
-** WHERE clause during join processing but we need to remember that they
-** originated in the ON or USING clause.
-*/
-static void setJoinExpr(Expr *p){
- while( p ){
- ExprSetProperty(p, EP_FromJoin);
- setJoinExpr(p->pLeft);
- p = p->pRight;
- }
-}
-
-/*
-** This routine processes the join information for a SELECT statement.
-** ON and USING clauses are converted into extra terms of the WHERE clause.
-** NATURAL joins also create extra WHERE clause terms.
-**
-** This routine returns the number of errors encountered.
-*/
-static int sqliteProcessJoin(Parse *pParse, Select *p){
- SrcList *pSrc;
- int i, j;
- pSrc = p->pSrc;
- for(i=0; i<pSrc->nSrc-1; i++){
- struct SrcList_item *pTerm = &pSrc->a[i];
- struct SrcList_item *pOther = &pSrc->a[i+1];
-
- if( pTerm->pTab==0 || pOther->pTab==0 ) continue;
-
- /* When the NATURAL keyword is present, add WHERE clause terms for
- ** every column that the two tables have in common.
- */
- if( pTerm->jointype & JT_NATURAL ){
- Table *pTab;
- if( pTerm->pOn || pTerm->pUsing ){
- sqliteErrorMsg(pParse, "a NATURAL join may not have "
- "an ON or USING clause", 0);
- return 1;
- }
- pTab = pTerm->pTab;
- for(j=0; j<pTab->nCol; j++){
- if( columnIndex(pOther->pTab, pTab->aCol[j].zName)>=0 ){
- addWhereTerm(pTab->aCol[j].zName, pTab, pOther->pTab, &p->pWhere);
- }
- }
- }
-
- /* Disallow both ON and USING clauses in the same join
- */
- if( pTerm->pOn && pTerm->pUsing ){
- sqliteErrorMsg(pParse, "cannot have both ON and USING "
- "clauses in the same join");
- return 1;
- }
-
- /* Add the ON clause to the end of the WHERE clause, connected by
- ** and AND operator.
- */
- if( pTerm->pOn ){
- setJoinExpr(pTerm->pOn);
- if( p->pWhere==0 ){
- p->pWhere = pTerm->pOn;
- }else{
- p->pWhere = sqliteExpr(TK_AND, p->pWhere, pTerm->pOn, 0);
- }
- pTerm->pOn = 0;
- }
-
- /* Create extra terms on the WHERE clause for each column named
- ** in the USING clause. Example: If the two tables to be joined are
- ** A and B and the USING clause names X, Y, and Z, then add this
- ** to the WHERE clause: A.X=B.X AND A.Y=B.Y AND A.Z=B.Z
- ** Report an error if any column mentioned in the USING clause is
- ** not contained in both tables to be joined.
- */
- if( pTerm->pUsing ){
- IdList *pList;
- int j;
- assert( i<pSrc->nSrc-1 );
- pList = pTerm->pUsing;
- for(j=0; j<pList->nId; j++){
- if( columnIndex(pTerm->pTab, pList->a[j].zName)<0 ||
- columnIndex(pOther->pTab, pList->a[j].zName)<0 ){
- sqliteErrorMsg(pParse, "cannot join using column %s - column "
- "not present in both tables", pList->a[j].zName);
- return 1;
- }
- addWhereTerm(pList->a[j].zName, pTerm->pTab, pOther->pTab, &p->pWhere);
- }
- }
- }
- return 0;
-}
-
-/*
-** Delete the given Select structure and all of its substructures.
-*/
-void sqliteSelectDelete(Select *p){
- if( p==0 ) return;
- sqliteExprListDelete(p->pEList);
- sqliteSrcListDelete(p->pSrc);
- sqliteExprDelete(p->pWhere);
- sqliteExprListDelete(p->pGroupBy);
- sqliteExprDelete(p->pHaving);
- sqliteExprListDelete(p->pOrderBy);
- sqliteSelectDelete(p->pPrior);
- sqliteFree(p->zSelect);
- sqliteFree(p);
-}
-
-/*
-** Delete the aggregate information from the parse structure.
-*/
-static void sqliteAggregateInfoReset(Parse *pParse){
- sqliteFree(pParse->aAgg);
- pParse->aAgg = 0;
- pParse->nAgg = 0;
- pParse->useAgg = 0;
-}
-
-/*
-** Insert code into "v" that will push the record on the top of the
-** stack into the sorter.
-*/
-static void pushOntoSorter(Parse *pParse, Vdbe *v, ExprList *pOrderBy){
- char *zSortOrder;
- int i;
- zSortOrder = sqliteMalloc( pOrderBy->nExpr + 1 );
- if( zSortOrder==0 ) return;
- for(i=0; i<pOrderBy->nExpr; i++){
- int order = pOrderBy->a[i].sortOrder;
- int type;
- int c;
- if( (order & SQLITE_SO_TYPEMASK)==SQLITE_SO_TEXT ){
- type = SQLITE_SO_TEXT;
- }else if( (order & SQLITE_SO_TYPEMASK)==SQLITE_SO_NUM ){
- type = SQLITE_SO_NUM;
- }else if( pParse->db->file_format>=4 ){
- type = sqliteExprType(pOrderBy->a[i].pExpr);
- }else{
- type = SQLITE_SO_NUM;
- }
- if( (order & SQLITE_SO_DIRMASK)==SQLITE_SO_ASC ){
- c = type==SQLITE_SO_TEXT ? 'A' : '+';
- }else{
- c = type==SQLITE_SO_TEXT ? 'D' : '-';
- }
- zSortOrder[i] = c;
- sqliteExprCode(pParse, pOrderBy->a[i].pExpr);
- }
- zSortOrder[pOrderBy->nExpr] = 0;
- sqliteVdbeOp3(v, OP_SortMakeKey, pOrderBy->nExpr, 0, zSortOrder, P3_DYNAMIC);
- sqliteVdbeAddOp(v, OP_SortPut, 0, 0);
-}
-
-/*
-** This routine adds a P3 argument to the last VDBE opcode that was
-** inserted. The P3 argument added is a string suitable for the
-** OP_MakeKey or OP_MakeIdxKey opcodes. The string consists of
-** characters 't' or 'n' depending on whether or not the various
-** fields of the key to be generated should be treated as numeric
-** or as text. See the OP_MakeKey and OP_MakeIdxKey opcode
-** documentation for additional information about the P3 string.
-** See also the sqliteAddIdxKeyType() routine.
-*/
-void sqliteAddKeyType(Vdbe *v, ExprList *pEList){
- int nColumn = pEList->nExpr;
- char *zType = sqliteMalloc( nColumn+1 );
- int i;
- if( zType==0 ) return;
- for(i=0; i<nColumn; i++){
- zType[i] = sqliteExprType(pEList->a[i].pExpr)==SQLITE_SO_NUM ? 'n' : 't';
- }
- zType[i] = 0;
- sqliteVdbeChangeP3(v, -1, zType, P3_DYNAMIC);
-}
-
-/*
-** Add code to implement the OFFSET and LIMIT
-*/
-static void codeLimiter(
- Vdbe *v, /* Generate code into this VM */
- Select *p, /* The SELECT statement being coded */
- int iContinue, /* Jump here to skip the current record */
- int iBreak, /* Jump here to end the loop */
- int nPop /* Number of times to pop stack when jumping */
-){
- if( p->iOffset>=0 ){
- int addr = sqliteVdbeCurrentAddr(v) + 2;
- if( nPop>0 ) addr++;
- sqliteVdbeAddOp(v, OP_MemIncr, p->iOffset, addr);
- if( nPop>0 ){
- sqliteVdbeAddOp(v, OP_Pop, nPop, 0);
- }
- sqliteVdbeAddOp(v, OP_Goto, 0, iContinue);
- }
- if( p->iLimit>=0 ){
- sqliteVdbeAddOp(v, OP_MemIncr, p->iLimit, iBreak);
- }
-}
-
-/*
-** This routine generates the code for the inside of the inner loop
-** of a SELECT.
-**
-** If srcTab and nColumn are both zero, then the pEList expressions
-** are evaluated in order to get the data for this row. If nColumn>0
-** then data is pulled from srcTab and pEList is used only to get the
-** datatypes for each column.
-*/
-static int selectInnerLoop(
- Parse *pParse, /* The parser context */
- Select *p, /* The complete select statement being coded */
- ExprList *pEList, /* List of values being extracted */
- int srcTab, /* Pull data from this table */
- int nColumn, /* Number of columns in the source table */
- ExprList *pOrderBy, /* If not NULL, sort results using this key */
- int distinct, /* If >=0, make sure results are distinct */
- int eDest, /* How to dispose of the results */
- int iParm, /* An argument to the disposal method */
- int iContinue, /* Jump here to continue with next row */
- int iBreak /* Jump here to break out of the inner loop */
-){
- Vdbe *v = pParse->pVdbe;
- int i;
- int hasDistinct; /* True if the DISTINCT keyword is present */
-
- if( v==0 ) return 0;
- assert( pEList!=0 );
-
- /* If there was a LIMIT clause on the SELECT statement, then do the check
- ** to see if this row should be output.
- */
- hasDistinct = distinct>=0 && pEList && pEList->nExpr>0;
- if( pOrderBy==0 && !hasDistinct ){
- codeLimiter(v, p, iContinue, iBreak, 0);
- }
-
- /* Pull the requested columns.
- */
- if( nColumn>0 ){
- for(i=0; i<nColumn; i++){
- sqliteVdbeAddOp(v, OP_Column, srcTab, i);
- }
- }else{
- nColumn = pEList->nExpr;
- for(i=0; i<pEList->nExpr; i++){
- sqliteExprCode(pParse, pEList->a[i].pExpr);
- }
- }
-
- /* If the DISTINCT keyword was present on the SELECT statement
- ** and this row has been seen before, then do not make this row
- ** part of the result.
- */
- if( hasDistinct ){
-#if NULL_ALWAYS_DISTINCT
- sqliteVdbeAddOp(v, OP_IsNull, -pEList->nExpr, sqliteVdbeCurrentAddr(v)+7);
-#endif
- sqliteVdbeAddOp(v, OP_MakeKey, pEList->nExpr, 1);
- if( pParse->db->file_format>=4 ) sqliteAddKeyType(v, pEList);
- sqliteVdbeAddOp(v, OP_Distinct, distinct, sqliteVdbeCurrentAddr(v)+3);
- sqliteVdbeAddOp(v, OP_Pop, pEList->nExpr+1, 0);
- sqliteVdbeAddOp(v, OP_Goto, 0, iContinue);
- sqliteVdbeAddOp(v, OP_String, 0, 0);
- sqliteVdbeAddOp(v, OP_PutStrKey, distinct, 0);
- if( pOrderBy==0 ){
- codeLimiter(v, p, iContinue, iBreak, nColumn);
- }
- }
-
- switch( eDest ){
- /* In this mode, write each query result to the key of the temporary
- ** table iParm.
- */
- case SRT_Union: {
- sqliteVdbeAddOp(v, OP_MakeRecord, nColumn, NULL_ALWAYS_DISTINCT);
- sqliteVdbeAddOp(v, OP_String, 0, 0);
- sqliteVdbeAddOp(v, OP_PutStrKey, iParm, 0);
- break;
- }
-
- /* Store the result as data using a unique key.
- */
- case SRT_Table:
- case SRT_TempTable: {
- sqliteVdbeAddOp(v, OP_MakeRecord, nColumn, 0);
- if( pOrderBy ){
- pushOntoSorter(pParse, v, pOrderBy);
- }else{
- sqliteVdbeAddOp(v, OP_NewRecno, iParm, 0);
- sqliteVdbeAddOp(v, OP_Pull, 1, 0);
- sqliteVdbeAddOp(v, OP_PutIntKey, iParm, 0);
- }
- break;
- }
-
- /* Construct a record from the query result, but instead of
- ** saving that record, use it as a key to delete elements from
- ** the temporary table iParm.
- */
- case SRT_Except: {
- int addr;
- addr = sqliteVdbeAddOp(v, OP_MakeRecord, nColumn, NULL_ALWAYS_DISTINCT);
- sqliteVdbeAddOp(v, OP_NotFound, iParm, addr+3);
- sqliteVdbeAddOp(v, OP_Delete, iParm, 0);
- break;
- }
-
- /* If we are creating a set for an "expr IN (SELECT ...)" construct,
- ** then there should be a single item on the stack. Write this
- ** item into the set table with bogus data.
- */
- case SRT_Set: {
- int addr1 = sqliteVdbeCurrentAddr(v);
- int addr2;
- assert( nColumn==1 );
- sqliteVdbeAddOp(v, OP_NotNull, -1, addr1+3);
- sqliteVdbeAddOp(v, OP_Pop, 1, 0);
- addr2 = sqliteVdbeAddOp(v, OP_Goto, 0, 0);
- if( pOrderBy ){
- pushOntoSorter(pParse, v, pOrderBy);
- }else{
- sqliteVdbeAddOp(v, OP_String, 0, 0);
- sqliteVdbeAddOp(v, OP_PutStrKey, iParm, 0);
- }
- sqliteVdbeChangeP2(v, addr2, sqliteVdbeCurrentAddr(v));
- break;
- }
-
- /* If this is a scalar select that is part of an expression, then
- ** store the results in the appropriate memory cell and break out
- ** of the scan loop.
- */
- case SRT_Mem: {
- assert( nColumn==1 );
- if( pOrderBy ){
- pushOntoSorter(pParse, v, pOrderBy);
- }else{
- sqliteVdbeAddOp(v, OP_MemStore, iParm, 1);
- sqliteVdbeAddOp(v, OP_Goto, 0, iBreak);
- }
- break;
- }
-
- /* Send the data to the callback function.
- */
- case SRT_Callback:
- case SRT_Sorter: {
- if( pOrderBy ){
- sqliteVdbeAddOp(v, OP_SortMakeRec, nColumn, 0);
- pushOntoSorter(pParse, v, pOrderBy);
- }else{
- assert( eDest==SRT_Callback );
- sqliteVdbeAddOp(v, OP_Callback, nColumn, 0);
- }
- break;
- }
-
- /* Invoke a subroutine to handle the results. The subroutine itself
- ** is responsible for popping the results off of the stack.
- */
- case SRT_Subroutine: {
- if( pOrderBy ){
- sqliteVdbeAddOp(v, OP_MakeRecord, nColumn, 0);
- pushOntoSorter(pParse, v, pOrderBy);
- }else{
- sqliteVdbeAddOp(v, OP_Gosub, 0, iParm);
- }
- break;
- }
-
- /* Discard the results. This is used for SELECT statements inside
- ** the body of a TRIGGER. The purpose of such selects is to call
- ** user-defined functions that have side effects. We do not care
- ** about the actual results of the select.
- */
- default: {
- assert( eDest==SRT_Discard );
- sqliteVdbeAddOp(v, OP_Pop, nColumn, 0);
- break;
- }
- }
- return 0;
-}
-
-/*
-** If the inner loop was generated using a non-null pOrderBy argument,
-** then the results were placed in a sorter. After the loop is terminated
-** we need to run the sorter and output the results. The following
-** routine generates the code needed to do that.
-*/
-static void generateSortTail(
- Select *p, /* The SELECT statement */
- Vdbe *v, /* Generate code into this VDBE */
- int nColumn, /* Number of columns of data */
- int eDest, /* Write the sorted results here */
- int iParm /* Optional parameter associated with eDest */
-){
- int end1 = sqliteVdbeMakeLabel(v);
- int end2 = sqliteVdbeMakeLabel(v);
- int addr;
- if( eDest==SRT_Sorter ) return;
- sqliteVdbeAddOp(v, OP_Sort, 0, 0);
- addr = sqliteVdbeAddOp(v, OP_SortNext, 0, end1);
- codeLimiter(v, p, addr, end2, 1);
- switch( eDest ){
- case SRT_Callback: {
- sqliteVdbeAddOp(v, OP_SortCallback, nColumn, 0);
- break;
- }
- case SRT_Table:
- case SRT_TempTable: {
- sqliteVdbeAddOp(v, OP_NewRecno, iParm, 0);
- sqliteVdbeAddOp(v, OP_Pull, 1, 0);
- sqliteVdbeAddOp(v, OP_PutIntKey, iParm, 0);
- break;
- }
- case SRT_Set: {
- assert( nColumn==1 );
- sqliteVdbeAddOp(v, OP_NotNull, -1, sqliteVdbeCurrentAddr(v)+3);
- sqliteVdbeAddOp(v, OP_Pop, 1, 0);
- sqliteVdbeAddOp(v, OP_Goto, 0, sqliteVdbeCurrentAddr(v)+3);
- sqliteVdbeAddOp(v, OP_String, 0, 0);
- sqliteVdbeAddOp(v, OP_PutStrKey, iParm, 0);
- break;
- }
- case SRT_Mem: {
- assert( nColumn==1 );
- sqliteVdbeAddOp(v, OP_MemStore, iParm, 1);
- sqliteVdbeAddOp(v, OP_Goto, 0, end1);
- break;
- }
- case SRT_Subroutine: {
- int i;
- for(i=0; i<nColumn; i++){
- sqliteVdbeAddOp(v, OP_Column, -1-i, i);
- }
- sqliteVdbeAddOp(v, OP_Gosub, 0, iParm);
- sqliteVdbeAddOp(v, OP_Pop, 1, 0);
- break;
- }
- default: {
- /* Do nothing */
- break;
- }
- }
- sqliteVdbeAddOp(v, OP_Goto, 0, addr);
- sqliteVdbeResolveLabel(v, end2);
- sqliteVdbeAddOp(v, OP_Pop, 1, 0);
- sqliteVdbeResolveLabel(v, end1);
- sqliteVdbeAddOp(v, OP_SortReset, 0, 0);
-}
-
-/*
-** Generate code that will tell the VDBE the datatypes of
-** columns in the result set.
-**
-** This routine only generates code if the "PRAGMA show_datatypes=on"
-** has been executed. The datatypes are reported out in the azCol
-** parameter to the callback function. The first N azCol[] entries
-** are the names of the columns, and the second N entries are the
-** datatypes for the columns.
-**
-** The "datatype" for a result that is a column of a type is the
-** datatype definition extracted from the CREATE TABLE statement.
-** The datatype for an expression is either TEXT or NUMERIC. The
-** datatype for a ROWID field is INTEGER.
-*/
-static void generateColumnTypes(
- Parse *pParse, /* Parser context */
- SrcList *pTabList, /* List of tables */
- ExprList *pEList /* Expressions defining the result set */
-){
- Vdbe *v = pParse->pVdbe;
- int i, j;
- for(i=0; i<pEList->nExpr; i++){
- Expr *p = pEList->a[i].pExpr;
- char *zType = 0;
- if( p==0 ) continue;
- if( p->op==TK_COLUMN && pTabList ){
- Table *pTab;
- int iCol = p->iColumn;
- for(j=0; j<pTabList->nSrc && pTabList->a[j].iCursor!=p->iTable; j++){}
- assert( j<pTabList->nSrc );
- pTab = pTabList->a[j].pTab;
- if( iCol<0 ) iCol = pTab->iPKey;
- assert( iCol==-1 || (iCol>=0 && iCol<pTab->nCol) );
- if( iCol<0 ){
- zType = "INTEGER";
- }else{
- zType = pTab->aCol[iCol].zType;
- }
- }else{
- if( sqliteExprType(p)==SQLITE_SO_TEXT ){
- zType = "TEXT";
- }else{
- zType = "NUMERIC";
- }
- }
- sqliteVdbeOp3(v, OP_ColumnName, i + pEList->nExpr, 0, zType, 0);
- }
-}
-
-/*
-** Generate code that will tell the VDBE the names of columns
-** in the result set. This information is used to provide the
-** azCol[] values in the callback.
-*/
-static void generateColumnNames(
- Parse *pParse, /* Parser context */
- SrcList *pTabList, /* List of tables */
- ExprList *pEList /* Expressions defining the result set */
-){
- Vdbe *v = pParse->pVdbe;
- int i, j;
- sqlite *db = pParse->db;
- int fullNames, shortNames;
-
- assert( v!=0 );
- if( pParse->colNamesSet || v==0 || sqlite_malloc_failed ) return;
- pParse->colNamesSet = 1;
- fullNames = (db->flags & SQLITE_FullColNames)!=0;
- shortNames = (db->flags & SQLITE_ShortColNames)!=0;
- for(i=0; i<pEList->nExpr; i++){
- Expr *p;
- int p2 = i==pEList->nExpr-1;
- p = pEList->a[i].pExpr;
- if( p==0 ) continue;
- if( pEList->a[i].zName ){
- char *zName = pEList->a[i].zName;
- sqliteVdbeOp3(v, OP_ColumnName, i, p2, zName, 0);
- continue;
- }
- if( p->op==TK_COLUMN && pTabList ){
- Table *pTab;
- char *zCol;
- int iCol = p->iColumn;
- for(j=0; j<pTabList->nSrc && pTabList->a[j].iCursor!=p->iTable; j++){}
- assert( j<pTabList->nSrc );
- pTab = pTabList->a[j].pTab;
- if( iCol<0 ) iCol = pTab->iPKey;
- assert( iCol==-1 || (iCol>=0 && iCol<pTab->nCol) );
- if( iCol<0 ){
- zCol = "_ROWID_";
- }else{
- zCol = pTab->aCol[iCol].zName;
- }
- if( !shortNames && !fullNames && p->span.z && p->span.z[0] ){
- int addr = sqliteVdbeOp3(v,OP_ColumnName, i, p2, p->span.z, p->span.n);
- sqliteVdbeCompressSpace(v, addr);
- }else if( fullNames || (!shortNames && pTabList->nSrc>1) ){
- char *zName = 0;
- char *zTab;
-
- zTab = pTabList->a[j].zAlias;
- if( fullNames || zTab==0 ) zTab = pTab->zName;
- sqliteSetString(&zName, zTab, ".", zCol, 0);
- sqliteVdbeOp3(v, OP_ColumnName, i, p2, zName, P3_DYNAMIC);
- }else{
- sqliteVdbeOp3(v, OP_ColumnName, i, p2, zCol, 0);
- }
- }else if( p->span.z && p->span.z[0] ){
- int addr = sqliteVdbeOp3(v,OP_ColumnName, i, p2, p->span.z, p->span.n);
- sqliteVdbeCompressSpace(v, addr);
- }else{
- char zName[30];
- assert( p->op!=TK_COLUMN || pTabList==0 );
- sprintf(zName, "column%d", i+1);
- sqliteVdbeOp3(v, OP_ColumnName, i, p2, zName, 0);
- }
- }
-}
-
-/*
-** Name of the connection operator, used for error messages.
-*/
-static const char *selectOpName(int id){
- char *z;
- switch( id ){
- case TK_ALL: z = "UNION ALL"; break;
- case TK_INTERSECT: z = "INTERSECT"; break;
- case TK_EXCEPT: z = "EXCEPT"; break;
- default: z = "UNION"; break;
- }
- return z;
-}
-
-/*
-** Forward declaration
-*/
-static int fillInColumnList(Parse*, Select*);
-
-/*
-** Given a SELECT statement, generate a Table structure that describes
-** the result set of that SELECT.
-*/
-Table *sqliteResultSetOfSelect(Parse *pParse, char *zTabName, Select *pSelect){
- Table *pTab;
- int i, j;
- ExprList *pEList;
- Column *aCol;
-
- if( fillInColumnList(pParse, pSelect) ){
- return 0;
- }
- pTab = sqliteMalloc( sizeof(Table) );
- if( pTab==0 ){
- return 0;
- }
- pTab->zName = zTabName ? sqliteStrDup(zTabName) : 0;
- pEList = pSelect->pEList;
- pTab->nCol = pEList->nExpr;
- assert( pTab->nCol>0 );
- pTab->aCol = aCol = sqliteMalloc( sizeof(pTab->aCol[0])*pTab->nCol );
- for(i=0; i<pTab->nCol; i++){
- Expr *p, *pR;
- if( pEList->a[i].zName ){
- aCol[i].zName = sqliteStrDup(pEList->a[i].zName);
- }else if( (p=pEList->a[i].pExpr)->op==TK_DOT
- && (pR=p->pRight)!=0 && pR->token.z && pR->token.z[0] ){
- int cnt;
- sqliteSetNString(&aCol[i].zName, pR->token.z, pR->token.n, 0);
- for(j=cnt=0; j<i; j++){
- if( sqliteStrICmp(aCol[j].zName, aCol[i].zName)==0 ){
- int n;
- char zBuf[30];
- sprintf(zBuf,"_%d",++cnt);
- n = strlen(zBuf);
- sqliteSetNString(&aCol[i].zName, pR->token.z, pR->token.n, zBuf, n,0);
- j = -1;
- }
- }
- }else if( p->span.z && p->span.z[0] ){
- sqliteSetNString(&pTab->aCol[i].zName, p->span.z, p->span.n, 0);
- }else{
- char zBuf[30];
- sprintf(zBuf, "column%d", i+1);
- aCol[i].zName = sqliteStrDup(zBuf);
- }
- sqliteDequote(aCol[i].zName);
- }
- pTab->iPKey = -1;
- return pTab;
-}
-
-/*
-** For the given SELECT statement, do three things.
-**
-** (1) Fill in the pTabList->a[].pTab fields in the SrcList that
-** defines the set of tables that should be scanned. For views,
-** fill pTabList->a[].pSelect with a copy of the SELECT statement
-** that implements the view. A copy is made of the view's SELECT
-** statement so that we can freely modify or delete that statement
-** without worrying about messing up the presistent representation
-** of the view.
-**
-** (2) Add terms to the WHERE clause to accomodate the NATURAL keyword
-** on joins and the ON and USING clause of joins.
-**
-** (3) Scan the list of columns in the result set (pEList) looking
-** for instances of the "*" operator or the TABLE.* operator.
-** If found, expand each "*" to be every column in every table
-** and TABLE.* to be every column in TABLE.
-**
-** Return 0 on success. If there are problems, leave an error message
-** in pParse and return non-zero.
-*/
-static int fillInColumnList(Parse *pParse, Select *p){
- int i, j, k, rc;
- SrcList *pTabList;
- ExprList *pEList;
- Table *pTab;
-
- if( p==0 || p->pSrc==0 ) return 1;
- pTabList = p->pSrc;
- pEList = p->pEList;
-
- /* Look up every table in the table list.
- */
- for(i=0; i<pTabList->nSrc; i++){
- if( pTabList->a[i].pTab ){
- /* This routine has run before! No need to continue */
- return 0;
- }
- if( pTabList->a[i].zName==0 ){
- /* A sub-query in the FROM clause of a SELECT */
- assert( pTabList->a[i].pSelect!=0 );
- if( pTabList->a[i].zAlias==0 ){
- char zFakeName[60];
- sprintf(zFakeName, "sqlite_subquery_%p_",
- (void*)pTabList->a[i].pSelect);
- sqliteSetString(&pTabList->a[i].zAlias, zFakeName, 0);
- }
- pTabList->a[i].pTab = pTab =
- sqliteResultSetOfSelect(pParse, pTabList->a[i].zAlias,
- pTabList->a[i].pSelect);
- if( pTab==0 ){
- return 1;
- }
- /* The isTransient flag indicates that the Table structure has been
- ** dynamically allocated and may be freed at any time. In other words,
- ** pTab is not pointing to a persistent table structure that defines
- ** part of the schema. */
- pTab->isTransient = 1;
- }else{
- /* An ordinary table or view name in the FROM clause */
- pTabList->a[i].pTab = pTab =
- sqliteLocateTable(pParse,pTabList->a[i].zName,pTabList->a[i].zDatabase);
- if( pTab==0 ){
- return 1;
- }
- if( pTab->pSelect ){
- /* We reach here if the named table is a really a view */
- if( sqliteViewGetColumnNames(pParse, pTab) ){
- return 1;
- }
- /* If pTabList->a[i].pSelect!=0 it means we are dealing with a
- ** view within a view. The SELECT structure has already been
- ** copied by the outer view so we can skip the copy step here
- ** in the inner view.
- */
- if( pTabList->a[i].pSelect==0 ){
- pTabList->a[i].pSelect = sqliteSelectDup(pTab->pSelect);
- }
- }
- }
- }
-
- /* Process NATURAL keywords, and ON and USING clauses of joins.
- */
- if( sqliteProcessJoin(pParse, p) ) return 1;
-
- /* For every "*" that occurs in the column list, insert the names of
- ** all columns in all tables. And for every TABLE.* insert the names
- ** of all columns in TABLE. The parser inserted a special expression
- ** with the TK_ALL operator for each "*" that it found in the column list.
- ** The following code just has to locate the TK_ALL expressions and expand
- ** each one to the list of all columns in all tables.
- **
- ** The first loop just checks to see if there are any "*" operators
- ** that need expanding.
- */
- for(k=0; k<pEList->nExpr; k++){
- Expr *pE = pEList->a[k].pExpr;
- if( pE->op==TK_ALL ) break;
- if( pE->op==TK_DOT && pE->pRight && pE->pRight->op==TK_ALL
- && pE->pLeft && pE->pLeft->op==TK_ID ) break;
- }
- rc = 0;
- if( k<pEList->nExpr ){
- /*
- ** If we get here it means the result set contains one or more "*"
- ** operators that need to be expanded. Loop through each expression
- ** in the result set and expand them one by one.
- */
- struct ExprList_item *a = pEList->a;
- ExprList *pNew = 0;
- for(k=0; k<pEList->nExpr; k++){
- Expr *pE = a[k].pExpr;
- if( pE->op!=TK_ALL &&
- (pE->op!=TK_DOT || pE->pRight==0 || pE->pRight->op!=TK_ALL) ){
- /* This particular expression does not need to be expanded.
- */
- pNew = sqliteExprListAppend(pNew, a[k].pExpr, 0);
- pNew->a[pNew->nExpr-1].zName = a[k].zName;
- a[k].pExpr = 0;
- a[k].zName = 0;
- }else{
- /* This expression is a "*" or a "TABLE.*" and needs to be
- ** expanded. */
- int tableSeen = 0; /* Set to 1 when TABLE matches */
- char *zTName; /* text of name of TABLE */
- if( pE->op==TK_DOT && pE->pLeft ){
- zTName = sqliteTableNameFromToken(&pE->pLeft->token);
- }else{
- zTName = 0;
- }
- for(i=0; i<pTabList->nSrc; i++){
- Table *pTab = pTabList->a[i].pTab;
- char *zTabName = pTabList->a[i].zAlias;
- if( zTabName==0 || zTabName[0]==0 ){
- zTabName = pTab->zName;
- }
- if( zTName && (zTabName==0 || zTabName[0]==0 ||
- sqliteStrICmp(zTName, zTabName)!=0) ){
- continue;
- }
- tableSeen = 1;
- for(j=0; j<pTab->nCol; j++){
- Expr *pExpr, *pLeft, *pRight;
- char *zName = pTab->aCol[j].zName;
-
- if( i>0 && (pTabList->a[i-1].jointype & JT_NATURAL)!=0 &&
- columnIndex(pTabList->a[i-1].pTab, zName)>=0 ){
- /* In a NATURAL join, omit the join columns from the
- ** table on the right */
- continue;
- }
- if( i>0 && sqliteIdListIndex(pTabList->a[i-1].pUsing, zName)>=0 ){
- /* In a join with a USING clause, omit columns in the
- ** using clause from the table on the right. */
- continue;
- }
- pRight = sqliteExpr(TK_ID, 0, 0, 0);
- if( pRight==0 ) break;
- pRight->token.z = zName;
- pRight->token.n = strlen(zName);
- pRight->token.dyn = 0;
- if( zTabName && pTabList->nSrc>1 ){
- pLeft = sqliteExpr(TK_ID, 0, 0, 0);
- pExpr = sqliteExpr(TK_DOT, pLeft, pRight, 0);
- if( pExpr==0 ) break;
- pLeft->token.z = zTabName;
- pLeft->token.n = strlen(zTabName);
- pLeft->token.dyn = 0;
- sqliteSetString((char**)&pExpr->span.z, zTabName, ".", zName, 0);
- pExpr->span.n = strlen(pExpr->span.z);
- pExpr->span.dyn = 1;
- pExpr->token.z = 0;
- pExpr->token.n = 0;
- pExpr->token.dyn = 0;
- }else{
- pExpr = pRight;
- pExpr->span = pExpr->token;
- }
- pNew = sqliteExprListAppend(pNew, pExpr, 0);
- }
- }
- if( !tableSeen ){
- if( zTName ){
- sqliteErrorMsg(pParse, "no such table: %s", zTName);
- }else{
- sqliteErrorMsg(pParse, "no tables specified");
- }
- rc = 1;
- }
- sqliteFree(zTName);
- }
- }
- sqliteExprListDelete(pEList);
- p->pEList = pNew;
- }
- return rc;
-}
-
-/*
-** This routine recursively unlinks the Select.pSrc.a[].pTab pointers
-** in a select structure. It just sets the pointers to NULL. This
-** routine is recursive in the sense that if the Select.pSrc.a[].pSelect
-** pointer is not NULL, this routine is called recursively on that pointer.
-**
-** This routine is called on the Select structure that defines a
-** VIEW in order to undo any bindings to tables. This is necessary
-** because those tables might be DROPed by a subsequent SQL command.
-** If the bindings are not removed, then the Select.pSrc->a[].pTab field
-** will be left pointing to a deallocated Table structure after the
-** DROP and a coredump will occur the next time the VIEW is used.
-*/
-void sqliteSelectUnbind(Select *p){
- int i;
- SrcList *pSrc = p->pSrc;
- Table *pTab;
- if( p==0 ) return;
- for(i=0; i<pSrc->nSrc; i++){
- if( (pTab = pSrc->a[i].pTab)!=0 ){
- if( pTab->isTransient ){
- sqliteDeleteTable(0, pTab);
- }
- pSrc->a[i].pTab = 0;
- if( pSrc->a[i].pSelect ){
- sqliteSelectUnbind(pSrc->a[i].pSelect);
- }
- }
- }
-}
-
-/*
-** This routine associates entries in an ORDER BY expression list with
-** columns in a result. For each ORDER BY expression, the opcode of
-** the top-level node is changed to TK_COLUMN and the iColumn value of
-** the top-level node is filled in with column number and the iTable
-** value of the top-level node is filled with iTable parameter.
-**
-** If there are prior SELECT clauses, they are processed first. A match
-** in an earlier SELECT takes precedence over a later SELECT.
-**
-** Any entry that does not match is flagged as an error. The number
-** of errors is returned.
-**
-** This routine does NOT correctly initialize the Expr.dataType field
-** of the ORDER BY expressions. The multiSelectSortOrder() routine
-** must be called to do that after the individual select statements
-** have all been analyzed. This routine is unable to compute Expr.dataType
-** because it must be called before the individual select statements
-** have been analyzed.
-*/
-static int matchOrderbyToColumn(
- Parse *pParse, /* A place to leave error messages */
- Select *pSelect, /* Match to result columns of this SELECT */
- ExprList *pOrderBy, /* The ORDER BY values to match against columns */
- int iTable, /* Insert this value in iTable */
- int mustComplete /* If TRUE all ORDER BYs must match */
-){
- int nErr = 0;
- int i, j;
- ExprList *pEList;
-
- if( pSelect==0 || pOrderBy==0 ) return 1;
- if( mustComplete ){
- for(i=0; i<pOrderBy->nExpr; i++){ pOrderBy->a[i].done = 0; }
- }
- if( fillInColumnList(pParse, pSelect) ){
- return 1;
- }
- if( pSelect->pPrior ){
- if( matchOrderbyToColumn(pParse, pSelect->pPrior, pOrderBy, iTable, 0) ){
- return 1;
- }
- }
- pEList = pSelect->pEList;
- for(i=0; i<pOrderBy->nExpr; i++){
- Expr *pE = pOrderBy->a[i].pExpr;
- int iCol = -1;
- if( pOrderBy->a[i].done ) continue;
- if( sqliteExprIsInteger(pE, &iCol) ){
- if( iCol<=0 || iCol>pEList->nExpr ){
- sqliteErrorMsg(pParse,
- "ORDER BY position %d should be between 1 and %d",
- iCol, pEList->nExpr);
- nErr++;
- break;
- }
- if( !mustComplete ) continue;
- iCol--;
- }
- for(j=0; iCol<0 && j<pEList->nExpr; j++){
- if( pEList->a[j].zName && (pE->op==TK_ID || pE->op==TK_STRING) ){
- char *zName, *zLabel;
- zName = pEList->a[j].zName;
- assert( pE->token.z );
- zLabel = sqliteStrNDup(pE->token.z, pE->token.n);
- sqliteDequote(zLabel);
- if( sqliteStrICmp(zName, zLabel)==0 ){
- iCol = j;
- }
- sqliteFree(zLabel);
- }
- if( iCol<0 && sqliteExprCompare(pE, pEList->a[j].pExpr) ){
- iCol = j;
- }
- }
- if( iCol>=0 ){
- pE->op = TK_COLUMN;
- pE->iColumn = iCol;
- pE->iTable = iTable;
- pOrderBy->a[i].done = 1;
- }
- if( iCol<0 && mustComplete ){
- sqliteErrorMsg(pParse,
- "ORDER BY term number %d does not match any result column", i+1);
- nErr++;
- break;
- }
- }
- return nErr;
-}
-
-/*
-** Get a VDBE for the given parser context. Create a new one if necessary.
-** If an error occurs, return NULL and leave a message in pParse.
-*/
-Vdbe *sqliteGetVdbe(Parse *pParse){
- Vdbe *v = pParse->pVdbe;
- if( v==0 ){
- v = pParse->pVdbe = sqliteVdbeCreate(pParse->db);
- }
- return v;
-}
-
-/*
-** This routine sets the Expr.dataType field on all elements of
-** the pOrderBy expression list. The pOrderBy list will have been
-** set up by matchOrderbyToColumn(). Hence each expression has
-** a TK_COLUMN as its root node. The Expr.iColumn refers to a
-** column in the result set. The datatype is set to SQLITE_SO_TEXT
-** if the corresponding column in p and every SELECT to the left of
-** p has a datatype of SQLITE_SO_TEXT. If the cooressponding column
-** in p or any of the left SELECTs is SQLITE_SO_NUM, then the datatype
-** of the order-by expression is set to SQLITE_SO_NUM.
-**
-** Examples:
-**
-** CREATE TABLE one(a INTEGER, b TEXT);
-** CREATE TABLE two(c VARCHAR(5), d FLOAT);
-**
-** SELECT b, b FROM one UNION SELECT d, c FROM two ORDER BY 1, 2;
-**
-** The primary sort key will use SQLITE_SO_NUM because the "d" in
-** the second SELECT is numeric. The 1st column of the first SELECT
-** is text but that does not matter because a numeric always overrides
-** a text.
-**
-** The secondary key will use the SQLITE_SO_TEXT sort order because
-** both the (second) "b" in the first SELECT and the "c" in the second
-** SELECT have a datatype of text.
-*/
-static void multiSelectSortOrder(Select *p, ExprList *pOrderBy){
- int i;
- ExprList *pEList;
- if( pOrderBy==0 ) return;
- if( p==0 ){
- for(i=0; i<pOrderBy->nExpr; i++){
- pOrderBy->a[i].pExpr->dataType = SQLITE_SO_TEXT;
- }
- return;
- }
- multiSelectSortOrder(p->pPrior, pOrderBy);
- pEList = p->pEList;
- for(i=0; i<pOrderBy->nExpr; i++){
- Expr *pE = pOrderBy->a[i].pExpr;
- if( pE->dataType==SQLITE_SO_NUM ) continue;
- assert( pE->iColumn>=0 );
- if( pEList->nExpr>pE->iColumn ){
- pE->dataType = sqliteExprType(pEList->a[pE->iColumn].pExpr);
- }
- }
-}
-
-/*
-** Compute the iLimit and iOffset fields of the SELECT based on the
-** nLimit and nOffset fields. nLimit and nOffset hold the integers
-** that appear in the original SQL statement after the LIMIT and OFFSET
-** keywords. Or that hold -1 and 0 if those keywords are omitted.
-** iLimit and iOffset are the integer memory register numbers for
-** counters used to compute the limit and offset. If there is no
-** limit and/or offset, then iLimit and iOffset are negative.
-**
-** This routine changes the values if iLimit and iOffset only if
-** a limit or offset is defined by nLimit and nOffset. iLimit and
-** iOffset should have been preset to appropriate default values
-** (usually but not always -1) prior to calling this routine.
-** Only if nLimit>=0 or nOffset>0 do the limit registers get
-** redefined. The UNION ALL operator uses this property to force
-** the reuse of the same limit and offset registers across multiple
-** SELECT statements.
-*/
-static void computeLimitRegisters(Parse *pParse, Select *p){
- /*
- ** If the comparison is p->nLimit>0 then "LIMIT 0" shows
- ** all rows. It is the same as no limit. If the comparision is
- ** p->nLimit>=0 then "LIMIT 0" show no rows at all.
- ** "LIMIT -1" always shows all rows. There is some
- ** contraversy about what the correct behavior should be.
- ** The current implementation interprets "LIMIT 0" to mean
- ** no rows.
- */
- if( p->nLimit>=0 ){
- int iMem = pParse->nMem++;
- Vdbe *v = sqliteGetVdbe(pParse);
- if( v==0 ) return;
- sqliteVdbeAddOp(v, OP_Integer, -p->nLimit, 0);
- sqliteVdbeAddOp(v, OP_MemStore, iMem, 1);
- p->iLimit = iMem;
- }
- if( p->nOffset>0 ){
- int iMem = pParse->nMem++;
- Vdbe *v = sqliteGetVdbe(pParse);
- if( v==0 ) return;
- sqliteVdbeAddOp(v, OP_Integer, -p->nOffset, 0);
- sqliteVdbeAddOp(v, OP_MemStore, iMem, 1);
- p->iOffset = iMem;
- }
-}
-
-/*
-** This routine is called to process a query that is really the union
-** or intersection of two or more separate queries.
-**
-** "p" points to the right-most of the two queries. the query on the
-** left is p->pPrior. The left query could also be a compound query
-** in which case this routine will be called recursively.
-**
-** The results of the total query are to be written into a destination
-** of type eDest with parameter iParm.
-**
-** Example 1: Consider a three-way compound SQL statement.
-**
-** SELECT a FROM t1 UNION SELECT b FROM t2 UNION SELECT c FROM t3
-**
-** This statement is parsed up as follows:
-**
-** SELECT c FROM t3
-** |
-** `-----> SELECT b FROM t2
-** |
-** `------> SELECT a FROM t1
-**
-** The arrows in the diagram above represent the Select.pPrior pointer.
-** So if this routine is called with p equal to the t3 query, then
-** pPrior will be the t2 query. p->op will be TK_UNION in this case.
-**
-** Notice that because of the way SQLite parses compound SELECTs, the
-** individual selects always group from left to right.
-*/
-static int multiSelect(Parse *pParse, Select *p, int eDest, int iParm){
- int rc; /* Success code from a subroutine */
- Select *pPrior; /* Another SELECT immediately to our left */
- Vdbe *v; /* Generate code to this VDBE */
-
- /* Make sure there is no ORDER BY or LIMIT clause on prior SELECTs. Only
- ** the last SELECT in the series may have an ORDER BY or LIMIT.
- */
- if( p==0 || p->pPrior==0 ) return 1;
- pPrior = p->pPrior;
- if( pPrior->pOrderBy ){
- sqliteErrorMsg(pParse,"ORDER BY clause should come after %s not before",
- selectOpName(p->op));
- return 1;
- }
- if( pPrior->nLimit>=0 || pPrior->nOffset>0 ){
- sqliteErrorMsg(pParse,"LIMIT clause should come after %s not before",
- selectOpName(p->op));
- return 1;
- }
-
- /* Make sure we have a valid query engine. If not, create a new one.
- */
- v = sqliteGetVdbe(pParse);
- if( v==0 ) return 1;
-
- /* Create the destination temporary table if necessary
- */
- if( eDest==SRT_TempTable ){
- sqliteVdbeAddOp(v, OP_OpenTemp, iParm, 0);
- eDest = SRT_Table;
- }
-
- /* Generate code for the left and right SELECT statements.
- */
- switch( p->op ){
- case TK_ALL: {
- if( p->pOrderBy==0 ){
- pPrior->nLimit = p->nLimit;
- pPrior->nOffset = p->nOffset;
- rc = sqliteSelect(pParse, pPrior, eDest, iParm, 0, 0, 0);
- if( rc ) return rc;
- p->pPrior = 0;
- p->iLimit = pPrior->iLimit;
- p->iOffset = pPrior->iOffset;
- p->nLimit = -1;
- p->nOffset = 0;
- rc = sqliteSelect(pParse, p, eDest, iParm, 0, 0, 0);
- p->pPrior = pPrior;
- if( rc ) return rc;
- break;
- }
- /* For UNION ALL ... ORDER BY fall through to the next case */
- }
- case TK_EXCEPT:
- case TK_UNION: {
- int unionTab; /* Cursor number of the temporary table holding result */
- int op; /* One of the SRT_ operations to apply to self */
- int priorOp; /* The SRT_ operation to apply to prior selects */
- int nLimit, nOffset; /* Saved values of p->nLimit and p->nOffset */
- ExprList *pOrderBy; /* The ORDER BY clause for the right SELECT */
-
- priorOp = p->op==TK_ALL ? SRT_Table : SRT_Union;
- if( eDest==priorOp && p->pOrderBy==0 && p->nLimit<0 && p->nOffset==0 ){
- /* We can reuse a temporary table generated by a SELECT to our
- ** right.
- */
- unionTab = iParm;
- }else{
- /* We will need to create our own temporary table to hold the
- ** intermediate results.
- */
- unionTab = pParse->nTab++;
- if( p->pOrderBy
- && matchOrderbyToColumn(pParse, p, p->pOrderBy, unionTab, 1) ){
- return 1;
- }
- if( p->op!=TK_ALL ){
- sqliteVdbeAddOp(v, OP_OpenTemp, unionTab, 1);
- sqliteVdbeAddOp(v, OP_KeyAsData, unionTab, 1);
- }else{
- sqliteVdbeAddOp(v, OP_OpenTemp, unionTab, 0);
- }
- }
-
- /* Code the SELECT statements to our left
- */
- rc = sqliteSelect(pParse, pPrior, priorOp, unionTab, 0, 0, 0);
- if( rc ) return rc;
-
- /* Code the current SELECT statement
- */
- switch( p->op ){
- case TK_EXCEPT: op = SRT_Except; break;
- case TK_UNION: op = SRT_Union; break;
- case TK_ALL: op = SRT_Table; break;
- }
- p->pPrior = 0;
- pOrderBy = p->pOrderBy;
- p->pOrderBy = 0;
- nLimit = p->nLimit;
- p->nLimit = -1;
- nOffset = p->nOffset;
- p->nOffset = 0;
- rc = sqliteSelect(pParse, p, op, unionTab, 0, 0, 0);
- p->pPrior = pPrior;
- p->pOrderBy = pOrderBy;
- p->nLimit = nLimit;
- p->nOffset = nOffset;
- if( rc ) return rc;
-
- /* Convert the data in the temporary table into whatever form
- ** it is that we currently need.
- */
- if( eDest!=priorOp || unionTab!=iParm ){
- int iCont, iBreak, iStart;
- assert( p->pEList );
- if( eDest==SRT_Callback ){
- generateColumnNames(pParse, 0, p->pEList);
- generateColumnTypes(pParse, p->pSrc, p->pEList);
- }
- iBreak = sqliteVdbeMakeLabel(v);
- iCont = sqliteVdbeMakeLabel(v);
- sqliteVdbeAddOp(v, OP_Rewind, unionTab, iBreak);
- computeLimitRegisters(pParse, p);
- iStart = sqliteVdbeCurrentAddr(v);
- multiSelectSortOrder(p, p->pOrderBy);
- rc = selectInnerLoop(pParse, p, p->pEList, unionTab, p->pEList->nExpr,
- p->pOrderBy, -1, eDest, iParm,
- iCont, iBreak);
- if( rc ) return 1;
- sqliteVdbeResolveLabel(v, iCont);
- sqliteVdbeAddOp(v, OP_Next, unionTab, iStart);
- sqliteVdbeResolveLabel(v, iBreak);
- sqliteVdbeAddOp(v, OP_Close, unionTab, 0);
- if( p->pOrderBy ){
- generateSortTail(p, v, p->pEList->nExpr, eDest, iParm);
- }
- }
- break;
- }
- case TK_INTERSECT: {
- int tab1, tab2;
- int iCont, iBreak, iStart;
- int nLimit, nOffset;
-
- /* INTERSECT is different from the others since it requires
- ** two temporary tables. Hence it has its own case. Begin
- ** by allocating the tables we will need.
- */
- tab1 = pParse->nTab++;
- tab2 = pParse->nTab++;
- if( p->pOrderBy && matchOrderbyToColumn(pParse,p,p->pOrderBy,tab1,1) ){
- return 1;
- }
- sqliteVdbeAddOp(v, OP_OpenTemp, tab1, 1);
- sqliteVdbeAddOp(v, OP_KeyAsData, tab1, 1);
-
- /* Code the SELECTs to our left into temporary table "tab1".
- */
- rc = sqliteSelect(pParse, pPrior, SRT_Union, tab1, 0, 0, 0);
- if( rc ) return rc;
-
- /* Code the current SELECT into temporary table "tab2"
- */
- sqliteVdbeAddOp(v, OP_OpenTemp, tab2, 1);
- sqliteVdbeAddOp(v, OP_KeyAsData, tab2, 1);
- p->pPrior = 0;
- nLimit = p->nLimit;
- p->nLimit = -1;
- nOffset = p->nOffset;
- p->nOffset = 0;
- rc = sqliteSelect(pParse, p, SRT_Union, tab2, 0, 0, 0);
- p->pPrior = pPrior;
- p->nLimit = nLimit;
- p->nOffset = nOffset;
- if( rc ) return rc;
-
- /* Generate code to take the intersection of the two temporary
- ** tables.
- */
- assert( p->pEList );
- if( eDest==SRT_Callback ){
- generateColumnNames(pParse, 0, p->pEList);
- generateColumnTypes(pParse, p->pSrc, p->pEList);
- }
- iBreak = sqliteVdbeMakeLabel(v);
- iCont = sqliteVdbeMakeLabel(v);
- sqliteVdbeAddOp(v, OP_Rewind, tab1, iBreak);
- computeLimitRegisters(pParse, p);
- iStart = sqliteVdbeAddOp(v, OP_FullKey, tab1, 0);
- sqliteVdbeAddOp(v, OP_NotFound, tab2, iCont);
- multiSelectSortOrder(p, p->pOrderBy);
- rc = selectInnerLoop(pParse, p, p->pEList, tab1, p->pEList->nExpr,
- p->pOrderBy, -1, eDest, iParm,
- iCont, iBreak);
- if( rc ) return 1;
- sqliteVdbeResolveLabel(v, iCont);
- sqliteVdbeAddOp(v, OP_Next, tab1, iStart);
- sqliteVdbeResolveLabel(v, iBreak);
- sqliteVdbeAddOp(v, OP_Close, tab2, 0);
- sqliteVdbeAddOp(v, OP_Close, tab1, 0);
- if( p->pOrderBy ){
- generateSortTail(p, v, p->pEList->nExpr, eDest, iParm);
- }
- break;
- }
- }
- assert( p->pEList && pPrior->pEList );
- if( p->pEList->nExpr!=pPrior->pEList->nExpr ){
- sqliteErrorMsg(pParse, "SELECTs to the left and right of %s"
- " do not have the same number of result columns", selectOpName(p->op));
- return 1;
- }
- return 0;
-}
-
-/*
-** Scan through the expression pExpr. Replace every reference to
-** a column in table number iTable with a copy of the iColumn-th
-** entry in pEList. (But leave references to the ROWID column
-** unchanged.)
-**
-** This routine is part of the flattening procedure. A subquery
-** whose result set is defined by pEList appears as entry in the
-** FROM clause of a SELECT such that the VDBE cursor assigned to that
-** FORM clause entry is iTable. This routine make the necessary
-** changes to pExpr so that it refers directly to the source table
-** of the subquery rather the result set of the subquery.
-*/
-static void substExprList(ExprList*,int,ExprList*); /* Forward Decl */
-static void substExpr(Expr *pExpr, int iTable, ExprList *pEList){
- if( pExpr==0 ) return;
- if( pExpr->op==TK_COLUMN && pExpr->iTable==iTable ){
- if( pExpr->iColumn<0 ){
- pExpr->op = TK_NULL;
- }else{
- Expr *pNew;
- assert( pEList!=0 && pExpr->iColumn<pEList->nExpr );
- assert( pExpr->pLeft==0 && pExpr->pRight==0 && pExpr->pList==0 );
- pNew = pEList->a[pExpr->iColumn].pExpr;
- assert( pNew!=0 );
- pExpr->op = pNew->op;
- pExpr->dataType = pNew->dataType;
- assert( pExpr->pLeft==0 );
- pExpr->pLeft = sqliteExprDup(pNew->pLeft);
- assert( pExpr->pRight==0 );
- pExpr->pRight = sqliteExprDup(pNew->pRight);
- assert( pExpr->pList==0 );
- pExpr->pList = sqliteExprListDup(pNew->pList);
- pExpr->iTable = pNew->iTable;
- pExpr->iColumn = pNew->iColumn;
- pExpr->iAgg = pNew->iAgg;
- sqliteTokenCopy(&pExpr->token, &pNew->token);
- sqliteTokenCopy(&pExpr->span, &pNew->span);
- }
- }else{
- substExpr(pExpr->pLeft, iTable, pEList);
- substExpr(pExpr->pRight, iTable, pEList);
- substExprList(pExpr->pList, iTable, pEList);
- }
-}
-static void
-substExprList(ExprList *pList, int iTable, ExprList *pEList){
- int i;
- if( pList==0 ) return;
- for(i=0; i<pList->nExpr; i++){
- substExpr(pList->a[i].pExpr, iTable, pEList);
- }
-}
-
-/*
-** This routine attempts to flatten subqueries in order to speed
-** execution. It returns 1 if it makes changes and 0 if no flattening
-** occurs.
-**
-** To understand the concept of flattening, consider the following
-** query:
-**
-** SELECT a FROM (SELECT x+y AS a FROM t1 WHERE z<100) WHERE a>5
-**
-** The default way of implementing this query is to execute the
-** subquery first and store the results in a temporary table, then
-** run the outer query on that temporary table. This requires two
-** passes over the data. Furthermore, because the temporary table
-** has no indices, the WHERE clause on the outer query cannot be
-** optimized.
-**
-** This routine attempts to rewrite queries such as the above into
-** a single flat select, like this:
-**
-** SELECT x+y AS a FROM t1 WHERE z<100 AND a>5
-**
-** The code generated for this simpification gives the same result
-** but only has to scan the data once. And because indices might
-** exist on the table t1, a complete scan of the data might be
-** avoided.
-**
-** Flattening is only attempted if all of the following are true:
-**
-** (1) The subquery and the outer query do not both use aggregates.
-**
-** (2) The subquery is not an aggregate or the outer query is not a join.
-**
-** (3) The subquery is not the right operand of a left outer join, or
-** the subquery is not itself a join. (Ticket #306)
-**
-** (4) The subquery is not DISTINCT or the outer query is not a join.
-**
-** (5) The subquery is not DISTINCT or the outer query does not use
-** aggregates.
-**
-** (6) The subquery does not use aggregates or the outer query is not
-** DISTINCT.
-**
-** (7) The subquery has a FROM clause.
-**
-** (8) The subquery does not use LIMIT or the outer query is not a join.
-**
-** (9) The subquery does not use LIMIT or the outer query does not use
-** aggregates.
-**
-** (10) The subquery does not use aggregates or the outer query does not
-** use LIMIT.
-**
-** (11) The subquery and the outer query do not both have ORDER BY clauses.
-**
-** (12) The subquery is not the right term of a LEFT OUTER JOIN or the
-** subquery has no WHERE clause. (added by ticket #350)
-**
-** In this routine, the "p" parameter is a pointer to the outer query.
-** The subquery is p->pSrc->a[iFrom]. isAgg is true if the outer query
-** uses aggregates and subqueryIsAgg is true if the subquery uses aggregates.
-**
-** If flattening is not attempted, this routine is a no-op and returns 0.
-** If flattening is attempted this routine returns 1.
-**
-** All of the expression analysis must occur on both the outer query and
-** the subquery before this routine runs.
-*/
-static int flattenSubquery(
- Parse *pParse, /* The parsing context */
- Select *p, /* The parent or outer SELECT statement */
- int iFrom, /* Index in p->pSrc->a[] of the inner subquery */
- int isAgg, /* True if outer SELECT uses aggregate functions */
- int subqueryIsAgg /* True if the subquery uses aggregate functions */
-){
- Select *pSub; /* The inner query or "subquery" */
- SrcList *pSrc; /* The FROM clause of the outer query */
- SrcList *pSubSrc; /* The FROM clause of the subquery */
- ExprList *pList; /* The result set of the outer query */
- int iParent; /* VDBE cursor number of the pSub result set temp table */
- int i;
- Expr *pWhere;
-
- /* Check to see if flattening is permitted. Return 0 if not.
- */
- if( p==0 ) return 0;
- pSrc = p->pSrc;
- assert( pSrc && iFrom>=0 && iFrom<pSrc->nSrc );
- pSub = pSrc->a[iFrom].pSelect;
- assert( pSub!=0 );
- if( isAgg && subqueryIsAgg ) return 0;
- if( subqueryIsAgg && pSrc->nSrc>1 ) return 0;
- pSubSrc = pSub->pSrc;
- assert( pSubSrc );
- if( pSubSrc->nSrc==0 ) return 0;
- if( (pSub->isDistinct || pSub->nLimit>=0) && (pSrc->nSrc>1 || isAgg) ){
- return 0;
- }
- if( (p->isDistinct || p->nLimit>=0) && subqueryIsAgg ) return 0;
- if( p->pOrderBy && pSub->pOrderBy ) return 0;
-
- /* Restriction 3: If the subquery is a join, make sure the subquery is
- ** not used as the right operand of an outer join. Examples of why this
- ** is not allowed:
- **
- ** t1 LEFT OUTER JOIN (t2 JOIN t3)
- **
- ** If we flatten the above, we would get
- **
- ** (t1 LEFT OUTER JOIN t2) JOIN t3
- **
- ** which is not at all the same thing.
- */
- if( pSubSrc->nSrc>1 && iFrom>0 && (pSrc->a[iFrom-1].jointype & JT_OUTER)!=0 ){
- return 0;
- }
-
- /* Restriction 12: If the subquery is the right operand of a left outer
- ** join, make sure the subquery has no WHERE clause.
- ** An examples of why this is not allowed:
- **
- ** t1 LEFT OUTER JOIN (SELECT * FROM t2 WHERE t2.x>0)
- **
- ** If we flatten the above, we would get
- **
- ** (t1 LEFT OUTER JOIN t2) WHERE t2.x>0
- **
- ** But the t2.x>0 test will always fail on a NULL row of t2, which
- ** effectively converts the OUTER JOIN into an INNER JOIN.
- */
- if( iFrom>0 && (pSrc->a[iFrom-1].jointype & JT_OUTER)!=0
- && pSub->pWhere!=0 ){
- return 0;
- }
-
- /* If we reach this point, it means flattening is permitted for the
- ** iFrom-th entry of the FROM clause in the outer query.
- */
-
- /* Move all of the FROM elements of the subquery into the
- ** the FROM clause of the outer query. Before doing this, remember
- ** the cursor number for the original outer query FROM element in
- ** iParent. The iParent cursor will never be used. Subsequent code
- ** will scan expressions looking for iParent references and replace
- ** those references with expressions that resolve to the subquery FROM
- ** elements we are now copying in.
- */
- iParent = pSrc->a[iFrom].iCursor;
- {
- int nSubSrc = pSubSrc->nSrc;
- int jointype = pSrc->a[iFrom].jointype;
-
- if( pSrc->a[iFrom].pTab && pSrc->a[iFrom].pTab->isTransient ){
- sqliteDeleteTable(0, pSrc->a[iFrom].pTab);
- }
- sqliteFree(pSrc->a[iFrom].zDatabase);
- sqliteFree(pSrc->a[iFrom].zName);
- sqliteFree(pSrc->a[iFrom].zAlias);
- if( nSubSrc>1 ){
- int extra = nSubSrc - 1;
- for(i=1; i<nSubSrc; i++){
- pSrc = sqliteSrcListAppend(pSrc, 0, 0);
- }
- p->pSrc = pSrc;
- for(i=pSrc->nSrc-1; i-extra>=iFrom; i--){
- pSrc->a[i] = pSrc->a[i-extra];
- }
- }
- for(i=0; i<nSubSrc; i++){
- pSrc->a[i+iFrom] = pSubSrc->a[i];
- memset(&pSubSrc->a[i], 0, sizeof(pSubSrc->a[i]));
- }
- pSrc->a[iFrom+nSubSrc-1].jointype = jointype;
- }
-
- /* Now begin substituting subquery result set expressions for
- ** references to the iParent in the outer query.
- **
- ** Example:
- **
- ** SELECT a+5, b*10 FROM (SELECT x*3 AS a, y+10 AS b FROM t1) WHERE a>b;
- ** \ \_____________ subquery __________/ /
- ** \_____________________ outer query ______________________________/
- **
- ** We look at every expression in the outer query and every place we see
- ** "a" we substitute "x*3" and every place we see "b" we substitute "y+10".
- */
- substExprList(p->pEList, iParent, pSub->pEList);
- pList = p->pEList;
- for(i=0; i<pList->nExpr; i++){
- Expr *pExpr;
- if( pList->a[i].zName==0 && (pExpr = pList->a[i].pExpr)->span.z!=0 ){
- pList->a[i].zName = sqliteStrNDup(pExpr->span.z, pExpr->span.n);
- }
- }
- if( isAgg ){
- substExprList(p->pGroupBy, iParent, pSub->pEList);
- substExpr(p->pHaving, iParent, pSub->pEList);
- }
- if( pSub->pOrderBy ){
- assert( p->pOrderBy==0 );
- p->pOrderBy = pSub->pOrderBy;
- pSub->pOrderBy = 0;
- }else if( p->pOrderBy ){
- substExprList(p->pOrderBy, iParent, pSub->pEList);
- }
- if( pSub->pWhere ){
- pWhere = sqliteExprDup(pSub->pWhere);
- }else{
- pWhere = 0;
- }
- if( subqueryIsAgg ){
- assert( p->pHaving==0 );
- p->pHaving = p->pWhere;
- p->pWhere = pWhere;
- substExpr(p->pHaving, iParent, pSub->pEList);
- if( pSub->pHaving ){
- Expr *pHaving = sqliteExprDup(pSub->pHaving);
- if( p->pHaving ){
- p->pHaving = sqliteExpr(TK_AND, p->pHaving, pHaving, 0);
- }else{
- p->pHaving = pHaving;
- }
- }
- assert( p->pGroupBy==0 );
- p->pGroupBy = sqliteExprListDup(pSub->pGroupBy);
- }else if( p->pWhere==0 ){
- p->pWhere = pWhere;
- }else{
- substExpr(p->pWhere, iParent, pSub->pEList);
- if( pWhere ){
- p->pWhere = sqliteExpr(TK_AND, p->pWhere, pWhere, 0);
- }
- }
-
- /* The flattened query is distinct if either the inner or the
- ** outer query is distinct.
- */
- p->isDistinct = p->isDistinct || pSub->isDistinct;
-
- /* Transfer the limit expression from the subquery to the outer
- ** query.
- */
- if( pSub->nLimit>=0 ){
- if( p->nLimit<0 ){
- p->nLimit = pSub->nLimit;
- }else if( p->nLimit+p->nOffset > pSub->nLimit+pSub->nOffset ){
- p->nLimit = pSub->nLimit + pSub->nOffset - p->nOffset;
- }
- }
- p->nOffset += pSub->nOffset;
-
- /* Finially, delete what is left of the subquery and return
- ** success.
- */
- sqliteSelectDelete(pSub);
- return 1;
-}
-
-/*
-** Analyze the SELECT statement passed in as an argument to see if it
-** is a simple min() or max() query. If it is and this query can be
-** satisfied using a single seek to the beginning or end of an index,
-** then generate the code for this SELECT and return 1. If this is not a
-** simple min() or max() query, then return 0;
-**
-** A simply min() or max() query looks like this:
-**
-** SELECT min(a) FROM table;
-** SELECT max(a) FROM table;
-**
-** The query may have only a single table in its FROM argument. There
-** can be no GROUP BY or HAVING or WHERE clauses. The result set must
-** be the min() or max() of a single column of the table. The column
-** in the min() or max() function must be indexed.
-**
-** The parameters to this routine are the same as for sqliteSelect().
-** See the header comment on that routine for additional information.
-*/
-static int simpleMinMaxQuery(Parse *pParse, Select *p, int eDest, int iParm){
- Expr *pExpr;
- int iCol;
- Table *pTab;
- Index *pIdx;
- int base;
- Vdbe *v;
- int seekOp;
- int cont;
- ExprList *pEList, *pList, eList;
- struct ExprList_item eListItem;
- SrcList *pSrc;
-
-
- /* Check to see if this query is a simple min() or max() query. Return
- ** zero if it is not.
- */
- if( p->pGroupBy || p->pHaving || p->pWhere ) return 0;
- pSrc = p->pSrc;
- if( pSrc->nSrc!=1 ) return 0;
- pEList = p->pEList;
- if( pEList->nExpr!=1 ) return 0;
- pExpr = pEList->a[0].pExpr;
- if( pExpr->op!=TK_AGG_FUNCTION ) return 0;
- pList = pExpr->pList;
- if( pList==0 || pList->nExpr!=1 ) return 0;
- if( pExpr->token.n!=3 ) return 0;
- if( sqliteStrNICmp(pExpr->token.z,"min",3)==0 ){
- seekOp = OP_Rewind;
- }else if( sqliteStrNICmp(pExpr->token.z,"max",3)==0 ){
- seekOp = OP_Last;
- }else{
- return 0;
- }
- pExpr = pList->a[0].pExpr;
- if( pExpr->op!=TK_COLUMN ) return 0;
- iCol = pExpr->iColumn;
- pTab = pSrc->a[0].pTab;
-
- /* If we get to here, it means the query is of the correct form.
- ** Check to make sure we have an index and make pIdx point to the
- ** appropriate index. If the min() or max() is on an INTEGER PRIMARY
- ** key column, no index is necessary so set pIdx to NULL. If no
- ** usable index is found, return 0.
- */
- if( iCol<0 ){
- pIdx = 0;
- }else{
- for(pIdx=pTab->pIndex; pIdx; pIdx=pIdx->pNext){
- assert( pIdx->nColumn>=1 );
- if( pIdx->aiColumn[0]==iCol ) break;
- }
- if( pIdx==0 ) return 0;
- }
-
- /* Identify column types if we will be using the callback. This
- ** step is skipped if the output is going to a table or a memory cell.
- ** The column names have already been generated in the calling function.
- */
- v = sqliteGetVdbe(pParse);
- if( v==0 ) return 0;
- if( eDest==SRT_Callback ){
- generateColumnTypes(pParse, p->pSrc, p->pEList);
- }
-
- /* If the output is destined for a temporary table, open that table.
- */
- if( eDest==SRT_TempTable ){
- sqliteVdbeAddOp(v, OP_OpenTemp, iParm, 0);
- }
-
- /* Generating code to find the min or the max. Basically all we have
- ** to do is find the first or the last entry in the chosen index. If
- ** the min() or max() is on the INTEGER PRIMARY KEY, then find the first
- ** or last entry in the main table.
- */
- sqliteCodeVerifySchema(pParse, pTab->iDb);
- base = pSrc->a[0].iCursor;
- computeLimitRegisters(pParse, p);
- if( pSrc->a[0].pSelect==0 ){
- sqliteVdbeAddOp(v, OP_Integer, pTab->iDb, 0);
- sqliteVdbeOp3(v, OP_OpenRead, base, pTab->tnum, pTab->zName, 0);
- }
- cont = sqliteVdbeMakeLabel(v);
- if( pIdx==0 ){
- sqliteVdbeAddOp(v, seekOp, base, 0);
- }else{
- sqliteVdbeAddOp(v, OP_Integer, pIdx->iDb, 0);
- sqliteVdbeOp3(v, OP_OpenRead, base+1, pIdx->tnum, pIdx->zName, P3_STATIC);
- if( seekOp==OP_Rewind ){
- sqliteVdbeAddOp(v, OP_String, 0, 0);
- sqliteVdbeAddOp(v, OP_MakeKey, 1, 0);
- sqliteVdbeAddOp(v, OP_IncrKey, 0, 0);
- seekOp = OP_MoveTo;
- }
- sqliteVdbeAddOp(v, seekOp, base+1, 0);
- sqliteVdbeAddOp(v, OP_IdxRecno, base+1, 0);
- sqliteVdbeAddOp(v, OP_Close, base+1, 0);
- sqliteVdbeAddOp(v, OP_MoveTo, base, 0);
- }
- eList.nExpr = 1;
- memset(&eListItem, 0, sizeof(eListItem));
- eList.a = &eListItem;
- eList.a[0].pExpr = pExpr;
- selectInnerLoop(pParse, p, &eList, 0, 0, 0, -1, eDest, iParm, cont, cont);
- sqliteVdbeResolveLabel(v, cont);
- sqliteVdbeAddOp(v, OP_Close, base, 0);
-
- return 1;
-}
-
-/*
-** Generate code for the given SELECT statement.
-**
-** The results are distributed in various ways depending on the
-** value of eDest and iParm.
-**
-** eDest Value Result
-** ------------ -------------------------------------------
-** SRT_Callback Invoke the callback for each row of the result.
-**
-** SRT_Mem Store first result in memory cell iParm
-**
-** SRT_Set Store results as keys of a table with cursor iParm
-**
-** SRT_Union Store results as a key in a temporary table iParm
-**
-** SRT_Except Remove results from the temporary table iParm.
-**
-** SRT_Table Store results in temporary table iParm
-**
-** The table above is incomplete. Additional eDist value have be added
-** since this comment was written. See the selectInnerLoop() function for
-** a complete listing of the allowed values of eDest and their meanings.
-**
-** This routine returns the number of errors. If any errors are
-** encountered, then an appropriate error message is left in
-** pParse->zErrMsg.
-**
-** This routine does NOT free the Select structure passed in. The
-** calling function needs to do that.
-**
-** The pParent, parentTab, and *pParentAgg fields are filled in if this
-** SELECT is a subquery. This routine may try to combine this SELECT
-** with its parent to form a single flat query. In so doing, it might
-** change the parent query from a non-aggregate to an aggregate query.
-** For that reason, the pParentAgg flag is passed as a pointer, so it
-** can be changed.
-**
-** Example 1: The meaning of the pParent parameter.
-**
-** SELECT * FROM t1 JOIN (SELECT x, count(*) FROM t2) JOIN t3;
-** \ \_______ subquery _______/ /
-** \ /
-** \____________________ outer query ___________________/
-**
-** This routine is called for the outer query first. For that call,
-** pParent will be NULL. During the processing of the outer query, this
-** routine is called recursively to handle the subquery. For the recursive
-** call, pParent will point to the outer query. Because the subquery is
-** the second element in a three-way join, the parentTab parameter will
-** be 1 (the 2nd value of a 0-indexed array.)
-*/
-int sqliteSelect(
- Parse *pParse, /* The parser context */
- Select *p, /* The SELECT statement being coded. */
- int eDest, /* How to dispose of the results */
- int iParm, /* A parameter used by the eDest disposal method */
- Select *pParent, /* Another SELECT for which this is a sub-query */
- int parentTab, /* Index in pParent->pSrc of this query */
- int *pParentAgg /* True if pParent uses aggregate functions */
-){
- int i;
- WhereInfo *pWInfo;
- Vdbe *v;
- int isAgg = 0; /* True for select lists like "count(*)" */
- ExprList *pEList; /* List of columns to extract. */
- SrcList *pTabList; /* List of tables to select from */
- Expr *pWhere; /* The WHERE clause. May be NULL */
- ExprList *pOrderBy; /* The ORDER BY clause. May be NULL */
- ExprList *pGroupBy; /* The GROUP BY clause. May be NULL */
- Expr *pHaving; /* The HAVING clause. May be NULL */
- int isDistinct; /* True if the DISTINCT keyword is present */
- int distinct; /* Table to use for the distinct set */
- int rc = 1; /* Value to return from this function */
-
- if( sqlite_malloc_failed || pParse->nErr || p==0 ) return 1;
- if( sqliteAuthCheck(pParse, SQLITE_SELECT, 0, 0, 0) ) return 1;
-
- /* If there is are a sequence of queries, do the earlier ones first.
- */
- if( p->pPrior ){
- return multiSelect(pParse, p, eDest, iParm);
- }
-
- /* Make local copies of the parameters for this query.
- */
- pTabList = p->pSrc;
- pWhere = p->pWhere;
- pOrderBy = p->pOrderBy;
- pGroupBy = p->pGroupBy;
- pHaving = p->pHaving;
- isDistinct = p->isDistinct;
-
- /* Allocate VDBE cursors for each table in the FROM clause
- */
- sqliteSrcListAssignCursors(pParse, pTabList);
-
- /*
- ** Do not even attempt to generate any code if we have already seen
- ** errors before this routine starts.
- */
- if( pParse->nErr>0 ) goto select_end;
-
- /* Expand any "*" terms in the result set. (For example the "*" in
- ** "SELECT * FROM t1") The fillInColumnlist() routine also does some
- ** other housekeeping - see the header comment for details.
- */
- if( fillInColumnList(pParse, p) ){
- goto select_end;
- }
- pWhere = p->pWhere;
- pEList = p->pEList;
- if( pEList==0 ) goto select_end;
-
- /* If writing to memory or generating a set
- ** only a single column may be output.
- */
- if( (eDest==SRT_Mem || eDest==SRT_Set) && pEList->nExpr>1 ){
- sqliteErrorMsg(pParse, "only a single result allowed for "
- "a SELECT that is part of an expression");
- goto select_end;
- }
-
- /* ORDER BY is ignored for some destinations.
- */
- switch( eDest ){
- case SRT_Union:
- case SRT_Except:
- case SRT_Discard:
- pOrderBy = 0;
- break;
- default:
- break;
- }
-
- /* At this point, we should have allocated all the cursors that we
- ** need to handle subquerys and temporary tables.
- **
- ** Resolve the column names and do a semantics check on all the expressions.
- */
- for(i=0; i<pEList->nExpr; i++){
- if( sqliteExprResolveIds(pParse, pTabList, 0, pEList->a[i].pExpr) ){
- goto select_end;
- }
- if( sqliteExprCheck(pParse, pEList->a[i].pExpr, 1, &isAgg) ){
- goto select_end;
- }
- }
- if( pWhere ){
- if( sqliteExprResolveIds(pParse, pTabList, pEList, pWhere) ){
- goto select_end;
- }
- if( sqliteExprCheck(pParse, pWhere, 0, 0) ){
- goto select_end;
- }
- }
- if( pHaving ){
- if( pGroupBy==0 ){
- sqliteErrorMsg(pParse, "a GROUP BY clause is required before HAVING");
- goto select_end;
- }
- if( sqliteExprResolveIds(pParse, pTabList, pEList, pHaving) ){
- goto select_end;
- }
- if( sqliteExprCheck(pParse, pHaving, 1, &isAgg) ){
- goto select_end;
- }
- }
- if( pOrderBy ){
- for(i=0; i<pOrderBy->nExpr; i++){
- int iCol;
- Expr *pE = pOrderBy->a[i].pExpr;
- if( sqliteExprIsInteger(pE, &iCol) && iCol>0 && iCol<=pEList->nExpr ){
- sqliteExprDelete(pE);
- pE = pOrderBy->a[i].pExpr = sqliteExprDup(pEList->a[iCol-1].pExpr);
- }
- if( sqliteExprResolveIds(pParse, pTabList, pEList, pE) ){
- goto select_end;
- }
- if( sqliteExprCheck(pParse, pE, isAgg, 0) ){
- goto select_end;
- }
- if( sqliteExprIsConstant(pE) ){
- if( sqliteExprIsInteger(pE, &iCol)==0 ){
- sqliteErrorMsg(pParse,
- "ORDER BY terms must not be non-integer constants");
- goto select_end;
- }else if( iCol<=0 || iCol>pEList->nExpr ){
- sqliteErrorMsg(pParse,
- "ORDER BY column number %d out of range - should be "
- "between 1 and %d", iCol, pEList->nExpr);
- goto select_end;
- }
- }
- }
- }
- if( pGroupBy ){
- for(i=0; i<pGroupBy->nExpr; i++){
- int iCol;
- Expr *pE = pGroupBy->a[i].pExpr;
- if( sqliteExprIsInteger(pE, &iCol) && iCol>0 && iCol<=pEList->nExpr ){
- sqliteExprDelete(pE);
- pE = pGroupBy->a[i].pExpr = sqliteExprDup(pEList->a[iCol-1].pExpr);
- }
- if( sqliteExprResolveIds(pParse, pTabList, pEList, pE) ){
- goto select_end;
- }
- if( sqliteExprCheck(pParse, pE, isAgg, 0) ){
- goto select_end;
- }
- if( sqliteExprIsConstant(pE) ){
- if( sqliteExprIsInteger(pE, &iCol)==0 ){
- sqliteErrorMsg(pParse,
- "GROUP BY terms must not be non-integer constants");
- goto select_end;
- }else if( iCol<=0 || iCol>pEList->nExpr ){
- sqliteErrorMsg(pParse,
- "GROUP BY column number %d out of range - should be "
- "between 1 and %d", iCol, pEList->nExpr);
- goto select_end;
- }
- }
- }
- }
-
- /* Begin generating code.
- */
- v = sqliteGetVdbe(pParse);
- if( v==0 ) goto select_end;
-
- /* Identify column names if we will be using them in a callback. This
- ** step is skipped if the output is going to some other destination.
- */
- if( eDest==SRT_Callback ){
- generateColumnNames(pParse, pTabList, pEList);
- }
-
- /* Generate code for all sub-queries in the FROM clause
- */
- for(i=0; i<pTabList->nSrc; i++){
- const char *zSavedAuthContext;
- int needRestoreContext;
-
- if( pTabList->a[i].pSelect==0 ) continue;
- if( pTabList->a[i].zName!=0 ){
- zSavedAuthContext = pParse->zAuthContext;
- pParse->zAuthContext = pTabList->a[i].zName;
- needRestoreContext = 1;
- }else{
- needRestoreContext = 0;
- }
- sqliteSelect(pParse, pTabList->a[i].pSelect, SRT_TempTable,
- pTabList->a[i].iCursor, p, i, &isAgg);
- if( needRestoreContext ){
- pParse->zAuthContext = zSavedAuthContext;
- }
- pTabList = p->pSrc;
- pWhere = p->pWhere;
- if( eDest!=SRT_Union && eDest!=SRT_Except && eDest!=SRT_Discard ){
- pOrderBy = p->pOrderBy;
- }
- pGroupBy = p->pGroupBy;
- pHaving = p->pHaving;
- isDistinct = p->isDistinct;
- }
-
- /* Check for the special case of a min() or max() function by itself
- ** in the result set.
- */
- if( simpleMinMaxQuery(pParse, p, eDest, iParm) ){
- rc = 0;
- goto select_end;
- }
-
- /* Check to see if this is a subquery that can be "flattened" into its parent.
- ** If flattening is a possiblity, do so and return immediately.
- */
- if( pParent && pParentAgg &&
- flattenSubquery(pParse, pParent, parentTab, *pParentAgg, isAgg) ){
- if( isAgg ) *pParentAgg = 1;
- return rc;
- }
-
- /* Set the limiter.
- */
- computeLimitRegisters(pParse, p);
-
- /* Identify column types if we will be using a callback. This
- ** step is skipped if the output is going to a destination other
- ** than a callback.
- **
- ** We have to do this separately from the creation of column names
- ** above because if the pTabList contains views then they will not
- ** have been resolved and we will not know the column types until
- ** now.
- */
- if( eDest==SRT_Callback ){
- generateColumnTypes(pParse, pTabList, pEList);
- }
-
- /* If the output is destined for a temporary table, open that table.
- */
- if( eDest==SRT_TempTable ){
- sqliteVdbeAddOp(v, OP_OpenTemp, iParm, 0);
- }
-
- /* Do an analysis of aggregate expressions.
- */
- sqliteAggregateInfoReset(pParse);
- if( isAgg || pGroupBy ){
- assert( pParse->nAgg==0 );
- isAgg = 1;
- for(i=0; i<pEList->nExpr; i++){
- if( sqliteExprAnalyzeAggregates(pParse, pEList->a[i].pExpr) ){
- goto select_end;
- }
- }
- if( pGroupBy ){
- for(i=0; i<pGroupBy->nExpr; i++){
- if( sqliteExprAnalyzeAggregates(pParse, pGroupBy->a[i].pExpr) ){
- goto select_end;
- }
- }
- }
- if( pHaving && sqliteExprAnalyzeAggregates(pParse, pHaving) ){
- goto select_end;
- }
- if( pOrderBy ){
- for(i=0; i<pOrderBy->nExpr; i++){
- if( sqliteExprAnalyzeAggregates(pParse, pOrderBy->a[i].pExpr) ){
- goto select_end;
- }
- }
- }
- }
-
- /* Reset the aggregator
- */
- if( isAgg ){
- sqliteVdbeAddOp(v, OP_AggReset, 0, pParse->nAgg);
- for(i=0; i<pParse->nAgg; i++){
- FuncDef *pFunc;
- if( (pFunc = pParse->aAgg[i].pFunc)!=0 && pFunc->xFinalize!=0 ){
- sqliteVdbeOp3(v, OP_AggInit, 0, i, (char*)pFunc, P3_POINTER);
- }
- }
- if( pGroupBy==0 ){
- sqliteVdbeAddOp(v, OP_String, 0, 0);
- sqliteVdbeAddOp(v, OP_AggFocus, 0, 0);
- }
- }
-
- /* Initialize the memory cell to NULL
- */
- if( eDest==SRT_Mem ){
- sqliteVdbeAddOp(v, OP_String, 0, 0);
- sqliteVdbeAddOp(v, OP_MemStore, iParm, 1);
- }
-
- /* Open a temporary table to use for the distinct set.
- */
- if( isDistinct ){
- distinct = pParse->nTab++;
- sqliteVdbeAddOp(v, OP_OpenTemp, distinct, 1);
- }else{
- distinct = -1;
- }
-
- /* Begin the database scan
- */
- pWInfo = sqliteWhereBegin(pParse, pTabList, pWhere, 0,
- pGroupBy ? 0 : &pOrderBy);
- if( pWInfo==0 ) goto select_end;
-
- /* Use the standard inner loop if we are not dealing with
- ** aggregates
- */
- if( !isAgg ){
- if( selectInnerLoop(pParse, p, pEList, 0, 0, pOrderBy, distinct, eDest,
- iParm, pWInfo->iContinue, pWInfo->iBreak) ){
- goto select_end;
- }
- }
-
- /* If we are dealing with aggregates, then do the special aggregate
- ** processing.
- */
- else{
- AggExpr *pAgg;
- if( pGroupBy ){
- int lbl1;
- for(i=0; i<pGroupBy->nExpr; i++){
- sqliteExprCode(pParse, pGroupBy->a[i].pExpr);
- }
- sqliteVdbeAddOp(v, OP_MakeKey, pGroupBy->nExpr, 0);
- if( pParse->db->file_format>=4 ) sqliteAddKeyType(v, pGroupBy);
- lbl1 = sqliteVdbeMakeLabel(v);
- sqliteVdbeAddOp(v, OP_AggFocus, 0, lbl1);
- for(i=0, pAgg=pParse->aAgg; i<pParse->nAgg; i++, pAgg++){
- if( pAgg->isAgg ) continue;
- sqliteExprCode(pParse, pAgg->pExpr);
- sqliteVdbeAddOp(v, OP_AggSet, 0, i);
- }
- sqliteVdbeResolveLabel(v, lbl1);
- }
- for(i=0, pAgg=pParse->aAgg; i<pParse->nAgg; i++, pAgg++){
- Expr *pE;
- int nExpr;
- FuncDef *pDef;
- if( !pAgg->isAgg ) continue;
- assert( pAgg->pFunc!=0 );
- assert( pAgg->pFunc->xStep!=0 );
- pDef = pAgg->pFunc;
- pE = pAgg->pExpr;
- assert( pE!=0 );
- assert( pE->op==TK_AGG_FUNCTION );
- nExpr = sqliteExprCodeExprList(pParse, pE->pList, pDef->includeTypes);
- sqliteVdbeAddOp(v, OP_Integer, i, 0);
- sqliteVdbeOp3(v, OP_AggFunc, 0, nExpr, (char*)pDef, P3_POINTER);
- }
- }
-
- /* End the database scan loop.
- */
- sqliteWhereEnd(pWInfo);
-
- /* If we are processing aggregates, we need to set up a second loop
- ** over all of the aggregate values and process them.
- */
- if( isAgg ){
- int endagg = sqliteVdbeMakeLabel(v);
- int startagg;
- startagg = sqliteVdbeAddOp(v, OP_AggNext, 0, endagg);
- pParse->useAgg = 1;
- if( pHaving ){
- sqliteExprIfFalse(pParse, pHaving, startagg, 1);
- }
- if( selectInnerLoop(pParse, p, pEList, 0, 0, pOrderBy, distinct, eDest,
- iParm, startagg, endagg) ){
- goto select_end;
- }
- sqliteVdbeAddOp(v, OP_Goto, 0, startagg);
- sqliteVdbeResolveLabel(v, endagg);
- sqliteVdbeAddOp(v, OP_Noop, 0, 0);
- pParse->useAgg = 0;
- }
-
- /* If there is an ORDER BY clause, then we need to sort the results
- ** and send them to the callback one by one.
- */
- if( pOrderBy ){
- generateSortTail(p, v, pEList->nExpr, eDest, iParm);
- }
-
- /* If this was a subquery, we have now converted the subquery into a
- ** temporary table. So delete the subquery structure from the parent
- ** to prevent this subquery from being evaluated again and to force the
- ** the use of the temporary table.
- */
- if( pParent ){
- assert( pParent->pSrc->nSrc>parentTab );
- assert( pParent->pSrc->a[parentTab].pSelect==p );
- sqliteSelectDelete(p);
- pParent->pSrc->a[parentTab].pSelect = 0;
- }
-
- /* The SELECT was successfully coded. Set the return code to 0
- ** to indicate no errors.
- */
- rc = 0;
-
- /* Control jumps to here if an error is encountered above, or upon
- ** successful coding of the SELECT.
- */
-select_end:
- sqliteAggregateInfoReset(pParse);
- return rc;
-}
+++ /dev/null
-/*
-** 2001 September 15
-**
-** The author disclaims copyright to this source code. In place of
-** a legal notice, here is a blessing:
-**
-** May you do good and not evil.
-** May you find forgiveness for yourself and forgive others.
-** May you share freely, never taking more than you give.
-**
-*************************************************************************
-** This header file defines the interface that the SQLite library
-** presents to client programs.
-**
-** @(#) $Id: sqlite.h,v 1.1.1.1 2004/08/08 15:03:58 matt Exp $
-*/
-#ifndef _SQLITE_H_
-#define _SQLITE_H_
-#include <stdarg.h> /* Needed for the definition of va_list */
-
-/*
-** Make sure we can call this stuff from C++.
-*/
-#ifdef __cplusplus
-extern "C" {
-#endif
-
-/*
-** The version of the SQLite library.
-*/
-#define SQLITE_VERSION "2.8.15"
-
-/*
-** The version string is also compiled into the library so that a program
-** can check to make sure that the lib*.a file and the *.h file are from
-** the same version.
-*/
-extern const char sqlite_version[];
-
-/*
-** The SQLITE_UTF8 macro is defined if the library expects to see
-** UTF-8 encoded data. The SQLITE_ISO8859 macro is defined if the
-** iso8859 encoded should be used.
-*/
-#define SQLITE_UTF8 1
-
-/*
-** The following constant holds one of two strings, "UTF-8" or "iso8859",
-** depending on which character encoding the SQLite library expects to
-** see. The character encoding makes a difference for the LIKE and GLOB
-** operators and for the LENGTH() and SUBSTR() functions.
-*/
-extern const char sqlite_encoding[];
-
-/*
-** Each open sqlite database is represented by an instance of the
-** following opaque structure.
-*/
-typedef struct sqlite sqlite;
-
-/*
-** A function to open a new sqlite database.
-**
-** If the database does not exist and mode indicates write
-** permission, then a new database is created. If the database
-** does not exist and mode does not indicate write permission,
-** then the open fails, an error message generated (if errmsg!=0)
-** and the function returns 0.
-**
-** If mode does not indicates user write permission, then the
-** database is opened read-only.
-**
-** The Truth: As currently implemented, all databases are opened
-** for writing all the time. Maybe someday we will provide the
-** ability to open a database readonly. The mode parameters is
-** provided in anticipation of that enhancement.
-*/
-sqlite *sqlite_open(const char *filename, int mode, char **errmsg);
-
-/*
-** A function to close the database.
-**
-** Call this function with a pointer to a structure that was previously
-** returned from sqlite_open() and the corresponding database will by closed.
-*/
-void sqlite_close(sqlite *);
-
-/*
-** The type for a callback function.
-*/
-typedef int (*sqlite_callback)(void*,int,char**, char**);
-
-/*
-** A function to executes one or more statements of SQL.
-**
-** If one or more of the SQL statements are queries, then
-** the callback function specified by the 3rd parameter is
-** invoked once for each row of the query result. This callback
-** should normally return 0. If the callback returns a non-zero
-** value then the query is aborted, all subsequent SQL statements
-** are skipped and the sqlite_exec() function returns the SQLITE_ABORT.
-**
-** The 4th parameter is an arbitrary pointer that is passed
-** to the callback function as its first parameter.
-**
-** The 2nd parameter to the callback function is the number of
-** columns in the query result. The 3rd parameter to the callback
-** is an array of strings holding the values for each column.
-** The 4th parameter to the callback is an array of strings holding
-** the names of each column.
-**
-** The callback function may be NULL, even for queries. A NULL
-** callback is not an error. It just means that no callback
-** will be invoked.
-**
-** If an error occurs while parsing or evaluating the SQL (but
-** not while executing the callback) then an appropriate error
-** message is written into memory obtained from malloc() and
-** *errmsg is made to point to that message. The calling function
-** is responsible for freeing the memory that holds the error
-** message. Use sqlite_freemem() for this. If errmsg==NULL,
-** then no error message is ever written.
-**
-** The return value is is SQLITE_OK if there are no errors and
-** some other return code if there is an error. The particular
-** return value depends on the type of error.
-**
-** If the query could not be executed because a database file is
-** locked or busy, then this function returns SQLITE_BUSY. (This
-** behavior can be modified somewhat using the sqlite_busy_handler()
-** and sqlite_busy_timeout() functions below.)
-*/
-int sqlite_exec(
- sqlite*, /* An open database */
- const char *sql, /* SQL to be executed */
- sqlite_callback, /* Callback function */
- void *, /* 1st argument to callback function */
- char **errmsg /* Error msg written here */
-);
-
-/*
-** Return values for sqlite_exec() and sqlite_step()
-*/
-#define SQLITE_OK 0 /* Successful result */
-#define SQLITE_ERROR 1 /* SQL error or missing database */
-#define SQLITE_INTERNAL 2 /* An internal logic error in SQLite */
-#define SQLITE_PERM 3 /* Access permission denied */
-#define SQLITE_ABORT 4 /* Callback routine requested an abort */
-#define SQLITE_BUSY 5 /* The database file is locked */
-#define SQLITE_LOCKED 6 /* A table in the database is locked */
-#define SQLITE_NOMEM 7 /* A malloc() failed */
-#define SQLITE_READONLY 8 /* Attempt to write a readonly database */
-#define SQLITE_INTERRUPT 9 /* Operation terminated by sqlite_interrupt() */
-#define SQLITE_IOERR 10 /* Some kind of disk I/O error occurred */
-#define SQLITE_CORRUPT 11 /* The database disk image is malformed */
-#define SQLITE_NOTFOUND 12 /* (Internal Only) Table or record not found */
-#define SQLITE_FULL 13 /* Insertion failed because database is full */
-#define SQLITE_CANTOPEN 14 /* Unable to open the database file */
-#define SQLITE_PROTOCOL 15 /* Database lock protocol error */
-#define SQLITE_EMPTY 16 /* (Internal Only) Database table is empty */
-#define SQLITE_SCHEMA 17 /* The database schema changed */
-#define SQLITE_TOOBIG 18 /* Too much data for one row of a table */
-#define SQLITE_CONSTRAINT 19 /* Abort due to contraint violation */
-#define SQLITE_MISMATCH 20 /* Data type mismatch */
-#define SQLITE_MISUSE 21 /* Library used incorrectly */
-#define SQLITE_NOLFS 22 /* Uses OS features not supported on host */
-#define SQLITE_AUTH 23 /* Authorization denied */
-#define SQLITE_FORMAT 24 /* Auxiliary database format error */
-#define SQLITE_RANGE 25 /* 2nd parameter to sqlite_bind out of range */
-#define SQLITE_NOTADB 26 /* File opened that is not a database file */
-#define SQLITE_ROW 100 /* sqlite_step() has another row ready */
-#define SQLITE_DONE 101 /* sqlite_step() has finished executing */
-
-/*
-** Each entry in an SQLite table has a unique integer key. (The key is
-** the value of the INTEGER PRIMARY KEY column if there is such a column,
-** otherwise the key is generated at random. The unique key is always
-** available as the ROWID, OID, or _ROWID_ column.) The following routine
-** returns the integer key of the most recent insert in the database.
-**
-** This function is similar to the mysql_insert_id() function from MySQL.
-*/
-int sqlite_last_insert_rowid(sqlite*);
-
-/*
-** This function returns the number of database rows that were changed
-** (or inserted or deleted) by the most recent called sqlite_exec().
-**
-** All changes are counted, even if they were later undone by a
-** ROLLBACK or ABORT. Except, changes associated with creating and
-** dropping tables are not counted.
-**
-** If a callback invokes sqlite_exec() recursively, then the changes
-** in the inner, recursive call are counted together with the changes
-** in the outer call.
-**
-** SQLite implements the command "DELETE FROM table" without a WHERE clause
-** by dropping and recreating the table. (This is much faster than going
-** through and deleting individual elements form the table.) Because of
-** this optimization, the change count for "DELETE FROM table" will be
-** zero regardless of the number of elements that were originally in the
-** table. To get an accurate count of the number of rows deleted, use
-** "DELETE FROM table WHERE 1" instead.
-*/
-int sqlite_changes(sqlite*);
-
-/*
-** This function returns the number of database rows that were changed
-** by the last INSERT, UPDATE, or DELETE statment executed by sqlite_exec(),
-** or by the last VM to run to completion. The change count is not updated
-** by SQL statements other than INSERT, UPDATE or DELETE.
-**
-** Changes are counted, even if they are later undone by a ROLLBACK or
-** ABORT. Changes associated with trigger programs that execute as a
-** result of the INSERT, UPDATE, or DELETE statement are not counted.
-**
-** If a callback invokes sqlite_exec() recursively, then the changes
-** in the inner, recursive call are counted together with the changes
-** in the outer call.
-**
-** SQLite implements the command "DELETE FROM table" without a WHERE clause
-** by dropping and recreating the table. (This is much faster than going
-** through and deleting individual elements form the table.) Because of
-** this optimization, the change count for "DELETE FROM table" will be
-** zero regardless of the number of elements that were originally in the
-** table. To get an accurate count of the number of rows deleted, use
-** "DELETE FROM table WHERE 1" instead.
-**
-******* THIS IS AN EXPERIMENTAL API AND IS SUBJECT TO CHANGE ******
-*/
-int sqlite_last_statement_changes(sqlite*);
-
-/* If the parameter to this routine is one of the return value constants
-** defined above, then this routine returns a constant text string which
-** descripts (in English) the meaning of the return value.
-*/
-const char *sqlite_error_string(int);
-#define sqliteErrStr sqlite_error_string /* Legacy. Do not use in new code. */
-
-/* This function causes any pending database operation to abort and
-** return at its earliest opportunity. This routine is typically
-** called in response to a user action such as pressing "Cancel"
-** or Ctrl-C where the user wants a long query operation to halt
-** immediately.
-*/
-void sqlite_interrupt(sqlite*);
-
-
-/* This function returns true if the given input string comprises
-** one or more complete SQL statements.
-**
-** The algorithm is simple. If the last token other than spaces
-** and comments is a semicolon, then return true. otherwise return
-** false.
-*/
-int sqlite_complete(const char *sql);
-
-/*
-** This routine identifies a callback function that is invoked
-** whenever an attempt is made to open a database table that is
-** currently locked by another process or thread. If the busy callback
-** is NULL, then sqlite_exec() returns SQLITE_BUSY immediately if
-** it finds a locked table. If the busy callback is not NULL, then
-** sqlite_exec() invokes the callback with three arguments. The
-** second argument is the name of the locked table and the third
-** argument is the number of times the table has been busy. If the
-** busy callback returns 0, then sqlite_exec() immediately returns
-** SQLITE_BUSY. If the callback returns non-zero, then sqlite_exec()
-** tries to open the table again and the cycle repeats.
-**
-** The default busy callback is NULL.
-**
-** Sqlite is re-entrant, so the busy handler may start a new query.
-** (It is not clear why anyone would every want to do this, but it
-** is allowed, in theory.) But the busy handler may not close the
-** database. Closing the database from a busy handler will delete
-** data structures out from under the executing query and will
-** probably result in a coredump.
-*/
-void sqlite_busy_handler(sqlite*, int(*)(void*,const char*,int), void*);
-
-/*
-** This routine sets a busy handler that sleeps for a while when a
-** table is locked. The handler will sleep multiple times until
-** at least "ms" milleseconds of sleeping have been done. After
-** "ms" milleseconds of sleeping, the handler returns 0 which
-** causes sqlite_exec() to return SQLITE_BUSY.
-**
-** Calling this routine with an argument less than or equal to zero
-** turns off all busy handlers.
-*/
-void sqlite_busy_timeout(sqlite*, int ms);
-
-/*
-** This next routine is really just a wrapper around sqlite_exec().
-** Instead of invoking a user-supplied callback for each row of the
-** result, this routine remembers each row of the result in memory
-** obtained from malloc(), then returns all of the result after the
-** query has finished.
-**
-** As an example, suppose the query result where this table:
-**
-** Name | Age
-** -----------------------
-** Alice | 43
-** Bob | 28
-** Cindy | 21
-**
-** If the 3rd argument were &azResult then after the function returns
-** azResult will contain the following data:
-**
-** azResult[0] = "Name";
-** azResult[1] = "Age";
-** azResult[2] = "Alice";
-** azResult[3] = "43";
-** azResult[4] = "Bob";
-** azResult[5] = "28";
-** azResult[6] = "Cindy";
-** azResult[7] = "21";
-**
-** Notice that there is an extra row of data containing the column
-** headers. But the *nrow return value is still 3. *ncolumn is
-** set to 2. In general, the number of values inserted into azResult
-** will be ((*nrow) + 1)*(*ncolumn).
-**
-** After the calling function has finished using the result, it should
-** pass the result data pointer to sqlite_free_table() in order to
-** release the memory that was malloc-ed. Because of the way the
-** malloc() happens, the calling function must not try to call
-** malloc() directly. Only sqlite_free_table() is able to release
-** the memory properly and safely.
-**
-** The return value of this routine is the same as from sqlite_exec().
-*/
-int sqlite_get_table(
- sqlite*, /* An open database */
- const char *sql, /* SQL to be executed */
- char ***resultp, /* Result written to a char *[] that this points to */
- int *nrow, /* Number of result rows written here */
- int *ncolumn, /* Number of result columns written here */
- char **errmsg /* Error msg written here */
-);
-
-/*
-** Call this routine to free the memory that sqlite_get_table() allocated.
-*/
-void sqlite_free_table(char **result);
-
-/*
-** The following routines are wrappers around sqlite_exec() and
-** sqlite_get_table(). The only difference between the routines that
-** follow and the originals is that the second argument to the
-** routines that follow is really a printf()-style format
-** string describing the SQL to be executed. Arguments to the format
-** string appear at the end of the argument list.
-**
-** All of the usual printf formatting options apply. In addition, there
-** is a "%q" option. %q works like %s in that it substitutes a null-terminated
-** string from the argument list. But %q also doubles every '\'' character.
-** %q is designed for use inside a string literal. By doubling each '\''
-** character it escapes that character and allows it to be inserted into
-** the string.
-**
-** For example, so some string variable contains text as follows:
-**
-** char *zText = "It's a happy day!";
-**
-** We can use this text in an SQL statement as follows:
-**
-** sqlite_exec_printf(db, "INSERT INTO table VALUES('%q')",
-** callback1, 0, 0, zText);
-**
-** Because the %q format string is used, the '\'' character in zText
-** is escaped and the SQL generated is as follows:
-**
-** INSERT INTO table1 VALUES('It''s a happy day!')
-**
-** This is correct. Had we used %s instead of %q, the generated SQL
-** would have looked like this:
-**
-** INSERT INTO table1 VALUES('It's a happy day!');
-**
-** This second example is an SQL syntax error. As a general rule you
-** should always use %q instead of %s when inserting text into a string
-** literal.
-*/
-int sqlite_exec_printf(
- sqlite*, /* An open database */
- const char *sqlFormat, /* printf-style format string for the SQL */
- sqlite_callback, /* Callback function */
- void *, /* 1st argument to callback function */
- char **errmsg, /* Error msg written here */
- ... /* Arguments to the format string. */
-);
-int sqlite_exec_vprintf(
- sqlite*, /* An open database */
- const char *sqlFormat, /* printf-style format string for the SQL */
- sqlite_callback, /* Callback function */
- void *, /* 1st argument to callback function */
- char **errmsg, /* Error msg written here */
- va_list ap /* Arguments to the format string. */
-);
-int sqlite_get_table_printf(
- sqlite*, /* An open database */
- const char *sqlFormat, /* printf-style format string for the SQL */
- char ***resultp, /* Result written to a char *[] that this points to */
- int *nrow, /* Number of result rows written here */
- int *ncolumn, /* Number of result columns written here */
- char **errmsg, /* Error msg written here */
- ... /* Arguments to the format string */
-);
-int sqlite_get_table_vprintf(
- sqlite*, /* An open database */
- const char *sqlFormat, /* printf-style format string for the SQL */
- char ***resultp, /* Result written to a char *[] that this points to */
- int *nrow, /* Number of result rows written here */
- int *ncolumn, /* Number of result columns written here */
- char **errmsg, /* Error msg written here */
- va_list ap /* Arguments to the format string */
-);
-char *sqlite_mprintf(const char*,...);
-char *sqlite_vmprintf(const char*, va_list);
-
-/*
-** Windows systems should call this routine to free memory that
-** is returned in the in the errmsg parameter of sqlite_open() when
-** SQLite is a DLL. For some reason, it does not work to call free()
-** directly.
-*/
-void sqlite_freemem(void *p);
-
-/*
-** Windows systems need functions to call to return the sqlite_version
-** and sqlite_encoding strings.
-*/
-const char *sqlite_libversion(void);
-const char *sqlite_libencoding(void);
-
-/*
-** A pointer to the following structure is used to communicate with
-** the implementations of user-defined functions.
-*/
-typedef struct sqlite_func sqlite_func;
-
-/*
-** Use the following routines to create new user-defined functions. See
-** the documentation for details.
-*/
-int sqlite_create_function(
- sqlite*, /* Database where the new function is registered */
- const char *zName, /* Name of the new function */
- int nArg, /* Number of arguments. -1 means any number */
- void (*xFunc)(sqlite_func*,int,const char**), /* C code to implement */
- void *pUserData /* Available via the sqlite_user_data() call */
-);
-int sqlite_create_aggregate(
- sqlite*, /* Database where the new function is registered */
- const char *zName, /* Name of the function */
- int nArg, /* Number of arguments */
- void (*xStep)(sqlite_func*,int,const char**), /* Called for each row */
- void (*xFinalize)(sqlite_func*), /* Called once to get final result */
- void *pUserData /* Available via the sqlite_user_data() call */
-);
-
-/*
-** Use the following routine to define the datatype returned by a
-** user-defined function. The second argument can be one of the
-** constants SQLITE_NUMERIC, SQLITE_TEXT, or SQLITE_ARGS or it
-** can be an integer greater than or equal to zero. When the datatype
-** parameter is non-negative, the type of the result will be the
-** same as the datatype-th argument. If datatype==SQLITE_NUMERIC
-** then the result is always numeric. If datatype==SQLITE_TEXT then
-** the result is always text. If datatype==SQLITE_ARGS then the result
-** is numeric if any argument is numeric and is text otherwise.
-*/
-int sqlite_function_type(
- sqlite *db, /* The database there the function is registered */
- const char *zName, /* Name of the function */
- int datatype /* The datatype for this function */
-);
-#define SQLITE_NUMERIC (-1)
-#define SQLITE_TEXT (-2)
-#define SQLITE_ARGS (-3)
-
-/*
-** The user function implementations call one of the following four routines
-** in order to return their results. The first parameter to each of these
-** routines is a copy of the first argument to xFunc() or xFinialize().
-** The second parameter to these routines is the result to be returned.
-** A NULL can be passed as the second parameter to sqlite_set_result_string()
-** in order to return a NULL result.
-**
-** The 3rd argument to _string and _error is the number of characters to
-** take from the string. If this argument is negative, then all characters
-** up to and including the first '\000' are used.
-**
-** The sqlite_set_result_string() function allocates a buffer to hold the
-** result and returns a pointer to this buffer. The calling routine
-** (that is, the implmentation of a user function) can alter the content
-** of this buffer if desired.
-*/
-char *sqlite_set_result_string(sqlite_func*,const char*,int);
-void sqlite_set_result_int(sqlite_func*,int);
-void sqlite_set_result_double(sqlite_func*,double);
-void sqlite_set_result_error(sqlite_func*,const char*,int);
-
-/*
-** The pUserData parameter to the sqlite_create_function() and
-** sqlite_create_aggregate() routines used to register user functions
-** is available to the implementation of the function using this
-** call.
-*/
-void *sqlite_user_data(sqlite_func*);
-
-/*
-** Aggregate functions use the following routine to allocate
-** a structure for storing their state. The first time this routine
-** is called for a particular aggregate, a new structure of size nBytes
-** is allocated, zeroed, and returned. On subsequent calls (for the
-** same aggregate instance) the same buffer is returned. The implementation
-** of the aggregate can use the returned buffer to accumulate data.
-**
-** The buffer allocated is freed automatically be SQLite.
-*/
-void *sqlite_aggregate_context(sqlite_func*, int nBytes);
-
-/*
-** The next routine returns the number of calls to xStep for a particular
-** aggregate function instance. The current call to xStep counts so this
-** routine always returns at least 1.
-*/
-int sqlite_aggregate_count(sqlite_func*);
-
-/*
-** This routine registers a callback with the SQLite library. The
-** callback is invoked (at compile-time, not at run-time) for each
-** attempt to access a column of a table in the database. The callback
-** returns SQLITE_OK if access is allowed, SQLITE_DENY if the entire
-** SQL statement should be aborted with an error and SQLITE_IGNORE
-** if the column should be treated as a NULL value.
-*/
-int sqlite_set_authorizer(
- sqlite*,
- int (*xAuth)(void*,int,const char*,const char*,const char*,const char*),
- void *pUserData
-);
-
-/*
-** The second parameter to the access authorization function above will
-** be one of the values below. These values signify what kind of operation
-** is to be authorized. The 3rd and 4th parameters to the authorization
-** function will be parameters or NULL depending on which of the following
-** codes is used as the second parameter. The 5th parameter is the name
-** of the database ("main", "temp", etc.) if applicable. The 6th parameter
-** is the name of the inner-most trigger or view that is responsible for
-** the access attempt or NULL if this access attempt is directly from
-** input SQL code.
-**
-** Arg-3 Arg-4
-*/
-#define SQLITE_COPY 0 /* Table Name File Name */
-#define SQLITE_CREATE_INDEX 1 /* Index Name Table Name */
-#define SQLITE_CREATE_TABLE 2 /* Table Name NULL */
-#define SQLITE_CREATE_TEMP_INDEX 3 /* Index Name Table Name */
-#define SQLITE_CREATE_TEMP_TABLE 4 /* Table Name NULL */
-#define SQLITE_CREATE_TEMP_TRIGGER 5 /* Trigger Name Table Name */
-#define SQLITE_CREATE_TEMP_VIEW 6 /* View Name NULL */
-#define SQLITE_CREATE_TRIGGER 7 /* Trigger Name Table Name */
-#define SQLITE_CREATE_VIEW 8 /* View Name NULL */
-#define SQLITE_DELETE 9 /* Table Name NULL */
-#define SQLITE_DROP_INDEX 10 /* Index Name Table Name */
-#define SQLITE_DROP_TABLE 11 /* Table Name NULL */
-#define SQLITE_DROP_TEMP_INDEX 12 /* Index Name Table Name */
-#define SQLITE_DROP_TEMP_TABLE 13 /* Table Name NULL */
-#define SQLITE_DROP_TEMP_TRIGGER 14 /* Trigger Name Table Name */
-#define SQLITE_DROP_TEMP_VIEW 15 /* View Name NULL */
-#define SQLITE_DROP_TRIGGER 16 /* Trigger Name Table Name */
-#define SQLITE_DROP_VIEW 17 /* View Name NULL */
-#define SQLITE_INSERT 18 /* Table Name NULL */
-#define SQLITE_PRAGMA 19 /* Pragma Name 1st arg or NULL */
-#define SQLITE_READ 20 /* Table Name Column Name */
-#define SQLITE_SELECT 21 /* NULL NULL */
-#define SQLITE_TRANSACTION 22 /* NULL NULL */
-#define SQLITE_UPDATE 23 /* Table Name Column Name */
-#define SQLITE_ATTACH 24 /* Filename NULL */
-#define SQLITE_DETACH 25 /* Database Name NULL */
-
-
-/*
-** The return value of the authorization function should be one of the
-** following constants:
-*/
-/* #define SQLITE_OK 0 // Allow access (This is actually defined above) */
-#define SQLITE_DENY 1 /* Abort the SQL statement with an error */
-#define SQLITE_IGNORE 2 /* Don't allow access, but don't generate an error */
-
-/*
-** Register a function that is called at every invocation of sqlite_exec()
-** or sqlite_compile(). This function can be used (for example) to generate
-** a log file of all SQL executed against a database.
-*/
-void *sqlite_trace(sqlite*, void(*xTrace)(void*,const char*), void*);
-
-/*** The Callback-Free API
-**
-** The following routines implement a new way to access SQLite that does not
-** involve the use of callbacks.
-**
-** An sqlite_vm is an opaque object that represents a single SQL statement
-** that is ready to be executed.
-*/
-typedef struct sqlite_vm sqlite_vm;
-
-/*
-** To execute an SQLite query without the use of callbacks, you first have
-** to compile the SQL using this routine. The 1st parameter "db" is a pointer
-** to an sqlite object obtained from sqlite_open(). The 2nd parameter
-** "zSql" is the text of the SQL to be compiled. The remaining parameters
-** are all outputs.
-**
-** *pzTail is made to point to the first character past the end of the first
-** SQL statement in zSql. This routine only compiles the first statement
-** in zSql, so *pzTail is left pointing to what remains uncompiled.
-**
-** *ppVm is left pointing to a "virtual machine" that can be used to execute
-** the compiled statement. Or if there is an error, *ppVm may be set to NULL.
-** If the input text contained no SQL (if the input is and empty string or
-** a comment) then *ppVm is set to NULL.
-**
-** If any errors are detected during compilation, an error message is written
-** into space obtained from malloc() and *pzErrMsg is made to point to that
-** error message. The calling routine is responsible for freeing the text
-** of this message when it has finished with it. Use sqlite_freemem() to
-** free the message. pzErrMsg may be NULL in which case no error message
-** will be generated.
-**
-** On success, SQLITE_OK is returned. Otherwise and error code is returned.
-*/
-int sqlite_compile(
- sqlite *db, /* The open database */
- const char *zSql, /* SQL statement to be compiled */
- const char **pzTail, /* OUT: uncompiled tail of zSql */
- sqlite_vm **ppVm, /* OUT: the virtual machine to execute zSql */
- char **pzErrmsg /* OUT: Error message. */
-);
-
-/*
-** After an SQL statement has been compiled, it is handed to this routine
-** to be executed. This routine executes the statement as far as it can
-** go then returns. The return value will be one of SQLITE_DONE,
-** SQLITE_ERROR, SQLITE_BUSY, SQLITE_ROW, or SQLITE_MISUSE.
-**
-** SQLITE_DONE means that the execute of the SQL statement is complete
-** an no errors have occurred. sqlite_step() should not be called again
-** for the same virtual machine. *pN is set to the number of columns in
-** the result set and *pazColName is set to an array of strings that
-** describe the column names and datatypes. The name of the i-th column
-** is (*pazColName)[i] and the datatype of the i-th column is
-** (*pazColName)[i+*pN]. *pazValue is set to NULL.
-**
-** SQLITE_ERROR means that the virtual machine encountered a run-time
-** error. sqlite_step() should not be called again for the same
-** virtual machine. *pN is set to 0 and *pazColName and *pazValue are set
-** to NULL. Use sqlite_finalize() to obtain the specific error code
-** and the error message text for the error.
-**
-** SQLITE_BUSY means that an attempt to open the database failed because
-** another thread or process is holding a lock. The calling routine
-** can try again to open the database by calling sqlite_step() again.
-** The return code will only be SQLITE_BUSY if no busy handler is registered
-** using the sqlite_busy_handler() or sqlite_busy_timeout() routines. If
-** a busy handler callback has been registered but returns 0, then this
-** routine will return SQLITE_ERROR and sqltie_finalize() will return
-** SQLITE_BUSY when it is called.
-**
-** SQLITE_ROW means that a single row of the result is now available.
-** The data is contained in *pazValue. The value of the i-th column is
-** (*azValue)[i]. *pN and *pazColName are set as described in SQLITE_DONE.
-** Invoke sqlite_step() again to advance to the next row.
-**
-** SQLITE_MISUSE is returned if sqlite_step() is called incorrectly.
-** For example, if you call sqlite_step() after the virtual machine
-** has halted (after a prior call to sqlite_step() has returned SQLITE_DONE)
-** or if you call sqlite_step() with an incorrectly initialized virtual
-** machine or a virtual machine that has been deleted or that is associated
-** with an sqlite structure that has been closed.
-*/
-int sqlite_step(
- sqlite_vm *pVm, /* The virtual machine to execute */
- int *pN, /* OUT: Number of columns in result */
- const char ***pazValue, /* OUT: Column data */
- const char ***pazColName /* OUT: Column names and datatypes */
-);
-
-/*
-** This routine is called to delete a virtual machine after it has finished
-** executing. The return value is the result code. SQLITE_OK is returned
-** if the statement executed successfully and some other value is returned if
-** there was any kind of error. If an error occurred and pzErrMsg is not
-** NULL, then an error message is written into memory obtained from malloc()
-** and *pzErrMsg is made to point to that error message. The calling routine
-** should use sqlite_freemem() to delete this message when it has finished
-** with it.
-**
-** This routine can be called at any point during the execution of the
-** virtual machine. If the virtual machine has not completed execution
-** when this routine is called, that is like encountering an error or
-** an interrupt. (See sqlite_interrupt().) Incomplete updates may be
-** rolled back and transactions cancelled, depending on the circumstances,
-** and the result code returned will be SQLITE_ABORT.
-*/
-int sqlite_finalize(sqlite_vm*, char **pzErrMsg);
-
-/*
-** This routine deletes the virtual machine, writes any error message to
-** *pzErrMsg and returns an SQLite return code in the same way as the
-** sqlite_finalize() function.
-**
-** Additionally, if ppVm is not NULL, *ppVm is left pointing to a new virtual
-** machine loaded with the compiled version of the original query ready for
-** execution.
-**
-** If sqlite_reset() returns SQLITE_SCHEMA, then *ppVm is set to NULL.
-**
-******* THIS IS AN EXPERIMENTAL API AND IS SUBJECT TO CHANGE ******
-*/
-int sqlite_reset(sqlite_vm*, char **pzErrMsg);
-
-/*
-** If the SQL that was handed to sqlite_compile contains variables that
-** are represeted in the SQL text by a question mark ('?'). This routine
-** is used to assign values to those variables.
-**
-** The first parameter is a virtual machine obtained from sqlite_compile().
-** The 2nd "idx" parameter determines which variable in the SQL statement
-** to bind the value to. The left most '?' is 1. The 3rd parameter is
-** the value to assign to that variable. The 4th parameter is the number
-** of bytes in the value, including the terminating \000 for strings.
-** Finally, the 5th "copy" parameter is TRUE if SQLite should make its
-** own private copy of this value, or false if the space that the 3rd
-** parameter points to will be unchanging and can be used directly by
-** SQLite.
-**
-** Unbound variables are treated as having a value of NULL. To explicitly
-** set a variable to NULL, call this routine with the 3rd parameter as a
-** NULL pointer.
-**
-** If the 4th "len" parameter is -1, then strlen() is used to find the
-** length.
-**
-** This routine can only be called immediately after sqlite_compile()
-** or sqlite_reset() and before any calls to sqlite_step().
-**
-******* THIS IS AN EXPERIMENTAL API AND IS SUBJECT TO CHANGE ******
-*/
-int sqlite_bind(sqlite_vm*, int idx, const char *value, int len, int copy);
-
-/*
-** This routine configures a callback function - the progress callback - that
-** is invoked periodically during long running calls to sqlite_exec(),
-** sqlite_step() and sqlite_get_table(). An example use for this API is to keep
-** a GUI updated during a large query.
-**
-** The progress callback is invoked once for every N virtual machine opcodes,
-** where N is the second argument to this function. The progress callback
-** itself is identified by the third argument to this function. The fourth
-** argument to this function is a void pointer passed to the progress callback
-** function each time it is invoked.
-**
-** If a call to sqlite_exec(), sqlite_step() or sqlite_get_table() results
-** in less than N opcodes being executed, then the progress callback is not
-** invoked.
-**
-** Calling this routine overwrites any previously installed progress callback.
-** To remove the progress callback altogether, pass NULL as the third
-** argument to this function.
-**
-** If the progress callback returns a result other than 0, then the current
-** query is immediately terminated and any database changes rolled back. If the
-** query was part of a larger transaction, then the transaction is not rolled
-** back and remains active. The sqlite_exec() call returns SQLITE_ABORT.
-**
-******* THIS IS AN EXPERIMENTAL API AND IS SUBJECT TO CHANGE ******
-*/
-void sqlite_progress_handler(sqlite*, int, int(*)(void*), void*);
-
-/*
-** Register a callback function to be invoked whenever a new transaction
-** is committed. The pArg argument is passed through to the callback.
-** callback. If the callback function returns non-zero, then the commit
-** is converted into a rollback.
-**
-** If another function was previously registered, its pArg value is returned.
-** Otherwise NULL is returned.
-**
-** Registering a NULL function disables the callback.
-**
-******* THIS IS AN EXPERIMENTAL API AND IS SUBJECT TO CHANGE ******
-*/
-void *sqlite_commit_hook(sqlite*, int(*)(void*), void*);
-
-/*
-** Open an encrypted SQLite database. If pKey==0 or nKey==0, this routine
-** is the same as sqlite_open().
-**
-** The code to implement this API is not available in the public release
-** of SQLite.
-*/
-sqlite *sqlite_open_encrypted(
- const char *zFilename, /* Name of the encrypted database */
- const void *pKey, /* Pointer to the key */
- int nKey, /* Number of bytes in the key */
- int *pErrcode, /* Write error code here */
- char **pzErrmsg /* Write error message here */
-);
-
-/*
-** Change the key on an open database. If the current database is not
-** encrypted, this routine will encrypt it. If pNew==0 or nNew==0, the
-** database is decrypted.
-**
-** The code to implement this API is not available in the public release
-** of SQLite.
-*/
-int sqlite_rekey(
- sqlite *db, /* Database to be rekeyed */
- const void *pKey, int nKey /* The new key */
-);
-
-/*
-** Encode a binary buffer "in" of size n bytes so that it contains
-** no instances of characters '\'' or '\000'. The output is
-** null-terminated and can be used as a string value in an INSERT
-** or UPDATE statement. Use sqlite_decode_binary() to convert the
-** string back into its original binary.
-**
-** The result is written into a preallocated output buffer "out".
-** "out" must be able to hold at least 2 +(257*n)/254 bytes.
-** In other words, the output will be expanded by as much as 3
-** bytes for every 254 bytes of input plus 2 bytes of fixed overhead.
-** (This is approximately 2 + 1.0118*n or about a 1.2% size increase.)
-**
-** The return value is the number of characters in the encoded
-** string, excluding the "\000" terminator.
-**
-** If out==NULL then no output is generated but the routine still returns
-** the number of characters that would have been generated if out had
-** not been NULL.
-*/
-int sqlite_encode_binary(const unsigned char *in, int n, unsigned char *out);
-
-/*
-** Decode the string "in" into binary data and write it into "out".
-** This routine reverses the encoding created by sqlite_encode_binary().
-** The output will always be a few bytes less than the input. The number
-** of bytes of output is returned. If the input is not a well-formed
-** encoding, -1 is returned.
-**
-** The "in" and "out" parameters may point to the same buffer in order
-** to decode a string in place.
-*/
-int sqlite_decode_binary(const unsigned char *in, unsigned char *out);
-
-#ifdef __cplusplus
-} /* End of the 'extern "C"' block */
-#endif
-
-#endif /* _SQLITE_H_ */
+++ /dev/null
-/*
-** 2001 September 15
-**
-** The author disclaims copyright to this source code. In place of
-** a legal notice, here is a blessing:
-**
-** May you do good and not evil.
-** May you find forgiveness for yourself and forgive others.
-** May you share freely, never taking more than you give.
-**
-*************************************************************************
-** Internal interface definitions for SQLite.
-**
-** @(#) $Id: sqliteInt.h,v 1.1.1.1 2004/08/08 15:03:58 matt Exp $
-*/
-#include "config.h"
-#include "sqlite.h"
-#include "hash.h"
-#include "parse.h"
-#include "btree.h"
-#include <stdio.h>
-#include <stdlib.h>
-#include <string.h>
-#include <assert.h>
-
-/*
-** The maximum number of in-memory pages to use for the main database
-** table and for temporary tables.
-*/
-#define MAX_PAGES 2000
-#define TEMP_PAGES 500
-
-/*
-** If the following macro is set to 1, then NULL values are considered
-** distinct for the SELECT DISTINCT statement and for UNION or EXCEPT
-** compound queries. No other SQL database engine (among those tested)
-** works this way except for OCELOT. But the SQL92 spec implies that
-** this is how things should work.
-**
-** If the following macro is set to 0, then NULLs are indistinct for
-** SELECT DISTINCT and for UNION.
-*/
-#define NULL_ALWAYS_DISTINCT 0
-
-/*
-** If the following macro is set to 1, then NULL values are considered
-** distinct when determining whether or not two entries are the same
-** in a UNIQUE index. This is the way PostgreSQL, Oracle, DB2, MySQL,
-** OCELOT, and Firebird all work. The SQL92 spec explicitly says this
-** is the way things are suppose to work.
-**
-** If the following macro is set to 0, the NULLs are indistinct for
-** a UNIQUE index. In this mode, you can only have a single NULL entry
-** for a column declared UNIQUE. This is the way Informix and SQL Server
-** work.
-*/
-#define NULL_DISTINCT_FOR_UNIQUE 1
-
-/*
-** The maximum number of attached databases. This must be at least 2
-** in order to support the main database file (0) and the file used to
-** hold temporary tables (1). And it must be less than 256 because
-** an unsigned character is used to stored the database index.
-*/
-#define MAX_ATTACHED 10
-
-/*
-** The next macro is used to determine where TEMP tables and indices
-** are stored. Possible values:
-**
-** 0 Always use a temporary files
-** 1 Use a file unless overridden by "PRAGMA temp_store"
-** 2 Use memory unless overridden by "PRAGMA temp_store"
-** 3 Always use memory
-*/
-#ifndef TEMP_STORE
-# define TEMP_STORE 1
-#endif
-
-/*
-** When building SQLite for embedded systems where memory is scarce,
-** you can define one or more of the following macros to omit extra
-** features of the library and thus keep the size of the library to
-** a minimum.
-*/
-/* #define SQLITE_OMIT_AUTHORIZATION 1 */
-/* #define SQLITE_OMIT_INMEMORYDB 1 */
-/* #define SQLITE_OMIT_VACUUM 1 */
-/* #define SQLITE_OMIT_DATETIME_FUNCS 1 */
-/* #define SQLITE_OMIT_PROGRESS_CALLBACK 1 */
-
-/*
-** Integers of known sizes. These typedefs might change for architectures
-** where the sizes very. Preprocessor macros are available so that the
-** types can be conveniently redefined at compile-type. Like this:
-**
-** cc '-DUINTPTR_TYPE=long long int' ...
-*/
-#ifndef UINT32_TYPE
-# define UINT32_TYPE unsigned int
-#endif
-#ifndef UINT16_TYPE
-# define UINT16_TYPE unsigned short int
-#endif
-#ifndef INT16_TYPE
-# define INT16_TYPE short int
-#endif
-#ifndef UINT8_TYPE
-# define UINT8_TYPE unsigned char
-#endif
-#ifndef INT8_TYPE
-# define INT8_TYPE signed char
-#endif
-#ifndef INTPTR_TYPE
-# if SQLITE_PTR_SZ==4
-# define INTPTR_TYPE int
-# else
-# define INTPTR_TYPE long long
-# endif
-#endif
-typedef UINT32_TYPE u32; /* 4-byte unsigned integer */
-typedef UINT16_TYPE u16; /* 2-byte unsigned integer */
-typedef INT16_TYPE i16; /* 2-byte signed integer */
-typedef UINT8_TYPE u8; /* 1-byte unsigned integer */
-typedef UINT8_TYPE i8; /* 1-byte signed integer */
-typedef INTPTR_TYPE ptr; /* Big enough to hold a pointer */
-typedef unsigned INTPTR_TYPE uptr; /* Big enough to hold a pointer */
-
-/*
-** Defer sourcing vdbe.h until after the "u8" typedef is defined.
-*/
-#include "vdbe.h"
-
-/*
-** Most C compilers these days recognize "long double", don't they?
-** Just in case we encounter one that does not, we will create a macro
-** for long double so that it can be easily changed to just "double".
-*/
-#ifndef LONGDOUBLE_TYPE
-# define LONGDOUBLE_TYPE long double
-#endif
-
-/*
-** This macro casts a pointer to an integer. Useful for doing
-** pointer arithmetic.
-*/
-#define Addr(X) ((uptr)X)
-
-/*
-** The maximum number of bytes of data that can be put into a single
-** row of a single table. The upper bound on this limit is 16777215
-** bytes (or 16MB-1). We have arbitrarily set the limit to just 1MB
-** here because the overflow page chain is inefficient for really big
-** records and we want to discourage people from thinking that
-** multi-megabyte records are OK. If your needs are different, you can
-** change this define and recompile to increase or decrease the record
-** size.
-**
-** The 16777198 is computed as follows: 238 bytes of payload on the
-** original pages plus 16448 overflow pages each holding 1020 bytes of
-** data.
-*/
-#define MAX_BYTES_PER_ROW 1048576
-/* #define MAX_BYTES_PER_ROW 16777198 */
-
-/*
-** If memory allocation problems are found, recompile with
-**
-** -DMEMORY_DEBUG=1
-**
-** to enable some sanity checking on malloc() and free(). To
-** check for memory leaks, recompile with
-**
-** -DMEMORY_DEBUG=2
-**
-** and a line of text will be written to standard error for
-** each malloc() and free(). This output can be analyzed
-** by an AWK script to determine if there are any leaks.
-*/
-#ifdef MEMORY_DEBUG
-# define sqliteMalloc(X) sqliteMalloc_(X,1,__FILE__,__LINE__)
-# define sqliteMallocRaw(X) sqliteMalloc_(X,0,__FILE__,__LINE__)
-# define sqliteFree(X) sqliteFree_(X,__FILE__,__LINE__)
-# define sqliteRealloc(X,Y) sqliteRealloc_(X,Y,__FILE__,__LINE__)
-# define sqliteStrDup(X) sqliteStrDup_(X,__FILE__,__LINE__)
-# define sqliteStrNDup(X,Y) sqliteStrNDup_(X,Y,__FILE__,__LINE__)
- void sqliteStrRealloc(char**);
-#else
-# define sqliteRealloc_(X,Y) sqliteRealloc(X,Y)
-# define sqliteStrRealloc(X)
-#endif
-
-/*
-** This variable gets set if malloc() ever fails. After it gets set,
-** the SQLite library shuts down permanently.
-*/
-extern int sqlite_malloc_failed;
-
-/*
-** The following global variables are used for testing and debugging
-** only. They only work if MEMORY_DEBUG is defined.
-*/
-#ifdef MEMORY_DEBUG
-extern int sqlite_nMalloc; /* Number of sqliteMalloc() calls */
-extern int sqlite_nFree; /* Number of sqliteFree() calls */
-extern int sqlite_iMallocFail; /* Fail sqliteMalloc() after this many calls */
-#endif
-
-/*
-** Name of the master database table. The master database table
-** is a special table that holds the names and attributes of all
-** user tables and indices.
-*/
-#define MASTER_NAME "sqlite_master"
-#define TEMP_MASTER_NAME "sqlite_temp_master"
-
-/*
-** The name of the schema table.
-*/
-#define SCHEMA_TABLE(x) (x?TEMP_MASTER_NAME:MASTER_NAME)
-
-/*
-** A convenience macro that returns the number of elements in
-** an array.
-*/
-#define ArraySize(X) (sizeof(X)/sizeof(X[0]))
-
-/*
-** Forward references to structures
-*/
-typedef struct Column Column;
-typedef struct Table Table;
-typedef struct Index Index;
-typedef struct Instruction Instruction;
-typedef struct Expr Expr;
-typedef struct ExprList ExprList;
-typedef struct Parse Parse;
-typedef struct Token Token;
-typedef struct IdList IdList;
-typedef struct SrcList SrcList;
-typedef struct WhereInfo WhereInfo;
-typedef struct WhereLevel WhereLevel;
-typedef struct Select Select;
-typedef struct AggExpr AggExpr;
-typedef struct FuncDef FuncDef;
-typedef struct Trigger Trigger;
-typedef struct TriggerStep TriggerStep;
-typedef struct TriggerStack TriggerStack;
-typedef struct FKey FKey;
-typedef struct Db Db;
-typedef struct AuthContext AuthContext;
-
-/*
-** Each database file to be accessed by the system is an instance
-** of the following structure. There are normally two of these structures
-** in the sqlite.aDb[] array. aDb[0] is the main database file and
-** aDb[1] is the database file used to hold temporary tables. Additional
-** databases may be attached.
-*/
-struct Db {
- char *zName; /* Name of this database */
- Btree *pBt; /* The B*Tree structure for this database file */
- int schema_cookie; /* Database schema version number for this file */
- Hash tblHash; /* All tables indexed by name */
- Hash idxHash; /* All (named) indices indexed by name */
- Hash trigHash; /* All triggers indexed by name */
- Hash aFKey; /* Foreign keys indexed by to-table */
- u8 inTrans; /* 0: not writable. 1: Transaction. 2: Checkpoint */
- u16 flags; /* Flags associated with this database */
- void *pAux; /* Auxiliary data. Usually NULL */
- void (*xFreeAux)(void*); /* Routine to free pAux */
-};
-
-/*
-** These macros can be used to test, set, or clear bits in the
-** Db.flags field.
-*/
-#define DbHasProperty(D,I,P) (((D)->aDb[I].flags&(P))==(P))
-#define DbHasAnyProperty(D,I,P) (((D)->aDb[I].flags&(P))!=0)
-#define DbSetProperty(D,I,P) (D)->aDb[I].flags|=(P)
-#define DbClearProperty(D,I,P) (D)->aDb[I].flags&=~(P)
-
-/*
-** Allowed values for the DB.flags field.
-**
-** The DB_Locked flag is set when the first OP_Transaction or OP_Checkpoint
-** opcode is emitted for a database. This prevents multiple occurances
-** of those opcodes for the same database in the same program. Similarly,
-** the DB_Cookie flag is set when the OP_VerifyCookie opcode is emitted,
-** and prevents duplicate OP_VerifyCookies from taking up space and slowing
-** down execution.
-**
-** The DB_SchemaLoaded flag is set after the database schema has been
-** read into internal hash tables.
-**
-** DB_UnresetViews means that one or more views have column names that
-** have been filled out. If the schema changes, these column names might
-** changes and so the view will need to be reset.
-*/
-#define DB_Locked 0x0001 /* OP_Transaction opcode has been emitted */
-#define DB_Cookie 0x0002 /* OP_VerifyCookie opcode has been emiited */
-#define DB_SchemaLoaded 0x0004 /* The schema has been loaded */
-#define DB_UnresetViews 0x0008 /* Some views have defined column names */
-
-
-/*
-** Each database is an instance of the following structure.
-**
-** The sqlite.file_format is initialized by the database file
-** and helps determines how the data in the database file is
-** represented. This field allows newer versions of the library
-** to read and write older databases. The various file formats
-** are as follows:
-**
-** file_format==1 Version 2.1.0.
-** file_format==2 Version 2.2.0. Add support for INTEGER PRIMARY KEY.
-** file_format==3 Version 2.6.0. Fix empty-string index bug.
-** file_format==4 Version 2.7.0. Add support for separate numeric and
-** text datatypes.
-**
-** The sqlite.temp_store determines where temporary database files
-** are stored. If 1, then a file is created to hold those tables. If
-** 2, then they are held in memory. 0 means use the default value in
-** the TEMP_STORE macro.
-**
-** The sqlite.lastRowid records the last insert rowid generated by an
-** insert statement. Inserts on views do not affect its value. Each
-** trigger has its own context, so that lastRowid can be updated inside
-** triggers as usual. The previous value will be restored once the trigger
-** exits. Upon entering a before or instead of trigger, lastRowid is no
-** longer (since after version 2.8.12) reset to -1.
-**
-** The sqlite.nChange does not count changes within triggers and keeps no
-** context. It is reset at start of sqlite_exec.
-** The sqlite.lsChange represents the number of changes made by the last
-** insert, update, or delete statement. It remains constant throughout the
-** length of a statement and is then updated by OP_SetCounts. It keeps a
-** context stack just like lastRowid so that the count of changes
-** within a trigger is not seen outside the trigger. Changes to views do not
-** affect the value of lsChange.
-** The sqlite.csChange keeps track of the number of current changes (since
-** the last statement) and is used to update sqlite_lsChange.
-*/
-struct sqlite {
- int nDb; /* Number of backends currently in use */
- Db *aDb; /* All backends */
- Db aDbStatic[2]; /* Static space for the 2 default backends */
- int flags; /* Miscellanous flags. See below */
- u8 file_format; /* What file format version is this database? */
- u8 safety_level; /* How aggressive at synching data to disk */
- u8 want_to_close; /* Close after all VDBEs are deallocated */
- u8 temp_store; /* 1=file, 2=memory, 0=compile-time default */
- u8 onError; /* Default conflict algorithm */
- int next_cookie; /* Next value of aDb[0].schema_cookie */
- int cache_size; /* Number of pages to use in the cache */
- int nTable; /* Number of tables in the database */
- void *pBusyArg; /* 1st Argument to the busy callback */
- int (*xBusyCallback)(void *,const char*,int); /* The busy callback */
- void *pCommitArg; /* Argument to xCommitCallback() */
- int (*xCommitCallback)(void*);/* Invoked at every commit. */
- Hash aFunc; /* All functions that can be in SQL exprs */
- int lastRowid; /* ROWID of most recent insert (see above) */
- int priorNewRowid; /* Last randomly generated ROWID */
- int magic; /* Magic number for detect library misuse */
- int nChange; /* Number of rows changed (see above) */
- int lsChange; /* Last statement change count (see above) */
- int csChange; /* Current statement change count (see above) */
- struct sqliteInitInfo { /* Information used during initialization */
- int iDb; /* When back is being initialized */
- int newTnum; /* Rootpage of table being initialized */
- u8 busy; /* TRUE if currently initializing */
- } init;
- struct Vdbe *pVdbe; /* List of active virtual machines */
- void (*xTrace)(void*,const char*); /* Trace function */
- void *pTraceArg; /* Argument to the trace function */
-#ifndef SQLITE_OMIT_AUTHORIZATION
- int (*xAuth)(void*,int,const char*,const char*,const char*,const char*);
- /* Access authorization function */
- void *pAuthArg; /* 1st argument to the access auth function */
-#endif
-#ifndef SQLITE_OMIT_PROGRESS_CALLBACK
- int (*xProgress)(void *); /* The progress callback */
- void *pProgressArg; /* Argument to the progress callback */
- int nProgressOps; /* Number of opcodes for progress callback */
-#endif
-};
-
-/*
-** Possible values for the sqlite.flags and or Db.flags fields.
-**
-** On sqlite.flags, the SQLITE_InTrans value means that we have
-** executed a BEGIN. On Db.flags, SQLITE_InTrans means a statement
-** transaction is active on that particular database file.
-*/
-#define SQLITE_VdbeTrace 0x00000001 /* True to trace VDBE execution */
-#define SQLITE_Initialized 0x00000002 /* True after initialization */
-#define SQLITE_Interrupt 0x00000004 /* Cancel current operation */
-#define SQLITE_InTrans 0x00000008 /* True if in a transaction */
-#define SQLITE_InternChanges 0x00000010 /* Uncommitted Hash table changes */
-#define SQLITE_FullColNames 0x00000020 /* Show full column names on SELECT */
-#define SQLITE_ShortColNames 0x00000040 /* Show short columns names */
-#define SQLITE_CountRows 0x00000080 /* Count rows changed by INSERT, */
- /* DELETE, or UPDATE and return */
- /* the count using a callback. */
-#define SQLITE_NullCallback 0x00000100 /* Invoke the callback once if the */
- /* result set is empty */
-#define SQLITE_ReportTypes 0x00000200 /* Include information on datatypes */
- /* in 4th argument of callback */
-
-/*
-** Possible values for the sqlite.magic field.
-** The numbers are obtained at random and have no special meaning, other
-** than being distinct from one another.
-*/
-#define SQLITE_MAGIC_OPEN 0xa029a697 /* Database is open */
-#define SQLITE_MAGIC_CLOSED 0x9f3c2d33 /* Database is closed */
-#define SQLITE_MAGIC_BUSY 0xf03b7906 /* Database currently in use */
-#define SQLITE_MAGIC_ERROR 0xb5357930 /* An SQLITE_MISUSE error occurred */
-
-/*
-** Each SQL function is defined by an instance of the following
-** structure. A pointer to this structure is stored in the sqlite.aFunc
-** hash table. When multiple functions have the same name, the hash table
-** points to a linked list of these structures.
-*/
-struct FuncDef {
- void (*xFunc)(sqlite_func*,int,const char**); /* Regular function */
- void (*xStep)(sqlite_func*,int,const char**); /* Aggregate function step */
- void (*xFinalize)(sqlite_func*); /* Aggregate function finializer */
- signed char nArg; /* Number of arguments. -1 means unlimited */
- signed char dataType; /* Arg that determines datatype. -1=NUMERIC, */
- /* -2=TEXT. -3=SQLITE_ARGS */
- u8 includeTypes; /* Add datatypes to args of xFunc and xStep */
- void *pUserData; /* User data parameter */
- FuncDef *pNext; /* Next function with same name */
-};
-
-/*
-** information about each column of an SQL table is held in an instance
-** of this structure.
-*/
-struct Column {
- char *zName; /* Name of this column */
- char *zDflt; /* Default value of this column */
- char *zType; /* Data type for this column */
- u8 notNull; /* True if there is a NOT NULL constraint */
- u8 isPrimKey; /* True if this column is part of the PRIMARY KEY */
- u8 sortOrder; /* Some combination of SQLITE_SO_... values */
- u8 dottedName; /* True if zName contains a "." character */
-};
-
-/*
-** The allowed sort orders.
-**
-** The TEXT and NUM values use bits that do not overlap with DESC and ASC.
-** That way the two can be combined into a single number.
-*/
-#define SQLITE_SO_UNK 0 /* Use the default collating type. (SCT_NUM) */
-#define SQLITE_SO_TEXT 2 /* Sort using memcmp() */
-#define SQLITE_SO_NUM 4 /* Sort using sqliteCompare() */
-#define SQLITE_SO_TYPEMASK 6 /* Mask to extract the collating sequence */
-#define SQLITE_SO_ASC 0 /* Sort in ascending order */
-#define SQLITE_SO_DESC 1 /* Sort in descending order */
-#define SQLITE_SO_DIRMASK 1 /* Mask to extract the sort direction */
-
-/*
-** Each SQL table is represented in memory by an instance of the
-** following structure.
-**
-** Table.zName is the name of the table. The case of the original
-** CREATE TABLE statement is stored, but case is not significant for
-** comparisons.
-**
-** Table.nCol is the number of columns in this table. Table.aCol is a
-** pointer to an array of Column structures, one for each column.
-**
-** If the table has an INTEGER PRIMARY KEY, then Table.iPKey is the index of
-** the column that is that key. Otherwise Table.iPKey is negative. Note
-** that the datatype of the PRIMARY KEY must be INTEGER for this field to
-** be set. An INTEGER PRIMARY KEY is used as the rowid for each row of
-** the table. If a table has no INTEGER PRIMARY KEY, then a random rowid
-** is generated for each row of the table. Table.hasPrimKey is true if
-** the table has any PRIMARY KEY, INTEGER or otherwise.
-**
-** Table.tnum is the page number for the root BTree page of the table in the
-** database file. If Table.iDb is the index of the database table backend
-** in sqlite.aDb[]. 0 is for the main database and 1 is for the file that
-** holds temporary tables and indices. If Table.isTransient
-** is true, then the table is stored in a file that is automatically deleted
-** when the VDBE cursor to the table is closed. In this case Table.tnum
-** refers VDBE cursor number that holds the table open, not to the root
-** page number. Transient tables are used to hold the results of a
-** sub-query that appears instead of a real table name in the FROM clause
-** of a SELECT statement.
-*/
-struct Table {
- char *zName; /* Name of the table */
- int nCol; /* Number of columns in this table */
- Column *aCol; /* Information about each column */
- int iPKey; /* If not less then 0, use aCol[iPKey] as the primary key */
- Index *pIndex; /* List of SQL indexes on this table. */
- int tnum; /* Root BTree node for this table (see note above) */
- Select *pSelect; /* NULL for tables. Points to definition if a view. */
- u8 readOnly; /* True if this table should not be written by the user */
- u8 iDb; /* Index into sqlite.aDb[] of the backend for this table */
- u8 isTransient; /* True if automatically deleted when VDBE finishes */
- u8 hasPrimKey; /* True if there exists a primary key */
- u8 keyConf; /* What to do in case of uniqueness conflict on iPKey */
- Trigger *pTrigger; /* List of SQL triggers on this table */
- FKey *pFKey; /* Linked list of all foreign keys in this table */
-};
-
-/*
-** Each foreign key constraint is an instance of the following structure.
-**
-** A foreign key is associated with two tables. The "from" table is
-** the table that contains the REFERENCES clause that creates the foreign
-** key. The "to" table is the table that is named in the REFERENCES clause.
-** Consider this example:
-**
-** CREATE TABLE ex1(
-** a INTEGER PRIMARY KEY,
-** b INTEGER CONSTRAINT fk1 REFERENCES ex2(x)
-** );
-**
-** For foreign key "fk1", the from-table is "ex1" and the to-table is "ex2".
-**
-** Each REFERENCES clause generates an instance of the following structure
-** which is attached to the from-table. The to-table need not exist when
-** the from-table is created. The existance of the to-table is not checked
-** until an attempt is made to insert data into the from-table.
-**
-** The sqlite.aFKey hash table stores pointers to this structure
-** given the name of a to-table. For each to-table, all foreign keys
-** associated with that table are on a linked list using the FKey.pNextTo
-** field.
-*/
-struct FKey {
- Table *pFrom; /* The table that constains the REFERENCES clause */
- FKey *pNextFrom; /* Next foreign key in pFrom */
- char *zTo; /* Name of table that the key points to */
- FKey *pNextTo; /* Next foreign key that points to zTo */
- int nCol; /* Number of columns in this key */
- struct sColMap { /* Mapping of columns in pFrom to columns in zTo */
- int iFrom; /* Index of column in pFrom */
- char *zCol; /* Name of column in zTo. If 0 use PRIMARY KEY */
- } *aCol; /* One entry for each of nCol column s */
- u8 isDeferred; /* True if constraint checking is deferred till COMMIT */
- u8 updateConf; /* How to resolve conflicts that occur on UPDATE */
- u8 deleteConf; /* How to resolve conflicts that occur on DELETE */
- u8 insertConf; /* How to resolve conflicts that occur on INSERT */
-};
-
-/*
-** SQLite supports many different ways to resolve a contraint
-** error. ROLLBACK processing means that a constraint violation
-** causes the operation in process to fail and for the current transaction
-** to be rolled back. ABORT processing means the operation in process
-** fails and any prior changes from that one operation are backed out,
-** but the transaction is not rolled back. FAIL processing means that
-** the operation in progress stops and returns an error code. But prior
-** changes due to the same operation are not backed out and no rollback
-** occurs. IGNORE means that the particular row that caused the constraint
-** error is not inserted or updated. Processing continues and no error
-** is returned. REPLACE means that preexisting database rows that caused
-** a UNIQUE constraint violation are removed so that the new insert or
-** update can proceed. Processing continues and no error is reported.
-**
-** RESTRICT, SETNULL, and CASCADE actions apply only to foreign keys.
-** RESTRICT is the same as ABORT for IMMEDIATE foreign keys and the
-** same as ROLLBACK for DEFERRED keys. SETNULL means that the foreign
-** key is set to NULL. CASCADE means that a DELETE or UPDATE of the
-** referenced table row is propagated into the row that holds the
-** foreign key.
-**
-** The following symbolic values are used to record which type
-** of action to take.
-*/
-#define OE_None 0 /* There is no constraint to check */
-#define OE_Rollback 1 /* Fail the operation and rollback the transaction */
-#define OE_Abort 2 /* Back out changes but do no rollback transaction */
-#define OE_Fail 3 /* Stop the operation but leave all prior changes */
-#define OE_Ignore 4 /* Ignore the error. Do not do the INSERT or UPDATE */
-#define OE_Replace 5 /* Delete existing record, then do INSERT or UPDATE */
-
-#define OE_Restrict 6 /* OE_Abort for IMMEDIATE, OE_Rollback for DEFERRED */
-#define OE_SetNull 7 /* Set the foreign key value to NULL */
-#define OE_SetDflt 8 /* Set the foreign key value to its default */
-#define OE_Cascade 9 /* Cascade the changes */
-
-#define OE_Default 99 /* Do whatever the default action is */
-
-/*
-** Each SQL index is represented in memory by an
-** instance of the following structure.
-**
-** The columns of the table that are to be indexed are described
-** by the aiColumn[] field of this structure. For example, suppose
-** we have the following table and index:
-**
-** CREATE TABLE Ex1(c1 int, c2 int, c3 text);
-** CREATE INDEX Ex2 ON Ex1(c3,c1);
-**
-** In the Table structure describing Ex1, nCol==3 because there are
-** three columns in the table. In the Index structure describing
-** Ex2, nColumn==2 since 2 of the 3 columns of Ex1 are indexed.
-** The value of aiColumn is {2, 0}. aiColumn[0]==2 because the
-** first column to be indexed (c3) has an index of 2 in Ex1.aCol[].
-** The second column to be indexed (c1) has an index of 0 in
-** Ex1.aCol[], hence Ex2.aiColumn[1]==0.
-**
-** The Index.onError field determines whether or not the indexed columns
-** must be unique and what to do if they are not. When Index.onError=OE_None,
-** it means this is not a unique index. Otherwise it is a unique index
-** and the value of Index.onError indicate the which conflict resolution
-** algorithm to employ whenever an attempt is made to insert a non-unique
-** element.
-*/
-struct Index {
- char *zName; /* Name of this index */
- int nColumn; /* Number of columns in the table used by this index */
- int *aiColumn; /* Which columns are used by this index. 1st is 0 */
- Table *pTable; /* The SQL table being indexed */
- int tnum; /* Page containing root of this index in database file */
- u8 onError; /* OE_Abort, OE_Ignore, OE_Replace, or OE_None */
- u8 autoIndex; /* True if is automatically created (ex: by UNIQUE) */
- u8 iDb; /* Index in sqlite.aDb[] of where this index is stored */
- Index *pNext; /* The next index associated with the same table */
-};
-
-/*
-** Each token coming out of the lexer is an instance of
-** this structure. Tokens are also used as part of an expression.
-**
-** Note if Token.z==0 then Token.dyn and Token.n are undefined and
-** may contain random values. Do not make any assuptions about Token.dyn
-** and Token.n when Token.z==0.
-*/
-struct Token {
- const char *z; /* Text of the token. Not NULL-terminated! */
- unsigned dyn : 1; /* True for malloced memory, false for static */
- unsigned n : 31; /* Number of characters in this token */
-};
-
-/*
-** Each node of an expression in the parse tree is an instance
-** of this structure.
-**
-** Expr.op is the opcode. The integer parser token codes are reused
-** as opcodes here. For example, the parser defines TK_GE to be an integer
-** code representing the ">=" operator. This same integer code is reused
-** to represent the greater-than-or-equal-to operator in the expression
-** tree.
-**
-** Expr.pRight and Expr.pLeft are subexpressions. Expr.pList is a list
-** of argument if the expression is a function.
-**
-** Expr.token is the operator token for this node. For some expressions
-** that have subexpressions, Expr.token can be the complete text that gave
-** rise to the Expr. In the latter case, the token is marked as being
-** a compound token.
-**
-** An expression of the form ID or ID.ID refers to a column in a table.
-** For such expressions, Expr.op is set to TK_COLUMN and Expr.iTable is
-** the integer cursor number of a VDBE cursor pointing to that table and
-** Expr.iColumn is the column number for the specific column. If the
-** expression is used as a result in an aggregate SELECT, then the
-** value is also stored in the Expr.iAgg column in the aggregate so that
-** it can be accessed after all aggregates are computed.
-**
-** If the expression is a function, the Expr.iTable is an integer code
-** representing which function. If the expression is an unbound variable
-** marker (a question mark character '?' in the original SQL) then the
-** Expr.iTable holds the index number for that variable.
-**
-** The Expr.pSelect field points to a SELECT statement. The SELECT might
-** be the right operand of an IN operator. Or, if a scalar SELECT appears
-** in an expression the opcode is TK_SELECT and Expr.pSelect is the only
-** operand.
-*/
-struct Expr {
- u8 op; /* Operation performed by this node */
- u8 dataType; /* Either SQLITE_SO_TEXT or SQLITE_SO_NUM */
- u8 iDb; /* Database referenced by this expression */
- u8 flags; /* Various flags. See below */
- Expr *pLeft, *pRight; /* Left and right subnodes */
- ExprList *pList; /* A list of expressions used as function arguments
- ** or in "<expr> IN (<expr-list)" */
- Token token; /* An operand token */
- Token span; /* Complete text of the expression */
- int iTable, iColumn; /* When op==TK_COLUMN, then this expr node means the
- ** iColumn-th field of the iTable-th table. */
- int iAgg; /* When op==TK_COLUMN and pParse->useAgg==TRUE, pull
- ** result from the iAgg-th element of the aggregator */
- Select *pSelect; /* When the expression is a sub-select. Also the
- ** right side of "<expr> IN (<select>)" */
-};
-
-/*
-** The following are the meanings of bits in the Expr.flags field.
-*/
-#define EP_FromJoin 0x0001 /* Originated in ON or USING clause of a join */
-
-/*
-** These macros can be used to test, set, or clear bits in the
-** Expr.flags field.
-*/
-#define ExprHasProperty(E,P) (((E)->flags&(P))==(P))
-#define ExprHasAnyProperty(E,P) (((E)->flags&(P))!=0)
-#define ExprSetProperty(E,P) (E)->flags|=(P)
-#define ExprClearProperty(E,P) (E)->flags&=~(P)
-
-/*
-** A list of expressions. Each expression may optionally have a
-** name. An expr/name combination can be used in several ways, such
-** as the list of "expr AS ID" fields following a "SELECT" or in the
-** list of "ID = expr" items in an UPDATE. A list of expressions can
-** also be used as the argument to a function, in which case the a.zName
-** field is not used.
-*/
-struct ExprList {
- int nExpr; /* Number of expressions on the list */
- int nAlloc; /* Number of entries allocated below */
- struct ExprList_item {
- Expr *pExpr; /* The list of expressions */
- char *zName; /* Token associated with this expression */
- u8 sortOrder; /* 1 for DESC or 0 for ASC */
- u8 isAgg; /* True if this is an aggregate like count(*) */
- u8 done; /* A flag to indicate when processing is finished */
- } *a; /* One entry for each expression */
-};
-
-/*
-** An instance of this structure can hold a simple list of identifiers,
-** such as the list "a,b,c" in the following statements:
-**
-** INSERT INTO t(a,b,c) VALUES ...;
-** CREATE INDEX idx ON t(a,b,c);
-** CREATE TRIGGER trig BEFORE UPDATE ON t(a,b,c) ...;
-**
-** The IdList.a.idx field is used when the IdList represents the list of
-** column names after a table name in an INSERT statement. In the statement
-**
-** INSERT INTO t(a,b,c) ...
-**
-** If "a" is the k-th column of table "t", then IdList.a[0].idx==k.
-*/
-struct IdList {
- int nId; /* Number of identifiers on the list */
- int nAlloc; /* Number of entries allocated for a[] below */
- struct IdList_item {
- char *zName; /* Name of the identifier */
- int idx; /* Index in some Table.aCol[] of a column named zName */
- } *a;
-};
-
-/*
-** The following structure describes the FROM clause of a SELECT statement.
-** Each table or subquery in the FROM clause is a separate element of
-** the SrcList.a[] array.
-**
-** With the addition of multiple database support, the following structure
-** can also be used to describe a particular table such as the table that
-** is modified by an INSERT, DELETE, or UPDATE statement. In standard SQL,
-** such a table must be a simple name: ID. But in SQLite, the table can
-** now be identified by a database name, a dot, then the table name: ID.ID.
-*/
-struct SrcList {
- i16 nSrc; /* Number of tables or subqueries in the FROM clause */
- i16 nAlloc; /* Number of entries allocated in a[] below */
- struct SrcList_item {
- char *zDatabase; /* Name of database holding this table */
- char *zName; /* Name of the table */
- char *zAlias; /* The "B" part of a "A AS B" phrase. zName is the "A" */
- Table *pTab; /* An SQL table corresponding to zName */
- Select *pSelect; /* A SELECT statement used in place of a table name */
- int jointype; /* Type of join between this table and the next */
- int iCursor; /* The VDBE cursor number used to access this table */
- Expr *pOn; /* The ON clause of a join */
- IdList *pUsing; /* The USING clause of a join */
- } a[1]; /* One entry for each identifier on the list */
-};
-
-/*
-** Permitted values of the SrcList.a.jointype field
-*/
-#define JT_INNER 0x0001 /* Any kind of inner or cross join */
-#define JT_NATURAL 0x0002 /* True for a "natural" join */
-#define JT_LEFT 0x0004 /* Left outer join */
-#define JT_RIGHT 0x0008 /* Right outer join */
-#define JT_OUTER 0x0010 /* The "OUTER" keyword is present */
-#define JT_ERROR 0x0020 /* unknown or unsupported join type */
-
-/*
-** For each nested loop in a WHERE clause implementation, the WhereInfo
-** structure contains a single instance of this structure. This structure
-** is intended to be private the the where.c module and should not be
-** access or modified by other modules.
-*/
-struct WhereLevel {
- int iMem; /* Memory cell used by this level */
- Index *pIdx; /* Index used */
- int iCur; /* Cursor number used for this index */
- int score; /* How well this indexed scored */
- int brk; /* Jump here to break out of the loop */
- int cont; /* Jump here to continue with the next loop cycle */
- int op, p1, p2; /* Opcode used to terminate the loop */
- int iLeftJoin; /* Memory cell used to implement LEFT OUTER JOIN */
- int top; /* First instruction of interior of the loop */
- int inOp, inP1, inP2;/* Opcode used to implement an IN operator */
- int bRev; /* Do the scan in the reverse direction */
-};
-
-/*
-** The WHERE clause processing routine has two halves. The
-** first part does the start of the WHERE loop and the second
-** half does the tail of the WHERE loop. An instance of
-** this structure is returned by the first half and passed
-** into the second half to give some continuity.
-*/
-struct WhereInfo {
- Parse *pParse;
- SrcList *pTabList; /* List of tables in the join */
- int iContinue; /* Jump here to continue with next record */
- int iBreak; /* Jump here to break out of the loop */
- int nLevel; /* Number of nested loop */
- int savedNTab; /* Value of pParse->nTab before WhereBegin() */
- int peakNTab; /* Value of pParse->nTab after WhereBegin() */
- WhereLevel a[1]; /* Information about each nest loop in the WHERE */
-};
-
-/*
-** An instance of the following structure contains all information
-** needed to generate code for a single SELECT statement.
-**
-** The zSelect field is used when the Select structure must be persistent.
-** Normally, the expression tree points to tokens in the original input
-** string that encodes the select. But if the Select structure must live
-** longer than its input string (for example when it is used to describe
-** a VIEW) we have to make a copy of the input string so that the nodes
-** of the expression tree will have something to point to. zSelect is used
-** to hold that copy.
-**
-** nLimit is set to -1 if there is no LIMIT clause. nOffset is set to 0.
-** If there is a LIMIT clause, the parser sets nLimit to the value of the
-** limit and nOffset to the value of the offset (or 0 if there is not
-** offset). But later on, nLimit and nOffset become the memory locations
-** in the VDBE that record the limit and offset counters.
-*/
-struct Select {
- ExprList *pEList; /* The fields of the result */
- u8 op; /* One of: TK_UNION TK_ALL TK_INTERSECT TK_EXCEPT */
- u8 isDistinct; /* True if the DISTINCT keyword is present */
- SrcList *pSrc; /* The FROM clause */
- Expr *pWhere; /* The WHERE clause */
- ExprList *pGroupBy; /* The GROUP BY clause */
- Expr *pHaving; /* The HAVING clause */
- ExprList *pOrderBy; /* The ORDER BY clause */
- Select *pPrior; /* Prior select in a compound select statement */
- int nLimit, nOffset; /* LIMIT and OFFSET values. -1 means not used */
- int iLimit, iOffset; /* Memory registers holding LIMIT & OFFSET counters */
- char *zSelect; /* Complete text of the SELECT command */
-};
-
-/*
-** The results of a select can be distributed in several ways.
-*/
-#define SRT_Callback 1 /* Invoke a callback with each row of result */
-#define SRT_Mem 2 /* Store result in a memory cell */
-#define SRT_Set 3 /* Store result as unique keys in a table */
-#define SRT_Union 5 /* Store result as keys in a table */
-#define SRT_Except 6 /* Remove result from a UNION table */
-#define SRT_Table 7 /* Store result as data with a unique key */
-#define SRT_TempTable 8 /* Store result in a trasient table */
-#define SRT_Discard 9 /* Do not save the results anywhere */
-#define SRT_Sorter 10 /* Store results in the sorter */
-#define SRT_Subroutine 11 /* Call a subroutine to handle results */
-
-/*
-** When a SELECT uses aggregate functions (like "count(*)" or "avg(f1)")
-** we have to do some additional analysis of expressions. An instance
-** of the following structure holds information about a single subexpression
-** somewhere in the SELECT statement. An array of these structures holds
-** all the information we need to generate code for aggregate
-** expressions.
-**
-** Note that when analyzing a SELECT containing aggregates, both
-** non-aggregate field variables and aggregate functions are stored
-** in the AggExpr array of the Parser structure.
-**
-** The pExpr field points to an expression that is part of either the
-** field list, the GROUP BY clause, the HAVING clause or the ORDER BY
-** clause. The expression will be freed when those clauses are cleaned
-** up. Do not try to delete the expression attached to AggExpr.pExpr.
-**
-** If AggExpr.pExpr==0, that means the expression is "count(*)".
-*/
-struct AggExpr {
- int isAgg; /* if TRUE contains an aggregate function */
- Expr *pExpr; /* The expression */
- FuncDef *pFunc; /* Information about the aggregate function */
-};
-
-/*
-** An SQL parser context. A copy of this structure is passed through
-** the parser and down into all the parser action routine in order to
-** carry around information that is global to the entire parse.
-*/
-struct Parse {
- sqlite *db; /* The main database structure */
- int rc; /* Return code from execution */
- char *zErrMsg; /* An error message */
- Token sErrToken; /* The token at which the error occurred */
- Token sFirstToken; /* The first token parsed */
- Token sLastToken; /* The last token parsed */
- const char *zTail; /* All SQL text past the last semicolon parsed */
- Table *pNewTable; /* A table being constructed by CREATE TABLE */
- Vdbe *pVdbe; /* An engine for executing database bytecode */
- u8 colNamesSet; /* TRUE after OP_ColumnName has been issued to pVdbe */
- u8 explain; /* True if the EXPLAIN flag is found on the query */
- u8 nameClash; /* A permanent table name clashes with temp table name */
- u8 useAgg; /* If true, extract field values from the aggregator
- ** while generating expressions. Normally false */
- int nErr; /* Number of errors seen */
- int nTab; /* Number of previously allocated VDBE cursors */
- int nMem; /* Number of memory cells used so far */
- int nSet; /* Number of sets used so far */
- int nAgg; /* Number of aggregate expressions */
- int nVar; /* Number of '?' variables seen in the SQL so far */
- AggExpr *aAgg; /* An array of aggregate expressions */
- const char *zAuthContext; /* The 6th parameter to db->xAuth callbacks */
- Trigger *pNewTrigger; /* Trigger under construct by a CREATE TRIGGER */
- TriggerStack *trigStack; /* Trigger actions being coded */
-};
-
-/*
-** An instance of the following structure can be declared on a stack and used
-** to save the Parse.zAuthContext value so that it can be restored later.
-*/
-struct AuthContext {
- const char *zAuthContext; /* Put saved Parse.zAuthContext here */
- Parse *pParse; /* The Parse structure */
-};
-
-/*
-** Bitfield flags for P2 value in OP_PutIntKey and OP_Delete
-*/
-#define OPFLAG_NCHANGE 1 /* Set to update db->nChange */
-#define OPFLAG_LASTROWID 2 /* Set to update db->lastRowid */
-#define OPFLAG_CSCHANGE 4 /* Set to update db->csChange */
-
-/*
- * Each trigger present in the database schema is stored as an instance of
- * struct Trigger.
- *
- * Pointers to instances of struct Trigger are stored in two ways.
- * 1. In the "trigHash" hash table (part of the sqlite* that represents the
- * database). This allows Trigger structures to be retrieved by name.
- * 2. All triggers associated with a single table form a linked list, using the
- * pNext member of struct Trigger. A pointer to the first element of the
- * linked list is stored as the "pTrigger" member of the associated
- * struct Table.
- *
- * The "step_list" member points to the first element of a linked list
- * containing the SQL statements specified as the trigger program.
- */
-struct Trigger {
- char *name; /* The name of the trigger */
- char *table; /* The table or view to which the trigger applies */
- u8 iDb; /* Database containing this trigger */
- u8 iTabDb; /* Database containing Trigger.table */
- u8 op; /* One of TK_DELETE, TK_UPDATE, TK_INSERT */
- u8 tr_tm; /* One of TK_BEFORE, TK_AFTER */
- Expr *pWhen; /* The WHEN clause of the expresion (may be NULL) */
- IdList *pColumns; /* If this is an UPDATE OF <column-list> trigger,
- the <column-list> is stored here */
- int foreach; /* One of TK_ROW or TK_STATEMENT */
- Token nameToken; /* Token containing zName. Use during parsing only */
-
- TriggerStep *step_list; /* Link list of trigger program steps */
- Trigger *pNext; /* Next trigger associated with the table */
-};
-
-/*
- * An instance of struct TriggerStep is used to store a single SQL statement
- * that is a part of a trigger-program.
- *
- * Instances of struct TriggerStep are stored in a singly linked list (linked
- * using the "pNext" member) referenced by the "step_list" member of the
- * associated struct Trigger instance. The first element of the linked list is
- * the first step of the trigger-program.
- *
- * The "op" member indicates whether this is a "DELETE", "INSERT", "UPDATE" or
- * "SELECT" statement. The meanings of the other members is determined by the
- * value of "op" as follows:
- *
- * (op == TK_INSERT)
- * orconf -> stores the ON CONFLICT algorithm
- * pSelect -> If this is an INSERT INTO ... SELECT ... statement, then
- * this stores a pointer to the SELECT statement. Otherwise NULL.
- * target -> A token holding the name of the table to insert into.
- * pExprList -> If this is an INSERT INTO ... VALUES ... statement, then
- * this stores values to be inserted. Otherwise NULL.
- * pIdList -> If this is an INSERT INTO ... (<column-names>) VALUES ...
- * statement, then this stores the column-names to be
- * inserted into.
- *
- * (op == TK_DELETE)
- * target -> A token holding the name of the table to delete from.
- * pWhere -> The WHERE clause of the DELETE statement if one is specified.
- * Otherwise NULL.
- *
- * (op == TK_UPDATE)
- * target -> A token holding the name of the table to update rows of.
- * pWhere -> The WHERE clause of the UPDATE statement if one is specified.
- * Otherwise NULL.
- * pExprList -> A list of the columns to update and the expressions to update
- * them to. See sqliteUpdate() documentation of "pChanges"
- * argument.
- *
- */
-struct TriggerStep {
- int op; /* One of TK_DELETE, TK_UPDATE, TK_INSERT, TK_SELECT */
- int orconf; /* OE_Rollback etc. */
- Trigger *pTrig; /* The trigger that this step is a part of */
-
- Select *pSelect; /* Valid for SELECT and sometimes
- INSERT steps (when pExprList == 0) */
- Token target; /* Valid for DELETE, UPDATE, INSERT steps */
- Expr *pWhere; /* Valid for DELETE, UPDATE steps */
- ExprList *pExprList; /* Valid for UPDATE statements and sometimes
- INSERT steps (when pSelect == 0) */
- IdList *pIdList; /* Valid for INSERT statements only */
-
- TriggerStep * pNext; /* Next in the link-list */
-};
-
-/*
- * An instance of struct TriggerStack stores information required during code
- * generation of a single trigger program. While the trigger program is being
- * coded, its associated TriggerStack instance is pointed to by the
- * "pTriggerStack" member of the Parse structure.
- *
- * The pTab member points to the table that triggers are being coded on. The
- * newIdx member contains the index of the vdbe cursor that points at the temp
- * table that stores the new.* references. If new.* references are not valid
- * for the trigger being coded (for example an ON DELETE trigger), then newIdx
- * is set to -1. The oldIdx member is analogous to newIdx, for old.* references.
- *
- * The ON CONFLICT policy to be used for the trigger program steps is stored
- * as the orconf member. If this is OE_Default, then the ON CONFLICT clause
- * specified for individual triggers steps is used.
- *
- * struct TriggerStack has a "pNext" member, to allow linked lists to be
- * constructed. When coding nested triggers (triggers fired by other triggers)
- * each nested trigger stores its parent trigger's TriggerStack as the "pNext"
- * pointer. Once the nested trigger has been coded, the pNext value is restored
- * to the pTriggerStack member of the Parse stucture and coding of the parent
- * trigger continues.
- *
- * Before a nested trigger is coded, the linked list pointed to by the
- * pTriggerStack is scanned to ensure that the trigger is not about to be coded
- * recursively. If this condition is detected, the nested trigger is not coded.
- */
-struct TriggerStack {
- Table *pTab; /* Table that triggers are currently being coded on */
- int newIdx; /* Index of vdbe cursor to "new" temp table */
- int oldIdx; /* Index of vdbe cursor to "old" temp table */
- int orconf; /* Current orconf policy */
- int ignoreJump; /* where to jump to for a RAISE(IGNORE) */
- Trigger *pTrigger; /* The trigger currently being coded */
- TriggerStack *pNext; /* Next trigger down on the trigger stack */
-};
-
-/*
-** The following structure contains information used by the sqliteFix...
-** routines as they walk the parse tree to make database references
-** explicit.
-*/
-typedef struct DbFixer DbFixer;
-struct DbFixer {
- Parse *pParse; /* The parsing context. Error messages written here */
- const char *zDb; /* Make sure all objects are contained in this database */
- const char *zType; /* Type of the container - used for error messages */
- const Token *pName; /* Name of the container - used for error messages */
-};
-
-/*
- * This global flag is set for performance testing of triggers. When it is set
- * SQLite will perform the overhead of building new and old trigger references
- * even when no triggers exist
- */
-extern int always_code_trigger_setup;
-
-/*
-** Internal function prototypes
-*/
-int sqliteStrICmp(const char *, const char *);
-int sqliteStrNICmp(const char *, const char *, int);
-int sqliteHashNoCase(const char *, int);
-int sqliteIsNumber(const char*);
-int sqliteCompare(const char *, const char *);
-int sqliteSortCompare(const char *, const char *);
-void sqliteRealToSortable(double r, char *);
-#ifdef MEMORY_DEBUG
- void *sqliteMalloc_(int,int,char*,int);
- void sqliteFree_(void*,char*,int);
- void *sqliteRealloc_(void*,int,char*,int);
- char *sqliteStrDup_(const char*,char*,int);
- char *sqliteStrNDup_(const char*, int,char*,int);
- void sqliteCheckMemory(void*,int);
-#else
- void *sqliteMalloc(int);
- void *sqliteMallocRaw(int);
- void sqliteFree(void*);
- void *sqliteRealloc(void*,int);
- char *sqliteStrDup(const char*);
- char *sqliteStrNDup(const char*, int);
-# define sqliteCheckMemory(a,b)
-#endif
-char *sqliteMPrintf(const char*, ...);
-char *sqliteVMPrintf(const char*, va_list);
-void sqliteSetString(char **, const char *, ...);
-void sqliteSetNString(char **, ...);
-void sqliteErrorMsg(Parse*, const char*, ...);
-void sqliteDequote(char*);
-int sqliteKeywordCode(const char*, int);
-int sqliteRunParser(Parse*, const char*, char **);
-void sqliteExec(Parse*);
-Expr *sqliteExpr(int, Expr*, Expr*, Token*);
-void sqliteExprSpan(Expr*,Token*,Token*);
-Expr *sqliteExprFunction(ExprList*, Token*);
-void sqliteExprDelete(Expr*);
-ExprList *sqliteExprListAppend(ExprList*,Expr*,Token*);
-void sqliteExprListDelete(ExprList*);
-int sqliteInit(sqlite*, char**);
-void sqlitePragma(Parse*,Token*,Token*,int);
-void sqliteResetInternalSchema(sqlite*, int);
-void sqliteBeginParse(Parse*,int);
-void sqliteRollbackInternalChanges(sqlite*);
-void sqliteCommitInternalChanges(sqlite*);
-Table *sqliteResultSetOfSelect(Parse*,char*,Select*);
-void sqliteOpenMasterTable(Vdbe *v, int);
-void sqliteStartTable(Parse*,Token*,Token*,int,int);
-void sqliteAddColumn(Parse*,Token*);
-void sqliteAddNotNull(Parse*, int);
-void sqliteAddPrimaryKey(Parse*, IdList*, int);
-void sqliteAddColumnType(Parse*,Token*,Token*);
-void sqliteAddDefaultValue(Parse*,Token*,int);
-int sqliteCollateType(const char*, int);
-void sqliteAddCollateType(Parse*, int);
-void sqliteEndTable(Parse*,Token*,Select*);
-void sqliteCreateView(Parse*,Token*,Token*,Select*,int);
-int sqliteViewGetColumnNames(Parse*,Table*);
-void sqliteDropTable(Parse*, Token*, int);
-void sqliteDeleteTable(sqlite*, Table*);
-void sqliteInsert(Parse*, SrcList*, ExprList*, Select*, IdList*, int);
-IdList *sqliteIdListAppend(IdList*, Token*);
-int sqliteIdListIndex(IdList*,const char*);
-SrcList *sqliteSrcListAppend(SrcList*, Token*, Token*);
-void sqliteSrcListAddAlias(SrcList*, Token*);
-void sqliteSrcListAssignCursors(Parse*, SrcList*);
-void sqliteIdListDelete(IdList*);
-void sqliteSrcListDelete(SrcList*);
-void sqliteCreateIndex(Parse*,Token*,SrcList*,IdList*,int,Token*,Token*);
-void sqliteDropIndex(Parse*, SrcList*);
-void sqliteAddKeyType(Vdbe*, ExprList*);
-void sqliteAddIdxKeyType(Vdbe*, Index*);
-int sqliteSelect(Parse*, Select*, int, int, Select*, int, int*);
-Select *sqliteSelectNew(ExprList*,SrcList*,Expr*,ExprList*,Expr*,ExprList*,
- int,int,int);
-void sqliteSelectDelete(Select*);
-void sqliteSelectUnbind(Select*);
-Table *sqliteSrcListLookup(Parse*, SrcList*);
-int sqliteIsReadOnly(Parse*, Table*, int);
-void sqliteDeleteFrom(Parse*, SrcList*, Expr*);
-void sqliteUpdate(Parse*, SrcList*, ExprList*, Expr*, int);
-WhereInfo *sqliteWhereBegin(Parse*, SrcList*, Expr*, int, ExprList**);
-void sqliteWhereEnd(WhereInfo*);
-void sqliteExprCode(Parse*, Expr*);
-int sqliteExprCodeExprList(Parse*, ExprList*, int);
-void sqliteExprIfTrue(Parse*, Expr*, int, int);
-void sqliteExprIfFalse(Parse*, Expr*, int, int);
-Table *sqliteFindTable(sqlite*,const char*, const char*);
-Table *sqliteLocateTable(Parse*,const char*, const char*);
-Index *sqliteFindIndex(sqlite*,const char*, const char*);
-void sqliteUnlinkAndDeleteIndex(sqlite*,Index*);
-void sqliteCopy(Parse*, SrcList*, Token*, Token*, int);
-void sqliteVacuum(Parse*, Token*);
-int sqliteRunVacuum(char**, sqlite*);
-int sqliteGlobCompare(const unsigned char*,const unsigned char*);
-int sqliteLikeCompare(const unsigned char*,const unsigned char*);
-char *sqliteTableNameFromToken(Token*);
-int sqliteExprCheck(Parse*, Expr*, int, int*);
-int sqliteExprType(Expr*);
-int sqliteExprCompare(Expr*, Expr*);
-int sqliteFuncId(Token*);
-int sqliteExprResolveIds(Parse*, SrcList*, ExprList*, Expr*);
-int sqliteExprAnalyzeAggregates(Parse*, Expr*);
-Vdbe *sqliteGetVdbe(Parse*);
-void sqliteRandomness(int, void*);
-void sqliteRollbackAll(sqlite*);
-void sqliteCodeVerifySchema(Parse*, int);
-void sqliteBeginTransaction(Parse*, int);
-void sqliteCommitTransaction(Parse*);
-void sqliteRollbackTransaction(Parse*);
-int sqliteExprIsConstant(Expr*);
-int sqliteExprIsInteger(Expr*, int*);
-int sqliteIsRowid(const char*);
-void sqliteGenerateRowDelete(sqlite*, Vdbe*, Table*, int, int);
-void sqliteGenerateRowIndexDelete(sqlite*, Vdbe*, Table*, int, char*);
-void sqliteGenerateConstraintChecks(Parse*,Table*,int,char*,int,int,int,int);
-void sqliteCompleteInsertion(Parse*, Table*, int, char*, int, int, int);
-int sqliteOpenTableAndIndices(Parse*, Table*, int);
-void sqliteBeginWriteOperation(Parse*, int, int);
-void sqliteEndWriteOperation(Parse*);
-Expr *sqliteExprDup(Expr*);
-void sqliteTokenCopy(Token*, Token*);
-ExprList *sqliteExprListDup(ExprList*);
-SrcList *sqliteSrcListDup(SrcList*);
-IdList *sqliteIdListDup(IdList*);
-Select *sqliteSelectDup(Select*);
-FuncDef *sqliteFindFunction(sqlite*,const char*,int,int,int);
-void sqliteRegisterBuiltinFunctions(sqlite*);
-void sqliteRegisterDateTimeFunctions(sqlite*);
-int sqliteSafetyOn(sqlite*);
-int sqliteSafetyOff(sqlite*);
-int sqliteSafetyCheck(sqlite*);
-void sqliteChangeCookie(sqlite*, Vdbe*);
-void sqliteBeginTrigger(Parse*, Token*,int,int,IdList*,SrcList*,int,Expr*,int);
-void sqliteFinishTrigger(Parse*, TriggerStep*, Token*);
-void sqliteDropTrigger(Parse*, SrcList*);
-void sqliteDropTriggerPtr(Parse*, Trigger*, int);
-int sqliteTriggersExist(Parse* , Trigger* , int , int , int, ExprList*);
-int sqliteCodeRowTrigger(Parse*, int, ExprList*, int, Table *, int, int,
- int, int);
-void sqliteViewTriggers(Parse*, Table*, Expr*, int, ExprList*);
-void sqliteDeleteTriggerStep(TriggerStep*);
-TriggerStep *sqliteTriggerSelectStep(Select*);
-TriggerStep *sqliteTriggerInsertStep(Token*, IdList*, ExprList*, Select*, int);
-TriggerStep *sqliteTriggerUpdateStep(Token*, ExprList*, Expr*, int);
-TriggerStep *sqliteTriggerDeleteStep(Token*, Expr*);
-void sqliteDeleteTrigger(Trigger*);
-int sqliteJoinType(Parse*, Token*, Token*, Token*);
-void sqliteCreateForeignKey(Parse*, IdList*, Token*, IdList*, int);
-void sqliteDeferForeignKey(Parse*, int);
-#ifndef SQLITE_OMIT_AUTHORIZATION
- void sqliteAuthRead(Parse*,Expr*,SrcList*);
- int sqliteAuthCheck(Parse*,int, const char*, const char*, const char*);
- void sqliteAuthContextPush(Parse*, AuthContext*, const char*);
- void sqliteAuthContextPop(AuthContext*);
-#else
-# define sqliteAuthRead(a,b,c)
-# define sqliteAuthCheck(a,b,c,d,e) SQLITE_OK
-# define sqliteAuthContextPush(a,b,c)
-# define sqliteAuthContextPop(a) ((void)(a))
-#endif
-void sqliteAttach(Parse*, Token*, Token*, Token*);
-void sqliteDetach(Parse*, Token*);
-int sqliteBtreeFactory(const sqlite *db, const char *zFilename,
- int mode, int nPg, Btree **ppBtree);
-int sqliteFixInit(DbFixer*, Parse*, int, const char*, const Token*);
-int sqliteFixSrcList(DbFixer*, SrcList*);
-int sqliteFixSelect(DbFixer*, Select*);
-int sqliteFixExpr(DbFixer*, Expr*);
-int sqliteFixExprList(DbFixer*, ExprList*);
-int sqliteFixTriggerStep(DbFixer*, TriggerStep*);
-double sqliteAtoF(const char *z, const char **);
-char *sqlite_snprintf(int,char*,const char*,...);
-int sqliteFitsIn32Bits(const char *);
+++ /dev/null
-use Test;
-BEGIN { plan tests => 1 }
-END { ok($loaded) }
-use DBD::SQLite2;
-$loaded++;
-
-unlink("foo", "output/foo", "output/database", "output/datbase");
-
+++ /dev/null
-use Test;
-BEGIN { plan tests => 3 }
-use DBI;
-my $dbh = DBI->connect("dbi:SQLite2:dbname=foo", "", "");
-ok($dbh);
-ok($dbh->{sqlite_version});
-ok($dbh->{sqlite_encoding});
-print "sqlite_version=$dbh->{sqlite_version}, sqlite_encoding=$dbh->{sqlite_encoding}\n";
-$dbh->disconnect;
-
+++ /dev/null
-use strict;
-use Test;
-BEGIN { plan tests => 4 }
-use DBI;
-my $dbh = DBI->connect("dbi:SQLite2:dbname=foo", "", "");
-ok($dbh);
-$dbh->{AutoCommit} = 1;
-$dbh->do("CREATE TABLE f (f1, f2, f3)");
-my $sth = $dbh->prepare("SELECT f.f1, f.* FROM f");
-ok($sth->execute());
-my $names = $sth->{NAME};
-ok(@$names == 4);
-print(join(', ', @$names), "\n");
-ok($names->[0] eq "f1"); # make sure the "f." is removed
-$sth->finish;
-$dbh->disconnect;
+++ /dev/null
-use Test;
-BEGIN { plan tests => 9 }
-use DBI;
-my $dbh = DBI->connect("dbi:SQLite2:dbname=foo", "", "");
-ok($dbh);
-my $sth = $dbh->prepare("INSERT INTO f VALUES (?, ?, ?)");
-ok($sth);
-ok(my $rows = $sth->execute("Fred", "Bloggs", "fred\@bloggs.com"));
-ok($rows == 1);
-ok($dbh->func('last_insert_rowid'));
-ok($sth->execute("test", "test", "1"));
-ok($sth->execute("test", "test", "2"));
-ok($sth->execute("test", "test", "3"));
-ok($dbh->do("delete from f where f1='test'") == 3);
-$dbh->disconnect;
+++ /dev/null
-use Test;
-BEGIN { plan tests => 7 }
-use DBI;
-my $dbh = DBI->connect("dbi:SQLite2:dbname=foo", "", "", { RaiseError => 1 });
-ok($dbh);
-my $sth = $dbh->prepare("SELECT * FROM f");
-ok($sth);
-ok($sth->execute);
-my $row = $sth->fetch;
-ok($row);
-ok(@$row, 3);
-print join(", ", @$row), "\n";
-my $rows = $sth->execute;
-ok($rows);
-ok($sth->fetch);
-$sth->finish;
-$dbh->disconnect;
+++ /dev/null
-use Test;
-BEGIN { plan tests => 2 }
-use DBI;
-my $dbh = DBI->connect("dbi:SQLite2:dbname=foo", "", "",
- {AutoCommit => 0, RaiseError => 1});
-
-ok($dbh);
-
-$dbh->do("CREATE TABLE MST (id, lbl)");
-$dbh->do("CREATE TABLE TRN (no, id, qty)");
-
-$dbh->commit; #not work?
-$dbh->do("INSERT INTO MST VALUES(1, 'ITEM1')");
-$dbh->do("INSERT INTO MST VALUES(2, 'ITEM2')");
-$dbh->do("INSERT INTO MST VALUES(3, 'ITEM3')");
-$dbh->do("INSERT INTO TRN VALUES('A', 1, 5)");
-$dbh->do("INSERT INTO TRN VALUES('B', 2, 2)");
-$dbh->do("INSERT INTO TRN VALUES('C', 1, 4)");
-$dbh->do("INSERT INTO TRN VALUES('D', 3, 3)");
-$dbh->rollback; #not work?
-
-my $sth = $dbh->prepare(
-"SELECT TRN.id AS ID, MST.LBL AS TITLE,
- SUM(qty) AS TOTAL FROM TRN,MST
-WHERE TRN.ID = MST.ID
-GROUP BY TRN.ID ORDER BY TRN.ID DESC");
-my $rows = $sth->execute();
-ok($rows, "0E0");
-my $names = $sth->{NAME};
-print(join(', ', @$names), "\n");
-while(my $raD = $sth->fetchrow_arrayref()) {
- print join(":", @$raD), "\n";
-}
-$dbh->disconnect;
+++ /dev/null
-use Test;
-BEGIN { plan tests => 2 }
-use DBI;
-
-unlink('foo');
-my $db = DBI->connect('dbi:SQLite2:foo', '', '', { RaiseError => 1, PrintError => 0 });
-eval {
- $db->do('ssdfsdf sdf sd sdfsdfdsf sdfsdf');
-};
-ok($@);
-
-$db->do('create table testerror (a, b)');
-$db->do('insert into testerror values (1, 2)');
-$db->do('insert into testerror values (3, 4)');
-
-$db->do('create unique index testerror_idx on testerror (a)');
-eval {
- $db->do('insert into testerror values (1, 5)');
-};
-ok($@);
+++ /dev/null
-use Test;
-BEGIN { plan tests => 18 }
-use DBI;
-
-sub now {
- return time();
-}
-
-sub add2 {
- my ( $a, $b ) = @_;
-
- return $a + $b;
-}
-
-sub my_sum {
- my $sum = 0;
- foreach my $x (@_) {
- $sum += $x;
- }
- return $sum;
-}
-
-sub error {
- die "function is dying: ", @_, "\n";
-}
-
-sub void_return {
-}
-
-sub return2 {
- return ( 1, 2 );
-}
-
-sub return_null {
- return undef;
-}
-
-sub my_defined {
- return defined $_[0];
-}
-
-sub noop {
- return $_[0];
-}
-
-my $dbh = DBI->connect("dbi:SQLite2:dbname=foo", "", "", { PrintError => 0 } );
-ok($dbh);
-
-$dbh->func( "now", 0, \&now, "create_function" );
-my $result = $dbh->selectrow_arrayref( "SELECT now()" );
-
-ok( $result->[0] );
-
-$dbh->do( 'CREATE TEMP TABLE func_test ( a, b )' );
-$dbh->do( 'INSERT INTO func_test VALUES ( 1, 3 )' );
-$dbh->do( 'INSERT INTO func_test VALUES ( 0, 4 )' );
-
-$dbh->func( "add2", 2, \&add2, "create_function" );
-$result = $dbh->selectrow_arrayref( "SELECT add2(1,3)" );
-ok( $result->[0] == 4 );
-
-$result = $dbh->selectall_arrayref( "SELECT add2(a,b) FROM func_test" );
-ok( $result->[0][0] = 4 && $result->[1][0] == 4 );
-
-$dbh->func( "my_sum", -1, \&my_sum, "create_function" );
-$result = $dbh->selectrow_arrayref( "SELECT my_sum( '2', 3, 4, '5')" );
-ok( $result->[0] == 14 );
-
-$dbh->func( "error", -1, \&error, "create_function" );
-$result = $dbh->selectrow_arrayref( "SELECT error( 'I died' )" );
-ok( !$result );
-ok( $DBI::errstr =~ /function is dying: I died/ );
-
-$dbh->func( "void_return", -1, \&void_return, "create_function" );
-$result = $dbh->selectrow_arrayref( "SELECT void_return( 'I died' )" );
-ok( $result && !defined $result->[0] );
-
-$dbh->func( "return_null", -1, \&return_null, "create_function" );
-$result = $dbh->selectrow_arrayref( "SELECT return_null()" );
-ok( $result && !defined $result->[0] );
-
-$dbh->func( "return2", -1, \&return2, "create_function" );
-$result = $dbh->selectrow_arrayref( "SELECT return2()" );
-ok( $result && $result->[0] == 2 );
-
-$dbh->func( "my_defined", 1, \&my_defined, "create_function" );
-$result = $dbh->selectrow_arrayref( "SELECT my_defined(1)" );
-ok( $result && $result->[0] );
-
-$result = $dbh->selectrow_arrayref( "SELECT my_defined('')" );
-ok( $result && $result->[0] );
-
-$result = $dbh->selectrow_arrayref( "SELECT my_defined('abc')" );
-ok( $result && $result->[0] );
-
-$result = $dbh->selectrow_arrayref( "SELECT my_defined(NULL)" );
-ok( $result && !$result->[0] );
-
-$dbh->func( "noop", 1, \&noop, "create_function" );
-$result = $dbh->selectrow_arrayref( "SELECT noop(NULL)" );
-ok( $result && !defined $result->[0] );
-
-$result = $dbh->selectrow_arrayref( "SELECT noop(1)" );
-ok( $result && $result->[0] == 1);
-
-$result = $dbh->selectrow_arrayref( "SELECT noop('')" );
-ok( $result && $result->[0] eq '' );
-
-$result = $dbh->selectrow_arrayref( "SELECT noop(1.1)" );
-ok( $result && $result->[0] == 1.1 );
-
-$dbh->disconnect;
+++ /dev/null
-use strict;
-
-package count_aggr;
-
-sub new {
- bless { count => 0 }, shift;
-}
-
-sub step {
- $_[0]{count}++;
- return;
-}
-
-sub finalize {
- my $c = $_[0]{count};
- $_[0]{count} = undef;
-
- return $c;
-}
-
-package obj_aggregate;
-
-sub new {
- bless { count => 0 }, shift;
-}
-
-sub step {
- $_[0]{count}++
- if defined $_[1];
-}
-
-sub finalize {
- my $c = $_[0]{count};
- $_[0]{count} = undef;
- return $c;
-}
-
-package fail_aggregate;
-
-sub new {
- my $class = shift;
- if ( ref $class ) {
- die "new() failed on request"
- if $class->{'fail'} eq 'new';
- return undef
- if $class->{'fail'} eq 'undef';
- return bless { %$class }, ref $class;
- } else {
- return bless { 'fail' => $_[0] }, $class;
- }
-}
-
-sub step {
- die "step() failed on request"
- if $_[0]{fail} eq 'step';
-}
-
-sub finalize {
- die "finalize() failed on request"
- if $_[0]{fail} eq 'finalize';
-}
-
-package main;
-
-use Test;
-BEGIN { plan tests => 15 }
-use DBI;
-
-my $dbh = DBI->connect("dbi:SQLite2:dbname=foo", "", "", { PrintError => 0 } );
-ok($dbh);
-
-$dbh->do( "DROP TABLE aggr_test;" );
-$dbh->do( "CREATE TABLE aggr_test ( field )" );
-foreach my $val ( qw/NULL 1 'test'/ ) {
- $dbh->do( "INSERT INTO aggr_test VALUES ( $val )" );
-}
-
-$dbh->func( "newcount", 0, "count_aggr", "create_aggregate" );
-my $result = $dbh->selectrow_arrayref( "SELECT newcount() FROM aggr_test" );
-ok( $result && $result->[0] == 3 );
-
-# Make sure that the init() function is called correctly
-$result = $dbh->selectall_arrayref( "SELECT newcount() FROM aggr_test GROUP BY field" );
-ok( @$result == 3 && $result->[0][0] == 1 && $result->[1][0] == 1 );
-
-
-# Test aggregate on empty table
-$dbh->do( "DROP TABLE aggr_empty_test;" );
-$dbh->do( "CREATE TABLE aggr_empty_test ( field )" );
-$result = $dbh->selectrow_arrayref( "SELECT newcount() FROM aggr_empty_test" );
-ok( $result && !$result->[0] );
-# Make sure that the init() function is called correctly
-$result = $dbh->selectrow_arrayref( "SELECT newcount() FROM aggr_empty_test" );
-ok( $result && !$result->[0] );
-
-$dbh->func( "defined", 1, 'obj_aggregate', "create_aggregate" );
-$result = $dbh->selectrow_arrayref( "SELECT defined(field) FROM aggr_test" );
-ok( $result && $result->[0] == 2 );
-$result = $dbh->selectrow_arrayref( "SELECT defined(field) FROM aggr_test" );
-ok( $result && $result->[0] == 2 );
-$result = $dbh->selectrow_arrayref( "SELECT defined(field) FROM aggr_empty_test" );
-ok( $result && !$result->[0] );
-$result = $dbh->selectrow_arrayref( "SELECT defined(field) FROM aggr_empty_test" );
-ok( $result && !$result->[0] );
-
-my $last_warn;
-local $SIG{__WARN__} = sub { $last_warn = join "", @_ };
-foreach my $fail ( qw/ new step finalize/ ) {
- $last_warn = '';
- my $aggr = new fail_aggregate( $fail );
- $dbh->func( "fail_$fail", -1, $aggr, 'create_aggregate' );
- $result = $dbh->selectrow_arrayref( "SELECT fail_$fail() FROM aggr_test" );
-# ok( !$result && $DBI::errstr =~ /$fail\(\) failed on request/ );
- ok( !defined $result->[0] && $last_warn =~ /$fail\(\) failed on request/ );
-
- # No need to check this one, since step() will never be called
- # on an empty table
- next if $fail eq 'step';
- $result = $dbh->selectrow_arrayref( "SELECT fail_$fail() FROM aggr_empty_test" );
-# ok( !$result && $DBI::errstr =~ /$fail\(\) failed on request/ );
- ok( !defined $result->[0] && $last_warn =~ /$fail\(\) failed on request/ );
-}
-
-my $aggr = new fail_aggregate( 'undef' );
-$last_warn = '';
-$dbh->func( "fail_undef", -1, $aggr, 'create_aggregate' );
-$result = $dbh->selectrow_arrayref( "SELECT fail_undef() FROM aggr_test" );
-# ok( !$result && $DBI::errstr =~ /new\(\) should return a blessed reference/ );
-ok( !defined $result->[0] && $last_warn =~ /new\(\) should return a blessed reference/ );
+++ /dev/null
-#!/usr/local/bin/perl
-#
-# $Id: 10dsnlist.t,v 1.1.1.1 2004/08/08 15:03:58 matt Exp $
-#
-# This test creates a database and drops it. Should be executed
-# after listdsn.
-#
-
-
-#
-# Include lib.pl
-#
-require DBI;
-$mdriver = "";
-foreach $file ("lib.pl", "t/lib.pl", "DBD-~DBD_DRIVER~/t/lib.pl") {
- do $file; if ($@) { print STDERR "Error while executing lib.pl: $@\n";
- exit 10;
- }
- if ($mdriver ne '') {
- last;
- }
-}
-if ($mdriver eq 'pNET' || $mdriver eq 'Adabas') {
- print "1..0\n";
- exit 0;
-}
-print "Driver is $mdriver\n";
-
-sub ServerError() {
- print STDERR ("Cannot connect: ", $DBI::errstr, "\n",
- "\tEither your server is not up and running or you have no\n",
- "\tpermissions for acessing the DSN $test_dsn.\n",
- "\tThis test requires a running server and write permissions.\n",
- "\tPlease make sure your server is running and you have\n",
- "\tpermissions, then retry.\n");
- exit 10;
-}
-
-#
-# Main loop; leave this untouched, put tests into the loop
-#
-while (Testing()) {
- # Check if the server is awake.
- $dbh = undef;
- Test($state or ($dbh = DBI->connect($test_dsn, $test_user,
- $test_password)))
- or ServerError();
-
- Test($state or (@dsn = DBI->data_sources($mdriver)) >= 0);
- if (!$state) {
- my $d;
- print "List of $mdriver data sources:\n";
- foreach $d (@dsn) {
- print " $d\n";
- }
- print "List ends.\n";
- }
- Test($state or $dbh->disconnect());
-
- #
- # Try different DSN's
- #
- my(@dsnList);
- if (($mdriver eq 'mysql' or $mdriver eq 'mSQL')
- and $test_dsn eq "DBI:$mdriver:test") {
- @dsnList = ("DBI:$mdriver:test:localhost",
- "DBI:$mdriver:test;localhost",
- "DBI:$mdriver:database=test;host=localhost");
- }
- my($dsn);
- foreach $dsn (@dsnList) {
- Test($state or ($dbh = DBI->connect($dsn, $test_user,
- $test_password)))
- or print "Cannot connect to DSN $dsn: ${DBI::errstr}\n";
- Test($state or $dbh->disconnect());
- }
-}
-
-exit 0;
-
-# Hate -w :-)
-$test_dsn = $test_user = $test_password = $DBI::errstr;
+++ /dev/null
-#!/usr/local/bin/perl
-#
-# $Id: 20createdrop.t,v 1.1.1.1 2004/08/08 15:03:58 matt Exp $
-#
-# This is a skeleton test. For writing new tests, take this file
-# and modify/extend it.
-#
-
-use strict;
-use vars qw($test_dsn $test_user $test_password $mdriver $dbdriver);
-$DBI::errstr = ''; # Make -w happy
-require DBI;
-
-
-#
-# Include lib.pl
-#
-$mdriver = "";
-my $file;
-foreach $file ("lib.pl", "t/lib.pl") {
- do $file; if ($@) { print STDERR "Error while executing lib.pl: $@\n";
- exit 10;
- }
- if ($mdriver ne '') {
- last;
- }
-}
-
-sub ServerError() {
- print STDERR ("Cannot connect: ", $DBI::errstr, "\n",
- "\tEither your server is not up and running or you have no\n",
- "\tpermissions for acessing the DSN $test_dsn.\n",
- "\tThis test requires a running server and write permissions.\n",
- "\tPlease make sure your server is running and you have\n",
- "\tpermissions, then retry.\n");
- exit 10;
-}
-
-#
-# Main loop; leave this untouched, put tests into the loop
-#
-use vars qw($state);
-while (Testing()) {
- #
- # Connect to the database
- my $dbh;
- Test($state or $dbh = DBI->connect($test_dsn, $test_user, $test_password))
- or ServerError();
-
- #
- # Find a possible new table name
- #
- my $table;
- Test($state or $table = FindNewTable($dbh))
- or DbiError($dbh->err, $dbh->errstr);
-
- #
- # Create a new table
- #
- my $def;
- if (!$state) {
- ($def = TableDefinition($table,
- ["id", "INTEGER", 4, 0],
- ["name", "CHAR", 64, 0]));
- print "Creating table:\n$def\n";
- }
- Test($state or $dbh->do($def))
- or DbiError($dbh->err, $dbh->errstr);
-
-
- #
- # ... and drop it.
- #
- Test($state or $dbh->do("DROP TABLE $table"))
- or DbiError($dbh->err, $dbh->errstr);
-
- #
- # Finally disconnect.
- #
- Test($state or $dbh->disconnect())
- or DbiError($dbh->err, $dbh->errstr);
-}
+++ /dev/null
-#!/usr/local/bin/perl
-#
-# $Id: 30insertfetch.t,v 1.1.1.1 2004/08/08 15:03:58 matt Exp $
-#
-# This is a simple insert/fetch test.
-#
-$^W = 1;
-
-#
-# Make -w happy
-#
-$test_dsn = '';
-$test_user = '';
-$test_password = '';
-
-
-#
-# Include lib.pl
-#
-use DBI;
-$mdriver = "";
-foreach $file ("lib.pl", "t/lib.pl", "DBD-~DBD_DRIVER~/t/lib.pl") {
- do $file; if ($@) { print STDERR "Error while executing lib.pl: $@\n";
- exit 10;
- }
- if ($mdriver ne '') {
- last;
- }
-}
-
-sub ServerError() {
- print STDERR ("Cannot connect: ", $DBI::errstr, "\n",
- "\tEither your server is not up and running or you have no\n",
- "\tpermissions for acessing the DSN $test_dsn.\n",
- "\tThis test requires a running server and write permissions.\n",
- "\tPlease make sure your server is running and you have\n",
- "\tpermissions, then retry.\n");
- exit 10;
-}
-
-#
-# Main loop; leave this untouched, put tests after creating
-# the new table.
-#
-while (Testing()) {
-
- #
- # Connect to the database
- Test($state or $dbh = DBI->connect($test_dsn, $test_user, $test_password),
- 'connect')
- or ServerError();
-
- #
- # Find a possible new table name
- #
- Test($state or $table = FindNewTable($dbh), 'FindNewTable')
- or DbiError($dbh->err, $dbh->errstr);
-
- #
- # Create a new table; EDIT THIS!
- #
- Test($state or ($def = TableDefinition($table,
- ["id", "INTEGER", 4, 0],
- ["name", "CHAR", 64, 0],
- ["val", "INTEGER", 4, 0],
- ["txt", "CHAR", 64, 0]) and
- $dbh->do($def)), 'create', $def)
- or DbiError($dbh->err, $dbh->errstr);
-
-
- #
- # Insert a row into the test table.......
- #
- Test($state or $dbh->do("INSERT INTO $table"
- . " VALUES(1, 'Alligator Descartes', 1111,"
- . " 'Some Text')"), 'insert')
- or DbiError($dbh->err, $dbh->errstr);
-
- #
- # Now, try SELECT'ing the row out.
- #
- Test($state or $cursor = $dbh->prepare("SELECT * FROM $table"
- . " WHERE id = 1"),
- 'prepare select')
- or DbiError($dbh->err, $dbh->errstr);
-
- Test($state or $cursor->execute, 'execute select')
- or DbiError($cursor->err, $cursor->errstr);
-
- my ($row, $errstr);
- Test($state or (defined($row = $cursor->fetchrow_arrayref) &&
- !($cursor->errstr)), 'fetch select')
- or DbiError($cursor->err, $cursor->errstr);
-
- Test($state or ($row->[0] == 1 &&
- $row->[1] eq 'Alligator Descartes' &&
- $row->[2] == 1111 &&
- $row->[3] eq 'Some Text'), 'compare select')
- or DbiError($cursor->err, $cursor->errstr);
-
- Test($state or $cursor->finish, 'finish select')
- or DbiError($cursor->err, $cursor->errstr);
-
- Test($state or undef $cursor || 1, 'undef select');
-
- #
- # ...and delete it........
- #
- Test($state or $dbh->do("DELETE FROM $table WHERE id = 1"), 'delete')
- or DbiError($dbh->err, $dbh->errstr);
-
- #
- # Now, try SELECT'ing the row out. This should fail.
- #
- Test($state or $cursor = $dbh->prepare("SELECT * FROM $table"
- . " WHERE id = 1"),
- 'prepare select deleted')
- or DbiError($dbh->err, $dbh->errstr);
-
- Test($state or $cursor->execute, 'execute select deleted')
- or DbiError($cursor->err, $cursor->errstr);
-
- Test($state or (!defined($row = $cursor->fetchrow_arrayref) &&
- (!defined($errstr = $cursor->errstr) ||
- $cursor->errstr eq '')), 'fetch select deleted')
- or DbiError($cursor->err, $cursor->errstr);
-
- Test($state or $cursor->finish, 'finish select deleted')
- or DbiError($cursor->err, $cursor->errstr);
-
- Test($state or undef $cursor || 1, 'undef select deleted');
-
-
- #
- # Finally drop the test table.
- #
- Test($state or $dbh->do("DROP TABLE $table"), 'drop')
- or DbiError($dbh->err, $dbh->errstr);
-
-}
-
+++ /dev/null
-#!/usr/local/bin/perl
-#
-# $Id: 40bindparam.t,v 1.1.1.1 2004/08/08 15:03:58 matt Exp $
-#
-# This is a skeleton test. For writing new tests, take this file
-# and modify/extend it.
-#
-
-$^W = 1;
-
-#
-# Make -w happy
-#
-$test_dsn = '';
-$test_user = '';
-$test_password = '';
-
-
-#
-# Include lib.pl
-#
-require DBI;
-use vars qw($COL_NULLABLE);
-$mdriver = "";
-foreach $file ("lib.pl", "t/lib.pl") {
- do $file; if ($@) { print STDERR "Error while executing lib.pl: $@\n";
- exit 10;
- }
- if ($mdriver ne '') {
- last;
- }
-}
-if ($mdriver eq 'pNET') {
- print "1..0\n";
- exit 0;
-}
-
-sub ServerError() {
- my $err = $DBI::errstr; # Hate -w ...
- print STDERR ("Cannot connect: ", $DBI::errstr, "\n",
- "\tEither your server is not up and running or you have no\n",
- "\tpermissions for acessing the DSN $test_dsn.\n",
- "\tThis test requires a running server and write permissions.\n",
- "\tPlease make sure your server is running and you have\n",
- "\tpermissions, then retry.\n");
- exit 10;
-}
-
-if (!defined(&SQL_VARCHAR)) {
- eval "sub SQL_VARCHAR { 12 }";
-}
-if (!defined(&SQL_INTEGER)) {
- eval "sub SQL_INTEGER { 4 }";
-}
-
-#
-# Main loop; leave this untouched, put tests after creating
-# the new table.
-#
-while (Testing()) {
- #
- # Connect to the database
- Test($state or $dbh = DBI->connect($test_dsn, $test_user, $test_password),
- 'connect')
- or ServerError();
-
- # For some reason this test is fscked with the utf8 flag on.
- # It seems to be because the string "K\x{00f6}nig" which to
- # me looks like unicode, should set the UTF8 flag on that
- # scalar. But no. It doesn't. Stupid fscking piece of crap.
- # (the test works if I manually set that flag with utf8::upgrade())
- # $dbh->{NoUTF8Flag} = 1 if $] > 5.007;
-
- #
- # Find a possible new table name
- #
- Test($state or $table = FindNewTable($dbh), 'FindNewTable')
- or DbiError($dbh->err, $dbh->errstr);
-
- #
- # Create a new table; EDIT THIS!
- #
- Test($state or ($def = TableDefinition($table,
- ["id", "INTEGER", 4, 0],
- ["name", "CHAR", 64, $COL_NULLABLE]) and
- $dbh->do($def)), 'create', $def)
- or DbiError($dbh->err, $dbh->errstr);
-
-
- Test($state or $cursor = $dbh->prepare("INSERT INTO $table"
- . " VALUES (?, ?)"), 'prepare')
- or DbiError($dbh->err, $dbh->errstr);
-
- #
- # Insert some rows
- #
-
- my $konig = "Andreas K\xf6nig";
- # warn("Konig: $konig\n");
-
- # Automatic type detection
- my $numericVal = 1;
- my $charVal = "Alligator Descartes";
- Test($state or $cursor->execute($numericVal, $charVal), 'execute insert 1')
- or DbiError($dbh->err, $dbh->errstr);
-
- # Does the driver remember the automatically detected type?
- Test($state or $cursor->execute("3", "Jochen Wiedmann"),
- 'execute insert num as string')
- or DbiError($dbh->err, $dbh->errstr);
- $numericVal = 2;
- $charVal = "Tim Bunce";
- Test($state or $cursor->execute($numericVal, $charVal), 'execute insert 2')
- or DbiError($dbh->err, $dbh->errstr);
-
- # Now try the explicit type settings
- Test($state or $cursor->bind_param(1, " 4", SQL_INTEGER()), 'bind 1')
- or DbiError($dbh->err, $dbh->errstr);
- Test($state or $cursor->bind_param(2, $konig), 'bind 2')
- or DbiError($dbh->err, $dbh->errstr);
- Test($state or $cursor->execute, 'execute binds')
- or DbiError($dbh->err, $dbh->errstr);
-
- # Works undef -> NULL?
- Test($state or $cursor->bind_param(1, 5, SQL_INTEGER()))
- or DbiError($dbh->err, $dbh->errstr);
- Test($state or $cursor->bind_param(2, undef))
- or DbiError($dbh->err, $dbh->errstr);
- Test($state or $cursor->execute)
- or DbiError($dbh->err, $dbh->errstr);
-
-
- Test($state or $cursor -> finish, 'finish');
-
- Test($state or undef $cursor || 1, 'undef cursor');
-
- Test($state or $dbh -> disconnect, 'disconnect');
-
- Test($state or undef $dbh || 1, 'undef dbh');
-
- #
- # And now retreive the rows using bind_columns
- #
- #
- # Connect to the database
- #
- Test($state or $dbh = DBI->connect($test_dsn, $test_user, $test_password),
- 'connect for read')
- or ServerError();
-
- # $dbh->{NoUTF8Flag} = 1 if $] > 5.007;
-
- Test($state or $cursor = $dbh->prepare("SELECT * FROM $table"
- . " ORDER BY id"))
- or DbiError($dbh->err, $dbh->errstr);
-
- Test($state or $cursor->execute)
- or DbiError($dbh->err, $dbh->errstr);
-
- Test($state or $cursor->bind_columns(undef, \$id, \$name))
- or DbiError($dbh->err, $dbh->errstr);
-
- Test($state or ($ref = $cursor->fetch) && $id == 1 &&
- $name eq 'Alligator Descartes')
- or printf("Query returned id = %s, name = %s, ref = %s, %d\n",
- $id, $name, $ref, scalar(@$ref));
-
- Test($state or (($ref = $cursor->fetch) && $id == 2 &&
- $name eq 'Tim Bunce'))
- or printf("Query returned id = %s, name = %s, ref = %s, %d\n",
- $id, $name, $ref, scalar(@$ref));
-
- Test($state or (($ref = $cursor->fetch) && $id == 3 &&
- $name eq 'Jochen Wiedmann'))
- or printf("Query returned id = %s, name = %s, ref = %s, %d\n",
- $id, $name, $ref, scalar(@$ref));
-
- # warn("Konig: $konig\n");
- Test($state or (($ref = $cursor->fetch) && $id == 4 &&
- $name eq $konig))
- or printf("Query returned id = %s, name = %s, ref = %s, %d\n",
- $id, $name, $ref, scalar(@$ref));
-
- # warn("$konig == $name ?\n");
- Test($state or (($ref = $cursor->fetch) && $id == 5 &&
- !defined($name)))
- or printf("Query returned id = %s, name = %s, ref = %s, %d\n",
- $id, $name, $ref, scalar(@$ref));
-
- Test($state or undef $cursor or 1);
-
- #
- # Finally drop the test table.
- #
- Test($state or $dbh->do("DROP TABLE $table"))
- or DbiError($dbh->err, $dbh->errstr);
-}
+++ /dev/null
-#!/usr/local/bin/perl
-#
-# $Id: 40blobs.t,v 1.1.1.1 2004/08/08 15:03:58 matt Exp $
-#
-# This is a test for correct handling of BLOBS; namely $dbh->quote
-# is expected to work correctly.
-#
-
-$^W = 1;
-
-
-#
-# Make -w happy
-#
-$test_dsn = '';
-$test_user = '';
-$test_password = '';
-
-
-#
-# Include lib.pl
-#
-require DBI;
-$mdriver = "";
-foreach $file ("lib.pl", "t/lib.pl") {
- do $file; if ($@) { print STDERR "Error while executing lib.pl: $@\n";
- exit 10;
- }
- if ($mdriver ne '') {
- last;
- }
-}
-if ($dbdriver eq 'mSQL' || $dbdriver eq 'mSQL1') {
- print "1..0\n";
- exit 0;
-}
-
-sub ServerError() {
- my $err = $DBI::errstr; # Hate -w ...
- print STDERR ("Cannot connect: ", $DBI::errstr, "\n",
- "\tEither your server is not up and running or you have no\n",
- "\tpermissions for acessing the DSN $test_dsn.\n",
- "\tThis test requires a running server and write permissions.\n",
- "\tPlease make sure your server is running and you have\n",
- "\tpermissions, then retry.\n");
- exit 10;
-}
-
-
-sub ShowBlob($) {
- my ($blob) = @_;
- print("showblob length: ", length($blob), "\n");
- if ($ENV{SHOW_BLOBS}) { open(OUT, ">>$ENV{SHOW_BLOBS}") }
- my $i = 0;
- while (1) {
- if (defined($blob) && length($blob) > ($i*32)) {
- $b = substr($blob, $i*32);
- } else {
- $b = "";
- last;
- }
- if ($ENV{SHOW_BLOBS}) { printf OUT "%08lx %s\n", $i*32, unpack("H64", $b) }
- else { printf("%08lx %s\n", $i*32, unpack("H64", $b)) }
- $i++;
- last if $i == 8;
- }
- if ($ENV{SHOW_BLOBS}) { close(OUT) }
-}
-
-
-#
-# Main loop; leave this untouched, put tests after creating
-# the new table.
-#
-while (Testing()) {
- #
- # Connect to the database
- Test($state or $dbh = DBI->connect($test_dsn, $test_user, $test_password))
- or ServerError();
-
-
- $dbh->{sqlite_handle_binary_nulls} = 1;
-
- #
- # Find a possible new table name
- #
- Test($state or $table = FindNewTable($dbh))
- or DbiError($dbh->error, $dbh->errstr);
-
- my($def);
- foreach $size (128) {
- #
- # Create a new table
- #
- if (!$state) {
- $def = TableDefinition($table,
- ["id", "INTEGER", 4, 0],
- ["name", "BLOB", $size, 0]);
- print "Creating table:\n$def\n";
- }
- Test($state or $dbh->do($def))
- or DbiError($dbh->err, $dbh->errstr);
-
-
- #
- # Create a blob
- #
- my ($blob, $qblob) = "";
- if (!$state) {
- my $b = "";
- for ($j = 0; $j < 256; $j++) {
- $b .= chr($j);
- }
- for ($i = 0; $i < $size; $i++) {
- $blob .= $b;
- }
- if ($mdriver eq 'pNET') {
- # Quote manually, no remote quote
- $qblob = eval "DBD::" . $dbdriver . "::db->quote(\$blob)";
- } else {
- $qblob = $dbh->quote($blob);
- }
- }
-
- #
- # Insert a row into the test table.......
- #
- my($query);
- if (!$state) {
- $query = "INSERT INTO $table VALUES (1, ?)";
- if ($ENV{'SHOW_BLOBS'} && open(OUT, ">" . $ENV{'SHOW_BLOBS'})) {
- print OUT $query, "\n";
- close(OUT);
- }
- }
- Test($state or $dbh->do($query,undef,$blob))
- or DbiError($dbh->err, $dbh->errstr);
-
- #
- # Now, try SELECT'ing the row out.
- #
- Test($state or $cursor = $dbh->prepare("SELECT * FROM $table"
- . " WHERE id = 1"))
- or DbiError($dbh->err, $dbh->errstr);
-
- Test($state or $cursor->execute)
- or DbiError($dbh->err, $dbh->errstr);
-
- Test($state or (defined($row = $cursor->fetchrow_arrayref)))
- or DbiError($cursor->err, $cursor->errstr);
-
- Test($state or (@$row == 2 && $$row[0] == 1 && $$row[1] eq $blob))
- or (ShowBlob($blob),
- ShowBlob(defined($$row[1]) ? $$row[1] : ""));
-
- Test($state or $cursor->finish)
- or DbiError($cursor->err, $cursor->errstr);
-
- Test($state or undef $cursor || 1)
- or DbiError($cursor->err, $cursor->errstr);
-
- #
- # Finally drop the test table.
- #
- Test($state or $dbh->do("DROP TABLE $table"))
- or DbiError($dbh->err, $dbh->errstr);
- }
-}
+++ /dev/null
-#!/usr/local/bin/perl
-#
-# $Id: 40listfields.t,v 1.1.1.1 2004/08/08 15:03:58 matt Exp $
-#
-# This is a test for statement attributes being present appropriately.
-#
-
-
-#
-# Make -w happy
-#
-$test_dsn = '';
-$test_user = '';
-$test_password = '';
-$COL_KEY = '';
-
-
-#
-# Include lib.pl
-#
-use DBI;
-use vars qw($verbose);
-
-$dbdriver = "";
-foreach $file ("lib.pl", "t/lib.pl") {
- do $file; if ($@) { print STDERR "Error while executing lib.pl: $@\n";
- exit 10;
- }
- if ($dbdriver ne '') {
- last;
- }
-}
-
-
-@table_def = (
- ["id", "INTEGER", 4, $COL_KEY],
- ["name", "CHAR", 64, $COL_NULLABLE]
- );
-
-sub ServerError() {
- print STDERR ("Cannot connect: ", $DBI::errstr, "\n",
- "\tEither your server is not up and running or you have no\n",
- "\tpermissions for acessing the DSN $test_dsn.\n",
- "\tThis test requires a running server and write permissions.\n",
- "\tPlease make sure your server is running and you have\n",
- "\tpermissions, then retry.\n");
- exit 10;
-}
-
-#
-# Main loop; leave this untouched, put tests after creating
-# the new table.
-#
-while (Testing()) {
- #
- # Connect to the database
- Test($state or $dbh = DBI->connect($test_dsn, $test_user, $test_password))
- or ServerError();
-
- #
- # Find a possible new table name
- #
- Test($state or $table = FindNewTable($dbh))
- or DbiError($dbh->err, $dbh->errstr);
-
- #
- # Create a new table
- #
- Test($state or ($def = TableDefinition($table, @table_def),
- $dbh->do($def)))
- or DbiError($dbh->err, $dbh->errstr);
-
-
- Test($state or $cursor = $dbh->prepare("SELECT * FROM $table"))
- or DbiError($dbh->err, $dbh->errstr);
-
- Test($state or $cursor->execute)
- or DbiError($cursor->err, $cursor->errstr);
-
- my $res;
- Test($state or (($res = $cursor->{'NUM_OF_FIELDS'}) == @table_def))
- or DbiError($cursor->err, $cursor->errstr);
- if (!$state && $verbose) {
- printf("Number of fields: %s\n", defined($res) ? $res : "undef");
- }
-
- Test($state or ($ref = $cursor->{'NAME'}) && @$ref == @table_def
- && (lc $$ref[0]) eq $table_def[0][0]
- && (lc $$ref[1]) eq $table_def[1][0])
- or DbiError($cursor->err, $cursor->errstr);
- if (!$state && $verbose) {
- print "Names:\n";
- for ($i = 0; $i < @$ref; $i++) {
- print " ", $$ref[$i], "\n";
- }
- }
-
- Test($state or ($dbdriver eq 'CSV') or ($dbdriver eq 'ConfFile')
- or ($dbdriver eq 'SQLite2')
- or ($ref = $cursor->{'NULLABLE'}) && @$ref == @table_def
- && !($$ref[0] xor ($table_def[0][3] & $COL_NULLABLE))
- && !($$ref[1] xor ($table_def[1][3] & $COL_NULLABLE)))
- or DbiError($cursor->err, $cursor->errstr);
- if (!$state && $verbose) {
- print "Nullable:\n";
- for ($i = 0; $i < @$ref; $i++) {
- print " ", ($$ref[$i] & $COL_NULLABLE) ? "yes" : "no", "\n";
- }
- }
-
- Test($state or undef $cursor || 1);
-
-
- #
- # Drop the test table
- #
- Test($state or ($cursor = $dbh->prepare("DROP TABLE $table")))
- or DbiError($dbh->err, $dbh->errstr);
- Test($state or $cursor->execute)
- or DbiError($cursor->err, $cursor->errstr);
-
- # NUM_OF_FIELDS should be zero (Non-Select)
- Test($state or ($cursor->{'NUM_OF_FIELDS'} == 0))
- or !$verbose or printf("NUM_OF_FIELDS is %s, not zero.\n",
- $cursor->{'NUM_OF_FIELDS'});
- Test($state or (undef $cursor) or 1);
-}
+++ /dev/null
-#!/usr/local/bin/perl
-#
-# $Id: 40nulls.t,v 1.1.1.1 2004/08/08 15:03:58 matt Exp $
-#
-# This is a test for correctly handling NULL values.
-#
-
-
-#
-# Make -w happy
-#
-$test_dsn = '';
-$test_user = '';
-$test_password = '';
-
-
-#
-# Include lib.pl
-#
-use DBI;
-use vars qw($COL_NULLABLE);
-
-$mdriver = "";
-foreach $file ("lib.pl", "t/lib.pl") {
- do $file; if ($@) { print STDERR "Error while executing lib.pl: $@\n";
- exit 10;
- }
- if ($mdriver ne '') {
- last;
- }
-}
-
-sub ServerError() {
- print STDERR ("Cannot connect: ", $DBI::errstr, "\n",
- "\tEither your server is not up and running or you have no\n",
- "\tpermissions for acessing the DSN $test_dsn.\n",
- "\tThis test requires a running server and write permissions.\n",
- "\tPlease make sure your server is running and you have\n",
- "\tpermissions, then retry.\n");
- exit 10;
-}
-
-#
-# Main loop; leave this untouched, put tests after creating
-# the new table.
-#
-while (Testing()) {
- #
- # Connect to the database
- Test($state or $dbh = DBI->connect($test_dsn, $test_user, $test_password))
- or ServerError();
-
- #
- # Find a possible new table name
- #
- Test($state or $table = FindNewTable($dbh))
- or DbiError($dbh->err, $dbh->errstr);
-
- #
- # Create a new table; EDIT THIS!
- #
- Test($state or ($def = TableDefinition($table,
- ["id", "INTEGER", 4, $COL_NULLABLE],
- ["name", "CHAR", 64, 0]),
- $dbh->do($def)))
- or DbiError($dbh->err, $dbh->errstr);
-
-
- #
- # Test whether or not a field containing a NULL is returned correctly
- # as undef, or something much more bizarre
- #
- Test($state or $dbh->do("INSERT INTO $table VALUES"
- . " ( NULL, 'NULL-valued id' )"))
- or DbiError($dbh->err, $dbh->errstr);
-
- Test($state or $cursor = $dbh->prepare("SELECT * FROM $table"
- . " WHERE " . IsNull("id")))
- or DbiError($dbh->err, $dbh->errstr);
-
- Test($state or $cursor->execute)
- or DbiError($dbh->err, $dbh->errstr);
-
- Test($state or ($rv = $cursor->fetchrow_arrayref) or $dbdriver eq 'CSV'
- or $dbdriver eq 'ConfFile')
- or DbiError($dbh->err, $dbh->errstr);
-
- Test($state or (!defined($$rv[0]) and defined($$rv[1])) or
- $dbdriver eq 'CSV' or $dbdriver eq 'ConfFile')
- or DbiError($dbh->err, $dbh->errstr);
-
- Test($state or $cursor->finish)
- or DbiError($dbh->err, $dbh->errstr);
-
- Test($state or undef $cursor || 1);
-
-
- #
- # Finally drop the test table.
- #
- Test($state or $dbh->do("DROP TABLE $table"))
- or DbiError($dbh->err, $dbh->errstr);
-
-}
+++ /dev/null
-#!/usr/local/bin/perl
-#
-# $Id: 40numrows.t,v 1.1.1.1 2004/08/08 15:03:58 matt Exp $
-#
-# This tests, whether the number of rows can be retrieved.
-#
-
-$^W = 1;
-$| = 1;
-
-
-#
-# Make -w happy
-#
-$test_dsn = '';
-$test_user = '';
-$test_password = '';
-
-
-#
-# Include lib.pl
-#
-use DBI;
-$mdriver = "";
-foreach $file ("lib.pl", "t/lib.pl", "DBD-~DBD_DRIVER~/t/lib.pl") {
- do $file; if ($@) { print STDERR "Error while executing lib.pl: $@\n";
- exit 10;
- }
- if ($mdriver ne '') {
- last;
- }
-}
-
-sub ServerError() {
- print STDERR ("Cannot connect: ", $DBI::errstr, "\n",
- "\tEither your server is not up and running or you have no\n",
- "\tpermissions for acessing the DSN $test_dsn.\n",
- "\tThis test requires a running server and write permissions.\n",
- "\tPlease make sure your server is running and you have\n",
- "\tpermissions, then retry.\n");
- exit 10;
-}
-
-
-sub TrueRows($) {
- my ($sth) = @_;
- my $count = 0;
- while ($sth->fetchrow_arrayref) {
- ++$count;
- }
- $count;
-}
-
-
-#
-# Main loop; leave this untouched, put tests after creating
-# the new table.
-#
-while (Testing()) {
- #
- # Connect to the database
- Test($state or ($dbh = DBI->connect($test_dsn, $test_user,
- $test_password)))
- or ServerError();
-
- #
- # Find a possible new table name
- #
- Test($state or ($table = FindNewTable($dbh)))
- or DbiError($dbh->err, $dbh->errstr);
-
- #
- # Create a new table; EDIT THIS!
- #
- Test($state or ($def = TableDefinition($table,
- ["id", "INTEGER", 4, 0],
- ["name", "CHAR", 64, 0]),
- $dbh->do($def)))
- or DbiError($dbh->err, $dbh->errstr);
-
-
- #
- # This section should exercise the sth->rows
- # method by preparing a statement, then finding the
- # number of rows within it.
- # Prior to execution, this should fail. After execution, the
- # number of rows affected by the statement will be returned.
- #
- Test($state or $dbh->do("INSERT INTO $table"
- . " VALUES( 1, 'Alligator Descartes' )"))
- or DbiError($dbh->err, $dbh->errstr);
-
- Test($state or ($cursor = $dbh->prepare("SELECT * FROM $table"
- . " WHERE id = 1")))
- or DbiError($dbh->err, $dbh->errstr);
-
- Test($state or $cursor->execute)
- or DbiError($dbh->err, $dbh->errstr);
-
- Test($state or ($numrows = TrueRows($cursor)) == 1)
- or ErrMsgF("Expected to fetch 1 rows, got %s.\n", $numrows);
-
- Test($state or $cursor->finish)
- or DbiError($dbh->err, $dbh->errstr);
-
- Test($state or undef $cursor or 1);
-
- Test($state or $dbh->do("INSERT INTO $table"
- . " VALUES( 2, 'Jochen Wiedmann' )"))
- or DbiError($dbh->err, $dbh->errstr);
-
- Test($state or ($cursor = $dbh->prepare("SELECT * FROM $table"
- . " WHERE id >= 1")))
- or DbiError($dbh->err, $dbh->errstr);
-
- Test($state or $cursor->execute)
- or DbiError($dbh->err, $dbh->errstr);
-
- Test($state or ($numrows = TrueRows($cursor)) == 2)
- or ErrMsgF("Expected to fetch 2 rows, got %s.\n", $numrows);
-
- Test($state or $cursor->finish)
- or DbiError($dbh->err, $dbh->errstr);
-
- Test($state or undef $cursor or 1);
-
- Test($state or $dbh->do("INSERT INTO $table"
- . " VALUES(3, 'Tim Bunce')"))
- or DbiError($dbh->err, $dbh->errstr);
-
- Test($state or ($cursor = $dbh->prepare("SELECT * FROM $table"
- . " WHERE id >= 2")))
- or DbiError($dbh->err, $dbh->errstr);
-
- Test($state or $cursor->execute)
- or DbiError($dbh->err, $dbh->errstr);
-
- Test($state or ($numrows = TrueRows($cursor)) == 2)
- or ErrMsgF("Expected to fetch 2 rows, got %s.\n", $numrows);
-
- Test($state or $cursor->finish)
- or DbiError($dbh->err, $dbh->errstr);
-
- Test($state or undef $cursor or 1);
-
- #
- # Finally drop the test table.
- #
- Test($state or $dbh->do("DROP TABLE $table"))
- or DbiError($dbh->err, $dbh->errstr);
-
-}
+++ /dev/null
-#!/usr/local/bin/perl
-#
-# $Id: 50chopblanks.t,v 1.1.1.1 2004/08/08 15:03:59 matt Exp $
-#
-# This driver should check whether 'ChopBlanks' works.
-#
-
-
-#
-# Make -w happy
-#
-use vars qw($test_dsn $test_user $test_password $mdriver $verbose $state
- $dbdriver);
-use vars qw($COL_NULLABLE $COL_KEY);
-$test_dsn = '';
-$test_user = '';
-$test_password = '';
-
-#
-# Include lib.pl
-#
-use DBI;
-use strict;
-$mdriver = "";
-{
- my $file;
- foreach $file ("lib.pl", "t/lib.pl") {
- do $file; if ($@) { print STDERR "Error while executing lib.pl: $@\n";
- exit 10;
- }
- if ($mdriver ne '') {
- last;
- }
- }
-}
-
-sub ServerError() {
- print STDERR ("Cannot connect: ", $DBI::errstr, "\n",
- "\tEither your server is not up and running or you have no\n",
- "\tpermissions for acessing the DSN $test_dsn.\n",
- "\tThis test requires a running server and write permissions.\n",
- "\tPlease make sure your server is running and you have\n",
- "\tpermissions, then retry.\n");
- exit 10;
-}
-
-#
-# Main loop; leave this untouched, put tests after creating
-# the new table.
-#
-while (Testing()) {
- my ($dbh, $sth, $query);
-
- #
- # Connect to the database
- Test($state or ($dbh = DBI->connect($test_dsn, $test_user,
- $test_password)))
- or ServerError();
-
- #
- # Find a possible new table name
- #
- my $table = '';
- Test($state or $table = FindNewTable($dbh))
- or ErrMsgF("Cannot determine a legal table name: Error %s.\n",
- $dbh->errstr);
-
- #
- # Create a new table; EDIT THIS!
- #
- Test($state or ($query = TableDefinition($table,
- ["id", "INTEGER", 4, $COL_NULLABLE],
- ["name", "CHAR", 64, $COL_NULLABLE]),
- $dbh->do($query)))
- or ErrMsgF("Cannot create table: Error %s.\n",
- $dbh->errstr);
-
-
- #
- # and here's the right place for inserting new tests:
- #
- my @rows
- = ([1, 'NULL'],
- [2, ' '],
- [3, ' a b c ']);
- my $ref;
- foreach $ref (@rows) {
- my ($id, $name) = @$ref;
- if (!$state) {
- $query = sprintf("INSERT INTO $table (id, name) VALUES ($id, %s)",
- $dbh->quote($name));
- }
- Test($state or $dbh->do($query))
- or ErrMsgF("INSERT failed: query $query, error %s.\n",
- $dbh->errstr);
- $query = "SELECT id, name FROM $table WHERE id = $id\n";
- Test($state or ($sth = $dbh->prepare($query)))
- or ErrMsgF("prepare failed: query $query, error %s.\n",
- $dbh->errstr);
-
- # First try to retreive without chopping blanks.
- $sth->{'ChopBlanks'} = 0;
- Test($state or $sth->execute)
- or ErrMsgF("execute failed: query %s, error %s.\n", $query,
- $sth->errstr);
- Test($state or defined($ref = $sth->fetchrow_arrayref))
- or ErrMsgF("fetch failed: query $query, error %s.\n",
- $sth->errstr);
- Test($state or ($$ref[1] eq $name)
- or ($name =~ /^$$ref[1]\s+$/ &&
- ($dbdriver eq 'mysql' || $dbdriver eq 'ODBC')))
- or ErrMsgF("problems with ChopBlanks = 0:"
- . " expected '%s', got '%s'.\n",
- $name, $$ref[1]);
- Test($state or $sth->finish());
-
- # Now try to retreive with chopping blanks.
- $sth->{'ChopBlanks'} = 1;
- Test($state or $sth->execute)
- or ErrMsg("execute failed: query $query, error %s.\n",
- $sth->errstr);
- my $n = $name;
- $n =~ s/\s+$//;
- Test($state or ($ref = $sth->fetchrow_arrayref))
- or ErrMsgF("fetch failed: query $query, error %s.\n",
- $sth->errstr);
- Test($state or ($$ref[1] eq $n))
- or ErrMsgF("problems with ChopBlanks = 1:"
- . " expected '%s', got '%s'.\n",
- $n, $$ref[1]);
-
- Test($state or $sth->finish)
- or ErrMsgF("Cannot finish: %s.\n", $sth->errstr);
- }
-
- #
- # Finally drop the test table.
- #
- Test($state or $dbh->do("DROP TABLE $table"))
- or ErrMsgF("Cannot DROP test table $table: %s.\n",
- $dbh->errstr);
-
- # ... and disconnect
- Test($state or $dbh->disconnect)
- or ErrMsgF("Cannot disconnect: %s.\n", $dbh->errmsg);
-}
-
-
-
+++ /dev/null
-#!/usr/local/bin/perl
-#
-# $Id: 50commit.t,v 1.1.1.1 2004/08/08 15:03:59 matt Exp $
-#
-# This is testing the transaction support.
-#
-$^W = 1;
-
-
-#
-# Include lib.pl
-#
-require DBI;
-$mdriver = "";
-foreach $file ("lib.pl", "t/lib.pl") {
- do $file; if ($@) { print STDERR "Error while executing lib.pl: $@\n";
- exit 10;
- }
- if ($mdriver ne '') {
- last;
- }
-}
-if ($mdriver eq 'whatever') {
- print "1..0\n";
- exit 0;
-}
-
-
-use vars qw($gotWarning);
-sub CatchWarning ($) {
- $gotWarning = 1;
-}
-
-
-sub NumRows($$$) {
- my($dbh, $table, $num) = @_;
- my($sth, $got);
-
- if (!($sth = $dbh->prepare("SELECT * FROM $table"))) {
- return "Failed to prepare: err " . $dbh->err . ", errstr "
- . $dbh->errstr;
- }
- if (!$sth->execute) {
- return "Failed to execute: err " . $dbh->err . ", errstr "
- . $dbh->errstr;
- }
- $got = 0;
- while ($sth->fetchrow_arrayref) {
- ++$got;
- }
- if ($got ne $num) {
- return "Wrong result: Expected $num rows, got $got.\n";
- }
- return '';
-}
-
-#
-# Main loop; leave this untouched, put tests after creating
-# the new table.
-#
-while (Testing()) {
- #
- # Connect to the database
- Test($state or ($dbh = DBI->connect($test_dsn, $test_user,
- $test_password)),
- 'connect',
- "Attempting to connect.\n")
- or ErrMsgF("Cannot connect: Error %s.\n\n"
- . "Make sure, your database server is up and running.\n"
- . "Check that '$test_dsn' references a valid database"
- . " name.\nDBI error message: %s\n",
- $DBI::err, $DBI::errstr);
-
- #
- # Find a possible new table name
- #
- Test($state or $table = FindNewTable($dbh))
- or ErrMsgF("Cannot determine a legal table name: Error %s.\n",
- $dbh->errstr);
-
- #
- # Create a new table
- #
- Test($state or ($def = TableDefinition($table,
- ["id", "INTEGER", 4, 0],
- ["name", "CHAR", 64, 0]),
- $dbh->do($def)))
- or ErrMsgF("Cannot create table: Error %s.\n",
- $dbh->errstr);
-
- Test($state or $dbh->{AutoCommit})
- or ErrMsg("AutoCommit is off\n", 'AutoCommint on');
-
- #
- # Tests for databases that do support transactions
- #
- if (HaveTransactions()) {
- # Turn AutoCommit off
- $dbh->{AutoCommit} = 0;
- Test($state or (!$dbh->err && !$dbh->errstr && !$dbh->{AutoCommit}))
- or ErrMsgF("Failed to turn AutoCommit off: err %s, errstr %s\n",
- $dbh->err, $dbh->errstr);
-
- # Check rollback
- Test($state or $dbh->do("INSERT INTO $table VALUES (1, 'Jochen')"))
- or ErrMsgF("Failed to insert value: err %s, errstr %s.\n",
- $dbh->err, $dbh->errstr);
- my $msg;
- Test($state or !($msg = NumRows($dbh, $table, 1)))
- or ErrMsg($msg);
- Test($state or $dbh->rollback)
- or ErrMsgF("Failed to rollback: err %s, errstr %s.\n",
- $dbh->err, $dbh->errstr);
- Test($state or !($msg = NumRows($dbh, $table, 0)))
- or ErrMsg($msg);
-
- # Check commit
- Test($state or $dbh->do("DELETE FROM $table WHERE id = 1"))
- or ErrMsgF("Failed to insert value: err %s, errstr %s.\n",
- $dbh->err, $dbh->errstr);
- Test($state or !($msg = NumRows($dbh, $table, 0)))
- or ErrMsg($msg);
- Test($state or $dbh->commit)
- or ErrMsgF("Failed to rollback: err %s, errstr %s.\n",
- $dbh->err, $dbh->errstr);
- Test($state or !($msg = NumRows($dbh, $table, 0)))
- or ErrMsg($msg);
-
- # Check auto rollback after disconnect
- Test($state or $dbh->do("INSERT INTO $table VALUES (1, 'Jochen')"))
- or ErrMsgF("Failed to insert: err %s, errstr %s.\n",
- $dbh->err, $dbh->errstr);
- Test($state or !($msg = NumRows($dbh, $table, 1)))
- or ErrMsg($msg);
- Test($state or $dbh->disconnect)
- or ErrMsgF("Failed to disconnect: err %s, errstr %s.\n",
- $dbh->err, $dbh->errstr);
- Test($state or ($dbh = DBI->connect($test_dsn, $test_user,
- $test_password)))
- or ErrMsgF("Failed to reconnect: err %s, errstr %s.\n",
- $DBI::err, $DBI::errstr);
- Test($state or !($msg = NumRows($dbh, $table, 0)))
- or ErrMsg($msg);
-
- # Check whether AutoCommit is on again
- Test($state or $dbh->{AutoCommit})
- or ErrMsg("AutoCommit is off\n");
-
- #
- # Tests for databases that don't support transactions
- #
- } else {
- if (!$state) {
- $@ = '';
- eval { $dbh->{AutoCommit} = 0; }
- }
- Test($state or $@)
- or ErrMsg("Expected fatal error for AutoCommit => 0\n",
- 'AutoCommit off -> error');
- }
-
- # Check whether AutoCommit mode works.
- Test($state or $dbh->do("INSERT INTO $table VALUES (1, 'Jochen')"))
- or ErrMsgF("Failed to delete: err %s, errstr %s.\n",
- $dbh->err, $dbh->errstr);
- Test($state or !($msg = NumRows($dbh, $table, 1)), 'NumRows')
- or ErrMsg($msg);
- Test($state or $dbh->disconnect, 'disconnect')
- or ErrMsgF("Failed to disconnect: err %s, errstr %s.\n",
- $dbh->err, $dbh->errstr);
- Test($state or ($dbh = DBI->connect($test_dsn, $test_user,
- $test_password)))
- or ErrMsgF("Failed to reconnect: err %s, errstr %s.\n",
- $DBI::err, $DBI::errstr);
- Test($state or !($msg = NumRows($dbh, $table, 1)))
- or ErrMsg($msg);
-
- # Check whether commit issues a warning in AutoCommit mode
- Test($state or $dbh->do("INSERT INTO $table VALUES (2, 'Tim')"))
- or ErrMsgF("Failed to insert: err %s, errstr %s.\n",
- $dbh->err, $dbh->errstr);
- my $result;
- if (!$state) {
- $@ = '';
- $SIG{__WARN__} = \&CatchWarning;
- $gotWarning = 0;
- eval { $result = $dbh->commit; };
- $SIG{__WARN__} = 'DEFAULT';
- }
- Test($state or $gotWarning)
- or ErrMsg("Missing warning when committing in AutoCommit mode");
-
- # Check whether rollback issues a warning in AutoCommit mode
- # We accept error messages as being legal, because the DBI
- # requirement of just issueing a warning seems scary.
- Test($state or $dbh->do("INSERT INTO $table VALUES (3, 'Alligator')"))
- or ErrMsgF("Failed to insert: err %s, errstr %s.\n",
- $dbh->err, $dbh->errstr);
- if (!$state) {
- $@ = '';
- $SIG{__WARN__} = \&CatchWarning;
- $gotWarning = 0;
- eval { $result = $dbh->rollback; };
- $SIG{__WARN__} = 'DEFAULT';
- }
- Test($state or $gotWarning or $dbh->err)
- or ErrMsg("Missing warning when rolling back in AutoCommit mode");
-
-
- #
- # Finally drop the test table.
- #
- Test($state or $dbh->do("DROP TABLE $table"))
- or ErrMsgF("Cannot DROP test table $table: %s.\n",
- $dbh->errstr);
- Test($state or $dbh->disconnect())
- or ErrMsgF("Cannot DROP test table $table: %s.\n",
- $dbh->errstr);
-}
+++ /dev/null
-use Test;
-BEGIN { plan tests => 24 }
-use DBI;
-my $dbh = DBI->connect("dbi:SQLite2:dbname=foo", "", "", { });
-ok($dbh);
-$dbh->{PrintError} = 0;
-$dbh->do("drop table meta$_") for 1..4;
-$dbh->{PrintError} = 1;
-ok $dbh->do("create table meta1 (f1 varchar(2) PRIMARY KEY, f2 char(1))");
-ok $dbh->do("create table meta2 (f1 varchar(2), f2 char(1), PRIMARY KEY (f1))");
-ok $dbh->do("create table meta3 (f2 char(1), f1 varchar(2) PRIMARY KEY)");
-$dbh->trace(0);
-$DBI::neat_maxlen = 4000;
-my $sth = $dbh->primary_key_info('', '', '%');
-ok $sth;
-my $pki = $sth->fetchall_hashref('TABLE_NAME');
-ok $pki;
-#use Data::Dumper; print Dumper($pki);
-ok keys %$pki == 3;
-ok $_->{COLUMN_NAME} eq 'f1' for values %$pki;
-
-ok $dbh->do("create table meta4 (f1 varchar(2), f2 char(1), PRIMARY KEY (f1,f2))");
-$sth = $dbh->primary_key_info('', '', 'meta4');
-ok $sth;
-$pki = $sth->fetchall_hashref('COLUMN_NAME');
-ok $pki;
-#use Data::Dumper; print Dumper($pki);
-ok keys %$pki == 2;
-ok $pki->{f1}->{KEY_SEQ} == 1;
-ok $pki->{f2}->{KEY_SEQ} == 2;
-
-my @pk = $dbh->primary_key('','','meta4');
-ok @pk == 2;
-ok "@pk" eq "f1 f2";
-
-ok $dbh->do("insert into meta4 values ('xyz', 'b')");
-$sth = $dbh->prepare("select * from meta4");
-ok $sth;
-ok $sth->execute();
-my $types = $sth->{TYPE};
-my $names = $sth->{NAME};
-ok( @$types == @$names );
-print "# Types: @$types\n";
-print "# Names: @$names\n";
-ok($types->[0] eq 'varchar(2)');
-ok($types->[1] eq 'char(1)');
+++ /dev/null
-use Test;
-use DBI;
-use Fatal qw(open);
-my @c_files = <*.c>, <*.xs>;
-plan tests => scalar(@c_files);
-
-FILE:
-foreach my $file (@c_files) {
- open(F, $file);
- my $line = 0;
- while (<F>) {
- $line++;
- if (/^(.*)\/\//) {
- my $m = $1;
- if ($m !~ /\*/) { # skip the // in c++ comment in parse.c
- ok(0, 1, "C++ comment in $file line $line");
- next FILE;
- }
- }
- }
- ok(1,1,"$file has no C++ comments");
- close(F);
-}
+++ /dev/null
-use Test;
-BEGIN { plan tests => 2 }
-ok(-e 'foo');
-unlink('foo');
-ok(!-e 'foo');
-
+++ /dev/null
-# Hej, Emacs, give us -*- perl -*- mode here!
-#
-# $Id: SQLite2.dbtest,v 1.1.1.1 2004/08/08 15:03:59 matt Exp $
-#
-# database specific definitions for a 'CSV' database
-
-
-# This function generates a mapping of ANSI type names to
-# database specific type names; it is called by TableDefinition().
-#
-sub AnsiTypeToDb ($;$) {
- my ($type, $size) = @_;
- my ($ret);
-
- if ((lc $type) eq 'char' || (lc $type) eq 'varchar') {
- $size ||= 1;
- return (uc $type) . " ($size)";
- } elsif ((lc $type) eq 'blob' || (lc $type) eq 'real' ||
- (lc $type) eq 'integer') {
- return uc $type;
- } elsif ((lc $type) eq 'int') {
- return 'INTEGER';
- } else {
- warn "Unknown type $type\n";
- $ret = $type;
- }
- $ret;
-}
-
-
-#
-# This function generates a table definition based on an
-# input list. The input list consists of references, each
-# reference referring to a single column. The column
-# reference consists of column name, type, size and a bitmask of
-# certain flags, namely
-#
-# $COL_NULLABLE - true, if this column may contain NULL's
-# $COL_KEY - true, if this column is part of the table's
-# primary key
-#
-# Hopefully there's no big need for you to modify this function,
-# if your database conforms to ANSI specifications.
-#
-
-sub TableDefinition ($@) {
- my($tablename, @cols) = @_;
- my($def);
-
- #
- # Should be acceptable for most ANSI conformant databases;
- #
- # msql 1 uses a non-ANSI definition of the primary key: A
- # column definition has the attribute "PRIMARY KEY". On
- # the other hand, msql 2 uses the ANSI fashion ...
- #
- my($col, @keys, @colDefs, $keyDef);
-
- #
- # Count number of keys
- #
- @keys = ();
- foreach $col (@cols) {
- if ($$col[2] & $::COL_KEY) {
- push(@keys, $$col[0]);
- }
- }
-
- foreach $col (@cols) {
- my $colDef = $$col[0] . " " . AnsiTypeToDb($$col[1], $$col[2]);
- if (!($$col[3] & $::COL_NULLABLE)) {
- $colDef .= " NOT NULL";
- }
- push(@colDefs, $colDef);
- }
- if (@keys) {
- $keyDef = ", PRIMARY KEY (" . join(", ", @keys) . ")";
- } else {
- $keyDef = "";
- }
- $def = sprintf("CREATE TABLE %s (%s%s)", $tablename,
- join(", ", @colDefs), $keyDef);
-}
-
-
-#
-# This function generates a list of tables associated to a
-# given DSN.
-#
-sub ListTables(@) {
- my($dbh) = shift;
- my(@tables);
-
- @tables = $dbh->func('list_tables');
- if ($dbh->errstr) {
- die "Cannot create table list: " . $dbh->errstr;
- }
- @tables;
-}
-
-
-#
-# This function is called by DBD::pNET; given a hostname and a
-# dsn without hostname, return a dsn for connecting to dsn at
-# host.
-sub HostDsn ($$) {
- my($hostname, $dsn) = @_;
- "$dsn:$hostname";
-}
-
-
-#
-# Return a string for checking, whether a given column is NULL.
-#
-sub IsNull($) {
- my($var) = @_;
-
- "$var IS NULL";
-}
-
-
-#
-# Return TRUE, if database supports transactions
-#
-sub HaveTransactions () {
- 1;
-}
-
-
-if (! -d "output") {
- mkdir "output", 0755;
-}
-
-1;
+++ /dev/null
-#!/usr/local/bin/perl
-#
-# $Id: ak-dbd.t,v 1.1.1.1 2004/08/08 15:03:59 matt Exp $
-#
-# This is a skeleton test. For writing new tests, take this file
-# and modify/extend it.
-#
-
-$^W = 1;
-$| = 1;
-
-
-#
-# Make -w happy
-#
-use vars qw($test_dsn $test_user $test_password $dbdriver $mdriver
- $verbose $state);
-use vars qw($COL_NULLABLE $COL_KEY);
-$test_dsn = '';
-$test_user = '';
-$test_password = '';
-
-
-#
-# Include lib.pl
-#
-use DBI;
-use strict;
-$dbdriver = "";
-{ my $file;
- foreach $file ("lib.pl", "t/lib.pl", "DBD-~DBD_DRIVER~/t/lib.pl") {
- do $file; if ($@) { print STDERR "Error while executing lib.pl: $@\n";
- exit 10;
- }
- if ($dbdriver ne '') {
- last;
- }
- }
-}
-
-my $test_db = '';
-my $test_hostname = $ENV{DBI_HOST} || 'localhost';
-
-if ($test_dsn =~ /^DBI\:[^\:]+\:/) {
- $test_db = $';
- if ($test_db =~ /:/) {
- $test_db = $`;
- $test_hostname = $';
- }
-}
-
-#
-# Main loop; leave this untouched, put tests after creating
-# the new table.
-#
-while (Testing()) {
- #
- # Connect to the database
- my($dbh, $sth, $test_table, $query);
- $test_table = ''; # Avoid warnings for undefined variables.
- Test($state or ($dbh = DBI->connect($test_dsn, $test_user,
- $test_password)))
- or ErrMsg("Cannot connect: $DBI::errstr.\n");
-
- #
- # Verify whether constants work
- #
- if ($mdriver eq 'mysql') {
- my ($val);
- Test($state or (($val = &DBD::mysql::FIELD_TYPE_STRING()) == 254))
- or ErrMsg("Wrong value for FIELD_TYPE_STRING:"
- . " Expected 254, got $val\n");
- Test($state or (($val = &DBD::mysql::FIELD_TYPE_SHORT()) == 2))
- or ErrMsg("Wrong value for FIELD_TYPE_SHORT:"
- . " Expected 2, got $val\n");
- } elsif ($mdriver eq 'mSQL') {
- my ($val);
- Test($state or (($val = &DBD::mSQL::CHAR_TYPE()) == 2))
- or ErrMsg("Wrong value for CHAR_TYPE: Expected 2, got $val\n");
- Test($state or (($val = &DBD::mSQL::INT_TYPE()) == 1))
- or ErrMsg("Wrong value for INT_TYPE: Expected 1, got $val\n");
- }
-
- #
- # Find a possible new table name
- #
- Test($state or $test_table = FindNewTable($dbh)) or !$verbose
- or ErrMsg("Cannot get table name: $dbh->errstr.\n");
-
- #
- # Create a new table; EDIT THIS!
- #
- Test($state or ($query = TableDefinition($test_table,
- ["id", "INTEGER", 4, $COL_NULLABLE],
- ["name", "CHAR", 64, $COL_NULLABLE]),
- $dbh->do($query)))
- or ErrMsg("Cannot create table: query $query error $dbh->errstr.\n");
-
- #
- # and here's the right place for inserting new tests:
- #
- Test($state or $dbh->quote('tast1'))
- or ErrMsgF("quote('tast1') returned %s.\n", $dbh->quote('tast1'));
-
- ### ...and disconnect
- Test($state or $dbh->disconnect)
- or ErrMsg("\$dbh->disconnect() failed!\n",
- "Make sure your server is still functioning",
- "correctly, and check to make\n",
- "sure your network isn\'t malfunctioning in the",
- "case of the server running on a remote machine.\n");
-
- ### Now, re-connect again so that we can do some more complicated stuff..
- Test($state or ($dbh = DBI->connect($test_dsn, $test_user,
- $test_password)))
- or ErrMsg("reconnect failed: $DBI::errstr\n");
-
- ### List all the tables in the selected database........
- ### This test for mSQL and mysql only.
- if ($mdriver eq 'mysql' or $mdriver eq 'mSQL' or $mdriver eq 'mSQL1') {
- Test($state or $dbh->func('_ListTables'))
- or ErrMsgF("_ListTables failed: $dbh->errstr.\n"
- . "This could be due to the fact you have no tables,"
- . " but I hope not. You\n"
- . "could try running '%s -h %s %s' and see if it\n"
- . "reports any information about your database,"
- . " or errors.\n",
- ($mdriver eq 'mysql') ? "mysqlshow" : "relshow",
- $test_hostname, $test_db);
- }
-
- Test($state or $dbh->do("DROP TABLE $test_table"))
- or ErrMsg("Dropping table failed: $dbh->errstr.\n");
- Test($state or ($query = TableDefinition($test_table,
- ["id", "INTEGER", 4, $COL_NULLABLE],
- ["name", "CHAR", 64, $COL_NULLABLE]),
- $dbh->do($query)))
- or ErrMsg("create failed, query $query, error $dbh->errstr.\n");
-
- ### Get some meta-data for the table we've just created...
- if ($mdriver eq 'mysql' or $mdriver eq 'mSQL1' or $mdriver eq 'mSQL') {
- my $ref;
- Test($state or ($ref = $dbh->prepare("LISTFIELDS $test_table")))
- or ErrMsg("listfields failed: $dbh->errstr.\n");
- Test($state or $ref->execute);
- }
-
- ### Insert a row into the test table.......
- print "Inserting a row...\n";
- Test($state or ($dbh->do("INSERT INTO $test_table VALUES(1,"
- . " 'Alligator Descartes')")))
- or ErrMsg("INSERT failed: $dbh->errstr.\n");
-
- ### ...and delete it........
- print "Deleting a row...\n";
- Test($state or $dbh->do("DELETE FROM $test_table WHERE id = 1"))
- or ErrMsg("Cannot delete row: $dbh->errstr.\n");
- Test($state or ($sth = $dbh->prepare("SELECT * FROM $test_table"
- . " WHERE id = 1")))
- or ErrMsg("Cannot select: $dbh->errstr.\n");
-
- # This should fail with error message: We "forgot" execute.
- my($pe) = $sth->{'PrintError'};
- $sth->{'PrintError'} = 0;
- Test($state or !eval { $sth->fetchrow() })
- or ErrMsg("Missing error report from fetchrow.\n");
- $sth->{'PrintError'} = $pe;
-
- Test($state or $sth->execute)
- or ErrMsg("execute SELECT failed: $dbh->errstr.\n");
-
- # This should fail without error message: No rows returned.
- my(@row, $ref);
- {
- local($^W) = 0;
- Test($state or !defined($ref = $sth->fetch))
- or ErrMsgF("Unexpected row returned by fetchrow: $ref\n".
- scalar(@row));
- }
-
- # Now try a "finish"
- Test($state or $sth->finish)
- or ErrMsg("sth->finish failed: $sth->errstr.\n");
-
- # Call destructors:
- Test($state or (undef $sth || 1));
-
- ### This section should exercise the sth->func( '_NumRows' ) private
- ### method by preparing a statement, then finding the number of rows
- ### within it. Prior to execution, this should fail. After execution,
- ### the number of rows affected by the statement will be returned.
- Test($state or ($dbh->do($query = "INSERT INTO $test_table VALUES"
- . " (1, 'Alligator Descartes' )")))
- or ErrMsgF("INSERT failed: query $query, error %s.\n", $dbh->errstr);
- Test($state or ($sth = $dbh->prepare($query = "SELECT * FROM $test_table"
- . " WHERE id = 1")))
- or ErrMsgF("prepare failed: query $query, error %s.\n", $dbh->errstr);
- if ($dbdriver eq 'mysql' || $dbdriver eq 'mSQL' ||
- $dbdriver eq 'mSQL1') {
- Test($state or defined($sth->rows))
- or ErrMsg("sth->rows returning result before 'execute'.\n");
- }
-
- if (!$state) {
- print "Test 19: Setting \$debug_me to TRUE\n"; $::debug_me = 1;
- }
- Test($state or $sth->execute)
- or ErrMsgF("execute failed: query $query, error %s.\n", $sth->errstr);
- Test($state or ($sth->rows == 1) or ($sth->rows == -1))
- or ErrMsgF("sth->rows returned wrong result %s after 'execute'.\n",
- $sth->rows);
- Test($state or $sth->finish)
- or ErrMsgF("finish failed: %s.\n", $sth->errstr);
- Test($state or (undef $sth or 1));
-
- ### Test whether or not a field containing a NULL is returned correctly
- ### as undef, or something much more bizarre
- $query = "INSERT INTO $test_table VALUES ( NULL, 'NULL-valued id' )";
- Test($state or $dbh->do($query))
- or ErrMsgF("INSERT failed: query $query, error %s.\n", $dbh->errstr);
- $query = "SELECT id FROM $test_table WHERE " . IsNull("id");
- Test($state or ($sth = $dbh->prepare($query)))
- or ErrMsgF("Cannot prepare, query = $query, error %s.\n",
- $dbh->errstr);
- if (!$state) {
- print "Test 25: Setting \$debug_me to TRUE\n"; $::debug_me = 1;
- }
- Test($state or $sth->execute)
- or ErrMsgF("Cannot execute, query = $query, error %s.\n",
- $dbh->errstr);
- my $rv;
- Test($state or defined($rv = $sth->fetch) or $dbdriver eq 'CSV'
- or $dbdriver eq 'ConfFile')
- or ErrMsgF("fetch failed, error %s.\n", $dbh->errstr);
- Test($state or !defined($$rv[0]))
- or ErrMsgF("Expected NULL value, got %s.\n", $$rv[0]);
- Test($state or $sth->finish)
- or ErrMsgF("finish failed: %s.\n", $sth->errstr);
- Test($state or undef $sth or 1);
-
- ### Delete the test row from the table
- $query = "DELETE FROM $test_table WHERE id = NULL AND"
- . " name = 'NULL-valued id'";
- Test($state or ($rv = $dbh->do($query)))
- or ErrMsg("DELETE failed: query $query, error %s.\n", $dbh->errstr);
-
- ### Test whether or not a char field containing a blank is returned
- ### correctly as blank, or something much more bizarre
- $query = "INSERT INTO $test_table VALUES (2, NULL)";
- Test($state or $dbh->do($query))
- or ErrMsg("INSERT failed: query $query, error %s.\n", $dbh->errstr);
- $query = "SELECT name FROM $test_table WHERE id = 2 AND name IS NULL";
-
- Test($state or ($sth = $dbh->prepare($query)))
- or ErrMsg("prepare failed: query $query, error %s.\n", $dbh->errstr);
- Test($state or $sth->execute)
- or ErrMsg("execute failed: query $query, error %s.\n", $dbh->errstr);
- $rv = undef;
- Test($state or defined($ref = $sth->fetch))
- or ErrMsgF("fetchrow failed: query $query, error %s.\n", $sth->errstr);
- Test($state or !defined($$ref[0]) )
- or ErrMsgF("blank value returned as [%s].\n", $$ref[0]);
- Test($state or $sth->finish)
- or ErrMsg("finish failed: $sth->errmsg.\n");
- Test($state or undef $sth or 1);
-
- ### Delete the test row from the table
- $query = "DELETE FROM $test_table WHERE id = 2 AND name IS NULL";
- Test($state or $dbh->do($query))
- or ErrMsg("DELETE failed: query $query, error $dbh->errstr.\n");
-
- ### Test the new funky routines to list the fields applicable to a SELECT
- ### statement, and not necessarily just those in a table...
- $query = "SELECT * FROM $test_table";
- Test($state or ($sth = $dbh->prepare($query)))
- or ErrMsg("prepare failed: query $query, error $dbh->errstr.\n");
- Test($state or $sth->execute)
- or ErrMsg("execute failed: query $query, error $dbh->errstr.\n");
- if ($mdriver eq 'mysql' || $mdriver eq 'mSQL' || $mdriver eq 'mSQL1') {
- my($warning);
- $SIG{__WARN__} = sub { $warning = shift; };
- Test($state or ($ref = $sth->func('_ListSelectedFields')))
- or ErrMsg("_ListSelectedFields failed, error $sth->errstr.\n");
- Test($state or ($warning =~ /deprecated/))
- or ErrMsg("Expected warning from _ListSelectedFields");
- $SIG{__WARN__} = 'DEFAULT';
- }
- Test($state or $sth->execute, 'execute 284')
- or ErrMsg("re-execute failed: query $query, error $dbh->errstr.\n");
- Test($state or (@row = $sth->fetchrow_array), 'fetchrow 286')
- or ErrMsg("Query returned no result, query $query,",
- " error $sth->errstr.\n");
- Test($state or $sth->finish)
- or ErrMsg("finish failed: $sth->errmsg.\n");
- Test($state or undef $sth or 1);
-
- ### Insert some more data into the test table.........
- $query = "INSERT INTO $test_table VALUES( 2, 'Gary Shea' )";
- Test($state or $dbh->do($query))
- or ErrMsg("INSERT failed: query $query, error $dbh->errstr.\n");
- $query = "UPDATE $test_table SET id = 3 WHERE name = 'Gary Shea'";
- Test($state or ($sth = $dbh->prepare($query)))
- or ErrMsg("prepare failed: query $query, error $sth->errmsg.\n");
- # This should fail: We "forgot" execute.
- if ($mdriver eq 'mysql' || $mdriver eq 'mSQL' ||
- $mdriver eq 'mSQL1') {
- Test($state or !defined($sth->{'NAME'}))
- or ErrMsg("Expected error without execute, got $ref.\n");
- }
- Test($state or undef $sth or 1);
-
- ### Drop the test table out of our database to clean up.........
- $query = "DROP TABLE $test_table";
- Test($state or $dbh->do($query))
- or ErrMsg("DROP failed: query $query, error $dbh->errstr.\n");
-
- Test($state or $dbh->disconnect)
- or ErrMsg("disconnect failed: $dbh->errstr.\n");
-
- #
- # Try mysql's insertid feature
- #
- if ($dbdriver eq 'mysql') {
- my ($sth, $table);
- Test($state or ($dbh = DBI->connect($test_dsn, $test_user,
- $test_password)))
- or ErrMsgF("connect failed: %s.\n", $DBI::errstr);
- Test($state or ($table = FindNewTable($dbh)));
- Test($state or $dbh->do("CREATE TABLE $table ("
- . " id integer AUTO_INCREMENT PRIMARY KEY,"
- . " country char(30) NOT NULL)"))
- or printf("Error while executing query: %s\n", $dbh->errstr);
- Test($state or
- ($sth = $dbh->prepare("INSERT INTO $table VALUES (NULL, 'a')")))
- or printf("Error while preparing query: %s\n", $dbh->errstr);
- Test($state or $sth->execute)
- or printf("Error while executing query: %s\n", $sth->errstr);
- Test($state or $sth->finish)
- or printf("Error while finishing query: %s\n", $sth->errstr);
- Test($state or
- ($sth = $dbh->prepare("INSERT INTO $table VALUES (NULL, 'b')")))
- or printf("Error while preparing query: %s\n", $dbh->errstr);
- Test($state or $sth->execute)
- or printf("Error while executing query: %s\n", $sth->errstr);
- Test($state or $sth->{insertid} =~ /\d+/)
- or printf("insertid generated incorrect result: %s\n",
- $sth->insertid);
- Test($state or $sth->finish)
- or printf("Error while finishing query: %s\n", $sth->errstr);
- Test($state or $dbh->do("DROP TABLE $table"));
- Test($state or $dbh->disconnect)
- or ErrMsg("disconnect failed: $dbh->errstr.\n");
- }
-}
+++ /dev/null
-#!/usr/local/bin/perl
-#
-# Test suite for the admin functions of DBD::mSQL and DBD::mysql.
-#
-
-
-#
-# Make -w happy
-#
-$test_dsn = $test_user = $test_password = $verbose = '';
-$| = 1;
-
-
-#
-# Include lib.pl
-#
-$DBI::errstr = ''; # Make -w happy
-require DBI;
-$mdriver = "";
-foreach $file ("lib.pl", "t/lib.pl", "DBD-~DBD_DRIVER~/t/lib.pl") {
- do $file; if ($@) { print STDERR "Error while executing lib.pl: $@\n";
- exit 10;
- }
- if ($mdriver ne '') {
- last;
- }
-}
-
-
-sub ServerError() {
- print STDERR ("Cannot connect: ", $DBI::errstr, "\n",
- "\tEither your server is not up and running or you have no\n",
- "\tpermissions for acessing the DSN $test_dsn.\n",
- "\tThis test requires a running server and write permissions.\n",
- "\tPlease make sure your server is running and you have\n",
- "\tpermissions, then retry.\n");
- exit 10;
-}
-
-
-sub InDsnList($@) {
- my($dsn, @dsnList) = @_;
- my($d);
- foreach $d (@dsnList) {
- if ($d =~ /^dbi:[^:]+:$dsn\b/i) {
- return 1;
- }
- }
- 0;
-}
-
-
-#
-# Main loop; leave this untouched, put tests after creating
-# the new table.
-#
-while (Testing()) {
- # Check if the server is awake.
- $dbh = undef;
- Test($state or ($dbh = DBI->connect($test_dsn, $test_user,
- $test_password)))
- or ServerError();
-
- Test($state or (@dsn = DBI->data_sources($mdriver)) >= 0);
- if (!$state && $verbose) {
- my $d;
- print "List of $mdriver data sources:\n";
- foreach $d (@dsn) {
- print " $d\n";
- }
- print "List ends.\n";
- }
-
- my $drh;
- Test($state or ($drh = DBI->install_driver($mdriver)))
- or print STDERR ("Cannot obtain drh: " . $DBI::errstr);
-
- #
- # Check the ping method.
- #
- Test($state or $dbh->ping())
- or ErrMsgF("Ping failed: %s.\n", $dbh->errstr);
-
-
- if ($mdriver eq 'mSQL' or $mdriver eq 'mysql') {
- my($testdsn) = "testaa";
- my($testdsn1, $testdsn2);
- my($accessDenied) = 0;
- my($warning);
- my($warningSub) = sub { $warning = shift };
-
- if (!$state) {
- while (InDsnList($testdsn, @dsn)) {
- ++$testdsn;
- }
- $testdsn1 = $testdsn;
- ++$testdsn1;
- while (InDsnList($testdsn1, @dsn)) {
- ++$testdsn1;
- }
- $testdsn2 = $testdsn1;
- ++$testdsn2;
- while (InDsnList($testdsn2, @dsn)) {
- ++$testdsn2;
- }
-
- $SIG{__WARN__} = $warningSub;
- $warning = '';
- if (!($result = $drh->func($testdsn, '_CreateDB'))
- and ($drh->errstr =~ /(access|permission) denied/i)) {
- $accessDenied = 1;
- $result = 1;
- }
- $SIG{__WARN__} = 'DEFAULT';
- }
-
- Test($state or $result)
- or print STDERR ("Error while executing _CreateDB: "
- . $drh->errstr);
- Test($state or ($warning =~ /deprecated/))
- or print STDERR ("Expected warning, got '$warning'.\n");
-
- Test($state or $accessDenied
- or InDsnList($testdsn, DBI->data_sources($mdriver)))
- or print STDERR ("New DB not in DSN list\n");
-
- $SIG{__WARN__} = $warningSub;
- $warning = '';
- Test($state or $accessDenied
- or $drh->func($testdsn, '_DropDB'))
- or print STDERR ("Error while executing _DropDB: "
- . $drh->errstr);
- Test($state or $accessDenied or ($warning =~ /deprecated/))
- or print STDERR ("Expected warning, got '$warning'\n");
- $SIG{__WARN__} = 'DEFAULT';
-
- Test($state or $accessDenied
- or !InDsnList($testdsn, DBI->data_sources($mdriver)))
- or print STDERR ("New DB not removed from DSN list\n");
-
- my($mayShutdown) = $ENV{'DB_SHUTDOWN_ALLOWED'};
-
- Test($state or $accessDenied
- or $drh->func('createdb', $testdsn1, 'admin'))
- or printf STDERR ("\$drh->admin('createdb') failed: %s\n",
- $drh->errstr);
- Test($state or $accessDenied
- or InDsnList($testdsn1, DBI->data_sources($mdriver)))
- or printf STDERR ("DSN $testdsn1 not in DSN list.\n");
- Test($state or $accessDenied
- or $drh->func('dropdb', $testdsn1, 'admin'))
- or printf STDERR ("\$drh->admin('dropdb') failed: %s\n",
- $drh->errstr);
- Test($state or $accessDenied
- or !InDsnList($testdsn1, DBI->data_sources($mdriver)))
- or printf STDERR ("DSN $testdsn1 not removed from DSN list.\n");
- Test($state or $accessDenied
- or $drh->func('createdb', $testdsn2, 'admin'))
- or printf STDERR ("\$drh->admin('createdb') failed: %s\n",
- $drh->errstr);
- Test($state or $accessDenied
- or InDsnList($testdsn2, DBI->data_sources($mdriver)))
- or printf STDERR ("DSN $testdsn2 not in DSN list.\n");
- Test($state or $accessDenied
- or $drh->func('dropdb', $testdsn2, 'admin'))
- or printf STDERR ("\$drh->admin('dropdb') failed: %s\n",
- $drh->errstr);
- Test($state or $accessDenied
- or !InDsnList($testdsn2, DBI->data_sources($mdriver)))
- or printf STDERR ("DSN $testdsn2 not removed from DSN list.\n");
-
- if ($mdriver eq 'mysql') {
- #
- # Try to do a shutdown.
- #
- Test($state or !$mayShutdown or $accessDenied
- or $dbh->func("shutdown", "admin"))
- or ErrMsgF("Cannot shutdown database: %s.\n", $dbh->errstr);
- if (!$state) {
- sleep 10;
- }
-
- #
- # Pinging should fail now.
- #
- Test($state or !$mayShutdown or $accessDenied or !$dbh->ping())
- or print STDERR ("Shutdown failed (ping succeeded)");
-
- #
- # Restart the database
- #
- if (!$state && $mayShutdown && !$accessDenied) {
- if (fork() == 0) {
- close STDIN;
- close STDOUT;
- close STDERR;
- exec "safe_mysqld &";
- }
- }
- sleep 5;
-
- #
- # Try DBD::mysql's automatic reconnect
- #
- Test($state or $dbh->ping())
- or ErrMsgF("Reconnect failed: %s.\n", $dbh->errstr);
- }
-
- Test($state or $dbh->disconnect);
- }
-}
+++ /dev/null
-# Hej, Emacs, give us -*- perl mode here!
-#
-# $Id: lib.pl,v 1.1.1.1 2004/08/08 15:03:59 matt Exp $
-#
-# lib.pl is the file where database specific things should live,
-# whereever possible. For example, you define certain constants
-# here and the like.
-#
-
-require 5.003;
-use strict;
-use vars qw($mdriver $dbdriver $childPid $test_dsn $test_user $test_password
- $haveFileSpec);
-
-
-#
-# Driver names; EDIT THIS!
-#
-$mdriver = 'SQLite2';
-$dbdriver = $mdriver; # $dbdriver is usually just the same as $mdriver.
- # The exception is DBD::pNET where we have to
- # to separate between local driver (pNET) and
- # the remote driver ($dbdriver)
-
-
-#
-# DSN being used; do not edit this, edit "$dbdriver.dbtest" instead
-#
-$haveFileSpec = eval { require File::Spec };
-my $table_dir = $haveFileSpec ?
- File::Spec->catdir(File::Spec->curdir(), 'output', 'foo') : 'output/foo';
-$test_dsn = $ENV{'DBI_DSN'}
- || "DBI:$dbdriver:dbname=$table_dir";
-$test_user = $ENV{'DBI_USER'} || "";
-$test_password = $ENV{'DBI_PASS'} || "";
-
-
-$::COL_NULLABLE = 1;
-$::COL_KEY = 2;
-
-
-my $file;
-if (-f ($file = "t/$dbdriver.dbtest") ||
- -f ($file = "$dbdriver.dbtest") ||
- -f ($file = "../tests/$dbdriver.dbtest") ||
- -f ($file = "tests/$dbdriver.dbtest")) {
- eval { require $file; };
- if ($@) {
- print STDERR "Cannot execute $file: $@.\n";
- print "1..0\n";
- exit 0;
- }
-}
-if (-f ($file = "t/$mdriver.mtest") ||
- -f ($file = "$mdriver.mtest") ||
- -f ($file = "../tests/$mdriver.mtest") ||
- -f ($file = "tests/$mdriver.mtest")) {
- eval { require $file; };
- if ($@) {
- print STDERR "Cannot execute $file: $@.\n";
- print "1..0\n";
- exit 0;
- }
-}
-
-
-open (STDERR, ">&STDOUT") || die "Cannot redirect stderr" ;
-select (STDERR) ; $| = 1 ;
-select (STDOUT) ; $| = 1 ;
-
-
-#
-# The Testing() function builds the frame of the test; it can be called
-# in many ways, see below.
-#
-# Usually there's no need for you to modify this function.
-#
-# Testing() (without arguments) indicates the beginning of the
-# main loop; it will return, if the main loop should be
-# entered (which will happen twice, once with $state = 1 and
-# once with $state = 0)
-# Testing('off') disables any further tests until the loop ends
-# Testing('group') indicates the begin of a group of tests; you
-# may use this, for example, if there's a certain test within
-# the group that should make all other tests fail.
-# Testing('disable') disables further tests within the group; must
-# not be called without a preceding Testing('group'); by default
-# tests are enabled
-# Testing('enabled') reenables tests after calling Testing('disable')
-# Testing('finish') terminates a group; any Testing('group') must
-# be paired with Testing('finish')
-#
-# You may nest test groups.
-#
-{
- # Note the use of the pairing {} in order to get local, but static,
- # variables.
- my (@stateStack, $count, $off);
-
- $count = 0;
-
- sub Testing(;$) {
- my ($command) = shift;
- if (!defined($command)) {
- @stateStack = ();
- $off = 0;
- if ($count == 0) {
- ++$count;
- $::state = 1;
- } elsif ($count == 1) {
- my($d);
- if ($off) {
- print "1..0\n";
- exit 0;
- }
- ++$count;
- $::state = 0;
- print "1..$::numTests\n";
- } else {
- return 0;
- }
- if ($off) {
- $::state = 1;
- }
- $::numTests = 0;
- } elsif ($command eq 'off') {
- $off = 1;
- $::state = 0;
- } elsif ($command eq 'group') {
- push(@stateStack, $::state);
- } elsif ($command eq 'disable') {
- $::state = 0;
- } elsif ($command eq 'enable') {
- if ($off) {
- $::state = 0;
- } else {
- my $s;
- $::state = 1;
- foreach $s (@stateStack) {
- if (!$s) {
- $::state = 0;
- last;
- }
- }
- }
- return;
- } elsif ($command eq 'finish') {
- $::state = pop(@stateStack);
- } else {
- die("Testing: Unknown argument\n");
- }
- return 1;
- }
-
-
-#
-# Read a single test result
-#
-
- sub Test ($;$$) {
- my($result, $error, $diag) = @_;
-
- ++$::numTests;
- if ($count == 2) {
- if (defined($diag)) {
- printf("$diag%s", (($diag =~ /\n$/) ? "" : "\n"));
- }
- if ($::state || $result) {
- print "ok $::numTests ". (defined($error) ? "$error\n" : "\n");
- return 1;
- } else {
- print("not ok $::numTests - " .
- (defined($error) ? "$error\n" : "\n"));
- print("FAILED Test $::numTests - " .
- (defined($error) ? "$error\n" : "\n"));
- return 0;
- }
- }
- return 1;
- }
-}
-
-
-#
-# Print a DBI error message
-#
-sub DbiError ($$) {
- my($rc, $err) = @_;
- $rc ||= 0;
- $err ||= '';
- print "Test $::numTests: DBI error $rc, $err\n";
-}
-
-
-#
-# This functions generates a list of possible DSN's aka
-# databases and returns a possible table name for a new
-# table being created.
-#
-# Problem is, we have two different situations here: Test scripts
-# call us by pasing a dbh, which is fine for most situations.
-# From within DBD::pNET, however, the dbh isn't that meaningful.
-# Thus we are working with the global variable $listTablesHook:
-# Once defined, we call &$listTablesHook instead of ListTables.
-#
-# See DBD::pNET/t/pNET.mtest for details.
-#
-{
- use vars qw($listTablesHook);
-
- my(@tables, $testtable, $listed);
-
- $testtable = "testaa";
- $listed = 0;
-
- sub FindNewTable($) {
- my($dbh) = @_;
-
- if (!$listed) {
- if (defined($listTablesHook)) {
- @tables = &$listTablesHook($dbh);
- } elsif (defined(&ListTables)) {
- @tables = &ListTables($dbh);
- } else {
- die "Fatal: ListTables not implemented.\n";
- }
- $listed = 1;
- }
-
- # A small loop to find a free test table we can use to mangle stuff in
- # and out of. This starts at testaa and loops until testaz, then testba
- # - testbz and so on until testzz.
- my $foundtesttable = 1;
- my $table;
- while ($foundtesttable) {
- $foundtesttable = 0;
- foreach $table (@tables) {
- if ($table eq $testtable) {
- $testtable++;
- $foundtesttable = 1;
- }
- }
- }
- $table = $testtable;
- $testtable++;
- $table;
- }
-}
-
-
-sub ErrMsg { print (@_); }
-sub ErrMsgF { printf (@_); }
-
-
-1;
+++ /dev/null
-/*
-** 2001 September 15
-**
-** The author disclaims copyright to this source code. In place of
-** a legal notice, here is a blessing:
-**
-** May you do good and not evil.
-** May you find forgiveness for yourself and forgive others.
-** May you share freely, never taking more than you give.
-**
-*************************************************************************
-** This file contains the sqlite_get_table() and sqlite_free_table()
-** interface routines. These are just wrappers around the main
-** interface routine of sqlite_exec().
-**
-** These routines are in a separate files so that they will not be linked
-** if they are not used.
-*/
-#include <stdlib.h>
-#include <string.h>
-#include "sqliteInt.h"
-
-/*
-** This structure is used to pass data from sqlite_get_table() through
-** to the callback function is uses to build the result.
-*/
-typedef struct TabResult {
- char **azResult;
- char *zErrMsg;
- int nResult;
- int nAlloc;
- int nRow;
- int nColumn;
- long nData;
- int rc;
-} TabResult;
-
-/*
-** This routine is called once for each row in the result table. Its job
-** is to fill in the TabResult structure appropriately, allocating new
-** memory as necessary.
-*/
-static int sqlite_get_table_cb(void *pArg, int nCol, char **argv, char **colv){
- TabResult *p = (TabResult*)pArg;
- int need;
- int i;
- char *z;
-
- /* Make sure there is enough space in p->azResult to hold everything
- ** we need to remember from this invocation of the callback.
- */
- if( p->nRow==0 && argv!=0 ){
- need = nCol*2;
- }else{
- need = nCol;
- }
- if( p->nData + need >= p->nAlloc ){
- char **azNew;
- p->nAlloc = p->nAlloc*2 + need + 1;
- azNew = realloc( p->azResult, sizeof(char*)*p->nAlloc );
- if( azNew==0 ){
- p->rc = SQLITE_NOMEM;
- return 1;
- }
- p->azResult = azNew;
- }
-
- /* If this is the first row, then generate an extra row containing
- ** the names of all columns.
- */
- if( p->nRow==0 ){
- p->nColumn = nCol;
- for(i=0; i<nCol; i++){
- if( colv[i]==0 ){
- z = 0;
- }else{
- z = malloc( strlen(colv[i])+1 );
- if( z==0 ){
- p->rc = SQLITE_NOMEM;
- return 1;
- }
- strcpy(z, colv[i]);
- }
- p->azResult[p->nData++] = z;
- }
- }else if( p->nColumn!=nCol ){
- sqliteSetString(&p->zErrMsg,
- "sqlite_get_table() called with two or more incompatible queries",
- (char*)0);
- p->rc = SQLITE_ERROR;
- return 1;
- }
-
- /* Copy over the row data
- */
- if( argv!=0 ){
- for(i=0; i<nCol; i++){
- if( argv[i]==0 ){
- z = 0;
- }else{
- z = malloc( strlen(argv[i])+1 );
- if( z==0 ){
- p->rc = SQLITE_NOMEM;
- return 1;
- }
- strcpy(z, argv[i]);
- }
- p->azResult[p->nData++] = z;
- }
- p->nRow++;
- }
- return 0;
-}
-
-/*
-** Query the database. But instead of invoking a callback for each row,
-** malloc() for space to hold the result and return the entire results
-** at the conclusion of the call.
-**
-** The result that is written to ***pazResult is held in memory obtained
-** from malloc(). But the caller cannot free this memory directly.
-** Instead, the entire table should be passed to sqlite_free_table() when
-** the calling procedure is finished using it.
-*/
-int sqlite_get_table(
- sqlite *db, /* The database on which the SQL executes */
- const char *zSql, /* The SQL to be executed */
- char ***pazResult, /* Write the result table here */
- int *pnRow, /* Write the number of rows in the result here */
- int *pnColumn, /* Write the number of columns of result here */
- char **pzErrMsg /* Write error messages here */
-){
- int rc;
- TabResult res;
- if( pazResult==0 ){ return SQLITE_ERROR; }
- *pazResult = 0;
- if( pnColumn ) *pnColumn = 0;
- if( pnRow ) *pnRow = 0;
- res.zErrMsg = 0;
- res.nResult = 0;
- res.nRow = 0;
- res.nColumn = 0;
- res.nData = 1;
- res.nAlloc = 20;
- res.rc = SQLITE_OK;
- res.azResult = malloc( sizeof(char*)*res.nAlloc );
- if( res.azResult==0 ){
- return SQLITE_NOMEM;
- }
- res.azResult[0] = 0;
- rc = sqlite_exec(db, zSql, sqlite_get_table_cb, &res, pzErrMsg);
- if( res.azResult ){
- res.azResult[0] = (char*)res.nData;
- }
- if( rc==SQLITE_ABORT ){
- sqlite_free_table(&res.azResult[1]);
- if( res.zErrMsg ){
- if( pzErrMsg ){
- free(*pzErrMsg);
- *pzErrMsg = res.zErrMsg;
- sqliteStrRealloc(pzErrMsg);
- }else{
- sqliteFree(res.zErrMsg);
- }
- }
- return res.rc;
- }
- sqliteFree(res.zErrMsg);
- if( rc!=SQLITE_OK ){
- sqlite_free_table(&res.azResult[1]);
- return rc;
- }
- if( res.nAlloc>res.nData ){
- char **azNew;
- azNew = realloc( res.azResult, sizeof(char*)*(res.nData+1) );
- if( azNew==0 ){
- sqlite_free_table(&res.azResult[1]);
- return SQLITE_NOMEM;
- }
- res.nAlloc = res.nData+1;
- res.azResult = azNew;
- }
- *pazResult = &res.azResult[1];
- if( pnColumn ) *pnColumn = res.nColumn;
- if( pnRow ) *pnRow = res.nRow;
- return rc;
-}
-
-/*
-** This routine frees the space the sqlite_get_table() malloced.
-*/
-void sqlite_free_table(
- char **azResult /* Result returned from from sqlite_get_table() */
-){
- if( azResult ){
- int i, n;
- azResult--;
- if( azResult==0 ) return;
- n = (int)(long)azResult[0];
- for(i=1; i<n; i++){ if( azResult[i] ) free(azResult[i]); }
- free(azResult);
- }
-}
+++ /dev/null
-/*
-** 2001 September 15
-**
-** The author disclaims copyright to this source code. In place of
-** a legal notice, here is a blessing:
-**
-** May you do good and not evil.
-** May you find forgiveness for yourself and forgive others.
-** May you share freely, never taking more than you give.
-**
-*************************************************************************
-** An tokenizer for SQL
-**
-** This file contains C code that splits an SQL input string up into
-** individual tokens and sends those tokens one-by-one over to the
-** parser for analysis.
-**
-** $Id: tokenize.c,v 1.1.1.1 2004/08/08 15:03:58 matt Exp $
-*/
-#include "sqliteInt.h"
-#include "os.h"
-#include <ctype.h>
-#include <stdlib.h>
-
-/*
-** All the keywords of the SQL language are stored as in a hash
-** table composed of instances of the following structure.
-*/
-typedef struct Keyword Keyword;
-struct Keyword {
- char *zName; /* The keyword name */
- u8 tokenType; /* Token value for this keyword */
- u8 len; /* Length of this keyword */
- u8 iNext; /* Index in aKeywordTable[] of next with same hash */
-};
-
-/*
-** These are the keywords
-*/
-static Keyword aKeywordTable[] = {
- { "ABORT", TK_ABORT, },
- { "AFTER", TK_AFTER, },
- { "ALL", TK_ALL, },
- { "AND", TK_AND, },
- { "AS", TK_AS, },
- { "ASC", TK_ASC, },
- { "ATTACH", TK_ATTACH, },
- { "BEFORE", TK_BEFORE, },
- { "BEGIN", TK_BEGIN, },
- { "BETWEEN", TK_BETWEEN, },
- { "BY", TK_BY, },
- { "CASCADE", TK_CASCADE, },
- { "CASE", TK_CASE, },
- { "CHECK", TK_CHECK, },
- { "CLUSTER", TK_CLUSTER, },
- { "COLLATE", TK_COLLATE, },
- { "COMMIT", TK_COMMIT, },
- { "CONFLICT", TK_CONFLICT, },
- { "CONSTRAINT", TK_CONSTRAINT, },
- { "COPY", TK_COPY, },
- { "CREATE", TK_CREATE, },
- { "CROSS", TK_JOIN_KW, },
- { "DATABASE", TK_DATABASE, },
- { "DEFAULT", TK_DEFAULT, },
- { "DEFERRED", TK_DEFERRED, },
- { "DEFERRABLE", TK_DEFERRABLE, },
- { "DELETE", TK_DELETE, },
- { "DELIMITERS", TK_DELIMITERS, },
- { "DESC", TK_DESC, },
- { "DETACH", TK_DETACH, },
- { "DISTINCT", TK_DISTINCT, },
- { "DROP", TK_DROP, },
- { "END", TK_END, },
- { "EACH", TK_EACH, },
- { "ELSE", TK_ELSE, },
- { "EXCEPT", TK_EXCEPT, },
- { "EXPLAIN", TK_EXPLAIN, },
- { "FAIL", TK_FAIL, },
- { "FOR", TK_FOR, },
- { "FOREIGN", TK_FOREIGN, },
- { "FROM", TK_FROM, },
- { "FULL", TK_JOIN_KW, },
- { "GLOB", TK_GLOB, },
- { "GROUP", TK_GROUP, },
- { "HAVING", TK_HAVING, },
- { "IGNORE", TK_IGNORE, },
- { "IMMEDIATE", TK_IMMEDIATE, },
- { "IN", TK_IN, },
- { "INDEX", TK_INDEX, },
- { "INITIALLY", TK_INITIALLY, },
- { "INNER", TK_JOIN_KW, },
- { "INSERT", TK_INSERT, },
- { "INSTEAD", TK_INSTEAD, },
- { "INTERSECT", TK_INTERSECT, },
- { "INTO", TK_INTO, },
- { "IS", TK_IS, },
- { "ISNULL", TK_ISNULL, },
- { "JOIN", TK_JOIN, },
- { "KEY", TK_KEY, },
- { "LEFT", TK_JOIN_KW, },
- { "LIKE", TK_LIKE, },
- { "LIMIT", TK_LIMIT, },
- { "MATCH", TK_MATCH, },
- { "NATURAL", TK_JOIN_KW, },
- { "NOT", TK_NOT, },
- { "NOTNULL", TK_NOTNULL, },
- { "NULL", TK_NULL, },
- { "OF", TK_OF, },
- { "OFFSET", TK_OFFSET, },
- { "ON", TK_ON, },
- { "OR", TK_OR, },
- { "ORDER", TK_ORDER, },
- { "OUTER", TK_JOIN_KW, },
- { "PRAGMA", TK_PRAGMA, },
- { "PRIMARY", TK_PRIMARY, },
- { "RAISE", TK_RAISE, },
- { "REFERENCES", TK_REFERENCES, },
- { "REPLACE", TK_REPLACE, },
- { "RESTRICT", TK_RESTRICT, },
- { "RIGHT", TK_JOIN_KW, },
- { "ROLLBACK", TK_ROLLBACK, },
- { "ROW", TK_ROW, },
- { "SELECT", TK_SELECT, },
- { "SET", TK_SET, },
- { "STATEMENT", TK_STATEMENT, },
- { "TABLE", TK_TABLE, },
- { "TEMP", TK_TEMP, },
- { "TEMPORARY", TK_TEMP, },
- { "THEN", TK_THEN, },
- { "TRANSACTION", TK_TRANSACTION, },
- { "TRIGGER", TK_TRIGGER, },
- { "UNION", TK_UNION, },
- { "UNIQUE", TK_UNIQUE, },
- { "UPDATE", TK_UPDATE, },
- { "USING", TK_USING, },
- { "VACUUM", TK_VACUUM, },
- { "VALUES", TK_VALUES, },
- { "VIEW", TK_VIEW, },
- { "WHEN", TK_WHEN, },
- { "WHERE", TK_WHERE, },
-};
-
-/*
-** This is the hash table
-*/
-#define KEY_HASH_SIZE 101
-static u8 aiHashTable[KEY_HASH_SIZE];
-
-
-/*
-** This function looks up an identifier to determine if it is a
-** keyword. If it is a keyword, the token code of that keyword is
-** returned. If the input is not a keyword, TK_ID is returned.
-*/
-int sqliteKeywordCode(const char *z, int n){
- int h, i;
- Keyword *p;
- static char needInit = 1;
- if( needInit ){
- /* Initialize the keyword hash table */
- sqliteOsEnterMutex();
- if( needInit ){
- int nk;
- nk = sizeof(aKeywordTable)/sizeof(aKeywordTable[0]);
- for(i=0; i<nk; i++){
- aKeywordTable[i].len = strlen(aKeywordTable[i].zName);
- h = sqliteHashNoCase(aKeywordTable[i].zName, aKeywordTable[i].len);
- h %= KEY_HASH_SIZE;
- aKeywordTable[i].iNext = aiHashTable[h];
- aiHashTable[h] = i+1;
- }
- needInit = 0;
- }
- sqliteOsLeaveMutex();
- }
- h = sqliteHashNoCase(z, n) % KEY_HASH_SIZE;
- for(i=aiHashTable[h]; i; i=p->iNext){
- p = &aKeywordTable[i-1];
- if( p->len==n && sqliteStrNICmp(p->zName, z, n)==0 ){
- return p->tokenType;
- }
- }
- return TK_ID;
-}
-
-
-/*
-** If X is a character that can be used in an identifier and
-** X&0x80==0 then isIdChar[X] will be 1. If X&0x80==0x80 then
-** X is always an identifier character. (Hence all UTF-8
-** characters can be part of an identifier). isIdChar[X] will
-** be 0 for every character in the lower 128 ASCII characters
-** that cannot be used as part of an identifier.
-**
-** In this implementation, an identifier can be a string of
-** alphabetic characters, digits, and "_" plus any character
-** with the high-order bit set. The latter rule means that
-** any sequence of UTF-8 characters or characters taken from
-** an extended ISO8859 character set can form an identifier.
-*/
-static const char isIdChar[] = {
-/* x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 xA xB xC xD xE xF */
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 0x */
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 1x */
- 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, /* 2x */
- 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, /* 3x */
- 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, /* 4x */
- 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 1, /* 5x */
- 0, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, /* 6x */
- 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, /* 7x */
-};
-
-
-/*
-** Return the length of the token that begins at z[0].
-** Store the token type in *tokenType before returning.
-*/
-static int sqliteGetToken(const unsigned char *z, int *tokenType){
- int i;
- switch( *z ){
- case ' ': case '\t': case '\n': case '\f': case '\r': {
- for(i=1; isspace(z[i]); i++){}
- *tokenType = TK_SPACE;
- return i;
- }
- case '-': {
- if( z[1]=='-' ){
- for(i=2; z[i] && z[i]!='\n'; i++){}
- *tokenType = TK_COMMENT;
- return i;
- }
- *tokenType = TK_MINUS;
- return 1;
- }
- case '(': {
- *tokenType = TK_LP;
- return 1;
- }
- case ')': {
- *tokenType = TK_RP;
- return 1;
- }
- case ';': {
- *tokenType = TK_SEMI;
- return 1;
- }
- case '+': {
- *tokenType = TK_PLUS;
- return 1;
- }
- case '*': {
- *tokenType = TK_STAR;
- return 1;
- }
- case '/': {
- if( z[1]!='*' || z[2]==0 ){
- *tokenType = TK_SLASH;
- return 1;
- }
- for(i=3; z[i] && (z[i]!='/' || z[i-1]!='*'); i++){}
- if( z[i] ) i++;
- *tokenType = TK_COMMENT;
- return i;
- }
- case '%': {
- *tokenType = TK_REM;
- return 1;
- }
- case '=': {
- *tokenType = TK_EQ;
- return 1 + (z[1]=='=');
- }
- case '<': {
- if( z[1]=='=' ){
- *tokenType = TK_LE;
- return 2;
- }else if( z[1]=='>' ){
- *tokenType = TK_NE;
- return 2;
- }else if( z[1]=='<' ){
- *tokenType = TK_LSHIFT;
- return 2;
- }else{
- *tokenType = TK_LT;
- return 1;
- }
- }
- case '>': {
- if( z[1]=='=' ){
- *tokenType = TK_GE;
- return 2;
- }else if( z[1]=='>' ){
- *tokenType = TK_RSHIFT;
- return 2;
- }else{
- *tokenType = TK_GT;
- return 1;
- }
- }
- case '!': {
- if( z[1]!='=' ){
- *tokenType = TK_ILLEGAL;
- return 2;
- }else{
- *tokenType = TK_NE;
- return 2;
- }
- }
- case '|': {
- if( z[1]!='|' ){
- *tokenType = TK_BITOR;
- return 1;
- }else{
- *tokenType = TK_CONCAT;
- return 2;
- }
- }
- case ',': {
- *tokenType = TK_COMMA;
- return 1;
- }
- case '&': {
- *tokenType = TK_BITAND;
- return 1;
- }
- case '~': {
- *tokenType = TK_BITNOT;
- return 1;
- }
- case '\'': case '"': {
- int delim = z[0];
- for(i=1; z[i]; i++){
- if( z[i]==delim ){
- if( z[i+1]==delim ){
- i++;
- }else{
- break;
- }
- }
- }
- if( z[i] ) i++;
- *tokenType = TK_STRING;
- return i;
- }
- case '.': {
- *tokenType = TK_DOT;
- return 1;
- }
- case '0': case '1': case '2': case '3': case '4':
- case '5': case '6': case '7': case '8': case '9': {
- *tokenType = TK_INTEGER;
- for(i=1; isdigit(z[i]); i++){}
- if( z[i]=='.' && isdigit(z[i+1]) ){
- i += 2;
- while( isdigit(z[i]) ){ i++; }
- *tokenType = TK_FLOAT;
- }
- if( (z[i]=='e' || z[i]=='E') &&
- ( isdigit(z[i+1])
- || ((z[i+1]=='+' || z[i+1]=='-') && isdigit(z[i+2]))
- )
- ){
- i += 2;
- while( isdigit(z[i]) ){ i++; }
- *tokenType = TK_FLOAT;
- }
- return i;
- }
- case '[': {
- for(i=1; z[i] && z[i-1]!=']'; i++){}
- *tokenType = TK_ID;
- return i;
- }
- case '?': {
- *tokenType = TK_VARIABLE;
- return 1;
- }
- default: {
- if( (*z&0x80)==0 && !isIdChar[*z] ){
- break;
- }
- for(i=1; (z[i]&0x80)!=0 || isIdChar[z[i]]; i++){}
- *tokenType = sqliteKeywordCode((char*)z, i);
- return i;
- }
- }
- *tokenType = TK_ILLEGAL;
- return 1;
-}
-
-/*
-** Run the parser on the given SQL string. The parser structure is
-** passed in. An SQLITE_ status code is returned. If an error occurs
-** and pzErrMsg!=NULL then an error message might be written into
-** memory obtained from malloc() and *pzErrMsg made to point to that
-** error message. Or maybe not.
-*/
-int sqliteRunParser(Parse *pParse, const char *zSql, char **pzErrMsg){
- int nErr = 0;
- int i;
- void *pEngine;
- int tokenType;
- int lastTokenParsed = -1;
- sqlite *db = pParse->db;
- extern void *sqliteParserAlloc(void*(*)(int));
- extern void sqliteParserFree(void*, void(*)(void*));
- extern int sqliteParser(void*, int, Token, Parse*);
-
- db->flags &= ~SQLITE_Interrupt;
- pParse->rc = SQLITE_OK;
- i = 0;
- pEngine = sqliteParserAlloc((void*(*)(int))malloc);
- if( pEngine==0 ){
- sqliteSetString(pzErrMsg, "out of memory", (char*)0);
- return 1;
- }
- pParse->sLastToken.dyn = 0;
- pParse->zTail = zSql;
- while( sqlite_malloc_failed==0 && zSql[i]!=0 ){
- assert( i>=0 );
- pParse->sLastToken.z = &zSql[i];
- assert( pParse->sLastToken.dyn==0 );
- pParse->sLastToken.n = sqliteGetToken((unsigned char*)&zSql[i], &tokenType);
- i += pParse->sLastToken.n;
- switch( tokenType ){
- case TK_SPACE:
- case TK_COMMENT: {
- if( (db->flags & SQLITE_Interrupt)!=0 ){
- pParse->rc = SQLITE_INTERRUPT;
- sqliteSetString(pzErrMsg, "interrupt", (char*)0);
- goto abort_parse;
- }
- break;
- }
- case TK_ILLEGAL: {
- sqliteSetNString(pzErrMsg, "unrecognized token: \"", -1,
- pParse->sLastToken.z, pParse->sLastToken.n, "\"", 1, 0);
- nErr++;
- goto abort_parse;
- }
- case TK_SEMI: {
- pParse->zTail = &zSql[i];
- /* Fall thru into the default case */
- }
- default: {
- sqliteParser(pEngine, tokenType, pParse->sLastToken, pParse);
- lastTokenParsed = tokenType;
- if( pParse->rc!=SQLITE_OK ){
- goto abort_parse;
- }
- break;
- }
- }
- }
-abort_parse:
- if( zSql[i]==0 && nErr==0 && pParse->rc==SQLITE_OK ){
- if( lastTokenParsed!=TK_SEMI ){
- sqliteParser(pEngine, TK_SEMI, pParse->sLastToken, pParse);
- pParse->zTail = &zSql[i];
- }
- sqliteParser(pEngine, 0, pParse->sLastToken, pParse);
- }
- sqliteParserFree(pEngine, free);
- if( pParse->rc!=SQLITE_OK && pParse->rc!=SQLITE_DONE && pParse->zErrMsg==0 ){
- sqliteSetString(&pParse->zErrMsg, sqlite_error_string(pParse->rc),
- (char*)0);
- }
- if( pParse->zErrMsg ){
- if( pzErrMsg && *pzErrMsg==0 ){
- *pzErrMsg = pParse->zErrMsg;
- }else{
- sqliteFree(pParse->zErrMsg);
- }
- pParse->zErrMsg = 0;
- if( !nErr ) nErr++;
- }
- if( pParse->pVdbe && pParse->nErr>0 ){
- sqliteVdbeDelete(pParse->pVdbe);
- pParse->pVdbe = 0;
- }
- if( pParse->pNewTable ){
- sqliteDeleteTable(pParse->db, pParse->pNewTable);
- pParse->pNewTable = 0;
- }
- if( pParse->pNewTrigger ){
- sqliteDeleteTrigger(pParse->pNewTrigger);
- pParse->pNewTrigger = 0;
- }
- if( nErr>0 && (pParse->rc==SQLITE_OK || pParse->rc==SQLITE_DONE) ){
- pParse->rc = SQLITE_ERROR;
- }
- return nErr;
-}
-
-/*
-** Token types used by the sqlite_complete() routine. See the header
-** comments on that procedure for additional information.
-*/
-#define tkEXPLAIN 0
-#define tkCREATE 1
-#define tkTEMP 2
-#define tkTRIGGER 3
-#define tkEND 4
-#define tkSEMI 5
-#define tkWS 6
-#define tkOTHER 7
-
-/*
-** Return TRUE if the given SQL string ends in a semicolon.
-**
-** Special handling is require for CREATE TRIGGER statements.
-** Whenever the CREATE TRIGGER keywords are seen, the statement
-** must end with ";END;".
-**
-** This implementation uses a state machine with 7 states:
-**
-** (0) START At the beginning or end of an SQL statement. This routine
-** returns 1 if it ends in the START state and 0 if it ends
-** in any other state.
-**
-** (1) EXPLAIN The keyword EXPLAIN has been seen at the beginning of
-** a statement.
-**
-** (2) CREATE The keyword CREATE has been seen at the beginning of a
-** statement, possibly preceeded by EXPLAIN and/or followed by
-** TEMP or TEMPORARY
-**
-** (3) NORMAL We are in the middle of statement which ends with a single
-** semicolon.
-**
-** (4) TRIGGER We are in the middle of a trigger definition that must be
-** ended by a semicolon, the keyword END, and another semicolon.
-**
-** (5) SEMI We've seen the first semicolon in the ";END;" that occurs at
-** the end of a trigger definition.
-**
-** (6) END We've seen the ";END" of the ";END;" that occurs at the end
-** of a trigger difinition.
-**
-** Transitions between states above are determined by tokens extracted
-** from the input. The following tokens are significant:
-**
-** (0) tkEXPLAIN The "explain" keyword.
-** (1) tkCREATE The "create" keyword.
-** (2) tkTEMP The "temp" or "temporary" keyword.
-** (3) tkTRIGGER The "trigger" keyword.
-** (4) tkEND The "end" keyword.
-** (5) tkSEMI A semicolon.
-** (6) tkWS Whitespace
-** (7) tkOTHER Any other SQL token.
-**
-** Whitespace never causes a state transition and is always ignored.
-*/
-int sqlite_complete(const char *zSql){
- u8 state = 0; /* Current state, using numbers defined in header comment */
- u8 token; /* Value of the next token */
-
- /* The following matrix defines the transition from one state to another
- ** according to what token is seen. trans[state][token] returns the
- ** next state.
- */
- static const u8 trans[7][8] = {
- /* Token: */
- /* State: ** EXPLAIN CREATE TEMP TRIGGER END SEMI WS OTHER */
- /* 0 START: */ { 1, 2, 3, 3, 3, 0, 0, 3, },
- /* 1 EXPLAIN: */ { 3, 2, 3, 3, 3, 0, 1, 3, },
- /* 2 CREATE: */ { 3, 3, 2, 4, 3, 0, 2, 3, },
- /* 3 NORMAL: */ { 3, 3, 3, 3, 3, 0, 3, 3, },
- /* 4 TRIGGER: */ { 4, 4, 4, 4, 4, 5, 4, 4, },
- /* 5 SEMI: */ { 4, 4, 4, 4, 6, 5, 5, 4, },
- /* 6 END: */ { 4, 4, 4, 4, 4, 0, 6, 4, },
- };
-
- while( *zSql ){
- switch( *zSql ){
- case ';': { /* A semicolon */
- token = tkSEMI;
- break;
- }
- case ' ':
- case '\r':
- case '\t':
- case '\n':
- case '\f': { /* White space is ignored */
- token = tkWS;
- break;
- }
- case '/': { /* C-style comments */
- if( zSql[1]!='*' ){
- token = tkOTHER;
- break;
- }
- zSql += 2;
- while( zSql[0] && (zSql[0]!='*' || zSql[1]!='/') ){ zSql++; }
- if( zSql[0]==0 ) return 0;
- zSql++;
- token = tkWS;
- break;
- }
- case '-': { /* SQL-style comments from "--" to end of line */
- if( zSql[1]!='-' ){
- token = tkOTHER;
- break;
- }
- while( *zSql && *zSql!='\n' ){ zSql++; }
- if( *zSql==0 ) return state==0;
- token = tkWS;
- break;
- }
- case '[': { /* Microsoft-style identifiers in [...] */
- zSql++;
- while( *zSql && *zSql!=']' ){ zSql++; }
- if( *zSql==0 ) return 0;
- token = tkOTHER;
- break;
- }
- case '"': /* single- and double-quoted strings */
- case '\'': {
- int c = *zSql;
- zSql++;
- while( *zSql && *zSql!=c ){ zSql++; }
- if( *zSql==0 ) return 0;
- token = tkOTHER;
- break;
- }
- default: {
- if( isIdChar[(u8)*zSql] ){
- /* Keywords and unquoted identifiers */
- int nId;
- for(nId=1; isIdChar[(u8)zSql[nId]]; nId++){}
- switch( *zSql ){
- case 'c': case 'C': {
- if( nId==6 && sqliteStrNICmp(zSql, "create", 6)==0 ){
- token = tkCREATE;
- }else{
- token = tkOTHER;
- }
- break;
- }
- case 't': case 'T': {
- if( nId==7 && sqliteStrNICmp(zSql, "trigger", 7)==0 ){
- token = tkTRIGGER;
- }else if( nId==4 && sqliteStrNICmp(zSql, "temp", 4)==0 ){
- token = tkTEMP;
- }else if( nId==9 && sqliteStrNICmp(zSql, "temporary", 9)==0 ){
- token = tkTEMP;
- }else{
- token = tkOTHER;
- }
- break;
- }
- case 'e': case 'E': {
- if( nId==3 && sqliteStrNICmp(zSql, "end", 3)==0 ){
- token = tkEND;
- }else if( nId==7 && sqliteStrNICmp(zSql, "explain", 7)==0 ){
- token = tkEXPLAIN;
- }else{
- token = tkOTHER;
- }
- break;
- }
- default: {
- token = tkOTHER;
- break;
- }
- }
- zSql += nId-1;
- }else{
- /* Operators and special symbols */
- token = tkOTHER;
- }
- break;
- }
- }
- state = trans[state][token];
- zSql++;
- }
- return state==0;
-}
+++ /dev/null
-/*
-**
-** The author disclaims copyright to this source code. In place of
-** a legal notice, here is a blessing:
-**
-** May you do good and not evil.
-** May you find forgiveness for yourself and forgive others.
-** May you share freely, never taking more than you give.
-**
-*************************************************************************
-*
-*/
-#include "sqliteInt.h"
-
-/*
-** Delete a linked list of TriggerStep structures.
-*/
-void sqliteDeleteTriggerStep(TriggerStep *pTriggerStep){
- while( pTriggerStep ){
- TriggerStep * pTmp = pTriggerStep;
- pTriggerStep = pTriggerStep->pNext;
-
- if( pTmp->target.dyn ) sqliteFree((char*)pTmp->target.z);
- sqliteExprDelete(pTmp->pWhere);
- sqliteExprListDelete(pTmp->pExprList);
- sqliteSelectDelete(pTmp->pSelect);
- sqliteIdListDelete(pTmp->pIdList);
-
- sqliteFree(pTmp);
- }
-}
-
-/*
-** This is called by the parser when it sees a CREATE TRIGGER statement
-** up to the point of the BEGIN before the trigger actions. A Trigger
-** structure is generated based on the information available and stored
-** in pParse->pNewTrigger. After the trigger actions have been parsed, the
-** sqliteFinishTrigger() function is called to complete the trigger
-** construction process.
-*/
-void sqliteBeginTrigger(
- Parse *pParse, /* The parse context of the CREATE TRIGGER statement */
- Token *pName, /* The name of the trigger */
- int tr_tm, /* One of TK_BEFORE, TK_AFTER, TK_INSTEAD */
- int op, /* One of TK_INSERT, TK_UPDATE, TK_DELETE */
- IdList *pColumns, /* column list if this is an UPDATE OF trigger */
- SrcList *pTableName,/* The name of the table/view the trigger applies to */
- int foreach, /* One of TK_ROW or TK_STATEMENT */
- Expr *pWhen, /* WHEN clause */
- int isTemp /* True if the TEMPORARY keyword is present */
-){
- Trigger *nt;
- Table *tab;
- char *zName = 0; /* Name of the trigger */
- sqlite *db = pParse->db;
- int iDb; /* When database to store the trigger in */
- DbFixer sFix;
-
- /* Check that:
- ** 1. the trigger name does not already exist.
- ** 2. the table (or view) does exist in the same database as the trigger.
- ** 3. that we are not trying to create a trigger on the sqlite_master table
- ** 4. That we are not trying to create an INSTEAD OF trigger on a table.
- ** 5. That we are not trying to create a BEFORE or AFTER trigger on a view.
- */
- if( sqlite_malloc_failed ) goto trigger_cleanup;
- assert( pTableName->nSrc==1 );
- if( db->init.busy
- && sqliteFixInit(&sFix, pParse, db->init.iDb, "trigger", pName)
- && sqliteFixSrcList(&sFix, pTableName)
- ){
- goto trigger_cleanup;
- }
- tab = sqliteSrcListLookup(pParse, pTableName);
- if( !tab ){
- goto trigger_cleanup;
- }
- iDb = isTemp ? 1 : tab->iDb;
- if( iDb>=2 && !db->init.busy ){
- sqliteErrorMsg(pParse, "triggers may not be added to auxiliary "
- "database %s", db->aDb[tab->iDb].zName);
- goto trigger_cleanup;
- }
-
- zName = sqliteStrNDup(pName->z, pName->n);
- sqliteDequote(zName);
- if( sqliteHashFind(&(db->aDb[iDb].trigHash), zName,pName->n+1) ){
- sqliteErrorMsg(pParse, "trigger %T already exists", pName);
- goto trigger_cleanup;
- }
- if( sqliteStrNICmp(tab->zName, "sqlite_", 7)==0 ){
- sqliteErrorMsg(pParse, "cannot create trigger on system table");
- pParse->nErr++;
- goto trigger_cleanup;
- }
- if( tab->pSelect && tr_tm != TK_INSTEAD ){
- sqliteErrorMsg(pParse, "cannot create %s trigger on view: %S",
- (tr_tm == TK_BEFORE)?"BEFORE":"AFTER", pTableName, 0);
- goto trigger_cleanup;
- }
- if( !tab->pSelect && tr_tm == TK_INSTEAD ){
- sqliteErrorMsg(pParse, "cannot create INSTEAD OF"
- " trigger on table: %S", pTableName, 0);
- goto trigger_cleanup;
- }
-#ifndef SQLITE_OMIT_AUTHORIZATION
- {
- int code = SQLITE_CREATE_TRIGGER;
- const char *zDb = db->aDb[tab->iDb].zName;
- const char *zDbTrig = isTemp ? db->aDb[1].zName : zDb;
- if( tab->iDb==1 || isTemp ) code = SQLITE_CREATE_TEMP_TRIGGER;
- if( sqliteAuthCheck(pParse, code, zName, tab->zName, zDbTrig) ){
- goto trigger_cleanup;
- }
- if( sqliteAuthCheck(pParse, SQLITE_INSERT, SCHEMA_TABLE(tab->iDb), 0, zDb)){
- goto trigger_cleanup;
- }
- }
-#endif
-
- /* INSTEAD OF triggers can only appear on views and BEGIN triggers
- ** cannot appear on views. So we might as well translate every
- ** INSTEAD OF trigger into a BEFORE trigger. It simplifies code
- ** elsewhere.
- */
- if (tr_tm == TK_INSTEAD){
- tr_tm = TK_BEFORE;
- }
-
- /* Build the Trigger object */
- nt = (Trigger*)sqliteMalloc(sizeof(Trigger));
- if( nt==0 ) goto trigger_cleanup;
- nt->name = zName;
- zName = 0;
- nt->table = sqliteStrDup(pTableName->a[0].zName);
- if( sqlite_malloc_failed ) goto trigger_cleanup;
- nt->iDb = iDb;
- nt->iTabDb = tab->iDb;
- nt->op = op;
- nt->tr_tm = tr_tm;
- nt->pWhen = sqliteExprDup(pWhen);
- nt->pColumns = sqliteIdListDup(pColumns);
- nt->foreach = foreach;
- sqliteTokenCopy(&nt->nameToken,pName);
- assert( pParse->pNewTrigger==0 );
- pParse->pNewTrigger = nt;
-
-trigger_cleanup:
- sqliteFree(zName);
- sqliteSrcListDelete(pTableName);
- sqliteIdListDelete(pColumns);
- sqliteExprDelete(pWhen);
-}
-
-/*
-** This routine is called after all of the trigger actions have been parsed
-** in order to complete the process of building the trigger.
-*/
-void sqliteFinishTrigger(
- Parse *pParse, /* Parser context */
- TriggerStep *pStepList, /* The triggered program */
- Token *pAll /* Token that describes the complete CREATE TRIGGER */
-){
- Trigger *nt = 0; /* The trigger whose construction is finishing up */
- sqlite *db = pParse->db; /* The database */
- DbFixer sFix;
-
- if( pParse->nErr || pParse->pNewTrigger==0 ) goto triggerfinish_cleanup;
- nt = pParse->pNewTrigger;
- pParse->pNewTrigger = 0;
- nt->step_list = pStepList;
- while( pStepList ){
- pStepList->pTrig = nt;
- pStepList = pStepList->pNext;
- }
- if( sqliteFixInit(&sFix, pParse, nt->iDb, "trigger", &nt->nameToken)
- && sqliteFixTriggerStep(&sFix, nt->step_list) ){
- goto triggerfinish_cleanup;
- }
-
- /* if we are not initializing, and this trigger is not on a TEMP table,
- ** build the sqlite_master entry
- */
- if( !db->init.busy ){
- static VdbeOpList insertTrig[] = {
- { OP_NewRecno, 0, 0, 0 },
- { OP_String, 0, 0, "trigger" },
- { OP_String, 0, 0, 0 }, /* 2: trigger name */
- { OP_String, 0, 0, 0 }, /* 3: table name */
- { OP_Integer, 0, 0, 0 },
- { OP_String, 0, 0, 0 }, /* 5: SQL */
- { OP_MakeRecord, 5, 0, 0 },
- { OP_PutIntKey, 0, 0, 0 },
- };
- int addr;
- Vdbe *v;
-
- /* Make an entry in the sqlite_master table */
- v = sqliteGetVdbe(pParse);
- if( v==0 ) goto triggerfinish_cleanup;
- sqliteBeginWriteOperation(pParse, 0, 0);
- sqliteOpenMasterTable(v, nt->iDb);
- addr = sqliteVdbeAddOpList(v, ArraySize(insertTrig), insertTrig);
- sqliteVdbeChangeP3(v, addr+2, nt->name, 0);
- sqliteVdbeChangeP3(v, addr+3, nt->table, 0);
- sqliteVdbeChangeP3(v, addr+5, pAll->z, pAll->n);
- if( nt->iDb==0 ){
- sqliteChangeCookie(db, v);
- }
- sqliteVdbeAddOp(v, OP_Close, 0, 0);
- sqliteEndWriteOperation(pParse);
- }
-
- if( !pParse->explain ){
- Table *pTab;
- sqliteHashInsert(&db->aDb[nt->iDb].trigHash,
- nt->name, strlen(nt->name)+1, nt);
- pTab = sqliteLocateTable(pParse, nt->table, db->aDb[nt->iTabDb].zName);
- assert( pTab!=0 );
- nt->pNext = pTab->pTrigger;
- pTab->pTrigger = nt;
- nt = 0;
- }
-
-triggerfinish_cleanup:
- sqliteDeleteTrigger(nt);
- sqliteDeleteTrigger(pParse->pNewTrigger);
- pParse->pNewTrigger = 0;
- sqliteDeleteTriggerStep(pStepList);
-}
-
-/*
-** Make a copy of all components of the given trigger step. This has
-** the effect of copying all Expr.token.z values into memory obtained
-** from sqliteMalloc(). As initially created, the Expr.token.z values
-** all point to the input string that was fed to the parser. But that
-** string is ephemeral - it will go away as soon as the sqlite_exec()
-** call that started the parser exits. This routine makes a persistent
-** copy of all the Expr.token.z strings so that the TriggerStep structure
-** will be valid even after the sqlite_exec() call returns.
-*/
-static void sqlitePersistTriggerStep(TriggerStep *p){
- if( p->target.z ){
- p->target.z = sqliteStrNDup(p->target.z, p->target.n);
- p->target.dyn = 1;
- }
- if( p->pSelect ){
- Select *pNew = sqliteSelectDup(p->pSelect);
- sqliteSelectDelete(p->pSelect);
- p->pSelect = pNew;
- }
- if( p->pWhere ){
- Expr *pNew = sqliteExprDup(p->pWhere);
- sqliteExprDelete(p->pWhere);
- p->pWhere = pNew;
- }
- if( p->pExprList ){
- ExprList *pNew = sqliteExprListDup(p->pExprList);
- sqliteExprListDelete(p->pExprList);
- p->pExprList = pNew;
- }
- if( p->pIdList ){
- IdList *pNew = sqliteIdListDup(p->pIdList);
- sqliteIdListDelete(p->pIdList);
- p->pIdList = pNew;
- }
-}
-
-/*
-** Turn a SELECT statement (that the pSelect parameter points to) into
-** a trigger step. Return a pointer to a TriggerStep structure.
-**
-** The parser calls this routine when it finds a SELECT statement in
-** body of a TRIGGER.
-*/
-TriggerStep *sqliteTriggerSelectStep(Select *pSelect){
- TriggerStep *pTriggerStep = sqliteMalloc(sizeof(TriggerStep));
- if( pTriggerStep==0 ) return 0;
-
- pTriggerStep->op = TK_SELECT;
- pTriggerStep->pSelect = pSelect;
- pTriggerStep->orconf = OE_Default;
- sqlitePersistTriggerStep(pTriggerStep);
-
- return pTriggerStep;
-}
-
-/*
-** Build a trigger step out of an INSERT statement. Return a pointer
-** to the new trigger step.
-**
-** The parser calls this routine when it sees an INSERT inside the
-** body of a trigger.
-*/
-TriggerStep *sqliteTriggerInsertStep(
- Token *pTableName, /* Name of the table into which we insert */
- IdList *pColumn, /* List of columns in pTableName to insert into */
- ExprList *pEList, /* The VALUE clause: a list of values to be inserted */
- Select *pSelect, /* A SELECT statement that supplies values */
- int orconf /* The conflict algorithm (OE_Abort, OE_Replace, etc.) */
-){
- TriggerStep *pTriggerStep = sqliteMalloc(sizeof(TriggerStep));
- if( pTriggerStep==0 ) return 0;
-
- assert(pEList == 0 || pSelect == 0);
- assert(pEList != 0 || pSelect != 0);
-
- pTriggerStep->op = TK_INSERT;
- pTriggerStep->pSelect = pSelect;
- pTriggerStep->target = *pTableName;
- pTriggerStep->pIdList = pColumn;
- pTriggerStep->pExprList = pEList;
- pTriggerStep->orconf = orconf;
- sqlitePersistTriggerStep(pTriggerStep);
-
- return pTriggerStep;
-}
-
-/*
-** Construct a trigger step that implements an UPDATE statement and return
-** a pointer to that trigger step. The parser calls this routine when it
-** sees an UPDATE statement inside the body of a CREATE TRIGGER.
-*/
-TriggerStep *sqliteTriggerUpdateStep(
- Token *pTableName, /* Name of the table to be updated */
- ExprList *pEList, /* The SET clause: list of column and new values */
- Expr *pWhere, /* The WHERE clause */
- int orconf /* The conflict algorithm. (OE_Abort, OE_Ignore, etc) */
-){
- TriggerStep *pTriggerStep = sqliteMalloc(sizeof(TriggerStep));
- if( pTriggerStep==0 ) return 0;
-
- pTriggerStep->op = TK_UPDATE;
- pTriggerStep->target = *pTableName;
- pTriggerStep->pExprList = pEList;
- pTriggerStep->pWhere = pWhere;
- pTriggerStep->orconf = orconf;
- sqlitePersistTriggerStep(pTriggerStep);
-
- return pTriggerStep;
-}
-
-/*
-** Construct a trigger step that implements a DELETE statement and return
-** a pointer to that trigger step. The parser calls this routine when it
-** sees a DELETE statement inside the body of a CREATE TRIGGER.
-*/
-TriggerStep *sqliteTriggerDeleteStep(Token *pTableName, Expr *pWhere){
- TriggerStep *pTriggerStep = sqliteMalloc(sizeof(TriggerStep));
- if( pTriggerStep==0 ) return 0;
-
- pTriggerStep->op = TK_DELETE;
- pTriggerStep->target = *pTableName;
- pTriggerStep->pWhere = pWhere;
- pTriggerStep->orconf = OE_Default;
- sqlitePersistTriggerStep(pTriggerStep);
-
- return pTriggerStep;
-}
-
-/*
-** Recursively delete a Trigger structure
-*/
-void sqliteDeleteTrigger(Trigger *pTrigger){
- if( pTrigger==0 ) return;
- sqliteDeleteTriggerStep(pTrigger->step_list);
- sqliteFree(pTrigger->name);
- sqliteFree(pTrigger->table);
- sqliteExprDelete(pTrigger->pWhen);
- sqliteIdListDelete(pTrigger->pColumns);
- if( pTrigger->nameToken.dyn ) sqliteFree((char*)pTrigger->nameToken.z);
- sqliteFree(pTrigger);
-}
-
-/*
- * This function is called to drop a trigger from the database schema.
- *
- * This may be called directly from the parser and therefore identifies
- * the trigger by name. The sqliteDropTriggerPtr() routine does the
- * same job as this routine except it take a spointer to the trigger
- * instead of the trigger name.
- *
- * Note that this function does not delete the trigger entirely. Instead it
- * removes it from the internal schema and places it in the trigDrop hash
- * table. This is so that the trigger can be restored into the database schema
- * if the transaction is rolled back.
- */
-void sqliteDropTrigger(Parse *pParse, SrcList *pName){
- Trigger *pTrigger;
- int i;
- const char *zDb;
- const char *zName;
- int nName;
- sqlite *db = pParse->db;
-
- if( sqlite_malloc_failed ) goto drop_trigger_cleanup;
- assert( pName->nSrc==1 );
- zDb = pName->a[0].zDatabase;
- zName = pName->a[0].zName;
- nName = strlen(zName);
- for(i=0; i<db->nDb; i++){
- int j = (i<2) ? i^1 : i; /* Search TEMP before MAIN */
- if( zDb && sqliteStrICmp(db->aDb[j].zName, zDb) ) continue;
- pTrigger = sqliteHashFind(&(db->aDb[j].trigHash), zName, nName+1);
- if( pTrigger ) break;
- }
- if( !pTrigger ){
- sqliteErrorMsg(pParse, "no such trigger: %S", pName, 0);
- goto drop_trigger_cleanup;
- }
- sqliteDropTriggerPtr(pParse, pTrigger, 0);
-
-drop_trigger_cleanup:
- sqliteSrcListDelete(pName);
-}
-
-/*
-** Drop a trigger given a pointer to that trigger. If nested is false,
-** then also generate code to remove the trigger from the SQLITE_MASTER
-** table.
-*/
-void sqliteDropTriggerPtr(Parse *pParse, Trigger *pTrigger, int nested){
- Table *pTable;
- Vdbe *v;
- sqlite *db = pParse->db;
-
- assert( pTrigger->iDb<db->nDb );
- if( pTrigger->iDb>=2 ){
- sqliteErrorMsg(pParse, "triggers may not be removed from "
- "auxiliary database %s", db->aDb[pTrigger->iDb].zName);
- return;
- }
- pTable = sqliteFindTable(db, pTrigger->table,db->aDb[pTrigger->iTabDb].zName);
- assert(pTable);
- assert( pTable->iDb==pTrigger->iDb || pTrigger->iDb==1 );
-#ifndef SQLITE_OMIT_AUTHORIZATION
- {
- int code = SQLITE_DROP_TRIGGER;
- const char *zDb = db->aDb[pTrigger->iDb].zName;
- const char *zTab = SCHEMA_TABLE(pTrigger->iDb);
- if( pTrigger->iDb ) code = SQLITE_DROP_TEMP_TRIGGER;
- if( sqliteAuthCheck(pParse, code, pTrigger->name, pTable->zName, zDb) ||
- sqliteAuthCheck(pParse, SQLITE_DELETE, zTab, 0, zDb) ){
- return;
- }
- }
-#endif
-
- /* Generate code to destroy the database record of the trigger.
- */
- if( pTable!=0 && !nested && (v = sqliteGetVdbe(pParse))!=0 ){
- int base;
- static VdbeOpList dropTrigger[] = {
- { OP_Rewind, 0, ADDR(9), 0},
- { OP_String, 0, 0, 0}, /* 1 */
- { OP_Column, 0, 1, 0},
- { OP_Ne, 0, ADDR(8), 0},
- { OP_String, 0, 0, "trigger"},
- { OP_Column, 0, 0, 0},
- { OP_Ne, 0, ADDR(8), 0},
- { OP_Delete, 0, 0, 0},
- { OP_Next, 0, ADDR(1), 0}, /* 8 */
- };
-
- sqliteBeginWriteOperation(pParse, 0, 0);
- sqliteOpenMasterTable(v, pTrigger->iDb);
- base = sqliteVdbeAddOpList(v, ArraySize(dropTrigger), dropTrigger);
- sqliteVdbeChangeP3(v, base+1, pTrigger->name, 0);
- if( pTrigger->iDb==0 ){
- sqliteChangeCookie(db, v);
- }
- sqliteVdbeAddOp(v, OP_Close, 0, 0);
- sqliteEndWriteOperation(pParse);
- }
-
- /*
- * If this is not an "explain", then delete the trigger structure.
- */
- if( !pParse->explain ){
- const char *zName = pTrigger->name;
- int nName = strlen(zName);
- if( pTable->pTrigger == pTrigger ){
- pTable->pTrigger = pTrigger->pNext;
- }else{
- Trigger *cc = pTable->pTrigger;
- while( cc ){
- if( cc->pNext == pTrigger ){
- cc->pNext = cc->pNext->pNext;
- break;
- }
- cc = cc->pNext;
- }
- assert(cc);
- }
- sqliteHashInsert(&(db->aDb[pTrigger->iDb].trigHash), zName, nName+1, 0);
- sqliteDeleteTrigger(pTrigger);
- }
-}
-
-/*
-** pEList is the SET clause of an UPDATE statement. Each entry
-** in pEList is of the format <id>=<expr>. If any of the entries
-** in pEList have an <id> which matches an identifier in pIdList,
-** then return TRUE. If pIdList==NULL, then it is considered a
-** wildcard that matches anything. Likewise if pEList==NULL then
-** it matches anything so always return true. Return false only
-** if there is no match.
-*/
-static int checkColumnOverLap(IdList *pIdList, ExprList *pEList){
- int e;
- if( !pIdList || !pEList ) return 1;
- for(e=0; e<pEList->nExpr; e++){
- if( sqliteIdListIndex(pIdList, pEList->a[e].zName)>=0 ) return 1;
- }
- return 0;
-}
-
-/* A global variable that is TRUE if we should always set up temp tables for
- * for triggers, even if there are no triggers to code. This is used to test
- * how much overhead the triggers algorithm is causing.
- *
- * This flag can be set or cleared using the "trigger_overhead_test" pragma.
- * The pragma is not documented since it is not really part of the interface
- * to SQLite, just the test procedure.
-*/
-int always_code_trigger_setup = 0;
-
-/*
- * Returns true if a trigger matching op, tr_tm and foreach that is NOT already
- * on the Parse objects trigger-stack (to prevent recursive trigger firing) is
- * found in the list specified as pTrigger.
- */
-int sqliteTriggersExist(
- Parse *pParse, /* Used to check for recursive triggers */
- Trigger *pTrigger, /* A list of triggers associated with a table */
- int op, /* one of TK_DELETE, TK_INSERT, TK_UPDATE */
- int tr_tm, /* one of TK_BEFORE, TK_AFTER */
- int foreach, /* one of TK_ROW or TK_STATEMENT */
- ExprList *pChanges /* Columns that change in an UPDATE statement */
-){
- Trigger * pTriggerCursor;
-
- if( always_code_trigger_setup ){
- return 1;
- }
-
- pTriggerCursor = pTrigger;
- while( pTriggerCursor ){
- if( pTriggerCursor->op == op &&
- pTriggerCursor->tr_tm == tr_tm &&
- pTriggerCursor->foreach == foreach &&
- checkColumnOverLap(pTriggerCursor->pColumns, pChanges) ){
- TriggerStack * ss;
- ss = pParse->trigStack;
- while( ss && ss->pTrigger != pTrigger ){
- ss = ss->pNext;
- }
- if( !ss )return 1;
- }
- pTriggerCursor = pTriggerCursor->pNext;
- }
-
- return 0;
-}
-
-/*
-** Convert the pStep->target token into a SrcList and return a pointer
-** to that SrcList.
-**
-** This routine adds a specific database name, if needed, to the target when
-** forming the SrcList. This prevents a trigger in one database from
-** referring to a target in another database. An exception is when the
-** trigger is in TEMP in which case it can refer to any other database it
-** wants.
-*/
-static SrcList *targetSrcList(
- Parse *pParse, /* The parsing context */
- TriggerStep *pStep /* The trigger containing the target token */
-){
- Token sDb; /* Dummy database name token */
- int iDb; /* Index of the database to use */
- SrcList *pSrc; /* SrcList to be returned */
-
- iDb = pStep->pTrig->iDb;
- if( iDb==0 || iDb>=2 ){
- assert( iDb<pParse->db->nDb );
- sDb.z = pParse->db->aDb[iDb].zName;
- sDb.n = strlen(sDb.z);
- pSrc = sqliteSrcListAppend(0, &sDb, &pStep->target);
- } else {
- pSrc = sqliteSrcListAppend(0, &pStep->target, 0);
- }
- return pSrc;
-}
-
-/*
-** Generate VDBE code for zero or more statements inside the body of a
-** trigger.
-*/
-static int codeTriggerProgram(
- Parse *pParse, /* The parser context */
- TriggerStep *pStepList, /* List of statements inside the trigger body */
- int orconfin /* Conflict algorithm. (OE_Abort, etc) */
-){
- TriggerStep * pTriggerStep = pStepList;
- int orconf;
-
- while( pTriggerStep ){
- int saveNTab = pParse->nTab;
-
- orconf = (orconfin == OE_Default)?pTriggerStep->orconf:orconfin;
- pParse->trigStack->orconf = orconf;
- switch( pTriggerStep->op ){
- case TK_SELECT: {
- Select * ss = sqliteSelectDup(pTriggerStep->pSelect);
- assert(ss);
- assert(ss->pSrc);
- sqliteSelect(pParse, ss, SRT_Discard, 0, 0, 0, 0);
- sqliteSelectDelete(ss);
- break;
- }
- case TK_UPDATE: {
- SrcList *pSrc;
- pSrc = targetSrcList(pParse, pTriggerStep);
- sqliteVdbeAddOp(pParse->pVdbe, OP_ListPush, 0, 0);
- sqliteUpdate(pParse, pSrc,
- sqliteExprListDup(pTriggerStep->pExprList),
- sqliteExprDup(pTriggerStep->pWhere), orconf);
- sqliteVdbeAddOp(pParse->pVdbe, OP_ListPop, 0, 0);
- break;
- }
- case TK_INSERT: {
- SrcList *pSrc;
- pSrc = targetSrcList(pParse, pTriggerStep);
- sqliteInsert(pParse, pSrc,
- sqliteExprListDup(pTriggerStep->pExprList),
- sqliteSelectDup(pTriggerStep->pSelect),
- sqliteIdListDup(pTriggerStep->pIdList), orconf);
- break;
- }
- case TK_DELETE: {
- SrcList *pSrc;
- sqliteVdbeAddOp(pParse->pVdbe, OP_ListPush, 0, 0);
- pSrc = targetSrcList(pParse, pTriggerStep);
- sqliteDeleteFrom(pParse, pSrc, sqliteExprDup(pTriggerStep->pWhere));
- sqliteVdbeAddOp(pParse->pVdbe, OP_ListPop, 0, 0);
- break;
- }
- default:
- assert(0);
- }
- pParse->nTab = saveNTab;
- pTriggerStep = pTriggerStep->pNext;
- }
-
- return 0;
-}
-
-/*
-** This is called to code FOR EACH ROW triggers.
-**
-** When the code that this function generates is executed, the following
-** must be true:
-**
-** 1. No cursors may be open in the main database. (But newIdx and oldIdx
-** can be indices of cursors in temporary tables. See below.)
-**
-** 2. If the triggers being coded are ON INSERT or ON UPDATE triggers, then
-** a temporary vdbe cursor (index newIdx) must be open and pointing at
-** a row containing values to be substituted for new.* expressions in the
-** trigger program(s).
-**
-** 3. If the triggers being coded are ON DELETE or ON UPDATE triggers, then
-** a temporary vdbe cursor (index oldIdx) must be open and pointing at
-** a row containing values to be substituted for old.* expressions in the
-** trigger program(s).
-**
-*/
-int sqliteCodeRowTrigger(
- Parse *pParse, /* Parse context */
- int op, /* One of TK_UPDATE, TK_INSERT, TK_DELETE */
- ExprList *pChanges, /* Changes list for any UPDATE OF triggers */
- int tr_tm, /* One of TK_BEFORE, TK_AFTER */
- Table *pTab, /* The table to code triggers from */
- int newIdx, /* The indice of the "new" row to access */
- int oldIdx, /* The indice of the "old" row to access */
- int orconf, /* ON CONFLICT policy */
- int ignoreJump /* Instruction to jump to for RAISE(IGNORE) */
-){
- Trigger * pTrigger;
- TriggerStack * pTriggerStack;
-
- assert(op == TK_UPDATE || op == TK_INSERT || op == TK_DELETE);
- assert(tr_tm == TK_BEFORE || tr_tm == TK_AFTER );
-
- assert(newIdx != -1 || oldIdx != -1);
-
- pTrigger = pTab->pTrigger;
- while( pTrigger ){
- int fire_this = 0;
-
- /* determine whether we should code this trigger */
- if( pTrigger->op == op && pTrigger->tr_tm == tr_tm &&
- pTrigger->foreach == TK_ROW ){
- fire_this = 1;
- pTriggerStack = pParse->trigStack;
- while( pTriggerStack ){
- if( pTriggerStack->pTrigger == pTrigger ){
- fire_this = 0;
- }
- pTriggerStack = pTriggerStack->pNext;
- }
- if( op == TK_UPDATE && pTrigger->pColumns &&
- !checkColumnOverLap(pTrigger->pColumns, pChanges) ){
- fire_this = 0;
- }
- }
-
- if( fire_this && (pTriggerStack = sqliteMalloc(sizeof(TriggerStack)))!=0 ){
- int endTrigger;
- SrcList dummyTablist;
- Expr * whenExpr;
- AuthContext sContext;
-
- dummyTablist.nSrc = 0;
-
- /* Push an entry on to the trigger stack */
- pTriggerStack->pTrigger = pTrigger;
- pTriggerStack->newIdx = newIdx;
- pTriggerStack->oldIdx = oldIdx;
- pTriggerStack->pTab = pTab;
- pTriggerStack->pNext = pParse->trigStack;
- pTriggerStack->ignoreJump = ignoreJump;
- pParse->trigStack = pTriggerStack;
- sqliteAuthContextPush(pParse, &sContext, pTrigger->name);
-
- /* code the WHEN clause */
- endTrigger = sqliteVdbeMakeLabel(pParse->pVdbe);
- whenExpr = sqliteExprDup(pTrigger->pWhen);
- if( sqliteExprResolveIds(pParse, &dummyTablist, 0, whenExpr) ){
- pParse->trigStack = pParse->trigStack->pNext;
- sqliteFree(pTriggerStack);
- sqliteExprDelete(whenExpr);
- return 1;
- }
- sqliteExprIfFalse(pParse, whenExpr, endTrigger, 1);
- sqliteExprDelete(whenExpr);
-
- sqliteVdbeAddOp(pParse->pVdbe, OP_ContextPush, 0, 0);
- codeTriggerProgram(pParse, pTrigger->step_list, orconf);
- sqliteVdbeAddOp(pParse->pVdbe, OP_ContextPop, 0, 0);
-
- /* Pop the entry off the trigger stack */
- pParse->trigStack = pParse->trigStack->pNext;
- sqliteAuthContextPop(&sContext);
- sqliteFree(pTriggerStack);
-
- sqliteVdbeResolveLabel(pParse->pVdbe, endTrigger);
- }
- pTrigger = pTrigger->pNext;
- }
-
- return 0;
-}
+++ /dev/null
-/*
-** 2001 September 15
-**
-** The author disclaims copyright to this source code. In place of
-** a legal notice, here is a blessing:
-**
-** May you do good and not evil.
-** May you find forgiveness for yourself and forgive others.
-** May you share freely, never taking more than you give.
-**
-*************************************************************************
-** This file contains C code routines that are called by the parser
-** to handle UPDATE statements.
-**
-** $Id: update.c,v 1.1.1.1 2004/08/08 15:03:58 matt Exp $
-*/
-#include "sqliteInt.h"
-
-/*
-** Process an UPDATE statement.
-**
-** UPDATE OR IGNORE table_wxyz SET a=b, c=d WHERE e<5 AND f NOT NULL;
-** \_______/ \________/ \______/ \________________/
-* onError pTabList pChanges pWhere
-*/
-void sqliteUpdate(
- Parse *pParse, /* The parser context */
- SrcList *pTabList, /* The table in which we should change things */
- ExprList *pChanges, /* Things to be changed */
- Expr *pWhere, /* The WHERE clause. May be null */
- int onError /* How to handle constraint errors */
-){
- int i, j; /* Loop counters */
- Table *pTab; /* The table to be updated */
- int loopStart; /* VDBE instruction address of the start of the loop */
- int jumpInst; /* Addr of VDBE instruction to jump out of loop */
- WhereInfo *pWInfo; /* Information about the WHERE clause */
- Vdbe *v; /* The virtual database engine */
- Index *pIdx; /* For looping over indices */
- int nIdx; /* Number of indices that need updating */
- int nIdxTotal; /* Total number of indices */
- int iCur; /* VDBE Cursor number of pTab */
- sqlite *db; /* The database structure */
- Index **apIdx = 0; /* An array of indices that need updating too */
- char *aIdxUsed = 0; /* aIdxUsed[i]==1 if the i-th index is used */
- int *aXRef = 0; /* aXRef[i] is the index in pChanges->a[] of the
- ** an expression for the i-th column of the table.
- ** aXRef[i]==-1 if the i-th column is not changed. */
- int chngRecno; /* True if the record number is being changed */
- Expr *pRecnoExpr; /* Expression defining the new record number */
- int openAll; /* True if all indices need to be opened */
- int isView; /* Trying to update a view */
- int iStackDepth; /* Index of memory cell holding stack depth */
- AuthContext sContext; /* The authorization context */
-
- int before_triggers; /* True if there are any BEFORE triggers */
- int after_triggers; /* True if there are any AFTER triggers */
- int row_triggers_exist = 0; /* True if any row triggers exist */
-
- int newIdx = -1; /* index of trigger "new" temp table */
- int oldIdx = -1; /* index of trigger "old" temp table */
-
- sContext.pParse = 0;
- if( pParse->nErr || sqlite_malloc_failed ) goto update_cleanup;
- db = pParse->db;
- assert( pTabList->nSrc==1 );
- iStackDepth = pParse->nMem++;
-
- /* Locate the table which we want to update.
- */
- pTab = sqliteSrcListLookup(pParse, pTabList);
- if( pTab==0 ) goto update_cleanup;
- before_triggers = sqliteTriggersExist(pParse, pTab->pTrigger,
- TK_UPDATE, TK_BEFORE, TK_ROW, pChanges);
- after_triggers = sqliteTriggersExist(pParse, pTab->pTrigger,
- TK_UPDATE, TK_AFTER, TK_ROW, pChanges);
- row_triggers_exist = before_triggers || after_triggers;
- isView = pTab->pSelect!=0;
- if( sqliteIsReadOnly(pParse, pTab, before_triggers) ){
- goto update_cleanup;
- }
- if( isView ){
- if( sqliteViewGetColumnNames(pParse, pTab) ){
- goto update_cleanup;
- }
- }
- aXRef = sqliteMalloc( sizeof(int) * pTab->nCol );
- if( aXRef==0 ) goto update_cleanup;
- for(i=0; i<pTab->nCol; i++) aXRef[i] = -1;
-
- /* If there are FOR EACH ROW triggers, allocate cursors for the
- ** special OLD and NEW tables
- */
- if( row_triggers_exist ){
- newIdx = pParse->nTab++;
- oldIdx = pParse->nTab++;
- }
-
- /* Allocate a cursors for the main database table and for all indices.
- ** The index cursors might not be used, but if they are used they
- ** need to occur right after the database cursor. So go ahead and
- ** allocate enough space, just in case.
- */
- pTabList->a[0].iCursor = iCur = pParse->nTab++;
- for(pIdx=pTab->pIndex; pIdx; pIdx=pIdx->pNext){
- pParse->nTab++;
- }
-
- /* Resolve the column names in all the expressions of the
- ** of the UPDATE statement. Also find the column index
- ** for each column to be updated in the pChanges array. For each
- ** column to be updated, make sure we have authorization to change
- ** that column.
- */
- chngRecno = 0;
- for(i=0; i<pChanges->nExpr; i++){
- if( sqliteExprResolveIds(pParse, pTabList, 0, pChanges->a[i].pExpr) ){
- goto update_cleanup;
- }
- if( sqliteExprCheck(pParse, pChanges->a[i].pExpr, 0, 0) ){
- goto update_cleanup;
- }
- for(j=0; j<pTab->nCol; j++){
- if( sqliteStrICmp(pTab->aCol[j].zName, pChanges->a[i].zName)==0 ){
- if( j==pTab->iPKey ){
- chngRecno = 1;
- pRecnoExpr = pChanges->a[i].pExpr;
- }
- aXRef[j] = i;
- break;
- }
- }
- if( j>=pTab->nCol ){
- if( sqliteIsRowid(pChanges->a[i].zName) ){
- chngRecno = 1;
- pRecnoExpr = pChanges->a[i].pExpr;
- }else{
- sqliteErrorMsg(pParse, "no such column: %s", pChanges->a[i].zName);
- goto update_cleanup;
- }
- }
-#ifndef SQLITE_OMIT_AUTHORIZATION
- {
- int rc;
- rc = sqliteAuthCheck(pParse, SQLITE_UPDATE, pTab->zName,
- pTab->aCol[j].zName, db->aDb[pTab->iDb].zName);
- if( rc==SQLITE_DENY ){
- goto update_cleanup;
- }else if( rc==SQLITE_IGNORE ){
- aXRef[j] = -1;
- }
- }
-#endif
- }
-
- /* Allocate memory for the array apIdx[] and fill it with pointers to every
- ** index that needs to be updated. Indices only need updating if their
- ** key includes one of the columns named in pChanges or if the record
- ** number of the original table entry is changing.
- */
- for(nIdx=nIdxTotal=0, pIdx=pTab->pIndex; pIdx; pIdx=pIdx->pNext, nIdxTotal++){
- if( chngRecno ){
- i = 0;
- }else {
- for(i=0; i<pIdx->nColumn; i++){
- if( aXRef[pIdx->aiColumn[i]]>=0 ) break;
- }
- }
- if( i<pIdx->nColumn ) nIdx++;
- }
- if( nIdxTotal>0 ){
- apIdx = sqliteMalloc( sizeof(Index*) * nIdx + nIdxTotal );
- if( apIdx==0 ) goto update_cleanup;
- aIdxUsed = (char*)&apIdx[nIdx];
- }
- for(nIdx=j=0, pIdx=pTab->pIndex; pIdx; pIdx=pIdx->pNext, j++){
- if( chngRecno ){
- i = 0;
- }else{
- for(i=0; i<pIdx->nColumn; i++){
- if( aXRef[pIdx->aiColumn[i]]>=0 ) break;
- }
- }
- if( i<pIdx->nColumn ){
- apIdx[nIdx++] = pIdx;
- aIdxUsed[j] = 1;
- }else{
- aIdxUsed[j] = 0;
- }
- }
-
- /* Resolve the column names in all the expressions in the
- ** WHERE clause.
- */
- if( pWhere ){
- if( sqliteExprResolveIds(pParse, pTabList, 0, pWhere) ){
- goto update_cleanup;
- }
- if( sqliteExprCheck(pParse, pWhere, 0, 0) ){
- goto update_cleanup;
- }
- }
-
- /* Start the view context
- */
- if( isView ){
- sqliteAuthContextPush(pParse, &sContext, pTab->zName);
- }
-
- /* Begin generating code.
- */
- v = sqliteGetVdbe(pParse);
- if( v==0 ) goto update_cleanup;
- sqliteBeginWriteOperation(pParse, 1, pTab->iDb);
-
- /* If we are trying to update a view, construct that view into
- ** a temporary table.
- */
- if( isView ){
- Select *pView;
- pView = sqliteSelectDup(pTab->pSelect);
- sqliteSelect(pParse, pView, SRT_TempTable, iCur, 0, 0, 0);
- sqliteSelectDelete(pView);
- }
-
- /* Begin the database scan
- */
- pWInfo = sqliteWhereBegin(pParse, pTabList, pWhere, 1, 0);
- if( pWInfo==0 ) goto update_cleanup;
-
- /* Remember the index of every item to be updated.
- */
- sqliteVdbeAddOp(v, OP_ListWrite, 0, 0);
-
- /* End the database scan loop.
- */
- sqliteWhereEnd(pWInfo);
-
- /* Initialize the count of updated rows
- */
- if( db->flags & SQLITE_CountRows && !pParse->trigStack ){
- sqliteVdbeAddOp(v, OP_Integer, 0, 0);
- }
-
- if( row_triggers_exist ){
- /* Create pseudo-tables for NEW and OLD
- */
- sqliteVdbeAddOp(v, OP_OpenPseudo, oldIdx, 0);
- sqliteVdbeAddOp(v, OP_OpenPseudo, newIdx, 0);
-
- /* The top of the update loop for when there are triggers.
- */
- sqliteVdbeAddOp(v, OP_ListRewind, 0, 0);
- sqliteVdbeAddOp(v, OP_StackDepth, 0, 0);
- sqliteVdbeAddOp(v, OP_MemStore, iStackDepth, 1);
- loopStart = sqliteVdbeAddOp(v, OP_MemLoad, iStackDepth, 0);
- sqliteVdbeAddOp(v, OP_StackReset, 0, 0);
- jumpInst = sqliteVdbeAddOp(v, OP_ListRead, 0, 0);
- sqliteVdbeAddOp(v, OP_Dup, 0, 0);
-
- /* Open a cursor and make it point to the record that is
- ** being updated.
- */
- sqliteVdbeAddOp(v, OP_Dup, 0, 0);
- if( !isView ){
- sqliteVdbeAddOp(v, OP_Integer, pTab->iDb, 0);
- sqliteVdbeAddOp(v, OP_OpenRead, iCur, pTab->tnum);
- }
- sqliteVdbeAddOp(v, OP_MoveTo, iCur, 0);
-
- /* Generate the OLD table
- */
- sqliteVdbeAddOp(v, OP_Recno, iCur, 0);
- sqliteVdbeAddOp(v, OP_RowData, iCur, 0);
- sqliteVdbeAddOp(v, OP_PutIntKey, oldIdx, 0);
-
- /* Generate the NEW table
- */
- if( chngRecno ){
- sqliteExprCode(pParse, pRecnoExpr);
- }else{
- sqliteVdbeAddOp(v, OP_Recno, iCur, 0);
- }
- for(i=0; i<pTab->nCol; i++){
- if( i==pTab->iPKey ){
- sqliteVdbeAddOp(v, OP_String, 0, 0);
- continue;
- }
- j = aXRef[i];
- if( j<0 ){
- sqliteVdbeAddOp(v, OP_Column, iCur, i);
- }else{
- sqliteExprCode(pParse, pChanges->a[j].pExpr);
- }
- }
- sqliteVdbeAddOp(v, OP_MakeRecord, pTab->nCol, 0);
- sqliteVdbeAddOp(v, OP_PutIntKey, newIdx, 0);
- if( !isView ){
- sqliteVdbeAddOp(v, OP_Close, iCur, 0);
- }
-
- /* Fire the BEFORE and INSTEAD OF triggers
- */
- if( sqliteCodeRowTrigger(pParse, TK_UPDATE, pChanges, TK_BEFORE, pTab,
- newIdx, oldIdx, onError, loopStart) ){
- goto update_cleanup;
- }
- }
-
- if( !isView ){
- /*
- ** Open every index that needs updating. Note that if any
- ** index could potentially invoke a REPLACE conflict resolution
- ** action, then we need to open all indices because we might need
- ** to be deleting some records.
- */
- sqliteVdbeAddOp(v, OP_Integer, pTab->iDb, 0);
- sqliteVdbeAddOp(v, OP_OpenWrite, iCur, pTab->tnum);
- if( onError==OE_Replace ){
- openAll = 1;
- }else{
- openAll = 0;
- for(pIdx=pTab->pIndex; pIdx; pIdx=pIdx->pNext){
- if( pIdx->onError==OE_Replace ){
- openAll = 1;
- break;
- }
- }
- }
- for(i=0, pIdx=pTab->pIndex; pIdx; pIdx=pIdx->pNext, i++){
- if( openAll || aIdxUsed[i] ){
- sqliteVdbeAddOp(v, OP_Integer, pIdx->iDb, 0);
- sqliteVdbeAddOp(v, OP_OpenWrite, iCur+i+1, pIdx->tnum);
- assert( pParse->nTab>iCur+i+1 );
- }
- }
-
- /* Loop over every record that needs updating. We have to load
- ** the old data for each record to be updated because some columns
- ** might not change and we will need to copy the old value.
- ** Also, the old data is needed to delete the old index entires.
- ** So make the cursor point at the old record.
- */
- if( !row_triggers_exist ){
- sqliteVdbeAddOp(v, OP_ListRewind, 0, 0);
- jumpInst = loopStart = sqliteVdbeAddOp(v, OP_ListRead, 0, 0);
- sqliteVdbeAddOp(v, OP_Dup, 0, 0);
- }
- sqliteVdbeAddOp(v, OP_NotExists, iCur, loopStart);
-
- /* If the record number will change, push the record number as it
- ** will be after the update. (The old record number is currently
- ** on top of the stack.)
- */
- if( chngRecno ){
- sqliteExprCode(pParse, pRecnoExpr);
- sqliteVdbeAddOp(v, OP_MustBeInt, 0, 0);
- }
-
- /* Compute new data for this record.
- */
- for(i=0; i<pTab->nCol; i++){
- if( i==pTab->iPKey ){
- sqliteVdbeAddOp(v, OP_String, 0, 0);
- continue;
- }
- j = aXRef[i];
- if( j<0 ){
- sqliteVdbeAddOp(v, OP_Column, iCur, i);
- }else{
- sqliteExprCode(pParse, pChanges->a[j].pExpr);
- }
- }
-
- /* Do constraint checks
- */
- sqliteGenerateConstraintChecks(pParse, pTab, iCur, aIdxUsed, chngRecno, 1,
- onError, loopStart);
-
- /* Delete the old indices for the current record.
- */
- sqliteGenerateRowIndexDelete(db, v, pTab, iCur, aIdxUsed);
-
- /* If changing the record number, delete the old record.
- */
- if( chngRecno ){
- sqliteVdbeAddOp(v, OP_Delete, iCur, 0);
- }
-
- /* Create the new index entries and the new record.
- */
- sqliteCompleteInsertion(pParse, pTab, iCur, aIdxUsed, chngRecno, 1, -1);
- }
-
- /* Increment the row counter
- */
- if( db->flags & SQLITE_CountRows && !pParse->trigStack){
- sqliteVdbeAddOp(v, OP_AddImm, 1, 0);
- }
-
- /* If there are triggers, close all the cursors after each iteration
- ** through the loop. The fire the after triggers.
- */
- if( row_triggers_exist ){
- if( !isView ){
- for(i=0, pIdx=pTab->pIndex; pIdx; pIdx=pIdx->pNext, i++){
- if( openAll || aIdxUsed[i] )
- sqliteVdbeAddOp(v, OP_Close, iCur+i+1, 0);
- }
- sqliteVdbeAddOp(v, OP_Close, iCur, 0);
- pParse->nTab = iCur;
- }
- if( sqliteCodeRowTrigger(pParse, TK_UPDATE, pChanges, TK_AFTER, pTab,
- newIdx, oldIdx, onError, loopStart) ){
- goto update_cleanup;
- }
- }
-
- /* Repeat the above with the next record to be updated, until
- ** all record selected by the WHERE clause have been updated.
- */
- sqliteVdbeAddOp(v, OP_Goto, 0, loopStart);
- sqliteVdbeChangeP2(v, jumpInst, sqliteVdbeCurrentAddr(v));
- sqliteVdbeAddOp(v, OP_ListReset, 0, 0);
-
- /* Close all tables if there were no FOR EACH ROW triggers */
- if( !row_triggers_exist ){
- for(i=0, pIdx=pTab->pIndex; pIdx; pIdx=pIdx->pNext, i++){
- if( openAll || aIdxUsed[i] ){
- sqliteVdbeAddOp(v, OP_Close, iCur+i+1, 0);
- }
- }
- sqliteVdbeAddOp(v, OP_Close, iCur, 0);
- pParse->nTab = iCur;
- }else{
- sqliteVdbeAddOp(v, OP_Close, newIdx, 0);
- sqliteVdbeAddOp(v, OP_Close, oldIdx, 0);
- }
-
- sqliteVdbeAddOp(v, OP_SetCounts, 0, 0);
- sqliteEndWriteOperation(pParse);
-
- /*
- ** Return the number of rows that were changed.
- */
- if( db->flags & SQLITE_CountRows && !pParse->trigStack ){
- sqliteVdbeOp3(v, OP_ColumnName, 0, 1, "rows updated", P3_STATIC);
- sqliteVdbeAddOp(v, OP_Callback, 1, 0);
- }
-
-update_cleanup:
- sqliteAuthContextPop(&sContext);
- sqliteFree(apIdx);
- sqliteFree(aXRef);
- sqliteSrcListDelete(pTabList);
- sqliteExprListDelete(pChanges);
- sqliteExprDelete(pWhere);
- return;
-}
+++ /dev/null
-/*
-** 2001 September 15
-**
-** The author disclaims copyright to this source code. In place of
-** a legal notice, here is a blessing:
-**
-** May you do good and not evil.
-** May you find forgiveness for yourself and forgive others.
-** May you share freely, never taking more than you give.
-**
-*************************************************************************
-** Utility functions used throughout sqlite.
-**
-** This file contains functions for allocating memory, comparing
-** strings, and stuff like that.
-**
-** $Id: util.c,v 1.1.1.1 2004/08/08 15:03:58 matt Exp $
-*/
-#include "sqliteInt.h"
-#include <stdarg.h>
-#include <ctype.h>
-
-/*
-** If malloc() ever fails, this global variable gets set to 1.
-** This causes the library to abort and never again function.
-*/
-int sqlite_malloc_failed = 0;
-
-/*
-** If MEMORY_DEBUG is defined, then use versions of malloc() and
-** free() that track memory usage and check for buffer overruns.
-*/
-#ifdef MEMORY_DEBUG
-
-/*
-** For keeping track of the number of mallocs and frees. This
-** is used to check for memory leaks.
-*/
-int sqlite_nMalloc; /* Number of sqliteMalloc() calls */
-int sqlite_nFree; /* Number of sqliteFree() calls */
-int sqlite_iMallocFail; /* Fail sqliteMalloc() after this many calls */
-#if MEMORY_DEBUG>1
-static int memcnt = 0;
-#endif
-
-/*
-** Number of 32-bit guard words
-*/
-#define N_GUARD 1
-
-/*
-** Allocate new memory and set it to zero. Return NULL if
-** no memory is available.
-*/
-void *sqliteMalloc_(int n, int bZero, char *zFile, int line){
- void *p;
- int *pi;
- int i, k;
- if( sqlite_iMallocFail>=0 ){
- sqlite_iMallocFail--;
- if( sqlite_iMallocFail==0 ){
- sqlite_malloc_failed++;
-#if MEMORY_DEBUG>1
- fprintf(stderr,"**** failed to allocate %d bytes at %s:%d\n",
- n, zFile,line);
-#endif
- sqlite_iMallocFail--;
- return 0;
- }
- }
- if( n==0 ) return 0;
- k = (n+sizeof(int)-1)/sizeof(int);
- pi = malloc( (N_GUARD*2+1+k)*sizeof(int));
- if( pi==0 ){
- sqlite_malloc_failed++;
- return 0;
- }
- sqlite_nMalloc++;
- for(i=0; i<N_GUARD; i++) pi[i] = 0xdead1122;
- pi[N_GUARD] = n;
- for(i=0; i<N_GUARD; i++) pi[k+1+N_GUARD+i] = 0xdead3344;
- p = &pi[N_GUARD+1];
- memset(p, bZero==0, n);
-#if MEMORY_DEBUG>1
- fprintf(stderr,"%06d malloc %d bytes at 0x%x from %s:%d\n",
- ++memcnt, n, (int)p, zFile,line);
-#endif
- return p;
-}
-
-/*
-** Check to see if the given pointer was obtained from sqliteMalloc()
-** and is able to hold at least N bytes. Raise an exception if this
-** is not the case.
-**
-** This routine is used for testing purposes only.
-*/
-void sqliteCheckMemory(void *p, int N){
- int *pi = p;
- int n, i, k;
- pi -= N_GUARD+1;
- for(i=0; i<N_GUARD; i++){
- assert( pi[i]==0xdead1122 );
- }
- n = pi[N_GUARD];
- assert( N>=0 && N<n );
- k = (n+sizeof(int)-1)/sizeof(int);
- for(i=0; i<N_GUARD; i++){
- assert( pi[k+N_GUARD+1+i]==0xdead3344 );
- }
-}
-
-/*
-** Free memory previously obtained from sqliteMalloc()
-*/
-void sqliteFree_(void *p, char *zFile, int line){
- if( p ){
- int *pi, i, k, n;
- pi = p;
- pi -= N_GUARD+1;
- sqlite_nFree++;
- for(i=0; i<N_GUARD; i++){
- if( pi[i]!=0xdead1122 ){
- fprintf(stderr,"Low-end memory corruption at 0x%x\n", (int)p);
- return;
- }
- }
- n = pi[N_GUARD];
- k = (n+sizeof(int)-1)/sizeof(int);
- for(i=0; i<N_GUARD; i++){
- if( pi[k+N_GUARD+1+i]!=0xdead3344 ){
- fprintf(stderr,"High-end memory corruption at 0x%x\n", (int)p);
- return;
- }
- }
- memset(pi, 0xff, (k+N_GUARD*2+1)*sizeof(int));
-#if MEMORY_DEBUG>1
- fprintf(stderr,"%06d free %d bytes at 0x%x from %s:%d\n",
- ++memcnt, n, (int)p, zFile,line);
-#endif
- free(pi);
- }
-}
-
-/*
-** Resize a prior allocation. If p==0, then this routine
-** works just like sqliteMalloc(). If n==0, then this routine
-** works just like sqliteFree().
-*/
-void *sqliteRealloc_(void *oldP, int n, char *zFile, int line){
- int *oldPi, *pi, i, k, oldN, oldK;
- void *p;
- if( oldP==0 ){
- return sqliteMalloc_(n,1,zFile,line);
- }
- if( n==0 ){
- sqliteFree_(oldP,zFile,line);
- return 0;
- }
- oldPi = oldP;
- oldPi -= N_GUARD+1;
- if( oldPi[0]!=0xdead1122 ){
- fprintf(stderr,"Low-end memory corruption in realloc at 0x%x\n", (int)oldP);
- return 0;
- }
- oldN = oldPi[N_GUARD];
- oldK = (oldN+sizeof(int)-1)/sizeof(int);
- for(i=0; i<N_GUARD; i++){
- if( oldPi[oldK+N_GUARD+1+i]!=0xdead3344 ){
- fprintf(stderr,"High-end memory corruption in realloc at 0x%x\n",
- (int)oldP);
- return 0;
- }
- }
- k = (n + sizeof(int) - 1)/sizeof(int);
- pi = malloc( (k+N_GUARD*2+1)*sizeof(int) );
- if( pi==0 ){
- sqlite_malloc_failed++;
- return 0;
- }
- for(i=0; i<N_GUARD; i++) pi[i] = 0xdead1122;
- pi[N_GUARD] = n;
- for(i=0; i<N_GUARD; i++) pi[k+N_GUARD+1+i] = 0xdead3344;
- p = &pi[N_GUARD+1];
- memcpy(p, oldP, n>oldN ? oldN : n);
- if( n>oldN ){
- memset(&((char*)p)[oldN], 0, n-oldN);
- }
- memset(oldPi, 0xab, (oldK+N_GUARD+2)*sizeof(int));
- free(oldPi);
-#if MEMORY_DEBUG>1
- fprintf(stderr,"%06d realloc %d to %d bytes at 0x%x to 0x%x at %s:%d\n",
- ++memcnt, oldN, n, (int)oldP, (int)p, zFile, line);
-#endif
- return p;
-}
-
-/*
-** Make a duplicate of a string into memory obtained from malloc()
-** Free the original string using sqliteFree().
-**
-** This routine is called on all strings that are passed outside of
-** the SQLite library. That way clients can free the string using free()
-** rather than having to call sqliteFree().
-*/
-void sqliteStrRealloc(char **pz){
- char *zNew;
- if( pz==0 || *pz==0 ) return;
- zNew = malloc( strlen(*pz) + 1 );
- if( zNew==0 ){
- sqlite_malloc_failed++;
- sqliteFree(*pz);
- *pz = 0;
- }
- strcpy(zNew, *pz);
- sqliteFree(*pz);
- *pz = zNew;
-}
-
-/*
-** Make a copy of a string in memory obtained from sqliteMalloc()
-*/
-char *sqliteStrDup_(const char *z, char *zFile, int line){
- char *zNew;
- if( z==0 ) return 0;
- zNew = sqliteMalloc_(strlen(z)+1, 0, zFile, line);
- if( zNew ) strcpy(zNew, z);
- return zNew;
-}
-char *sqliteStrNDup_(const char *z, int n, char *zFile, int line){
- char *zNew;
- if( z==0 ) return 0;
- zNew = sqliteMalloc_(n+1, 0, zFile, line);
- if( zNew ){
- memcpy(zNew, z, n);
- zNew[n] = 0;
- }
- return zNew;
-}
-#endif /* MEMORY_DEBUG */
-
-/*
-** The following versions of malloc() and free() are for use in a
-** normal build.
-*/
-#if !defined(MEMORY_DEBUG)
-
-/*
-** Allocate new memory and set it to zero. Return NULL if
-** no memory is available. See also sqliteMallocRaw().
-*/
-void *sqliteMalloc(int n){
- void *p;
- if( (p = malloc(n))==0 ){
- if( n>0 ) sqlite_malloc_failed++;
- }else{
- memset(p, 0, n);
- }
- return p;
-}
-
-/*
-** Allocate new memory but do not set it to zero. Return NULL if
-** no memory is available. See also sqliteMalloc().
-*/
-void *sqliteMallocRaw(int n){
- void *p;
- if( (p = malloc(n))==0 ){
- if( n>0 ) sqlite_malloc_failed++;
- }
- return p;
-}
-
-/*
-** Free memory previously obtained from sqliteMalloc()
-*/
-void sqliteFree(void *p){
- if( p ){
- free(p);
- }
-}
-
-/*
-** Resize a prior allocation. If p==0, then this routine
-** works just like sqliteMalloc(). If n==0, then this routine
-** works just like sqliteFree().
-*/
-void *sqliteRealloc(void *p, int n){
- void *p2;
- if( p==0 ){
- return sqliteMalloc(n);
- }
- if( n==0 ){
- sqliteFree(p);
- return 0;
- }
- p2 = realloc(p, n);
- if( p2==0 ){
- sqlite_malloc_failed++;
- }
- return p2;
-}
-
-/*
-** Make a copy of a string in memory obtained from sqliteMalloc()
-*/
-char *sqliteStrDup(const char *z){
- char *zNew;
- if( z==0 ) return 0;
- zNew = sqliteMallocRaw(strlen(z)+1);
- if( zNew ) strcpy(zNew, z);
- return zNew;
-}
-char *sqliteStrNDup(const char *z, int n){
- char *zNew;
- if( z==0 ) return 0;
- zNew = sqliteMallocRaw(n+1);
- if( zNew ){
- memcpy(zNew, z, n);
- zNew[n] = 0;
- }
- return zNew;
-}
-#endif /* !defined(MEMORY_DEBUG) */
-
-/*
-** Create a string from the 2nd and subsequent arguments (up to the
-** first NULL argument), store the string in memory obtained from
-** sqliteMalloc() and make the pointer indicated by the 1st argument
-** point to that string. The 1st argument must either be NULL or
-** point to memory obtained from sqliteMalloc().
-*/
-void sqliteSetString(char **pz, const char *zFirst, ...){
- va_list ap;
- int nByte;
- const char *z;
- char *zResult;
-
- if( pz==0 ) return;
- nByte = strlen(zFirst) + 1;
- va_start(ap, zFirst);
- while( (z = va_arg(ap, const char*))!=0 ){
- nByte += strlen(z);
- }
- va_end(ap);
- sqliteFree(*pz);
- *pz = zResult = sqliteMallocRaw( nByte );
- if( zResult==0 ){
- return;
- }
- strcpy(zResult, zFirst);
- zResult += strlen(zResult);
- va_start(ap, zFirst);
- while( (z = va_arg(ap, const char*))!=0 ){
- strcpy(zResult, z);
- zResult += strlen(zResult);
- }
- va_end(ap);
-#ifdef MEMORY_DEBUG
-#if MEMORY_DEBUG>1
- fprintf(stderr,"string at 0x%x is %s\n", (int)*pz, *pz);
-#endif
-#endif
-}
-
-/*
-** Works like sqliteSetString, but each string is now followed by
-** a length integer which specifies how much of the source string
-** to copy (in bytes). -1 means use the whole string. The 1st
-** argument must either be NULL or point to memory obtained from
-** sqliteMalloc().
-*/
-void sqliteSetNString(char **pz, ...){
- va_list ap;
- int nByte;
- const char *z;
- char *zResult;
- int n;
-
- if( pz==0 ) return;
- nByte = 0;
- va_start(ap, pz);
- while( (z = va_arg(ap, const char*))!=0 ){
- n = va_arg(ap, int);
- if( n<=0 ) n = strlen(z);
- nByte += n;
- }
- va_end(ap);
- sqliteFree(*pz);
- *pz = zResult = sqliteMallocRaw( nByte + 1 );
- if( zResult==0 ) return;
- va_start(ap, pz);
- while( (z = va_arg(ap, const char*))!=0 ){
- n = va_arg(ap, int);
- if( n<=0 ) n = strlen(z);
- strncpy(zResult, z, n);
- zResult += n;
- }
- *zResult = 0;
-#ifdef MEMORY_DEBUG
-#if MEMORY_DEBUG>1
- fprintf(stderr,"string at 0x%x is %s\n", (int)*pz, *pz);
-#endif
-#endif
- va_end(ap);
-}
-
-/*
-** Add an error message to pParse->zErrMsg and increment pParse->nErr.
-** The following formatting characters are allowed:
-**
-** %s Insert a string
-** %z A string that should be freed after use
-** %d Insert an integer
-** %T Insert a token
-** %S Insert the first element of a SrcList
-*/
-void sqliteErrorMsg(Parse *pParse, const char *zFormat, ...){
- va_list ap;
- pParse->nErr++;
- sqliteFree(pParse->zErrMsg);
- va_start(ap, zFormat);
- pParse->zErrMsg = sqliteVMPrintf(zFormat, ap);
- va_end(ap);
-}
-
-/*
-** Convert an SQL-style quoted string into a normal string by removing
-** the quote characters. The conversion is done in-place. If the
-** input does not begin with a quote character, then this routine
-** is a no-op.
-**
-** 2002-Feb-14: This routine is extended to remove MS-Access style
-** brackets from around identifers. For example: "[a-b-c]" becomes
-** "a-b-c".
-*/
-void sqliteDequote(char *z){
- int quote;
- int i, j;
- if( z==0 ) return;
- quote = z[0];
- switch( quote ){
- case '\'': break;
- case '"': break;
- case '[': quote = ']'; break;
- default: return;
- }
- for(i=1, j=0; z[i]; i++){
- if( z[i]==quote ){
- if( z[i+1]==quote ){
- z[j++] = quote;
- i++;
- }else{
- z[j++] = 0;
- break;
- }
- }else{
- z[j++] = z[i];
- }
- }
-}
-
-/* An array to map all upper-case characters into their corresponding
-** lower-case character.
-*/
-static unsigned char UpperToLower[] = {
- 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17,
- 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35,
- 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53,
- 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 97, 98, 99,100,101,102,103,
- 104,105,106,107,108,109,110,111,112,113,114,115,116,117,118,119,120,121,
- 122, 91, 92, 93, 94, 95, 96, 97, 98, 99,100,101,102,103,104,105,106,107,
- 108,109,110,111,112,113,114,115,116,117,118,119,120,121,122,123,124,125,
- 126,127,128,129,130,131,132,133,134,135,136,137,138,139,140,141,142,143,
- 144,145,146,147,148,149,150,151,152,153,154,155,156,157,158,159,160,161,
- 162,163,164,165,166,167,168,169,170,171,172,173,174,175,176,177,178,179,
- 180,181,182,183,184,185,186,187,188,189,190,191,192,193,194,195,196,197,
- 198,199,200,201,202,203,204,205,206,207,208,209,210,211,212,213,214,215,
- 216,217,218,219,220,221,222,223,224,225,226,227,228,229,230,231,232,233,
- 234,235,236,237,238,239,240,241,242,243,244,245,246,247,248,249,250,251,
- 252,253,254,255
-};
-
-/*
-** This function computes a hash on the name of a keyword.
-** Case is not significant.
-*/
-int sqliteHashNoCase(const char *z, int n){
- int h = 0;
- if( n<=0 ) n = strlen(z);
- while( n > 0 ){
- h = (h<<3) ^ h ^ UpperToLower[(unsigned char)*z++];
- n--;
- }
- return h & 0x7fffffff;
-}
-
-/*
-** Some systems have stricmp(). Others have strcasecmp(). Because
-** there is no consistency, we will define our own.
-*/
-int sqliteStrICmp(const char *zLeft, const char *zRight){
- register unsigned char *a, *b;
- a = (unsigned char *)zLeft;
- b = (unsigned char *)zRight;
- while( *a!=0 && UpperToLower[*a]==UpperToLower[*b]){ a++; b++; }
- return UpperToLower[*a] - UpperToLower[*b];
-}
-int sqliteStrNICmp(const char *zLeft, const char *zRight, int N){
- register unsigned char *a, *b;
- a = (unsigned char *)zLeft;
- b = (unsigned char *)zRight;
- while( N-- > 0 && *a!=0 && UpperToLower[*a]==UpperToLower[*b]){ a++; b++; }
- return N<0 ? 0 : UpperToLower[*a] - UpperToLower[*b];
-}
-
-/*
-** Return TRUE if z is a pure numeric string. Return FALSE if the
-** string contains any character which is not part of a number.
-**
-** Am empty string is considered non-numeric.
-*/
-int sqliteIsNumber(const char *z){
- if( *z=='-' || *z=='+' ) z++;
- if( !isdigit(*z) ){
- return 0;
- }
- z++;
- while( isdigit(*z) ){ z++; }
- if( *z=='.' ){
- z++;
- if( !isdigit(*z) ) return 0;
- while( isdigit(*z) ){ z++; }
- }
- if( *z=='e' || *z=='E' ){
- z++;
- if( *z=='+' || *z=='-' ) z++;
- if( !isdigit(*z) ) return 0;
- while( isdigit(*z) ){ z++; }
- }
- return *z==0;
-}
-
-/*
-** The string z[] is an ascii representation of a real number.
-** Convert this string to a double.
-**
-** This routine assumes that z[] really is a valid number. If it
-** is not, the result is undefined.
-**
-** This routine is used instead of the library atof() function because
-** the library atof() might want to use "," as the decimal point instead
-** of "." depending on how locale is set. But that would cause problems
-** for SQL. So this routine always uses "." regardless of locale.
-*/
-double sqliteAtoF(const char *z, const char **pzEnd){
- int sign = 1;
- LONGDOUBLE_TYPE v1 = 0.0;
- if( *z=='-' ){
- sign = -1;
- z++;
- }else if( *z=='+' ){
- z++;
- }
- while( isdigit(*z) ){
- v1 = v1*10.0 + (*z - '0');
- z++;
- }
- if( *z=='.' ){
- LONGDOUBLE_TYPE divisor = 1.0;
- z++;
- while( isdigit(*z) ){
- v1 = v1*10.0 + (*z - '0');
- divisor *= 10.0;
- z++;
- }
- v1 /= divisor;
- }
- if( *z=='e' || *z=='E' ){
- int esign = 1;
- int eval = 0;
- LONGDOUBLE_TYPE scale = 1.0;
- z++;
- if( *z=='-' ){
- esign = -1;
- z++;
- }else if( *z=='+' ){
- z++;
- }
- while( isdigit(*z) ){
- eval = eval*10 + *z - '0';
- z++;
- }
- while( eval>=64 ){ scale *= 1.0e+64; eval -= 64; }
- while( eval>=16 ){ scale *= 1.0e+16; eval -= 16; }
- while( eval>=4 ){ scale *= 1.0e+4; eval -= 4; }
- while( eval>=1 ){ scale *= 1.0e+1; eval -= 1; }
- if( esign<0 ){
- v1 /= scale;
- }else{
- v1 *= scale;
- }
- }
- if( pzEnd ) *pzEnd = z;
- return sign<0 ? -v1 : v1;
-}
-
-/*
-** The string zNum represents an integer. There might be some other
-** information following the integer too, but that part is ignored.
-** If the integer that the prefix of zNum represents will fit in a
-** 32-bit signed integer, return TRUE. Otherwise return FALSE.
-**
-** This routine returns FALSE for the string -2147483648 even that
-** that number will, in theory fit in a 32-bit integer. But positive
-** 2147483648 will not fit in 32 bits. So it seems safer to return
-** false.
-*/
-int sqliteFitsIn32Bits(const char *zNum){
- int i, c;
- if( *zNum=='-' || *zNum=='+' ) zNum++;
- for(i=0; (c=zNum[i])>='0' && c<='9'; i++){}
- return i<10 || (i==10 && memcmp(zNum,"2147483647",10)<=0);
-}
-
-/* This comparison routine is what we use for comparison operations
-** between numeric values in an SQL expression. "Numeric" is a little
-** bit misleading here. What we mean is that the strings have a
-** type of "numeric" from the point of view of SQL. The strings
-** do not necessarily contain numbers. They could contain text.
-**
-** If the input strings both look like actual numbers then they
-** compare in numerical order. Numerical strings are always less
-** than non-numeric strings so if one input string looks like a
-** number and the other does not, then the one that looks like
-** a number is the smaller. Non-numeric strings compare in
-** lexigraphical order (the same order as strcmp()).
-*/
-int sqliteCompare(const char *atext, const char *btext){
- int result;
- int isNumA, isNumB;
- if( atext==0 ){
- return -1;
- }else if( btext==0 ){
- return 1;
- }
- isNumA = sqliteIsNumber(atext);
- isNumB = sqliteIsNumber(btext);
- if( isNumA ){
- if( !isNumB ){
- result = -1;
- }else{
- double rA, rB;
- rA = sqliteAtoF(atext, 0);
- rB = sqliteAtoF(btext, 0);
- if( rA<rB ){
- result = -1;
- }else if( rA>rB ){
- result = +1;
- }else{
- result = 0;
- }
- }
- }else if( isNumB ){
- result = +1;
- }else {
- result = strcmp(atext, btext);
- }
- return result;
-}
-
-/*
-** This routine is used for sorting. Each key is a list of one or more
-** null-terminated elements. The list is terminated by two nulls in
-** a row. For example, the following text is a key with three elements
-**
-** Aone\000Dtwo\000Athree\000\000
-**
-** All elements begin with one of the characters "+-AD" and end with "\000"
-** with zero or more text elements in between. Except, NULL elements
-** consist of the special two-character sequence "N\000".
-**
-** Both arguments will have the same number of elements. This routine
-** returns negative, zero, or positive if the first argument is less
-** than, equal to, or greater than the first. (Result is a-b).
-**
-** Each element begins with one of the characters "+", "-", "A", "D".
-** This character determines the sort order and collating sequence:
-**
-** + Sort numerically in ascending order
-** - Sort numerically in descending order
-** A Sort as strings in ascending order
-** D Sort as strings in descending order.
-**
-** For the "+" and "-" sorting, pure numeric strings (strings for which the
-** isNum() function above returns TRUE) always compare less than strings
-** that are not pure numerics. Non-numeric strings compare in memcmp()
-** order. This is the same sort order as the sqliteCompare() function
-** above generates.
-**
-** The last point is a change from version 2.6.3 to version 2.7.0. In
-** version 2.6.3 and earlier, substrings of digits compare in numerical
-** and case was used only to break a tie.
-**
-** Elements that begin with 'A' or 'D' compare in memcmp() order regardless
-** of whether or not they look like a number.
-**
-** Note that the sort order imposed by the rules above is the same
-** from the ordering defined by the "<", "<=", ">", and ">=" operators
-** of expressions and for indices. This was not the case for version
-** 2.6.3 and earlier.
-*/
-int sqliteSortCompare(const char *a, const char *b){
- int res = 0;
- int isNumA, isNumB;
- int dir = 0;
-
- while( res==0 && *a && *b ){
- if( a[0]=='N' || b[0]=='N' ){
- if( a[0]==b[0] ){
- a += 2;
- b += 2;
- continue;
- }
- if( a[0]=='N' ){
- dir = b[0];
- res = -1;
- }else{
- dir = a[0];
- res = +1;
- }
- break;
- }
- assert( a[0]==b[0] );
- if( (dir=a[0])=='A' || a[0]=='D' ){
- res = strcmp(&a[1],&b[1]);
- if( res ) break;
- }else{
- isNumA = sqliteIsNumber(&a[1]);
- isNumB = sqliteIsNumber(&b[1]);
- if( isNumA ){
- double rA, rB;
- if( !isNumB ){
- res = -1;
- break;
- }
- rA = sqliteAtoF(&a[1], 0);
- rB = sqliteAtoF(&b[1], 0);
- if( rA<rB ){
- res = -1;
- break;
- }
- if( rA>rB ){
- res = +1;
- break;
- }
- }else if( isNumB ){
- res = +1;
- break;
- }else{
- res = strcmp(&a[1],&b[1]);
- if( res ) break;
- }
- }
- a += strlen(&a[1]) + 2;
- b += strlen(&b[1]) + 2;
- }
- if( dir=='-' || dir=='D' ) res = -res;
- return res;
-}
-
-/*
-** Some powers of 64. These constants are needed in the
-** sqliteRealToSortable() routine below.
-*/
-#define _64e3 (64.0 * 64.0 * 64.0)
-#define _64e4 (64.0 * 64.0 * 64.0 * 64.0)
-#define _64e15 (_64e3 * _64e4 * _64e4 * _64e4)
-#define _64e16 (_64e4 * _64e4 * _64e4 * _64e4)
-#define _64e63 (_64e15 * _64e16 * _64e16 * _64e16)
-#define _64e64 (_64e16 * _64e16 * _64e16 * _64e16)
-
-/*
-** The following procedure converts a double-precision floating point
-** number into a string. The resulting string has the property that
-** two such strings comparied using strcmp() or memcmp() will give the
-** same results as a numeric comparison of the original floating point
-** numbers.
-**
-** This routine is used to generate database keys from floating point
-** numbers such that the keys sort in the same order as the original
-** floating point numbers even though the keys are compared using
-** memcmp().
-**
-** The calling function should have allocated at least 14 characters
-** of space for the buffer z[].
-*/
-void sqliteRealToSortable(double r, char *z){
- int neg;
- int exp;
- int cnt = 0;
-
- /* This array maps integers between 0 and 63 into base-64 digits.
- ** The digits must be chosen such at their ASCII codes are increasing.
- ** This means we can not use the traditional base-64 digit set. */
- static const char zDigit[] =
- "0123456789"
- "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
- "abcdefghijklmnopqrstuvwxyz"
- "|~";
- if( r<0.0 ){
- neg = 1;
- r = -r;
- *z++ = '-';
- } else {
- neg = 0;
- *z++ = '0';
- }
- exp = 0;
-
- if( r==0.0 ){
- exp = -1024;
- }else if( r<(0.5/64.0) ){
- while( r < 0.5/_64e64 && exp > -961 ){ r *= _64e64; exp -= 64; }
- while( r < 0.5/_64e16 && exp > -1009 ){ r *= _64e16; exp -= 16; }
- while( r < 0.5/_64e4 && exp > -1021 ){ r *= _64e4; exp -= 4; }
- while( r < 0.5/64.0 && exp > -1024 ){ r *= 64.0; exp -= 1; }
- }else if( r>=0.5 ){
- while( r >= 0.5*_64e63 && exp < 960 ){ r *= 1.0/_64e64; exp += 64; }
- while( r >= 0.5*_64e15 && exp < 1008 ){ r *= 1.0/_64e16; exp += 16; }
- while( r >= 0.5*_64e3 && exp < 1020 ){ r *= 1.0/_64e4; exp += 4; }
- while( r >= 0.5 && exp < 1023 ){ r *= 1.0/64.0; exp += 1; }
- }
- if( neg ){
- exp = -exp;
- r = -r;
- }
- exp += 1024;
- r += 0.5;
- if( exp<0 ) return;
- if( exp>=2048 || r>=1.0 ){
- strcpy(z, "~~~~~~~~~~~~");
- return;
- }
- *z++ = zDigit[(exp>>6)&0x3f];
- *z++ = zDigit[exp & 0x3f];
- while( r>0.0 && cnt<10 ){
- int digit;
- r *= 64.0;
- digit = (int)r;
- assert( digit>=0 && digit<64 );
- *z++ = zDigit[digit & 0x3f];
- r -= digit;
- cnt++;
- }
- *z = 0;
-}
-
-#ifdef SQLITE_UTF8
-/*
-** X is a pointer to the first byte of a UTF-8 character. Increment
-** X so that it points to the next character. This only works right
-** if X points to a well-formed UTF-8 string.
-*/
-#define sqliteNextChar(X) while( (0xc0&*++(X))==0x80 ){}
-#define sqliteCharVal(X) sqlite_utf8_to_int(X)
-
-#else /* !defined(SQLITE_UTF8) */
-/*
-** For iso8859 encoding, the next character is just the next byte.
-*/
-#define sqliteNextChar(X) (++(X));
-#define sqliteCharVal(X) ((int)*(X))
-
-#endif /* defined(SQLITE_UTF8) */
-
-
-#ifdef SQLITE_UTF8
-/*
-** Convert the UTF-8 character to which z points into a 31-bit
-** UCS character. This only works right if z points to a well-formed
-** UTF-8 string.
-*/
-static int sqlite_utf8_to_int(const unsigned char *z){
- int c;
- static const int initVal[] = {
- 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14,
- 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29,
- 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44,
- 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59,
- 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74,
- 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89,
- 90, 91, 92, 93, 94, 95, 96, 97, 98, 99, 100, 101, 102, 103, 104,
- 105, 106, 107, 108, 109, 110, 111, 112, 113, 114, 115, 116, 117, 118, 119,
- 120, 121, 122, 123, 124, 125, 126, 127, 128, 129, 130, 131, 132, 133, 134,
- 135, 136, 137, 138, 139, 140, 141, 142, 143, 144, 145, 146, 147, 148, 149,
- 150, 151, 152, 153, 154, 155, 156, 157, 158, 159, 160, 161, 162, 163, 164,
- 165, 166, 167, 168, 169, 170, 171, 172, 173, 174, 175, 176, 177, 178, 179,
- 180, 181, 182, 183, 184, 185, 186, 187, 188, 189, 190, 191, 0, 1, 2,
- 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17,
- 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 0,
- 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15,
- 0, 1, 2, 3, 4, 5, 6, 7, 0, 1, 2, 3, 0, 1, 254,
- 255,
- };
- c = initVal[*(z++)];
- while( (0xc0&*z)==0x80 ){
- c = (c<<6) | (0x3f&*(z++));
- }
- return c;
-}
-#endif
-
-/*
-** Compare two UTF-8 strings for equality where the first string can
-** potentially be a "glob" expression. Return true (1) if they
-** are the same and false (0) if they are different.
-**
-** Globbing rules:
-**
-** '*' Matches any sequence of zero or more characters.
-**
-** '?' Matches exactly one character.
-**
-** [...] Matches one character from the enclosed list of
-** characters.
-**
-** [^...] Matches one character not in the enclosed list.
-**
-** With the [...] and [^...] matching, a ']' character can be included
-** in the list by making it the first character after '[' or '^'. A
-** range of characters can be specified using '-'. Example:
-** "[a-z]" matches any single lower-case letter. To match a '-', make
-** it the last character in the list.
-**
-** This routine is usually quick, but can be N**2 in the worst case.
-**
-** Hints: to match '*' or '?', put them in "[]". Like this:
-**
-** abc[*]xyz Matches "abc*xyz" only
-*/
-int
-sqliteGlobCompare(const unsigned char *zPattern, const unsigned char *zString){
- register int c;
- int invert;
- int seen;
- int c2;
-
- while( (c = *zPattern)!=0 ){
- switch( c ){
- case '*':
- while( (c=zPattern[1]) == '*' || c == '?' ){
- if( c=='?' ){
- if( *zString==0 ) return 0;
- sqliteNextChar(zString);
- }
- zPattern++;
- }
- if( c==0 ) return 1;
- if( c=='[' ){
- while( *zString && sqliteGlobCompare(&zPattern[1],zString)==0 ){
- sqliteNextChar(zString);
- }
- return *zString!=0;
- }else{
- while( (c2 = *zString)!=0 ){
- while( c2 != 0 && c2 != c ){ c2 = *++zString; }
- if( c2==0 ) return 0;
- if( sqliteGlobCompare(&zPattern[1],zString) ) return 1;
- sqliteNextChar(zString);
- }
- return 0;
- }
- case '?': {
- if( *zString==0 ) return 0;
- sqliteNextChar(zString);
- zPattern++;
- break;
- }
- case '[': {
- int prior_c = 0;
- seen = 0;
- invert = 0;
- c = sqliteCharVal(zString);
- if( c==0 ) return 0;
- c2 = *++zPattern;
- if( c2=='^' ){ invert = 1; c2 = *++zPattern; }
- if( c2==']' ){
- if( c==']' ) seen = 1;
- c2 = *++zPattern;
- }
- while( (c2 = sqliteCharVal(zPattern))!=0 && c2!=']' ){
- if( c2=='-' && zPattern[1]!=']' && zPattern[1]!=0 && prior_c>0 ){
- zPattern++;
- c2 = sqliteCharVal(zPattern);
- if( c>=prior_c && c<=c2 ) seen = 1;
- prior_c = 0;
- }else if( c==c2 ){
- seen = 1;
- prior_c = c2;
- }else{
- prior_c = c2;
- }
- sqliteNextChar(zPattern);
- }
- if( c2==0 || (seen ^ invert)==0 ) return 0;
- sqliteNextChar(zString);
- zPattern++;
- break;
- }
- default: {
- if( c != *zString ) return 0;
- zPattern++;
- zString++;
- break;
- }
- }
- }
- return *zString==0;
-}
-
-/*
-** Compare two UTF-8 strings for equality using the "LIKE" operator of
-** SQL. The '%' character matches any sequence of 0 or more
-** characters and '_' matches any single character. Case is
-** not significant.
-**
-** This routine is just an adaptation of the sqliteGlobCompare()
-** routine above.
-*/
-int
-sqliteLikeCompare(const unsigned char *zPattern, const unsigned char *zString){
- register int c;
- int c2;
-
- while( (c = UpperToLower[*zPattern])!=0 ){
- switch( c ){
- case '%': {
- while( (c=zPattern[1]) == '%' || c == '_' ){
- if( c=='_' ){
- if( *zString==0 ) return 0;
- sqliteNextChar(zString);
- }
- zPattern++;
- }
- if( c==0 ) return 1;
- c = UpperToLower[c];
- while( (c2=UpperToLower[*zString])!=0 ){
- while( c2 != 0 && c2 != c ){ c2 = UpperToLower[*++zString]; }
- if( c2==0 ) return 0;
- if( sqliteLikeCompare(&zPattern[1],zString) ) return 1;
- sqliteNextChar(zString);
- }
- return 0;
- }
- case '_': {
- if( *zString==0 ) return 0;
- sqliteNextChar(zString);
- zPattern++;
- break;
- }
- default: {
- if( c != UpperToLower[*zString] ) return 0;
- zPattern++;
- zString++;
- break;
- }
- }
- }
- return *zString==0;
-}
-
-/*
-** Change the sqlite.magic from SQLITE_MAGIC_OPEN to SQLITE_MAGIC_BUSY.
-** Return an error (non-zero) if the magic was not SQLITE_MAGIC_OPEN
-** when this routine is called.
-**
-** This routine is a attempt to detect if two threads use the
-** same sqlite* pointer at the same time. There is a race
-** condition so it is possible that the error is not detected.
-** But usually the problem will be seen. The result will be an
-** error which can be used to debug the application that is
-** using SQLite incorrectly.
-**
-** Ticket #202: If db->magic is not a valid open value, take care not
-** to modify the db structure at all. It could be that db is a stale
-** pointer. In other words, it could be that there has been a prior
-** call to sqlite_close(db) and db has been deallocated. And we do
-** not want to write into deallocated memory.
-*/
-int sqliteSafetyOn(sqlite *db){
- if( db->magic==SQLITE_MAGIC_OPEN ){
- db->magic = SQLITE_MAGIC_BUSY;
- return 0;
- }else if( db->magic==SQLITE_MAGIC_BUSY || db->magic==SQLITE_MAGIC_ERROR
- || db->want_to_close ){
- db->magic = SQLITE_MAGIC_ERROR;
- db->flags |= SQLITE_Interrupt;
- }
- return 1;
-}
-
-/*
-** Change the magic from SQLITE_MAGIC_BUSY to SQLITE_MAGIC_OPEN.
-** Return an error (non-zero) if the magic was not SQLITE_MAGIC_BUSY
-** when this routine is called.
-*/
-int sqliteSafetyOff(sqlite *db){
- if( db->magic==SQLITE_MAGIC_BUSY ){
- db->magic = SQLITE_MAGIC_OPEN;
- return 0;
- }else if( db->magic==SQLITE_MAGIC_OPEN || db->magic==SQLITE_MAGIC_ERROR
- || db->want_to_close ){
- db->magic = SQLITE_MAGIC_ERROR;
- db->flags |= SQLITE_Interrupt;
- }
- return 1;
-}
-
-/*
-** Check to make sure we are not currently executing an sqlite_exec().
-** If we are currently in an sqlite_exec(), return true and set
-** sqlite.magic to SQLITE_MAGIC_ERROR. This will cause a complete
-** shutdown of the database.
-**
-** This routine is used to try to detect when API routines are called
-** at the wrong time or in the wrong sequence.
-*/
-int sqliteSafetyCheck(sqlite *db){
- if( db->pVdbe!=0 ){
- db->magic = SQLITE_MAGIC_ERROR;
- return 1;
- }
- return 0;
-}
+++ /dev/null
-/*
-** 2003 April 6
-**
-** The author disclaims copyright to this source code. In place of
-** a legal notice, here is a blessing:
-**
-** May you do good and not evil.
-** May you find forgiveness for yourself and forgive others.
-** May you share freely, never taking more than you give.
-**
-*************************************************************************
-** This file contains code used to implement the VACUUM command.
-**
-** Most of the code in this file may be omitted by defining the
-** SQLITE_OMIT_VACUUM macro.
-**
-** $Id: vacuum.c,v 1.1.1.1 2004/08/08 15:03:58 matt Exp $
-*/
-#include "sqliteInt.h"
-#include "os.h"
-
-/*
-** A structure for holding a dynamic string - a string that can grow
-** without bound.
-*/
-typedef struct dynStr dynStr;
-struct dynStr {
- char *z; /* Text of the string in space obtained from sqliteMalloc() */
- int nAlloc; /* Amount of space allocated to z[] */
- int nUsed; /* Next unused slot in z[] */
-};
-
-/*
-** A structure that holds the vacuum context
-*/
-typedef struct vacuumStruct vacuumStruct;
-struct vacuumStruct {
- sqlite *dbOld; /* Original database */
- sqlite *dbNew; /* New database */
- char **pzErrMsg; /* Write errors here */
- int rc; /* Set to non-zero on an error */
- const char *zTable; /* Name of a table being copied */
- const char *zPragma; /* Pragma to execute with results */
- dynStr s1, s2; /* Two dynamic strings */
-};
-
-#if !defined(SQLITE_OMIT_VACUUM) || SQLITE_OMIT_VACUUM
-/*
-** Append text to a dynamic string
-*/
-static void appendText(dynStr *p, const char *zText, int nText){
- if( nText<0 ) nText = strlen(zText);
- if( p->z==0 || p->nUsed + nText + 1 >= p->nAlloc ){
- char *zNew;
- p->nAlloc = p->nUsed + nText + 1000;
- zNew = sqliteRealloc(p->z, p->nAlloc);
- if( zNew==0 ){
- sqliteFree(p->z);
- memset(p, 0, sizeof(*p));
- return;
- }
- p->z = zNew;
- }
- memcpy(&p->z[p->nUsed], zText, nText+1);
- p->nUsed += nText;
-}
-
-/*
-** Append text to a dynamic string, having first put the text in quotes.
-*/
-static void appendQuoted(dynStr *p, const char *zText){
- int i, j;
- appendText(p, "'", 1);
- for(i=j=0; zText[i]; i++){
- if( zText[i]=='\'' ){
- appendText(p, &zText[j], i-j+1);
- j = i + 1;
- appendText(p, "'", 1);
- }
- }
- if( j<i ){
- appendText(p, &zText[j], i-j);
- }
- appendText(p, "'", 1);
-}
-
-/*
-** Execute statements of SQL. If an error occurs, write the error
-** message into *pzErrMsg and return non-zero.
-*/
-static int execsql(char **pzErrMsg, sqlite *db, const char *zSql){
- char *zErrMsg = 0;
- int rc;
-
- /* printf("***** executing *****\n%s\n", zSql); */
- rc = sqlite_exec(db, zSql, 0, 0, &zErrMsg);
- if( zErrMsg ){
- sqliteSetString(pzErrMsg, zErrMsg, (char*)0);
- sqlite_freemem(zErrMsg);
- }
- return rc;
-}
-
-/*
-** This is the second stage callback. Each invocation contains all the
-** data for a single row of a single table in the original database. This
-** routine must write that information into the new database.
-*/
-static int vacuumCallback2(void *pArg, int argc, char **argv, char **NotUsed){
- vacuumStruct *p = (vacuumStruct*)pArg;
- const char *zSep = "(";
- int i;
-
- if( argv==0 ) return 0;
- p->s2.nUsed = 0;
- appendText(&p->s2, "INSERT INTO ", -1);
- appendQuoted(&p->s2, p->zTable);
- appendText(&p->s2, " VALUES", -1);
- for(i=0; i<argc; i++){
- appendText(&p->s2, zSep, 1);
- zSep = ",";
- if( argv[i]==0 ){
- appendText(&p->s2, "NULL", 4);
- }else{
- appendQuoted(&p->s2, argv[i]);
- }
- }
- appendText(&p->s2,")", 1);
- p->rc = execsql(p->pzErrMsg, p->dbNew, p->s2.z);
- return p->rc;
-}
-
-/*
-** This is the first stage callback. Each invocation contains three
-** arguments where are taken from the SQLITE_MASTER table of the original
-** database: (1) the entry type, (2) the entry name, and (3) the SQL for
-** the entry. In all cases, execute the SQL of the third argument.
-** For tables, run a query to select all entries in that table and
-** transfer them to the second-stage callback.
-*/
-static int vacuumCallback1(void *pArg, int argc, char **argv, char **NotUsed){
- vacuumStruct *p = (vacuumStruct*)pArg;
- int rc = 0;
- assert( argc==3 );
- if( argv==0 ) return 0;
- assert( argv[0]!=0 );
- assert( argv[1]!=0 );
- assert( argv[2]!=0 );
- rc = execsql(p->pzErrMsg, p->dbNew, argv[2]);
- if( rc==SQLITE_OK && strcmp(argv[0],"table")==0 ){
- char *zErrMsg = 0;
- p->s1.nUsed = 0;
- appendText(&p->s1, "SELECT * FROM ", -1);
- appendQuoted(&p->s1, argv[1]);
- p->zTable = argv[1];
- rc = sqlite_exec(p->dbOld, p->s1.z, vacuumCallback2, p, &zErrMsg);
- if( zErrMsg ){
- sqliteSetString(p->pzErrMsg, zErrMsg, (char*)0);
- sqlite_freemem(zErrMsg);
- }
- }
- if( rc!=SQLITE_ABORT ) p->rc = rc;
- return rc;
-}
-
-/*
-** This callback is used to transfer PRAGMA settings from one database
-** to the other. The value in argv[0] should be passed to a pragma
-** identified by ((vacuumStruct*)pArg)->zPragma.
-*/
-static int vacuumCallback3(void *pArg, int argc, char **argv, char **NotUsed){
- vacuumStruct *p = (vacuumStruct*)pArg;
- char zBuf[200];
- assert( argc==1 );
- if( argv==0 ) return 0;
- assert( argv[0]!=0 );
- assert( strlen(p->zPragma)<100 );
- assert( strlen(argv[0])<30 );
- sprintf(zBuf,"PRAGMA %s=%s;", p->zPragma, argv[0]);
- p->rc = execsql(p->pzErrMsg, p->dbNew, zBuf);
- return p->rc;
-}
-
-/*
-** Generate a random name of 20 character in length.
-*/
-static void randomName(unsigned char *zBuf){
- static const unsigned char zChars[] =
- "abcdefghijklmnopqrstuvwxyz"
- "0123456789";
- int i;
- sqliteRandomness(20, zBuf);
- for(i=0; i<20; i++){
- zBuf[i] = zChars[ zBuf[i]%(sizeof(zChars)-1) ];
- }
-}
-#endif
-
-/*
-** The non-standard VACUUM command is used to clean up the database,
-** collapse free space, etc. It is modelled after the VACUUM command
-** in PostgreSQL.
-**
-** In version 1.0.x of SQLite, the VACUUM command would call
-** gdbm_reorganize() on all the database tables. But beginning
-** with 2.0.0, SQLite no longer uses GDBM so this command has
-** become a no-op.
-*/
-void sqliteVacuum(Parse *pParse, Token *pTableName){
- Vdbe *v = sqliteGetVdbe(pParse);
- sqliteVdbeAddOp(v, OP_Vacuum, 0, 0);
- return;
-}
-
-/*
-** This routine implements the OP_Vacuum opcode of the VDBE.
-*/
-int sqliteRunVacuum(char **pzErrMsg, sqlite *db){
-#if !defined(SQLITE_OMIT_VACUUM) || SQLITE_OMIT_VACUUM
- const char *zFilename; /* full pathname of the database file */
- int nFilename; /* number of characters in zFilename[] */
- char *zTemp = 0; /* a temporary file in same directory as zFilename */
- sqlite *dbNew = 0; /* The new vacuumed database */
- int rc = SQLITE_OK; /* Return code from service routines */
- int i; /* Loop counter */
- char *zErrMsg; /* Error message */
- vacuumStruct sVac; /* Information passed to callbacks */
-
- /* These are all of the pragmas that need to be transferred over
- ** to the new database */
- static const char *zPragma[] = {
- "default_synchronous",
- "default_cache_size",
- /* "default_temp_store", */
- };
-
- if( db->flags & SQLITE_InTrans ){
- sqliteSetString(pzErrMsg, "cannot VACUUM from within a transaction",
- (char*)0);
- return SQLITE_ERROR;
- }
- if( db->flags & SQLITE_Interrupt ){
- return SQLITE_INTERRUPT;
- }
- memset(&sVac, 0, sizeof(sVac));
-
- /* Get the full pathname of the database file and create two
- ** temporary filenames in the same directory as the original file.
- */
- zFilename = sqliteBtreeGetFilename(db->aDb[0].pBt);
- if( zFilename==0 ){
- /* This only happens with the in-memory database. VACUUM is a no-op
- ** there, so just return */
- return SQLITE_OK;
- }
- nFilename = strlen(zFilename);
- zTemp = sqliteMalloc( nFilename+100 );
- if( zTemp==0 ) return SQLITE_NOMEM;
- strcpy(zTemp, zFilename);
- for(i=0; i<10; i++){
- zTemp[nFilename] = '-';
- randomName((unsigned char*)&zTemp[nFilename+1]);
- if( !sqliteOsFileExists(zTemp) ) break;
- }
- if( i>=10 ){
- sqliteSetString(pzErrMsg, "unable to create a temporary database file "
- "in the same directory as the original database", (char*)0);
- goto end_of_vacuum;
- }
-
-
- dbNew = sqlite_open(zTemp, 0, &zErrMsg);
- if( dbNew==0 ){
- sqliteSetString(pzErrMsg, "unable to open a temporary database at ",
- zTemp, " - ", zErrMsg, (char*)0);
- goto end_of_vacuum;
- }
- if( (rc = execsql(pzErrMsg, db, "BEGIN"))!=0 ) goto end_of_vacuum;
- if( (rc = execsql(pzErrMsg, dbNew, "PRAGMA synchronous=off; BEGIN"))!=0 ){
- goto end_of_vacuum;
- }
-
- sVac.dbOld = db;
- sVac.dbNew = dbNew;
- sVac.pzErrMsg = pzErrMsg;
- for(i=0; rc==SQLITE_OK && i<sizeof(zPragma)/sizeof(zPragma[0]); i++){
- char zBuf[200];
- assert( strlen(zPragma[i])<100 );
- sprintf(zBuf, "PRAGMA %s;", zPragma[i]);
- sVac.zPragma = zPragma[i];
- rc = sqlite_exec(db, zBuf, vacuumCallback3, &sVac, &zErrMsg);
- }
- if( rc==SQLITE_OK ){
- rc = sqlite_exec(db,
- "SELECT type, name, sql FROM sqlite_master "
- "WHERE sql NOT NULL AND type!='view' "
- "UNION ALL "
- "SELECT type, name, sql FROM sqlite_master "
- "WHERE sql NOT NULL AND type=='view'",
- vacuumCallback1, &sVac, &zErrMsg);
- }
- if( rc==SQLITE_OK ){
- rc = sqliteBtreeCopyFile(db->aDb[0].pBt, dbNew->aDb[0].pBt);
- sqlite_exec(db, "COMMIT", 0, 0, 0);
- sqliteResetInternalSchema(db, 0);
- }
-
-end_of_vacuum:
- if( rc && zErrMsg!=0 ){
- sqliteSetString(pzErrMsg, "unable to vacuum database - ",
- zErrMsg, (char*)0);
- }
- sqlite_exec(db, "ROLLBACK", 0, 0, 0);
- if( (dbNew && (dbNew->flags & SQLITE_Interrupt))
- || (db->flags & SQLITE_Interrupt) ){
- rc = SQLITE_INTERRUPT;
- }
- if( dbNew ) sqlite_close(dbNew);
- sqliteOsDelete(zTemp);
- sqliteFree(zTemp);
- sqliteFree(sVac.s1.z);
- sqliteFree(sVac.s2.z);
- if( zErrMsg ) sqlite_freemem(zErrMsg);
- if( rc==SQLITE_ABORT && sVac.rc!=SQLITE_INTERRUPT ) sVac.rc = SQLITE_ERROR;
- return sVac.rc;
-#endif
-}
+++ /dev/null
-/*
-** 2001 September 15
-**
-** The author disclaims copyright to this source code. In place of
-** a legal notice, here is a blessing:
-**
-** May you do good and not evil.
-** May you find forgiveness for yourself and forgive others.
-** May you share freely, never taking more than you give.
-**
-*************************************************************************
-** The code in this file implements execution method of the
-** Virtual Database Engine (VDBE). A separate file ("vdbeaux.c")
-** handles housekeeping details such as creating and deleting
-** VDBE instances. This file is solely interested in executing
-** the VDBE program.
-**
-** In the external interface, an "sqlite_vm*" is an opaque pointer
-** to a VDBE.
-**
-** The SQL parser generates a program which is then executed by
-** the VDBE to do the work of the SQL statement. VDBE programs are
-** similar in form to assembly language. The program consists of
-** a linear sequence of operations. Each operation has an opcode
-** and 3 operands. Operands P1 and P2 are integers. Operand P3
-** is a null-terminated string. The P2 operand must be non-negative.
-** Opcodes will typically ignore one or more operands. Many opcodes
-** ignore all three operands.
-**
-** Computation results are stored on a stack. Each entry on the
-** stack is either an integer, a null-terminated string, a floating point
-** number, or the SQL "NULL" value. An inplicit conversion from one
-** type to the other occurs as necessary.
-**
-** Most of the code in this file is taken up by the sqliteVdbeExec()
-** function which does the work of interpreting a VDBE program.
-** But other routines are also provided to help in building up
-** a program instruction by instruction.
-**
-** Various scripts scan this source file in order to generate HTML
-** documentation, headers files, or other derived files. The formatting
-** of the code in this file is, therefore, important. See other comments
-** in this file for details. If in doubt, do not deviate from existing
-** commenting and indentation practices when changing or adding code.
-**
-** $Id: vdbe.c,v 1.1.1.1 2004/08/08 15:03:58 matt Exp $
-*/
-#include "sqliteInt.h"
-#include "os.h"
-#include <ctype.h>
-#include "vdbeInt.h"
-
-/*
-** The following global variable is incremented every time a cursor
-** moves, either by the OP_MoveTo or the OP_Next opcode. The test
-** procedures use this information to make sure that indices are
-** working correctly. This variable has no function other than to
-** help verify the correct operation of the library.
-*/
-int sqlite_search_count = 0;
-
-/*
-** When this global variable is positive, it gets decremented once before
-** each instruction in the VDBE. When reaches zero, the SQLITE_Interrupt
-** of the db.flags field is set in order to simulate an interrupt.
-**
-** This facility is used for testing purposes only. It does not function
-** in an ordinary build.
-*/
-int sqlite_interrupt_count = 0;
-
-/*
-** Advance the virtual machine to the next output row.
-**
-** The return vale will be either SQLITE_BUSY, SQLITE_DONE,
-** SQLITE_ROW, SQLITE_ERROR, or SQLITE_MISUSE.
-**
-** SQLITE_BUSY means that the virtual machine attempted to open
-** a locked database and there is no busy callback registered.
-** Call sqlite_step() again to retry the open. *pN is set to 0
-** and *pazColName and *pazValue are both set to NULL.
-**
-** SQLITE_DONE means that the virtual machine has finished
-** executing. sqlite_step() should not be called again on this
-** virtual machine. *pN and *pazColName are set appropriately
-** but *pazValue is set to NULL.
-**
-** SQLITE_ROW means that the virtual machine has generated another
-** row of the result set. *pN is set to the number of columns in
-** the row. *pazColName is set to the names of the columns followed
-** by the column datatypes. *pazValue is set to the values of each
-** column in the row. The value of the i-th column is (*pazValue)[i].
-** The name of the i-th column is (*pazColName)[i] and the datatype
-** of the i-th column is (*pazColName)[i+*pN].
-**
-** SQLITE_ERROR means that a run-time error (such as a constraint
-** violation) has occurred. The details of the error will be returned
-** by the next call to sqlite_finalize(). sqlite_step() should not
-** be called again on the VM.
-**
-** SQLITE_MISUSE means that the this routine was called inappropriately.
-** Perhaps it was called on a virtual machine that had already been
-** finalized or on one that had previously returned SQLITE_ERROR or
-** SQLITE_DONE. Or it could be the case the the same database connection
-** is being used simulataneously by two or more threads.
-*/
-int sqlite_step(
- sqlite_vm *pVm, /* The virtual machine to execute */
- int *pN, /* OUT: Number of columns in result */
- const char ***pazValue, /* OUT: Column data */
- const char ***pazColName /* OUT: Column names and datatypes */
-){
- Vdbe *p = (Vdbe*)pVm;
- sqlite *db;
- int rc;
-
- if( p->magic!=VDBE_MAGIC_RUN ){
- return SQLITE_MISUSE;
- }
- db = p->db;
- if( sqliteSafetyOn(db) ){
- p->rc = SQLITE_MISUSE;
- return SQLITE_MISUSE;
- }
- if( p->explain ){
- rc = sqliteVdbeList(p);
- }else{
- rc = sqliteVdbeExec(p);
- }
- if( rc==SQLITE_DONE || rc==SQLITE_ROW ){
- if( pazColName ) *pazColName = (const char**)p->azColName;
- if( pN ) *pN = p->nResColumn;
- }else{
- if( pazColName) *pazColName = 0;
- if( pN ) *pN = 0;
- }
- if( pazValue ){
- if( rc==SQLITE_ROW ){
- *pazValue = (const char**)p->azResColumn;
- }else{
- *pazValue = 0;
- }
- }
- if( sqliteSafetyOff(db) ){
- return SQLITE_MISUSE;
- }
- return rc;
-}
-
-/*
-** Insert a new aggregate element and make it the element that
-** has focus.
-**
-** Return 0 on success and 1 if memory is exhausted.
-*/
-static int AggInsert(Agg *p, char *zKey, int nKey){
- AggElem *pElem, *pOld;
- int i;
- Mem *pMem;
- pElem = sqliteMalloc( sizeof(AggElem) + nKey +
- (p->nMem-1)*sizeof(pElem->aMem[0]) );
- if( pElem==0 ) return 1;
- pElem->zKey = (char*)&pElem->aMem[p->nMem];
- memcpy(pElem->zKey, zKey, nKey);
- pElem->nKey = nKey;
- pOld = sqliteHashInsert(&p->hash, pElem->zKey, pElem->nKey, pElem);
- if( pOld!=0 ){
- assert( pOld==pElem ); /* Malloc failed on insert */
- sqliteFree(pOld);
- return 0;
- }
- for(i=0, pMem=pElem->aMem; i<p->nMem; i++, pMem++){
- pMem->flags = MEM_Null;
- }
- p->pCurrent = pElem;
- return 0;
-}
-
-/*
-** Get the AggElem currently in focus
-*/
-#define AggInFocus(P) ((P).pCurrent ? (P).pCurrent : _AggInFocus(&(P)))
-static AggElem *_AggInFocus(Agg *p){
- HashElem *pElem = sqliteHashFirst(&p->hash);
- if( pElem==0 ){
- AggInsert(p,"",1);
- pElem = sqliteHashFirst(&p->hash);
- }
- return pElem ? sqliteHashData(pElem) : 0;
-}
-
-/*
-** Convert the given stack entity into a string if it isn't one
-** already.
-*/
-#define Stringify(P) if(((P)->flags & MEM_Str)==0){hardStringify(P);}
-static int hardStringify(Mem *pStack){
- int fg = pStack->flags;
- if( fg & MEM_Real ){
- sqlite_snprintf(sizeof(pStack->zShort),pStack->zShort,"%.15g",pStack->r);
- }else if( fg & MEM_Int ){
- sqlite_snprintf(sizeof(pStack->zShort),pStack->zShort,"%d",pStack->i);
- }else{
- pStack->zShort[0] = 0;
- }
- pStack->z = pStack->zShort;
- pStack->n = strlen(pStack->zShort)+1;
- pStack->flags = MEM_Str | MEM_Short;
- return 0;
-}
-
-/*
-** Convert the given stack entity into a string that has been obtained
-** from sqliteMalloc(). This is different from Stringify() above in that
-** Stringify() will use the NBFS bytes of static string space if the string
-** will fit but this routine always mallocs for space.
-** Return non-zero if we run out of memory.
-*/
-#define Dynamicify(P) (((P)->flags & MEM_Dyn)==0 ? hardDynamicify(P):0)
-static int hardDynamicify(Mem *pStack){
- int fg = pStack->flags;
- char *z;
- if( (fg & MEM_Str)==0 ){
- hardStringify(pStack);
- }
- assert( (fg & MEM_Dyn)==0 );
- z = sqliteMallocRaw( pStack->n );
- if( z==0 ) return 1;
- memcpy(z, pStack->z, pStack->n);
- pStack->z = z;
- pStack->flags |= MEM_Dyn;
- return 0;
-}
-
-/*
-** An ephemeral string value (signified by the MEM_Ephem flag) contains
-** a pointer to a dynamically allocated string where some other entity
-** is responsible for deallocating that string. Because the stack entry
-** does not control the string, it might be deleted without the stack
-** entry knowing it.
-**
-** This routine converts an ephemeral string into a dynamically allocated
-** string that the stack entry itself controls. In other words, it
-** converts an MEM_Ephem string into an MEM_Dyn string.
-*/
-#define Deephemeralize(P) \
- if( ((P)->flags&MEM_Ephem)!=0 && hardDeephem(P) ){ goto no_mem;}
-static int hardDeephem(Mem *pStack){
- char *z;
- assert( (pStack->flags & MEM_Ephem)!=0 );
- z = sqliteMallocRaw( pStack->n );
- if( z==0 ) return 1;
- memcpy(z, pStack->z, pStack->n);
- pStack->z = z;
- pStack->flags &= ~MEM_Ephem;
- pStack->flags |= MEM_Dyn;
- return 0;
-}
-
-/*
-** Release the memory associated with the given stack level. This
-** leaves the Mem.flags field in an inconsistent state.
-*/
-#define Release(P) if((P)->flags&MEM_Dyn){ sqliteFree((P)->z); }
-
-/*
-** Pop the stack N times.
-*/
-static void popStack(Mem **ppTos, int N){
- Mem *pTos = *ppTos;
- while( N>0 ){
- N--;
- Release(pTos);
- pTos--;
- }
- *ppTos = pTos;
-}
-
-/*
-** Return TRUE if zNum is a 32-bit signed integer and write
-** the value of the integer into *pNum. If zNum is not an integer
-** or is an integer that is too large to be expressed with just 32
-** bits, then return false.
-**
-** Under Linux (RedHat 7.2) this routine is much faster than atoi()
-** for converting strings into integers.
-*/
-static int toInt(const char *zNum, int *pNum){
- int v = 0;
- int neg;
- int i, c;
- if( *zNum=='-' ){
- neg = 1;
- zNum++;
- }else if( *zNum=='+' ){
- neg = 0;
- zNum++;
- }else{
- neg = 0;
- }
- for(i=0; (c=zNum[i])>='0' && c<='9'; i++){
- v = v*10 + c - '0';
- }
- *pNum = neg ? -v : v;
- return c==0 && i>0 && (i<10 || (i==10 && memcmp(zNum,"2147483647",10)<=0));
-}
-
-/*
-** Convert the given stack entity into a integer if it isn't one
-** already.
-**
-** Any prior string or real representation is invalidated.
-** NULLs are converted into 0.
-*/
-#define Integerify(P) if(((P)->flags&MEM_Int)==0){ hardIntegerify(P); }
-static void hardIntegerify(Mem *pStack){
- if( pStack->flags & MEM_Real ){
- pStack->i = (int)pStack->r;
- Release(pStack);
- }else if( pStack->flags & MEM_Str ){
- toInt(pStack->z, &pStack->i);
- Release(pStack);
- }else{
- pStack->i = 0;
- }
- pStack->flags = MEM_Int;
-}
-
-/*
-** Get a valid Real representation for the given stack element.
-**
-** Any prior string or integer representation is retained.
-** NULLs are converted into 0.0.
-*/
-#define Realify(P) if(((P)->flags&MEM_Real)==0){ hardRealify(P); }
-static void hardRealify(Mem *pStack){
- if( pStack->flags & MEM_Str ){
- pStack->r = sqliteAtoF(pStack->z, 0);
- }else if( pStack->flags & MEM_Int ){
- pStack->r = pStack->i;
- }else{
- pStack->r = 0.0;
- }
- pStack->flags |= MEM_Real;
-}
-
-/*
-** The parameters are pointers to the head of two sorted lists
-** of Sorter structures. Merge these two lists together and return
-** a single sorted list. This routine forms the core of the merge-sort
-** algorithm.
-**
-** In the case of a tie, left sorts in front of right.
-*/
-static Sorter *Merge(Sorter *pLeft, Sorter *pRight){
- Sorter sHead;
- Sorter *pTail;
- pTail = &sHead;
- pTail->pNext = 0;
- while( pLeft && pRight ){
- int c = sqliteSortCompare(pLeft->zKey, pRight->zKey);
- if( c<=0 ){
- pTail->pNext = pLeft;
- pLeft = pLeft->pNext;
- }else{
- pTail->pNext = pRight;
- pRight = pRight->pNext;
- }
- pTail = pTail->pNext;
- }
- if( pLeft ){
- pTail->pNext = pLeft;
- }else if( pRight ){
- pTail->pNext = pRight;
- }
- return sHead.pNext;
-}
-
-/*
-** The following routine works like a replacement for the standard
-** library routine fgets(). The difference is in how end-of-line (EOL)
-** is handled. Standard fgets() uses LF for EOL under unix, CRLF
-** under windows, and CR under mac. This routine accepts any of these
-** character sequences as an EOL mark. The EOL mark is replaced by
-** a single LF character in zBuf.
-*/
-static char *vdbe_fgets(char *zBuf, int nBuf, FILE *in){
- int i, c;
- for(i=0; i<nBuf-1 && (c=getc(in))!=EOF; i++){
- zBuf[i] = c;
- if( c=='\r' || c=='\n' ){
- if( c=='\r' ){
- zBuf[i] = '\n';
- c = getc(in);
- if( c!=EOF && c!='\n' ) ungetc(c, in);
- }
- i++;
- break;
- }
- }
- zBuf[i] = 0;
- return i>0 ? zBuf : 0;
-}
-
-/*
-** Make sure there is space in the Vdbe structure to hold at least
-** mxCursor cursors. If there is not currently enough space, then
-** allocate more.
-**
-** If a memory allocation error occurs, return 1. Return 0 if
-** everything works.
-*/
-static int expandCursorArraySize(Vdbe *p, int mxCursor){
- if( mxCursor>=p->nCursor ){
- Cursor *aCsr = sqliteRealloc( p->aCsr, (mxCursor+1)*sizeof(Cursor) );
- if( aCsr==0 ) return 1;
- p->aCsr = aCsr;
- memset(&p->aCsr[p->nCursor], 0, sizeof(Cursor)*(mxCursor+1-p->nCursor));
- p->nCursor = mxCursor+1;
- }
- return 0;
-}
-
-#ifdef VDBE_PROFILE
-/*
-** The following routine only works on pentium-class processors.
-** It uses the RDTSC opcode to read cycle count value out of the
-** processor and returns that value. This can be used for high-res
-** profiling.
-*/
-__inline__ unsigned long long int hwtime(void){
- unsigned long long int x;
- __asm__("rdtsc\n\t"
- "mov %%edx, %%ecx\n\t"
- :"=A" (x));
- return x;
-}
-#endif
-
-/*
-** The CHECK_FOR_INTERRUPT macro defined here looks to see if the
-** sqlite_interrupt() routine has been called. If it has been, then
-** processing of the VDBE program is interrupted.
-**
-** This macro added to every instruction that does a jump in order to
-** implement a loop. This test used to be on every single instruction,
-** but that meant we more testing that we needed. By only testing the
-** flag on jump instructions, we get a (small) speed improvement.
-*/
-#define CHECK_FOR_INTERRUPT \
- if( db->flags & SQLITE_Interrupt ) goto abort_due_to_interrupt;
-
-
-/*
-** Execute as much of a VDBE program as we can then return.
-**
-** sqliteVdbeMakeReady() must be called before this routine in order to
-** close the program with a final OP_Halt and to set up the callbacks
-** and the error message pointer.
-**
-** Whenever a row or result data is available, this routine will either
-** invoke the result callback (if there is one) or return with
-** SQLITE_ROW.
-**
-** If an attempt is made to open a locked database, then this routine
-** will either invoke the busy callback (if there is one) or it will
-** return SQLITE_BUSY.
-**
-** If an error occurs, an error message is written to memory obtained
-** from sqliteMalloc() and p->zErrMsg is made to point to that memory.
-** The error code is stored in p->rc and this routine returns SQLITE_ERROR.
-**
-** If the callback ever returns non-zero, then the program exits
-** immediately. There will be no error message but the p->rc field is
-** set to SQLITE_ABORT and this routine will return SQLITE_ERROR.
-**
-** A memory allocation error causes p->rc to be set to SQLITE_NOMEM and this
-** routine to return SQLITE_ERROR.
-**
-** Other fatal errors return SQLITE_ERROR.
-**
-** After this routine has finished, sqliteVdbeFinalize() should be
-** used to clean up the mess that was left behind.
-*/
-int sqliteVdbeExec(
- Vdbe *p /* The VDBE */
-){
- int pc; /* The program counter */
- Op *pOp; /* Current operation */
- int rc = SQLITE_OK; /* Value to return */
- sqlite *db = p->db; /* The database */
- Mem *pTos; /* Top entry in the operand stack */
- char zBuf[100]; /* Space to sprintf() an integer */
-#ifdef VDBE_PROFILE
- unsigned long long start; /* CPU clock count at start of opcode */
- int origPc; /* Program counter at start of opcode */
-#endif
-#ifndef SQLITE_OMIT_PROGRESS_CALLBACK
- int nProgressOps = 0; /* Opcodes executed since progress callback. */
-#endif
-
- if( p->magic!=VDBE_MAGIC_RUN ) return SQLITE_MISUSE;
- assert( db->magic==SQLITE_MAGIC_BUSY );
- assert( p->rc==SQLITE_OK || p->rc==SQLITE_BUSY );
- p->rc = SQLITE_OK;
- assert( p->explain==0 );
- if( sqlite_malloc_failed ) goto no_mem;
- pTos = p->pTos;
- if( p->popStack ){
- popStack(&pTos, p->popStack);
- p->popStack = 0;
- }
- CHECK_FOR_INTERRUPT;
- for(pc=p->pc; rc==SQLITE_OK; pc++){
- assert( pc>=0 && pc<p->nOp );
- assert( pTos<=&p->aStack[pc] );
-#ifdef VDBE_PROFILE
- origPc = pc;
- start = hwtime();
-#endif
- pOp = &p->aOp[pc];
-
- /* Only allow tracing if NDEBUG is not defined.
- */
-#ifndef NDEBUG
- if( p->trace ){
- sqliteVdbePrintOp(p->trace, pc, pOp);
- }
-#endif
-
- /* Check to see if we need to simulate an interrupt. This only happens
- ** if we have a special test build.
- */
-#ifdef SQLITE_TEST
- if( sqlite_interrupt_count>0 ){
- sqlite_interrupt_count--;
- if( sqlite_interrupt_count==0 ){
- sqlite_interrupt(db);
- }
- }
-#endif
-
-#ifndef SQLITE_OMIT_PROGRESS_CALLBACK
- /* Call the progress callback if it is configured and the required number
- ** of VDBE ops have been executed (either since this invocation of
- ** sqliteVdbeExec() or since last time the progress callback was called).
- ** If the progress callback returns non-zero, exit the virtual machine with
- ** a return code SQLITE_ABORT.
- */
- if( db->xProgress ){
- if( db->nProgressOps==nProgressOps ){
- if( db->xProgress(db->pProgressArg)!=0 ){
- rc = SQLITE_ABORT;
- continue; /* skip to the next iteration of the for loop */
- }
- nProgressOps = 0;
- }
- nProgressOps++;
- }
-#endif
-
- switch( pOp->opcode ){
-
-/*****************************************************************************
-** What follows is a massive switch statement where each case implements a
-** separate instruction in the virtual machine. If we follow the usual
-** indentation conventions, each case should be indented by 6 spaces. But
-** that is a lot of wasted space on the left margin. So the code within
-** the switch statement will break with convention and be flush-left. Another
-** big comment (similar to this one) will mark the point in the code where
-** we transition back to normal indentation.
-**
-** The formatting of each case is important. The makefile for SQLite
-** generates two C files "opcodes.h" and "opcodes.c" by scanning this
-** file looking for lines that begin with "case OP_". The opcodes.h files
-** will be filled with #defines that give unique integer values to each
-** opcode and the opcodes.c file is filled with an array of strings where
-** each string is the symbolic name for the corresponding opcode.
-**
-** Documentation about VDBE opcodes is generated by scanning this file
-** for lines of that contain "Opcode:". That line and all subsequent
-** comment lines are used in the generation of the opcode.html documentation
-** file.
-**
-** SUMMARY:
-**
-** Formatting is important to scripts that scan this file.
-** Do not deviate from the formatting style currently in use.
-**
-*****************************************************************************/
-
-/* Opcode: Goto * P2 *
-**
-** An unconditional jump to address P2.
-** The next instruction executed will be
-** the one at index P2 from the beginning of
-** the program.
-*/
-case OP_Goto: {
- CHECK_FOR_INTERRUPT;
- pc = pOp->p2 - 1;
- break;
-}
-
-/* Opcode: Gosub * P2 *
-**
-** Push the current address plus 1 onto the return address stack
-** and then jump to address P2.
-**
-** The return address stack is of limited depth. If too many
-** OP_Gosub operations occur without intervening OP_Returns, then
-** the return address stack will fill up and processing will abort
-** with a fatal error.
-*/
-case OP_Gosub: {
- if( p->returnDepth>=sizeof(p->returnStack)/sizeof(p->returnStack[0]) ){
- sqliteSetString(&p->zErrMsg, "return address stack overflow", (char*)0);
- p->rc = SQLITE_INTERNAL;
- return SQLITE_ERROR;
- }
- p->returnStack[p->returnDepth++] = pc+1;
- pc = pOp->p2 - 1;
- break;
-}
-
-/* Opcode: Return * * *
-**
-** Jump immediately to the next instruction after the last unreturned
-** OP_Gosub. If an OP_Return has occurred for all OP_Gosubs, then
-** processing aborts with a fatal error.
-*/
-case OP_Return: {
- if( p->returnDepth<=0 ){
- sqliteSetString(&p->zErrMsg, "return address stack underflow", (char*)0);
- p->rc = SQLITE_INTERNAL;
- return SQLITE_ERROR;
- }
- p->returnDepth--;
- pc = p->returnStack[p->returnDepth] - 1;
- break;
-}
-
-/* Opcode: Halt P1 P2 *
-**
-** Exit immediately. All open cursors, Lists, Sorts, etc are closed
-** automatically.
-**
-** P1 is the result code returned by sqlite_exec(). For a normal
-** halt, this should be SQLITE_OK (0). For errors, it can be some
-** other value. If P1!=0 then P2 will determine whether or not to
-** rollback the current transaction. Do not rollback if P2==OE_Fail.
-** Do the rollback if P2==OE_Rollback. If P2==OE_Abort, then back
-** out all changes that have occurred during this execution of the
-** VDBE, but do not rollback the transaction.
-**
-** There is an implied "Halt 0 0 0" instruction inserted at the very end of
-** every program. So a jump past the last instruction of the program
-** is the same as executing Halt.
-*/
-case OP_Halt: {
- p->magic = VDBE_MAGIC_HALT;
- p->pTos = pTos;
- if( pOp->p1!=SQLITE_OK ){
- p->rc = pOp->p1;
- p->errorAction = pOp->p2;
- if( pOp->p3 ){
- sqliteSetString(&p->zErrMsg, pOp->p3, (char*)0);
- }
- return SQLITE_ERROR;
- }else{
- p->rc = SQLITE_OK;
- return SQLITE_DONE;
- }
-}
-
-/* Opcode: Integer P1 * P3
-**
-** The integer value P1 is pushed onto the stack. If P3 is not zero
-** then it is assumed to be a string representation of the same integer.
-*/
-case OP_Integer: {
- pTos++;
- pTos->i = pOp->p1;
- pTos->flags = MEM_Int;
- if( pOp->p3 ){
- pTos->z = pOp->p3;
- pTos->flags |= MEM_Str | MEM_Static;
- pTos->n = strlen(pOp->p3)+1;
- }
- break;
-}
-
-/* Opcode: String * * P3
-**
-** The string value P3 is pushed onto the stack. If P3==0 then a
-** NULL is pushed onto the stack.
-*/
-case OP_String: {
- char *z = pOp->p3;
- pTos++;
- if( z==0 ){
- pTos->flags = MEM_Null;
- }else{
- pTos->z = z;
- pTos->n = strlen(z) + 1;
- pTos->flags = MEM_Str | MEM_Static;
- }
- break;
-}
-
-/* Opcode: Variable P1 * *
-**
-** Push the value of variable P1 onto the stack. A variable is
-** an unknown in the original SQL string as handed to sqlite_compile().
-** Any occurance of the '?' character in the original SQL is considered
-** a variable. Variables in the SQL string are number from left to
-** right beginning with 1. The values of variables are set using the
-** sqlite_bind() API.
-*/
-case OP_Variable: {
- int j = pOp->p1 - 1;
- pTos++;
- if( j>=0 && j<p->nVar && p->azVar[j]!=0 ){
- pTos->z = p->azVar[j];
- pTos->n = p->anVar[j];
- pTos->flags = MEM_Str | MEM_Static;
- }else{
- pTos->flags = MEM_Null;
- }
- break;
-}
-
-/* Opcode: Pop P1 * *
-**
-** P1 elements are popped off of the top of stack and discarded.
-*/
-case OP_Pop: {
- assert( pOp->p1>=0 );
- popStack(&pTos, pOp->p1);
- assert( pTos>=&p->aStack[-1] );
- break;
-}
-
-/* Opcode: Dup P1 P2 *
-**
-** A copy of the P1-th element of the stack
-** is made and pushed onto the top of the stack.
-** The top of the stack is element 0. So the
-** instruction "Dup 0 0 0" will make a copy of the
-** top of the stack.
-**
-** If the content of the P1-th element is a dynamically
-** allocated string, then a new copy of that string
-** is made if P2==0. If P2!=0, then just a pointer
-** to the string is copied.
-**
-** Also see the Pull instruction.
-*/
-case OP_Dup: {
- Mem *pFrom = &pTos[-pOp->p1];
- assert( pFrom<=pTos && pFrom>=p->aStack );
- pTos++;
- memcpy(pTos, pFrom, sizeof(*pFrom)-NBFS);
- if( pTos->flags & MEM_Str ){
- if( pOp->p2 && (pTos->flags & (MEM_Dyn|MEM_Ephem)) ){
- pTos->flags &= ~MEM_Dyn;
- pTos->flags |= MEM_Ephem;
- }else if( pTos->flags & MEM_Short ){
- memcpy(pTos->zShort, pFrom->zShort, pTos->n);
- pTos->z = pTos->zShort;
- }else if( (pTos->flags & MEM_Static)==0 ){
- pTos->z = sqliteMallocRaw(pFrom->n);
- if( sqlite_malloc_failed ) goto no_mem;
- memcpy(pTos->z, pFrom->z, pFrom->n);
- pTos->flags &= ~(MEM_Static|MEM_Ephem|MEM_Short);
- pTos->flags |= MEM_Dyn;
- }
- }
- break;
-}
-
-/* Opcode: Pull P1 * *
-**
-** The P1-th element is removed from its current location on
-** the stack and pushed back on top of the stack. The
-** top of the stack is element 0, so "Pull 0 0 0" is
-** a no-op. "Pull 1 0 0" swaps the top two elements of
-** the stack.
-**
-** See also the Dup instruction.
-*/
-case OP_Pull: {
- Mem *pFrom = &pTos[-pOp->p1];
- int i;
- Mem ts;
-
- ts = *pFrom;
- Deephemeralize(pTos);
- for(i=0; i<pOp->p1; i++, pFrom++){
- Deephemeralize(&pFrom[1]);
- *pFrom = pFrom[1];
- assert( (pFrom->flags & MEM_Ephem)==0 );
- if( pFrom->flags & MEM_Short ){
- assert( pFrom->flags & MEM_Str );
- assert( pFrom->z==pFrom[1].zShort );
- pFrom->z = pFrom->zShort;
- }
- }
- *pTos = ts;
- if( pTos->flags & MEM_Short ){
- assert( pTos->flags & MEM_Str );
- assert( pTos->z==pTos[-pOp->p1].zShort );
- pTos->z = pTos->zShort;
- }
- break;
-}
-
-/* Opcode: Push P1 * *
-**
-** Overwrite the value of the P1-th element down on the
-** stack (P1==0 is the top of the stack) with the value
-** of the top of the stack. Then pop the top of the stack.
-*/
-case OP_Push: {
- Mem *pTo = &pTos[-pOp->p1];
-
- assert( pTo>=p->aStack );
- Deephemeralize(pTos);
- Release(pTo);
- *pTo = *pTos;
- if( pTo->flags & MEM_Short ){
- assert( pTo->z==pTos->zShort );
- pTo->z = pTo->zShort;
- }
- pTos--;
- break;
-}
-
-
-/* Opcode: ColumnName P1 P2 P3
-**
-** P3 becomes the P1-th column name (first is 0). An array of pointers
-** to all column names is passed as the 4th parameter to the callback.
-** If P2==1 then this is the last column in the result set and thus the
-** number of columns in the result set will be P1. There must be at least
-** one OP_ColumnName with a P2==1 before invoking OP_Callback and the
-** number of columns specified in OP_Callback must one more than the P1
-** value of the OP_ColumnName that has P2==1.
-*/
-case OP_ColumnName: {
- assert( pOp->p1>=0 && pOp->p1<p->nOp );
- p->azColName[pOp->p1] = pOp->p3;
- p->nCallback = 0;
- if( pOp->p2 ) p->nResColumn = pOp->p1+1;
- break;
-}
-
-/* Opcode: Callback P1 * *
-**
-** Pop P1 values off the stack and form them into an array. Then
-** invoke the callback function using the newly formed array as the
-** 3rd parameter.
-*/
-case OP_Callback: {
- int i;
- char **azArgv = p->zArgv;
- Mem *pCol;
-
- pCol = &pTos[1-pOp->p1];
- assert( pCol>=p->aStack );
- for(i=0; i<pOp->p1; i++, pCol++){
- if( pCol->flags & MEM_Null ){
- azArgv[i] = 0;
- }else{
- Stringify(pCol);
- azArgv[i] = pCol->z;
- }
- }
- azArgv[i] = 0;
- p->nCallback++;
- p->azResColumn = azArgv;
- assert( p->nResColumn==pOp->p1 );
- p->popStack = pOp->p1;
- p->pc = pc + 1;
- p->pTos = pTos;
- return SQLITE_ROW;
-}
-
-/* Opcode: Concat P1 P2 P3
-**
-** Look at the first P1 elements of the stack. Append them all
-** together with the lowest element first. Use P3 as a separator.
-** Put the result on the top of the stack. The original P1 elements
-** are popped from the stack if P2==0 and retained if P2==1. If
-** any element of the stack is NULL, then the result is NULL.
-**
-** If P3 is NULL, then use no separator. When P1==1, this routine
-** makes a copy of the top stack element into memory obtained
-** from sqliteMalloc().
-*/
-case OP_Concat: {
- char *zNew;
- int nByte;
- int nField;
- int i, j;
- char *zSep;
- int nSep;
- Mem *pTerm;
-
- nField = pOp->p1;
- zSep = pOp->p3;
- if( zSep==0 ) zSep = "";
- nSep = strlen(zSep);
- assert( &pTos[1-nField] >= p->aStack );
- nByte = 1 - nSep;
- pTerm = &pTos[1-nField];
- for(i=0; i<nField; i++, pTerm++){
- if( pTerm->flags & MEM_Null ){
- nByte = -1;
- break;
- }else{
- Stringify(pTerm);
- nByte += pTerm->n - 1 + nSep;
- }
- }
- if( nByte<0 ){
- if( pOp->p2==0 ){
- popStack(&pTos, nField);
- }
- pTos++;
- pTos->flags = MEM_Null;
- break;
- }
- zNew = sqliteMallocRaw( nByte );
- if( zNew==0 ) goto no_mem;
- j = 0;
- pTerm = &pTos[1-nField];
- for(i=j=0; i<nField; i++, pTerm++){
- assert( pTerm->flags & MEM_Str );
- memcpy(&zNew[j], pTerm->z, pTerm->n-1);
- j += pTerm->n-1;
- if( nSep>0 && i<nField-1 ){
- memcpy(&zNew[j], zSep, nSep);
- j += nSep;
- }
- }
- zNew[j] = 0;
- if( pOp->p2==0 ){
- popStack(&pTos, nField);
- }
- pTos++;
- pTos->n = nByte;
- pTos->flags = MEM_Str|MEM_Dyn;
- pTos->z = zNew;
- break;
-}
-
-/* Opcode: Add * * *
-**
-** Pop the top two elements from the stack, add them together,
-** and push the result back onto the stack. If either element
-** is a string then it is converted to a double using the atof()
-** function before the addition.
-** If either operand is NULL, the result is NULL.
-*/
-/* Opcode: Multiply * * *
-**
-** Pop the top two elements from the stack, multiply them together,
-** and push the result back onto the stack. If either element
-** is a string then it is converted to a double using the atof()
-** function before the multiplication.
-** If either operand is NULL, the result is NULL.
-*/
-/* Opcode: Subtract * * *
-**
-** Pop the top two elements from the stack, subtract the
-** first (what was on top of the stack) from the second (the
-** next on stack)
-** and push the result back onto the stack. If either element
-** is a string then it is converted to a double using the atof()
-** function before the subtraction.
-** If either operand is NULL, the result is NULL.
-*/
-/* Opcode: Divide * * *
-**
-** Pop the top two elements from the stack, divide the
-** first (what was on top of the stack) from the second (the
-** next on stack)
-** and push the result back onto the stack. If either element
-** is a string then it is converted to a double using the atof()
-** function before the division. Division by zero returns NULL.
-** If either operand is NULL, the result is NULL.
-*/
-/* Opcode: Remainder * * *
-**
-** Pop the top two elements from the stack, divide the
-** first (what was on top of the stack) from the second (the
-** next on stack)
-** and push the remainder after division onto the stack. If either element
-** is a string then it is converted to a double using the atof()
-** function before the division. Division by zero returns NULL.
-** If either operand is NULL, the result is NULL.
-*/
-case OP_Add:
-case OP_Subtract:
-case OP_Multiply:
-case OP_Divide:
-case OP_Remainder: {
- Mem *pNos = &pTos[-1];
- assert( pNos>=p->aStack );
- if( ((pTos->flags | pNos->flags) & MEM_Null)!=0 ){
- Release(pTos);
- pTos--;
- Release(pTos);
- pTos->flags = MEM_Null;
- }else if( (pTos->flags & pNos->flags & MEM_Int)==MEM_Int ){
- int a, b;
- a = pTos->i;
- b = pNos->i;
- switch( pOp->opcode ){
- case OP_Add: b += a; break;
- case OP_Subtract: b -= a; break;
- case OP_Multiply: b *= a; break;
- case OP_Divide: {
- if( a==0 ) goto divide_by_zero;
- b /= a;
- break;
- }
- default: {
- if( a==0 ) goto divide_by_zero;
- b %= a;
- break;
- }
- }
- Release(pTos);
- pTos--;
- Release(pTos);
- pTos->i = b;
- pTos->flags = MEM_Int;
- }else{
- double a, b;
- Realify(pTos);
- Realify(pNos);
- a = pTos->r;
- b = pNos->r;
- switch( pOp->opcode ){
- case OP_Add: b += a; break;
- case OP_Subtract: b -= a; break;
- case OP_Multiply: b *= a; break;
- case OP_Divide: {
- if( a==0.0 ) goto divide_by_zero;
- b /= a;
- break;
- }
- default: {
- int ia = (int)a;
- int ib = (int)b;
- if( ia==0.0 ) goto divide_by_zero;
- b = ib % ia;
- break;
- }
- }
- Release(pTos);
- pTos--;
- Release(pTos);
- pTos->r = b;
- pTos->flags = MEM_Real;
- }
- break;
-
-divide_by_zero:
- Release(pTos);
- pTos--;
- Release(pTos);
- pTos->flags = MEM_Null;
- break;
-}
-
-/* Opcode: Function P1 * P3
-**
-** Invoke a user function (P3 is a pointer to a Function structure that
-** defines the function) with P1 string arguments taken from the stack.
-** Pop all arguments from the stack and push back the result.
-**
-** See also: AggFunc
-*/
-case OP_Function: {
- int n, i;
- Mem *pArg;
- char **azArgv;
- sqlite_func ctx;
-
- n = pOp->p1;
- pArg = &pTos[1-n];
- azArgv = p->zArgv;
- for(i=0; i<n; i++, pArg++){
- if( pArg->flags & MEM_Null ){
- azArgv[i] = 0;
- }else{
- Stringify(pArg);
- azArgv[i] = pArg->z;
- }
- }
- ctx.pFunc = (FuncDef*)pOp->p3;
- ctx.s.flags = MEM_Null;
- ctx.s.z = 0;
- ctx.isError = 0;
- ctx.isStep = 0;
- if( sqliteSafetyOff(db) ) goto abort_due_to_misuse;
- (*ctx.pFunc->xFunc)(&ctx, n, (const char**)azArgv);
- if( sqliteSafetyOn(db) ) goto abort_due_to_misuse;
- popStack(&pTos, n);
- pTos++;
- *pTos = ctx.s;
- if( pTos->flags & MEM_Short ){
- pTos->z = pTos->zShort;
- }
- if( ctx.isError ){
- sqliteSetString(&p->zErrMsg,
- (pTos->flags & MEM_Str)!=0 ? pTos->z : "user function error", (char*)0);
- rc = SQLITE_ERROR;
- }
- break;
-}
-
-/* Opcode: BitAnd * * *
-**
-** Pop the top two elements from the stack. Convert both elements
-** to integers. Push back onto the stack the bit-wise AND of the
-** two elements.
-** If either operand is NULL, the result is NULL.
-*/
-/* Opcode: BitOr * * *
-**
-** Pop the top two elements from the stack. Convert both elements
-** to integers. Push back onto the stack the bit-wise OR of the
-** two elements.
-** If either operand is NULL, the result is NULL.
-*/
-/* Opcode: ShiftLeft * * *
-**
-** Pop the top two elements from the stack. Convert both elements
-** to integers. Push back onto the stack the top element shifted
-** left by N bits where N is the second element on the stack.
-** If either operand is NULL, the result is NULL.
-*/
-/* Opcode: ShiftRight * * *
-**
-** Pop the top two elements from the stack. Convert both elements
-** to integers. Push back onto the stack the top element shifted
-** right by N bits where N is the second element on the stack.
-** If either operand is NULL, the result is NULL.
-*/
-case OP_BitAnd:
-case OP_BitOr:
-case OP_ShiftLeft:
-case OP_ShiftRight: {
- Mem *pNos = &pTos[-1];
- int a, b;
-
- assert( pNos>=p->aStack );
- if( (pTos->flags | pNos->flags) & MEM_Null ){
- popStack(&pTos, 2);
- pTos++;
- pTos->flags = MEM_Null;
- break;
- }
- Integerify(pTos);
- Integerify(pNos);
- a = pTos->i;
- b = pNos->i;
- switch( pOp->opcode ){
- case OP_BitAnd: a &= b; break;
- case OP_BitOr: a |= b; break;
- case OP_ShiftLeft: a <<= b; break;
- case OP_ShiftRight: a >>= b; break;
- default: /* CANT HAPPEN */ break;
- }
- assert( (pTos->flags & MEM_Dyn)==0 );
- assert( (pNos->flags & MEM_Dyn)==0 );
- pTos--;
- Release(pTos);
- pTos->i = a;
- pTos->flags = MEM_Int;
- break;
-}
-
-/* Opcode: AddImm P1 * *
-**
-** Add the value P1 to whatever is on top of the stack. The result
-** is always an integer.
-**
-** To force the top of the stack to be an integer, just add 0.
-*/
-case OP_AddImm: {
- assert( pTos>=p->aStack );
- Integerify(pTos);
- pTos->i += pOp->p1;
- break;
-}
-
-/* Opcode: ForceInt P1 P2 *
-**
-** Convert the top of the stack into an integer. If the current top of
-** the stack is not numeric (meaning that is is a NULL or a string that
-** does not look like an integer or floating point number) then pop the
-** stack and jump to P2. If the top of the stack is numeric then
-** convert it into the least integer that is greater than or equal to its
-** current value if P1==0, or to the least integer that is strictly
-** greater than its current value if P1==1.
-*/
-case OP_ForceInt: {
- int v;
- assert( pTos>=p->aStack );
- if( (pTos->flags & (MEM_Int|MEM_Real))==0
- && ((pTos->flags & MEM_Str)==0 || sqliteIsNumber(pTos->z)==0) ){
- Release(pTos);
- pTos--;
- pc = pOp->p2 - 1;
- break;
- }
- if( pTos->flags & MEM_Int ){
- v = pTos->i + (pOp->p1!=0);
- }else{
- Realify(pTos);
- v = (int)pTos->r;
- if( pTos->r>(double)v ) v++;
- if( pOp->p1 && pTos->r==(double)v ) v++;
- }
- Release(pTos);
- pTos->i = v;
- pTos->flags = MEM_Int;
- break;
-}
-
-/* Opcode: MustBeInt P1 P2 *
-**
-** Force the top of the stack to be an integer. If the top of the
-** stack is not an integer and cannot be converted into an integer
-** with out data loss, then jump immediately to P2, or if P2==0
-** raise an SQLITE_MISMATCH exception.
-**
-** If the top of the stack is not an integer and P2 is not zero and
-** P1 is 1, then the stack is popped. In all other cases, the depth
-** of the stack is unchanged.
-*/
-case OP_MustBeInt: {
- assert( pTos>=p->aStack );
- if( pTos->flags & MEM_Int ){
- /* Do nothing */
- }else if( pTos->flags & MEM_Real ){
- int i = (int)pTos->r;
- double r = (double)i;
- if( r!=pTos->r ){
- goto mismatch;
- }
- pTos->i = i;
- }else if( pTos->flags & MEM_Str ){
- int v;
- if( !toInt(pTos->z, &v) ){
- double r;
- if( !sqliteIsNumber(pTos->z) ){
- goto mismatch;
- }
- Realify(pTos);
- v = (int)pTos->r;
- r = (double)v;
- if( r!=pTos->r ){
- goto mismatch;
- }
- }
- pTos->i = v;
- }else{
- goto mismatch;
- }
- Release(pTos);
- pTos->flags = MEM_Int;
- break;
-
-mismatch:
- if( pOp->p2==0 ){
- rc = SQLITE_MISMATCH;
- goto abort_due_to_error;
- }else{
- if( pOp->p1 ) popStack(&pTos, 1);
- pc = pOp->p2 - 1;
- }
- break;
-}
-
-/* Opcode: Eq P1 P2 *
-**
-** Pop the top two elements from the stack. If they are equal, then
-** jump to instruction P2. Otherwise, continue to the next instruction.
-**
-** If either operand is NULL (and thus if the result is unknown) then
-** take the jump if P1 is true.
-**
-** If both values are numeric, they are converted to doubles using atof()
-** and compared for equality that way. Otherwise the strcmp() library
-** routine is used for the comparison. For a pure text comparison
-** use OP_StrEq.
-**
-** If P2 is zero, do not jump. Instead, push an integer 1 onto the
-** stack if the jump would have been taken, or a 0 if not. Push a
-** NULL if either operand was NULL.
-*/
-/* Opcode: Ne P1 P2 *
-**
-** Pop the top two elements from the stack. If they are not equal, then
-** jump to instruction P2. Otherwise, continue to the next instruction.
-**
-** If either operand is NULL (and thus if the result is unknown) then
-** take the jump if P1 is true.
-**
-** If both values are numeric, they are converted to doubles using atof()
-** and compared in that format. Otherwise the strcmp() library
-** routine is used for the comparison. For a pure text comparison
-** use OP_StrNe.
-**
-** If P2 is zero, do not jump. Instead, push an integer 1 onto the
-** stack if the jump would have been taken, or a 0 if not. Push a
-** NULL if either operand was NULL.
-*/
-/* Opcode: Lt P1 P2 *
-**
-** Pop the top two elements from the stack. If second element (the
-** next on stack) is less than the first (the top of stack), then
-** jump to instruction P2. Otherwise, continue to the next instruction.
-** In other words, jump if NOS<TOS.
-**
-** If either operand is NULL (and thus if the result is unknown) then
-** take the jump if P1 is true.
-**
-** If both values are numeric, they are converted to doubles using atof()
-** and compared in that format. Numeric values are always less than
-** non-numeric values. If both operands are non-numeric, the strcmp() library
-** routine is used for the comparison. For a pure text comparison
-** use OP_StrLt.
-**
-** If P2 is zero, do not jump. Instead, push an integer 1 onto the
-** stack if the jump would have been taken, or a 0 if not. Push a
-** NULL if either operand was NULL.
-*/
-/* Opcode: Le P1 P2 *
-**
-** Pop the top two elements from the stack. If second element (the
-** next on stack) is less than or equal to the first (the top of stack),
-** then jump to instruction P2. In other words, jump if NOS<=TOS.
-**
-** If either operand is NULL (and thus if the result is unknown) then
-** take the jump if P1 is true.
-**
-** If both values are numeric, they are converted to doubles using atof()
-** and compared in that format. Numeric values are always less than
-** non-numeric values. If both operands are non-numeric, the strcmp() library
-** routine is used for the comparison. For a pure text comparison
-** use OP_StrLe.
-**
-** If P2 is zero, do not jump. Instead, push an integer 1 onto the
-** stack if the jump would have been taken, or a 0 if not. Push a
-** NULL if either operand was NULL.
-*/
-/* Opcode: Gt P1 P2 *
-**
-** Pop the top two elements from the stack. If second element (the
-** next on stack) is greater than the first (the top of stack),
-** then jump to instruction P2. In other words, jump if NOS>TOS.
-**
-** If either operand is NULL (and thus if the result is unknown) then
-** take the jump if P1 is true.
-**
-** If both values are numeric, they are converted to doubles using atof()
-** and compared in that format. Numeric values are always less than
-** non-numeric values. If both operands are non-numeric, the strcmp() library
-** routine is used for the comparison. For a pure text comparison
-** use OP_StrGt.
-**
-** If P2 is zero, do not jump. Instead, push an integer 1 onto the
-** stack if the jump would have been taken, or a 0 if not. Push a
-** NULL if either operand was NULL.
-*/
-/* Opcode: Ge P1 P2 *
-**
-** Pop the top two elements from the stack. If second element (the next
-** on stack) is greater than or equal to the first (the top of stack),
-** then jump to instruction P2. In other words, jump if NOS>=TOS.
-**
-** If either operand is NULL (and thus if the result is unknown) then
-** take the jump if P1 is true.
-**
-** If both values are numeric, they are converted to doubles using atof()
-** and compared in that format. Numeric values are always less than
-** non-numeric values. If both operands are non-numeric, the strcmp() library
-** routine is used for the comparison. For a pure text comparison
-** use OP_StrGe.
-**
-** If P2 is zero, do not jump. Instead, push an integer 1 onto the
-** stack if the jump would have been taken, or a 0 if not. Push a
-** NULL if either operand was NULL.
-*/
-case OP_Eq:
-case OP_Ne:
-case OP_Lt:
-case OP_Le:
-case OP_Gt:
-case OP_Ge: {
- Mem *pNos = &pTos[-1];
- int c, v;
- int ft, fn;
- assert( pNos>=p->aStack );
- ft = pTos->flags;
- fn = pNos->flags;
- if( (ft | fn) & MEM_Null ){
- popStack(&pTos, 2);
- if( pOp->p2 ){
- if( pOp->p1 ) pc = pOp->p2-1;
- }else{
- pTos++;
- pTos->flags = MEM_Null;
- }
- break;
- }else if( (ft & fn & MEM_Int)==MEM_Int ){
- c = pNos->i - pTos->i;
- }else if( (ft & MEM_Int)!=0 && (fn & MEM_Str)!=0 && toInt(pNos->z,&v) ){
- c = v - pTos->i;
- }else if( (fn & MEM_Int)!=0 && (ft & MEM_Str)!=0 && toInt(pTos->z,&v) ){
- c = pNos->i - v;
- }else{
- Stringify(pTos);
- Stringify(pNos);
- c = sqliteCompare(pNos->z, pTos->z);
- }
- switch( pOp->opcode ){
- case OP_Eq: c = c==0; break;
- case OP_Ne: c = c!=0; break;
- case OP_Lt: c = c<0; break;
- case OP_Le: c = c<=0; break;
- case OP_Gt: c = c>0; break;
- default: c = c>=0; break;
- }
- popStack(&pTos, 2);
- if( pOp->p2 ){
- if( c ) pc = pOp->p2-1;
- }else{
- pTos++;
- pTos->i = c;
- pTos->flags = MEM_Int;
- }
- break;
-}
-/* INSERT NO CODE HERE!
-**
-** The opcode numbers are extracted from this source file by doing
-**
-** grep '^case OP_' vdbe.c | ... >opcodes.h
-**
-** The opcodes are numbered in the order that they appear in this file.
-** But in order for the expression generating code to work right, the
-** string comparison operators that follow must be numbered exactly 6
-** greater than the numeric comparison opcodes above. So no other
-** cases can appear between the two.
-*/
-/* Opcode: StrEq P1 P2 *
-**
-** Pop the top two elements from the stack. If they are equal, then
-** jump to instruction P2. Otherwise, continue to the next instruction.
-**
-** If either operand is NULL (and thus if the result is unknown) then
-** take the jump if P1 is true.
-**
-** The strcmp() library routine is used for the comparison. For a
-** numeric comparison, use OP_Eq.
-**
-** If P2 is zero, do not jump. Instead, push an integer 1 onto the
-** stack if the jump would have been taken, or a 0 if not. Push a
-** NULL if either operand was NULL.
-*/
-/* Opcode: StrNe P1 P2 *
-**
-** Pop the top two elements from the stack. If they are not equal, then
-** jump to instruction P2. Otherwise, continue to the next instruction.
-**
-** If either operand is NULL (and thus if the result is unknown) then
-** take the jump if P1 is true.
-**
-** The strcmp() library routine is used for the comparison. For a
-** numeric comparison, use OP_Ne.
-**
-** If P2 is zero, do not jump. Instead, push an integer 1 onto the
-** stack if the jump would have been taken, or a 0 if not. Push a
-** NULL if either operand was NULL.
-*/
-/* Opcode: StrLt P1 P2 *
-**
-** Pop the top two elements from the stack. If second element (the
-** next on stack) is less than the first (the top of stack), then
-** jump to instruction P2. Otherwise, continue to the next instruction.
-** In other words, jump if NOS<TOS.
-**
-** If either operand is NULL (and thus if the result is unknown) then
-** take the jump if P1 is true.
-**
-** The strcmp() library routine is used for the comparison. For a
-** numeric comparison, use OP_Lt.
-**
-** If P2 is zero, do not jump. Instead, push an integer 1 onto the
-** stack if the jump would have been taken, or a 0 if not. Push a
-** NULL if either operand was NULL.
-*/
-/* Opcode: StrLe P1 P2 *
-**
-** Pop the top two elements from the stack. If second element (the
-** next on stack) is less than or equal to the first (the top of stack),
-** then jump to instruction P2. In other words, jump if NOS<=TOS.
-**
-** If either operand is NULL (and thus if the result is unknown) then
-** take the jump if P1 is true.
-**
-** The strcmp() library routine is used for the comparison. For a
-** numeric comparison, use OP_Le.
-**
-** If P2 is zero, do not jump. Instead, push an integer 1 onto the
-** stack if the jump would have been taken, or a 0 if not. Push a
-** NULL if either operand was NULL.
-*/
-/* Opcode: StrGt P1 P2 *
-**
-** Pop the top two elements from the stack. If second element (the
-** next on stack) is greater than the first (the top of stack),
-** then jump to instruction P2. In other words, jump if NOS>TOS.
-**
-** If either operand is NULL (and thus if the result is unknown) then
-** take the jump if P1 is true.
-**
-** The strcmp() library routine is used for the comparison. For a
-** numeric comparison, use OP_Gt.
-**
-** If P2 is zero, do not jump. Instead, push an integer 1 onto the
-** stack if the jump would have been taken, or a 0 if not. Push a
-** NULL if either operand was NULL.
-*/
-/* Opcode: StrGe P1 P2 *
-**
-** Pop the top two elements from the stack. If second element (the next
-** on stack) is greater than or equal to the first (the top of stack),
-** then jump to instruction P2. In other words, jump if NOS>=TOS.
-**
-** If either operand is NULL (and thus if the result is unknown) then
-** take the jump if P1 is true.
-**
-** The strcmp() library routine is used for the comparison. For a
-** numeric comparison, use OP_Ge.
-**
-** If P2 is zero, do not jump. Instead, push an integer 1 onto the
-** stack if the jump would have been taken, or a 0 if not. Push a
-** NULL if either operand was NULL.
-*/
-case OP_StrEq:
-case OP_StrNe:
-case OP_StrLt:
-case OP_StrLe:
-case OP_StrGt:
-case OP_StrGe: {
- Mem *pNos = &pTos[-1];
- int c;
- assert( pNos>=p->aStack );
- if( (pNos->flags | pTos->flags) & MEM_Null ){
- popStack(&pTos, 2);
- if( pOp->p2 ){
- if( pOp->p1 ) pc = pOp->p2-1;
- }else{
- pTos++;
- pTos->flags = MEM_Null;
- }
- break;
- }else{
- Stringify(pTos);
- Stringify(pNos);
- c = strcmp(pNos->z, pTos->z);
- }
- /* The asserts on each case of the following switch are there to verify
- ** that string comparison opcodes are always exactly 6 greater than the
- ** corresponding numeric comparison opcodes. The code generator depends
- ** on this fact.
- */
- switch( pOp->opcode ){
- case OP_StrEq: c = c==0; assert( pOp->opcode-6==OP_Eq ); break;
- case OP_StrNe: c = c!=0; assert( pOp->opcode-6==OP_Ne ); break;
- case OP_StrLt: c = c<0; assert( pOp->opcode-6==OP_Lt ); break;
- case OP_StrLe: c = c<=0; assert( pOp->opcode-6==OP_Le ); break;
- case OP_StrGt: c = c>0; assert( pOp->opcode-6==OP_Gt ); break;
- default: c = c>=0; assert( pOp->opcode-6==OP_Ge ); break;
- }
- popStack(&pTos, 2);
- if( pOp->p2 ){
- if( c ) pc = pOp->p2-1;
- }else{
- pTos++;
- pTos->flags = MEM_Int;
- pTos->i = c;
- }
- break;
-}
-
-/* Opcode: And * * *
-**
-** Pop two values off the stack. Take the logical AND of the
-** two values and push the resulting boolean value back onto the
-** stack.
-*/
-/* Opcode: Or * * *
-**
-** Pop two values off the stack. Take the logical OR of the
-** two values and push the resulting boolean value back onto the
-** stack.
-*/
-case OP_And:
-case OP_Or: {
- Mem *pNos = &pTos[-1];
- int v1, v2; /* 0==TRUE, 1==FALSE, 2==UNKNOWN or NULL */
-
- assert( pNos>=p->aStack );
- if( pTos->flags & MEM_Null ){
- v1 = 2;
- }else{
- Integerify(pTos);
- v1 = pTos->i==0;
- }
- if( pNos->flags & MEM_Null ){
- v2 = 2;
- }else{
- Integerify(pNos);
- v2 = pNos->i==0;
- }
- if( pOp->opcode==OP_And ){
- static const unsigned char and_logic[] = { 0, 1, 2, 1, 1, 1, 2, 1, 2 };
- v1 = and_logic[v1*3+v2];
- }else{
- static const unsigned char or_logic[] = { 0, 0, 0, 0, 1, 2, 0, 2, 2 };
- v1 = or_logic[v1*3+v2];
- }
- popStack(&pTos, 2);
- pTos++;
- if( v1==2 ){
- pTos->flags = MEM_Null;
- }else{
- pTos->i = v1==0;
- pTos->flags = MEM_Int;
- }
- break;
-}
-
-/* Opcode: Negative * * *
-**
-** Treat the top of the stack as a numeric quantity. Replace it
-** with its additive inverse. If the top of the stack is NULL
-** its value is unchanged.
-*/
-/* Opcode: AbsValue * * *
-**
-** Treat the top of the stack as a numeric quantity. Replace it
-** with its absolute value. If the top of the stack is NULL
-** its value is unchanged.
-*/
-case OP_Negative:
-case OP_AbsValue: {
- assert( pTos>=p->aStack );
- if( pTos->flags & MEM_Real ){
- Release(pTos);
- if( pOp->opcode==OP_Negative || pTos->r<0.0 ){
- pTos->r = -pTos->r;
- }
- pTos->flags = MEM_Real;
- }else if( pTos->flags & MEM_Int ){
- Release(pTos);
- if( pOp->opcode==OP_Negative || pTos->i<0 ){
- pTos->i = -pTos->i;
- }
- pTos->flags = MEM_Int;
- }else if( pTos->flags & MEM_Null ){
- /* Do nothing */
- }else{
- Realify(pTos);
- Release(pTos);
- if( pOp->opcode==OP_Negative || pTos->r<0.0 ){
- pTos->r = -pTos->r;
- }
- pTos->flags = MEM_Real;
- }
- break;
-}
-
-/* Opcode: Not * * *
-**
-** Interpret the top of the stack as a boolean value. Replace it
-** with its complement. If the top of the stack is NULL its value
-** is unchanged.
-*/
-case OP_Not: {
- assert( pTos>=p->aStack );
- if( pTos->flags & MEM_Null ) break; /* Do nothing to NULLs */
- Integerify(pTos);
- Release(pTos);
- pTos->i = !pTos->i;
- pTos->flags = MEM_Int;
- break;
-}
-
-/* Opcode: BitNot * * *
-**
-** Interpret the top of the stack as an value. Replace it
-** with its ones-complement. If the top of the stack is NULL its
-** value is unchanged.
-*/
-case OP_BitNot: {
- assert( pTos>=p->aStack );
- if( pTos->flags & MEM_Null ) break; /* Do nothing to NULLs */
- Integerify(pTos);
- Release(pTos);
- pTos->i = ~pTos->i;
- pTos->flags = MEM_Int;
- break;
-}
-
-/* Opcode: Noop * * *
-**
-** Do nothing. This instruction is often useful as a jump
-** destination.
-*/
-case OP_Noop: {
- break;
-}
-
-/* Opcode: If P1 P2 *
-**
-** Pop a single boolean from the stack. If the boolean popped is
-** true, then jump to p2. Otherwise continue to the next instruction.
-** An integer is false if zero and true otherwise. A string is
-** false if it has zero length and true otherwise.
-**
-** If the value popped of the stack is NULL, then take the jump if P1
-** is true and fall through if P1 is false.
-*/
-/* Opcode: IfNot P1 P2 *
-**
-** Pop a single boolean from the stack. If the boolean popped is
-** false, then jump to p2. Otherwise continue to the next instruction.
-** An integer is false if zero and true otherwise. A string is
-** false if it has zero length and true otherwise.
-**
-** If the value popped of the stack is NULL, then take the jump if P1
-** is true and fall through if P1 is false.
-*/
-case OP_If:
-case OP_IfNot: {
- int c;
- assert( pTos>=p->aStack );
- if( pTos->flags & MEM_Null ){
- c = pOp->p1;
- }else{
- Integerify(pTos);
- c = pTos->i;
- if( pOp->opcode==OP_IfNot ) c = !c;
- }
- assert( (pTos->flags & MEM_Dyn)==0 );
- pTos--;
- if( c ) pc = pOp->p2-1;
- break;
-}
-
-/* Opcode: IsNull P1 P2 *
-**
-** If any of the top abs(P1) values on the stack are NULL, then jump
-** to P2. Pop the stack P1 times if P1>0. If P1<0 leave the stack
-** unchanged.
-*/
-case OP_IsNull: {
- int i, cnt;
- Mem *pTerm;
- cnt = pOp->p1;
- if( cnt<0 ) cnt = -cnt;
- pTerm = &pTos[1-cnt];
- assert( pTerm>=p->aStack );
- for(i=0; i<cnt; i++, pTerm++){
- if( pTerm->flags & MEM_Null ){
- pc = pOp->p2-1;
- break;
- }
- }
- if( pOp->p1>0 ) popStack(&pTos, cnt);
- break;
-}
-
-/* Opcode: NotNull P1 P2 *
-**
-** Jump to P2 if the top P1 values on the stack are all not NULL. Pop the
-** stack if P1 times if P1 is greater than zero. If P1 is less than
-** zero then leave the stack unchanged.
-*/
-case OP_NotNull: {
- int i, cnt;
- cnt = pOp->p1;
- if( cnt<0 ) cnt = -cnt;
- assert( &pTos[1-cnt] >= p->aStack );
- for(i=0; i<cnt && (pTos[1+i-cnt].flags & MEM_Null)==0; i++){}
- if( i>=cnt ) pc = pOp->p2-1;
- if( pOp->p1>0 ) popStack(&pTos, cnt);
- break;
-}
-
-/* Opcode: MakeRecord P1 P2 *
-**
-** Convert the top P1 entries of the stack into a single entry
-** suitable for use as a data record in a database table. The
-** details of the format are irrelavant as long as the OP_Column
-** opcode can decode the record later. Refer to source code
-** comments for the details of the record format.
-**
-** If P2 is true (non-zero) and one or more of the P1 entries
-** that go into building the record is NULL, then add some extra
-** bytes to the record to make it distinct for other entries created
-** during the same run of the VDBE. The extra bytes added are a
-** counter that is reset with each run of the VDBE, so records
-** created this way will not necessarily be distinct across runs.
-** But they should be distinct for transient tables (created using
-** OP_OpenTemp) which is what they are intended for.
-**
-** (Later:) The P2==1 option was intended to make NULLs distinct
-** for the UNION operator. But I have since discovered that NULLs
-** are indistinct for UNION. So this option is never used.
-*/
-case OP_MakeRecord: {
- char *zNewRecord;
- int nByte;
- int nField;
- int i, j;
- int idxWidth;
- u32 addr;
- Mem *pRec;
- int addUnique = 0; /* True to cause bytes to be added to make the
- ** generated record distinct */
- char zTemp[NBFS]; /* Temp space for small records */
-
- /* Assuming the record contains N fields, the record format looks
- ** like this:
- **
- ** -------------------------------------------------------------------
- ** | idx0 | idx1 | ... | idx(N-1) | idx(N) | data0 | ... | data(N-1) |
- ** -------------------------------------------------------------------
- **
- ** All data fields are converted to strings before being stored and
- ** are stored with their null terminators. NULL entries omit the
- ** null terminator. Thus an empty string uses 1 byte and a NULL uses
- ** zero bytes. Data(0) is taken from the lowest element of the stack
- ** and data(N-1) is the top of the stack.
- **
- ** Each of the idx() entries is either 1, 2, or 3 bytes depending on
- ** how big the total record is. Idx(0) contains the offset to the start
- ** of data(0). Idx(k) contains the offset to the start of data(k).
- ** Idx(N) contains the total number of bytes in the record.
- */
- nField = pOp->p1;
- pRec = &pTos[1-nField];
- assert( pRec>=p->aStack );
- nByte = 0;
- for(i=0; i<nField; i++, pRec++){
- if( pRec->flags & MEM_Null ){
- addUnique = pOp->p2;
- }else{
- Stringify(pRec);
- nByte += pRec->n;
- }
- }
- if( addUnique ) nByte += sizeof(p->uniqueCnt);
- if( nByte + nField + 1 < 256 ){
- idxWidth = 1;
- }else if( nByte + 2*nField + 2 < 65536 ){
- idxWidth = 2;
- }else{
- idxWidth = 3;
- }
- nByte += idxWidth*(nField + 1);
- if( nByte>MAX_BYTES_PER_ROW ){
- rc = SQLITE_TOOBIG;
- goto abort_due_to_error;
- }
- if( nByte<=NBFS ){
- zNewRecord = zTemp;
- }else{
- zNewRecord = sqliteMallocRaw( nByte );
- if( zNewRecord==0 ) goto no_mem;
- }
- j = 0;
- addr = idxWidth*(nField+1) + addUnique*sizeof(p->uniqueCnt);
- for(i=0, pRec=&pTos[1-nField]; i<nField; i++, pRec++){
- zNewRecord[j++] = addr & 0xff;
- if( idxWidth>1 ){
- zNewRecord[j++] = (addr>>8)&0xff;
- if( idxWidth>2 ){
- zNewRecord[j++] = (addr>>16)&0xff;
- }
- }
- if( (pRec->flags & MEM_Null)==0 ){
- addr += pRec->n;
- }
- }
- zNewRecord[j++] = addr & 0xff;
- if( idxWidth>1 ){
- zNewRecord[j++] = (addr>>8)&0xff;
- if( idxWidth>2 ){
- zNewRecord[j++] = (addr>>16)&0xff;
- }
- }
- if( addUnique ){
- memcpy(&zNewRecord[j], &p->uniqueCnt, sizeof(p->uniqueCnt));
- p->uniqueCnt++;
- j += sizeof(p->uniqueCnt);
- }
- for(i=0, pRec=&pTos[1-nField]; i<nField; i++, pRec++){
- if( (pRec->flags & MEM_Null)==0 ){
- memcpy(&zNewRecord[j], pRec->z, pRec->n);
- j += pRec->n;
- }
- }
- popStack(&pTos, nField);
- pTos++;
- pTos->n = nByte;
- if( nByte<=NBFS ){
- assert( zNewRecord==zTemp );
- memcpy(pTos->zShort, zTemp, nByte);
- pTos->z = pTos->zShort;
- pTos->flags = MEM_Str | MEM_Short;
- }else{
- assert( zNewRecord!=zTemp );
- pTos->z = zNewRecord;
- pTos->flags = MEM_Str | MEM_Dyn;
- }
- break;
-}
-
-/* Opcode: MakeKey P1 P2 P3
-**
-** Convert the top P1 entries of the stack into a single entry suitable
-** for use as the key in an index. The top P1 records are
-** converted to strings and merged. The null-terminators
-** are retained and used as separators.
-** The lowest entry in the stack is the first field and the top of the
-** stack becomes the last.
-**
-** If P2 is not zero, then the original entries remain on the stack
-** and the new key is pushed on top. If P2 is zero, the original
-** data is popped off the stack first then the new key is pushed
-** back in its place.
-**
-** P3 is a string that is P1 characters long. Each character is either
-** an 'n' or a 't' to indicates if the argument should be intepreted as
-** numeric or text type. The first character of P3 corresponds to the
-** lowest element on the stack. If P3 is NULL then all arguments are
-** assumed to be of the numeric type.
-**
-** The type makes a difference in that text-type fields may not be
-** introduced by 'b' (as described in the next paragraph). The
-** first character of a text-type field must be either 'a' (if it is NULL)
-** or 'c'. Numeric fields will be introduced by 'b' if their content
-** looks like a well-formed number. Otherwise the 'a' or 'c' will be
-** used.
-**
-** The key is a concatenation of fields. Each field is terminated by
-** a single 0x00 character. A NULL field is introduced by an 'a' and
-** is followed immediately by its 0x00 terminator. A numeric field is
-** introduced by a single character 'b' and is followed by a sequence
-** of characters that represent the number such that a comparison of
-** the character string using memcpy() sorts the numbers in numerical
-** order. The character strings for numbers are generated using the
-** sqliteRealToSortable() function. A text field is introduced by a
-** 'c' character and is followed by the exact text of the field. The
-** use of an 'a', 'b', or 'c' character at the beginning of each field
-** guarantees that NULLs sort before numbers and that numbers sort
-** before text. 0x00 characters do not occur except as separators
-** between fields.
-**
-** See also: MakeIdxKey, SortMakeKey
-*/
-/* Opcode: MakeIdxKey P1 P2 P3
-**
-** Convert the top P1 entries of the stack into a single entry suitable
-** for use as the key in an index. In addition, take one additional integer
-** off of the stack, treat that integer as a four-byte record number, and
-** append the four bytes to the key. Thus a total of P1+1 entries are
-** popped from the stack for this instruction and a single entry is pushed
-** back. The first P1 entries that are popped are strings and the last
-** entry (the lowest on the stack) is an integer record number.
-**
-** The converstion of the first P1 string entries occurs just like in
-** MakeKey. Each entry is separated from the others by a null.
-** The entire concatenation is null-terminated. The lowest entry
-** in the stack is the first field and the top of the stack becomes the
-** last.
-**
-** If P2 is not zero and one or more of the P1 entries that go into the
-** generated key is NULL, then jump to P2 after the new key has been
-** pushed on the stack. In other words, jump to P2 if the key is
-** guaranteed to be unique. This jump can be used to skip a subsequent
-** uniqueness test.
-**
-** P3 is a string that is P1 characters long. Each character is either
-** an 'n' or a 't' to indicates if the argument should be numeric or
-** text. The first character corresponds to the lowest element on the
-** stack. If P3 is null then all arguments are assumed to be numeric.
-**
-** See also: MakeKey, SortMakeKey
-*/
-case OP_MakeIdxKey:
-case OP_MakeKey: {
- char *zNewKey;
- int nByte;
- int nField;
- int addRowid;
- int i, j;
- int containsNull = 0;
- Mem *pRec;
- char zTemp[NBFS];
-
- addRowid = pOp->opcode==OP_MakeIdxKey;
- nField = pOp->p1;
- pRec = &pTos[1-nField];
- assert( pRec>=p->aStack );
- nByte = 0;
- for(j=0, i=0; i<nField; i++, j++, pRec++){
- int flags = pRec->flags;
- int len;
- char *z;
- if( flags & MEM_Null ){
- nByte += 2;
- containsNull = 1;
- }else if( pOp->p3 && pOp->p3[j]=='t' ){
- Stringify(pRec);
- pRec->flags &= ~(MEM_Int|MEM_Real);
- nByte += pRec->n+1;
- }else if( (flags & (MEM_Real|MEM_Int))!=0 || sqliteIsNumber(pRec->z) ){
- if( (flags & (MEM_Real|MEM_Int))==MEM_Int ){
- pRec->r = pRec->i;
- }else if( (flags & (MEM_Real|MEM_Int))==0 ){
- pRec->r = sqliteAtoF(pRec->z, 0);
- }
- Release(pRec);
- z = pRec->zShort;
- sqliteRealToSortable(pRec->r, z);
- len = strlen(z);
- pRec->z = 0;
- pRec->flags = MEM_Real;
- pRec->n = len+1;
- nByte += pRec->n+1;
- }else{
- nByte += pRec->n+1;
- }
- }
- if( nByte+sizeof(u32)>MAX_BYTES_PER_ROW ){
- rc = SQLITE_TOOBIG;
- goto abort_due_to_error;
- }
- if( addRowid ) nByte += sizeof(u32);
- if( nByte<=NBFS ){
- zNewKey = zTemp;
- }else{
- zNewKey = sqliteMallocRaw( nByte );
- if( zNewKey==0 ) goto no_mem;
- }
- j = 0;
- pRec = &pTos[1-nField];
- for(i=0; i<nField; i++, pRec++){
- if( pRec->flags & MEM_Null ){
- zNewKey[j++] = 'a';
- zNewKey[j++] = 0;
- }else if( pRec->flags==MEM_Real ){
- zNewKey[j++] = 'b';
- memcpy(&zNewKey[j], pRec->zShort, pRec->n);
- j += pRec->n;
- }else{
- assert( pRec->flags & MEM_Str );
- zNewKey[j++] = 'c';
- memcpy(&zNewKey[j], pRec->z, pRec->n);
- j += pRec->n;
- }
- }
- if( addRowid ){
- u32 iKey;
- pRec = &pTos[-nField];
- assert( pRec>=p->aStack );
- Integerify(pRec);
- iKey = intToKey(pRec->i);
- memcpy(&zNewKey[j], &iKey, sizeof(u32));
- popStack(&pTos, nField+1);
- if( pOp->p2 && containsNull ) pc = pOp->p2 - 1;
- }else{
- if( pOp->p2==0 ) popStack(&pTos, nField);
- }
- pTos++;
- pTos->n = nByte;
- if( nByte<=NBFS ){
- assert( zNewKey==zTemp );
- pTos->z = pTos->zShort;
- memcpy(pTos->zShort, zTemp, nByte);
- pTos->flags = MEM_Str | MEM_Short;
- }else{
- pTos->z = zNewKey;
- pTos->flags = MEM_Str | MEM_Dyn;
- }
- break;
-}
-
-/* Opcode: IncrKey * * *
-**
-** The top of the stack should contain an index key generated by
-** The MakeKey opcode. This routine increases the least significant
-** byte of that key by one. This is used so that the MoveTo opcode
-** will move to the first entry greater than the key rather than to
-** the key itself.
-*/
-case OP_IncrKey: {
- assert( pTos>=p->aStack );
- /* The IncrKey opcode is only applied to keys generated by
- ** MakeKey or MakeIdxKey and the results of those operands
- ** are always dynamic strings or zShort[] strings. So we
- ** are always free to modify the string in place.
- */
- assert( pTos->flags & (MEM_Dyn|MEM_Short) );
- pTos->z[pTos->n-1]++;
- break;
-}
-
-/* Opcode: Checkpoint P1 * *
-**
-** Begin a checkpoint. A checkpoint is the beginning of a operation that
-** is part of a larger transaction but which might need to be rolled back
-** itself without effecting the containing transaction. A checkpoint will
-** be automatically committed or rollback when the VDBE halts.
-**
-** The checkpoint is begun on the database file with index P1. The main
-** database file has an index of 0 and the file used for temporary tables
-** has an index of 1.
-*/
-case OP_Checkpoint: {
- int i = pOp->p1;
- if( i>=0 && i<db->nDb && db->aDb[i].pBt && db->aDb[i].inTrans==1 ){
- rc = sqliteBtreeBeginCkpt(db->aDb[i].pBt);
- if( rc==SQLITE_OK ) db->aDb[i].inTrans = 2;
- }
- break;
-}
-
-/* Opcode: Transaction P1 * *
-**
-** Begin a transaction. The transaction ends when a Commit or Rollback
-** opcode is encountered. Depending on the ON CONFLICT setting, the
-** transaction might also be rolled back if an error is encountered.
-**
-** P1 is the index of the database file on which the transaction is
-** started. Index 0 is the main database file and index 1 is the
-** file used for temporary tables.
-**
-** A write lock is obtained on the database file when a transaction is
-** started. No other process can read or write the file while the
-** transaction is underway. Starting a transaction also creates a
-** rollback journal. A transaction must be started before any changes
-** can be made to the database.
-*/
-case OP_Transaction: {
- int busy = 1;
- int i = pOp->p1;
- assert( i>=0 && i<db->nDb );
- if( db->aDb[i].inTrans ) break;
- while( db->aDb[i].pBt!=0 && busy ){
- rc = sqliteBtreeBeginTrans(db->aDb[i].pBt);
- switch( rc ){
- case SQLITE_BUSY: {
- if( db->xBusyCallback==0 ){
- p->pc = pc;
- p->undoTransOnError = 1;
- p->rc = SQLITE_BUSY;
- p->pTos = pTos;
- return SQLITE_BUSY;
- }else if( (*db->xBusyCallback)(db->pBusyArg, "", busy++)==0 ){
- sqliteSetString(&p->zErrMsg, sqlite_error_string(rc), (char*)0);
- busy = 0;
- }
- break;
- }
- case SQLITE_READONLY: {
- rc = SQLITE_OK;
- /* Fall thru into the next case */
- }
- case SQLITE_OK: {
- p->inTempTrans = 0;
- busy = 0;
- break;
- }
- default: {
- goto abort_due_to_error;
- }
- }
- }
- db->aDb[i].inTrans = 1;
- p->undoTransOnError = 1;
- break;
-}
-
-/* Opcode: Commit * * *
-**
-** Cause all modifications to the database that have been made since the
-** last Transaction to actually take effect. No additional modifications
-** are allowed until another transaction is started. The Commit instruction
-** deletes the journal file and releases the write lock on the database.
-** A read lock continues to be held if there are still cursors open.
-*/
-case OP_Commit: {
- int i;
- if( db->xCommitCallback!=0 ){
- if( sqliteSafetyOff(db) ) goto abort_due_to_misuse;
- if( db->xCommitCallback(db->pCommitArg)!=0 ){
- rc = SQLITE_CONSTRAINT;
- }
- if( sqliteSafetyOn(db) ) goto abort_due_to_misuse;
- }
- for(i=0; rc==SQLITE_OK && i<db->nDb; i++){
- if( db->aDb[i].inTrans ){
- rc = sqliteBtreeCommit(db->aDb[i].pBt);
- db->aDb[i].inTrans = 0;
- }
- }
- if( rc==SQLITE_OK ){
- sqliteCommitInternalChanges(db);
- }else{
- sqliteRollbackAll(db);
- }
- break;
-}
-
-/* Opcode: Rollback P1 * *
-**
-** Cause all modifications to the database that have been made since the
-** last Transaction to be undone. The database is restored to its state
-** before the Transaction opcode was executed. No additional modifications
-** are allowed until another transaction is started.
-**
-** P1 is the index of the database file that is committed. An index of 0
-** is used for the main database and an index of 1 is used for the file used
-** to hold temporary tables.
-**
-** This instruction automatically closes all cursors and releases both
-** the read and write locks on the indicated database.
-*/
-case OP_Rollback: {
- sqliteRollbackAll(db);
- break;
-}
-
-/* Opcode: ReadCookie P1 P2 *
-**
-** Read cookie number P2 from database P1 and push it onto the stack.
-** P2==0 is the schema version. P2==1 is the database format.
-** P2==2 is the recommended pager cache size, and so forth. P1==0 is
-** the main database file and P1==1 is the database file used to store
-** temporary tables.
-**
-** There must be a read-lock on the database (either a transaction
-** must be started or there must be an open cursor) before
-** executing this instruction.
-*/
-case OP_ReadCookie: {
- int aMeta[SQLITE_N_BTREE_META];
- assert( pOp->p2<SQLITE_N_BTREE_META );
- assert( pOp->p1>=0 && pOp->p1<db->nDb );
- assert( db->aDb[pOp->p1].pBt!=0 );
- rc = sqliteBtreeGetMeta(db->aDb[pOp->p1].pBt, aMeta);
- pTos++;
- pTos->i = aMeta[1+pOp->p2];
- pTos->flags = MEM_Int;
- break;
-}
-
-/* Opcode: SetCookie P1 P2 *
-**
-** Write the top of the stack into cookie number P2 of database P1.
-** P2==0 is the schema version. P2==1 is the database format.
-** P2==2 is the recommended pager cache size, and so forth. P1==0 is
-** the main database file and P1==1 is the database file used to store
-** temporary tables.
-**
-** A transaction must be started before executing this opcode.
-*/
-case OP_SetCookie: {
- int aMeta[SQLITE_N_BTREE_META];
- assert( pOp->p2<SQLITE_N_BTREE_META );
- assert( pOp->p1>=0 && pOp->p1<db->nDb );
- assert( db->aDb[pOp->p1].pBt!=0 );
- assert( pTos>=p->aStack );
- Integerify(pTos)
- rc = sqliteBtreeGetMeta(db->aDb[pOp->p1].pBt, aMeta);
- if( rc==SQLITE_OK ){
- aMeta[1+pOp->p2] = pTos->i;
- rc = sqliteBtreeUpdateMeta(db->aDb[pOp->p1].pBt, aMeta);
- }
- Release(pTos);
- pTos--;
- break;
-}
-
-/* Opcode: VerifyCookie P1 P2 *
-**
-** Check the value of global database parameter number 0 (the
-** schema version) and make sure it is equal to P2.
-** P1 is the database number which is 0 for the main database file
-** and 1 for the file holding temporary tables and some higher number
-** for auxiliary databases.
-**
-** The cookie changes its value whenever the database schema changes.
-** This operation is used to detect when that the cookie has changed
-** and that the current process needs to reread the schema.
-**
-** Either a transaction needs to have been started or an OP_Open needs
-** to be executed (to establish a read lock) before this opcode is
-** invoked.
-*/
-case OP_VerifyCookie: {
- int aMeta[SQLITE_N_BTREE_META];
- assert( pOp->p1>=0 && pOp->p1<db->nDb );
- rc = sqliteBtreeGetMeta(db->aDb[pOp->p1].pBt, aMeta);
- if( rc==SQLITE_OK && aMeta[1]!=pOp->p2 ){
- sqliteSetString(&p->zErrMsg, "database schema has changed", (char*)0);
- rc = SQLITE_SCHEMA;
- }
- break;
-}
-
-/* Opcode: OpenRead P1 P2 P3
-**
-** Open a read-only cursor for the database table whose root page is
-** P2 in a database file. The database file is determined by an
-** integer from the top of the stack. 0 means the main database and
-** 1 means the database used for temporary tables. Give the new
-** cursor an identifier of P1. The P1 values need not be contiguous
-** but all P1 values should be small integers. It is an error for
-** P1 to be negative.
-**
-** If P2==0 then take the root page number from the next of the stack.
-**
-** There will be a read lock on the database whenever there is an
-** open cursor. If the database was unlocked prior to this instruction
-** then a read lock is acquired as part of this instruction. A read
-** lock allows other processes to read the database but prohibits
-** any other process from modifying the database. The read lock is
-** released when all cursors are closed. If this instruction attempts
-** to get a read lock but fails, the script terminates with an
-** SQLITE_BUSY error code.
-**
-** The P3 value is the name of the table or index being opened.
-** The P3 value is not actually used by this opcode and may be
-** omitted. But the code generator usually inserts the index or
-** table name into P3 to make the code easier to read.
-**
-** See also OpenWrite.
-*/
-/* Opcode: OpenWrite P1 P2 P3
-**
-** Open a read/write cursor named P1 on the table or index whose root
-** page is P2. If P2==0 then take the root page number from the stack.
-**
-** The P3 value is the name of the table or index being opened.
-** The P3 value is not actually used by this opcode and may be
-** omitted. But the code generator usually inserts the index or
-** table name into P3 to make the code easier to read.
-**
-** This instruction works just like OpenRead except that it opens the cursor
-** in read/write mode. For a given table, there can be one or more read-only
-** cursors or a single read/write cursor but not both.
-**
-** See also OpenRead.
-*/
-case OP_OpenRead:
-case OP_OpenWrite: {
- int busy = 0;
- int i = pOp->p1;
- int p2 = pOp->p2;
- int wrFlag;
- Btree *pX;
- int iDb;
-
- assert( pTos>=p->aStack );
- Integerify(pTos);
- iDb = pTos->i;
- pTos--;
- assert( iDb>=0 && iDb<db->nDb );
- pX = db->aDb[iDb].pBt;
- assert( pX!=0 );
- wrFlag = pOp->opcode==OP_OpenWrite;
- if( p2<=0 ){
- assert( pTos>=p->aStack );
- Integerify(pTos);
- p2 = pTos->i;
- pTos--;
- if( p2<2 ){
- sqliteSetString(&p->zErrMsg, "root page number less than 2", (char*)0);
- rc = SQLITE_INTERNAL;
- break;
- }
- }
- assert( i>=0 );
- if( expandCursorArraySize(p, i) ) goto no_mem;
- sqliteVdbeCleanupCursor(&p->aCsr[i]);
- memset(&p->aCsr[i], 0, sizeof(Cursor));
- p->aCsr[i].nullRow = 1;
- if( pX==0 ) break;
- do{
- rc = sqliteBtreeCursor(pX, p2, wrFlag, &p->aCsr[i].pCursor);
- switch( rc ){
- case SQLITE_BUSY: {
- if( db->xBusyCallback==0 ){
- p->pc = pc;
- p->rc = SQLITE_BUSY;
- p->pTos = &pTos[1 + (pOp->p2<=0)]; /* Operands must remain on stack */
- return SQLITE_BUSY;
- }else if( (*db->xBusyCallback)(db->pBusyArg, pOp->p3, ++busy)==0 ){
- sqliteSetString(&p->zErrMsg, sqlite_error_string(rc), (char*)0);
- busy = 0;
- }
- break;
- }
- case SQLITE_OK: {
- busy = 0;
- break;
- }
- default: {
- goto abort_due_to_error;
- }
- }
- }while( busy );
- break;
-}
-
-/* Opcode: OpenTemp P1 P2 *
-**
-** Open a new cursor to a transient table.
-** The transient cursor is always opened read/write even if
-** the main database is read-only. The transient table is deleted
-** automatically when the cursor is closed.
-**
-** The cursor points to a BTree table if P2==0 and to a BTree index
-** if P2==1. A BTree table must have an integer key and can have arbitrary
-** data. A BTree index has no data but can have an arbitrary key.
-**
-** This opcode is used for tables that exist for the duration of a single
-** SQL statement only. Tables created using CREATE TEMPORARY TABLE
-** are opened using OP_OpenRead or OP_OpenWrite. "Temporary" in the
-** context of this opcode means for the duration of a single SQL statement
-** whereas "Temporary" in the context of CREATE TABLE means for the duration
-** of the connection to the database. Same word; different meanings.
-*/
-case OP_OpenTemp: {
- int i = pOp->p1;
- Cursor *pCx;
- assert( i>=0 );
- if( expandCursorArraySize(p, i) ) goto no_mem;
- pCx = &p->aCsr[i];
- sqliteVdbeCleanupCursor(pCx);
- memset(pCx, 0, sizeof(*pCx));
- pCx->nullRow = 1;
- rc = sqliteBtreeFactory(db, 0, 1, TEMP_PAGES, &pCx->pBt);
-
- if( rc==SQLITE_OK ){
- rc = sqliteBtreeBeginTrans(pCx->pBt);
- }
- if( rc==SQLITE_OK ){
- if( pOp->p2 ){
- int pgno;
- rc = sqliteBtreeCreateIndex(pCx->pBt, &pgno);
- if( rc==SQLITE_OK ){
- rc = sqliteBtreeCursor(pCx->pBt, pgno, 1, &pCx->pCursor);
- }
- }else{
- rc = sqliteBtreeCursor(pCx->pBt, 2, 1, &pCx->pCursor);
- }
- }
- break;
-}
-
-/* Opcode: OpenPseudo P1 * *
-**
-** Open a new cursor that points to a fake table that contains a single
-** row of data. Any attempt to write a second row of data causes the
-** first row to be deleted. All data is deleted when the cursor is
-** closed.
-**
-** A pseudo-table created by this opcode is useful for holding the
-** NEW or OLD tables in a trigger.
-*/
-case OP_OpenPseudo: {
- int i = pOp->p1;
- Cursor *pCx;
- assert( i>=0 );
- if( expandCursorArraySize(p, i) ) goto no_mem;
- pCx = &p->aCsr[i];
- sqliteVdbeCleanupCursor(pCx);
- memset(pCx, 0, sizeof(*pCx));
- pCx->nullRow = 1;
- pCx->pseudoTable = 1;
- break;
-}
-
-/* Opcode: Close P1 * *
-**
-** Close a cursor previously opened as P1. If P1 is not
-** currently open, this instruction is a no-op.
-*/
-case OP_Close: {
- int i = pOp->p1;
- if( i>=0 && i<p->nCursor ){
- sqliteVdbeCleanupCursor(&p->aCsr[i]);
- }
- break;
-}
-
-/* Opcode: MoveTo P1 P2 *
-**
-** Pop the top of the stack and use its value as a key. Reposition
-** cursor P1 so that it points to an entry with a matching key. If
-** the table contains no record with a matching key, then the cursor
-** is left pointing at the first record that is greater than the key.
-** If there are no records greater than the key and P2 is not zero,
-** then an immediate jump to P2 is made.
-**
-** See also: Found, NotFound, Distinct, MoveLt
-*/
-/* Opcode: MoveLt P1 P2 *
-**
-** Pop the top of the stack and use its value as a key. Reposition
-** cursor P1 so that it points to the entry with the largest key that is
-** less than the key popped from the stack.
-** If there are no records less than than the key and P2
-** is not zero then an immediate jump to P2 is made.
-**
-** See also: MoveTo
-*/
-case OP_MoveLt:
-case OP_MoveTo: {
- int i = pOp->p1;
- Cursor *pC;
-
- assert( pTos>=p->aStack );
- assert( i>=0 && i<p->nCursor );
- pC = &p->aCsr[i];
- if( pC->pCursor!=0 ){
- int res, oc;
- pC->nullRow = 0;
- if( pTos->flags & MEM_Int ){
- int iKey = intToKey(pTos->i);
- if( pOp->p2==0 && pOp->opcode==OP_MoveTo ){
- pC->movetoTarget = iKey;
- pC->deferredMoveto = 1;
- Release(pTos);
- pTos--;
- break;
- }
- sqliteBtreeMoveto(pC->pCursor, (char*)&iKey, sizeof(int), &res);
- pC->lastRecno = pTos->i;
- pC->recnoIsValid = res==0;
- }else{
- Stringify(pTos);
- sqliteBtreeMoveto(pC->pCursor, pTos->z, pTos->n, &res);
- pC->recnoIsValid = 0;
- }
- pC->deferredMoveto = 0;
- sqlite_search_count++;
- oc = pOp->opcode;
- if( oc==OP_MoveTo && res<0 ){
- sqliteBtreeNext(pC->pCursor, &res);
- pC->recnoIsValid = 0;
- if( res && pOp->p2>0 ){
- pc = pOp->p2 - 1;
- }
- }else if( oc==OP_MoveLt ){
- if( res>=0 ){
- sqliteBtreePrevious(pC->pCursor, &res);
- pC->recnoIsValid = 0;
- }else{
- /* res might be negative because the table is empty. Check to
- ** see if this is the case.
- */
- int keysize;
- res = sqliteBtreeKeySize(pC->pCursor,&keysize)!=0 || keysize==0;
- }
- if( res && pOp->p2>0 ){
- pc = pOp->p2 - 1;
- }
- }
- }
- Release(pTos);
- pTos--;
- break;
-}
-
-/* Opcode: Distinct P1 P2 *
-**
-** Use the top of the stack as a string key. If a record with that key does
-** not exist in the table of cursor P1, then jump to P2. If the record
-** does already exist, then fall thru. The cursor is left pointing
-** at the record if it exists. The key is not popped from the stack.
-**
-** This operation is similar to NotFound except that this operation
-** does not pop the key from the stack.
-**
-** See also: Found, NotFound, MoveTo, IsUnique, NotExists
-*/
-/* Opcode: Found P1 P2 *
-**
-** Use the top of the stack as a string key. If a record with that key
-** does exist in table of P1, then jump to P2. If the record
-** does not exist, then fall thru. The cursor is left pointing
-** to the record if it exists. The key is popped from the stack.
-**
-** See also: Distinct, NotFound, MoveTo, IsUnique, NotExists
-*/
-/* Opcode: NotFound P1 P2 *
-**
-** Use the top of the stack as a string key. If a record with that key
-** does not exist in table of P1, then jump to P2. If the record
-** does exist, then fall thru. The cursor is left pointing to the
-** record if it exists. The key is popped from the stack.
-**
-** The difference between this operation and Distinct is that
-** Distinct does not pop the key from the stack.
-**
-** See also: Distinct, Found, MoveTo, NotExists, IsUnique
-*/
-case OP_Distinct:
-case OP_NotFound:
-case OP_Found: {
- int i = pOp->p1;
- int alreadyExists = 0;
- Cursor *pC;
- assert( pTos>=p->aStack );
- assert( i>=0 && i<p->nCursor );
- if( (pC = &p->aCsr[i])->pCursor!=0 ){
- int res, rx;
- Stringify(pTos);
- rx = sqliteBtreeMoveto(pC->pCursor, pTos->z, pTos->n, &res);
- alreadyExists = rx==SQLITE_OK && res==0;
- pC->deferredMoveto = 0;
- }
- if( pOp->opcode==OP_Found ){
- if( alreadyExists ) pc = pOp->p2 - 1;
- }else{
- if( !alreadyExists ) pc = pOp->p2 - 1;
- }
- if( pOp->opcode!=OP_Distinct ){
- Release(pTos);
- pTos--;
- }
- break;
-}
-
-/* Opcode: IsUnique P1 P2 *
-**
-** The top of the stack is an integer record number. Call this
-** record number R. The next on the stack is an index key created
-** using MakeIdxKey. Call it K. This instruction pops R from the
-** stack but it leaves K unchanged.
-**
-** P1 is an index. So all but the last four bytes of K are an
-** index string. The last four bytes of K are a record number.
-**
-** This instruction asks if there is an entry in P1 where the
-** index string matches K but the record number is different
-** from R. If there is no such entry, then there is an immediate
-** jump to P2. If any entry does exist where the index string
-** matches K but the record number is not R, then the record
-** number for that entry is pushed onto the stack and control
-** falls through to the next instruction.
-**
-** See also: Distinct, NotFound, NotExists, Found
-*/
-case OP_IsUnique: {
- int i = pOp->p1;
- Mem *pNos = &pTos[-1];
- BtCursor *pCrsr;
- int R;
-
- /* Pop the value R off the top of the stack
- */
- assert( pNos>=p->aStack );
- Integerify(pTos);
- R = pTos->i;
- pTos--;
- assert( i>=0 && i<=p->nCursor );
- if( (pCrsr = p->aCsr[i].pCursor)!=0 ){
- int res, rc;
- int v; /* The record number on the P1 entry that matches K */
- char *zKey; /* The value of K */
- int nKey; /* Number of bytes in K */
-
- /* Make sure K is a string and make zKey point to K
- */
- Stringify(pNos);
- zKey = pNos->z;
- nKey = pNos->n;
- assert( nKey >= 4 );
-
- /* Search for an entry in P1 where all but the last four bytes match K.
- ** If there is no such entry, jump immediately to P2.
- */
- assert( p->aCsr[i].deferredMoveto==0 );
- rc = sqliteBtreeMoveto(pCrsr, zKey, nKey-4, &res);
- if( rc!=SQLITE_OK ) goto abort_due_to_error;
- if( res<0 ){
- rc = sqliteBtreeNext(pCrsr, &res);
- if( res ){
- pc = pOp->p2 - 1;
- break;
- }
- }
- rc = sqliteBtreeKeyCompare(pCrsr, zKey, nKey-4, 4, &res);
- if( rc!=SQLITE_OK ) goto abort_due_to_error;
- if( res>0 ){
- pc = pOp->p2 - 1;
- break;
- }
-
- /* At this point, pCrsr is pointing to an entry in P1 where all but
- ** the last for bytes of the key match K. Check to see if the last
- ** four bytes of the key are different from R. If the last four
- ** bytes equal R then jump immediately to P2.
- */
- sqliteBtreeKey(pCrsr, nKey - 4, 4, (char*)&v);
- v = keyToInt(v);
- if( v==R ){
- pc = pOp->p2 - 1;
- break;
- }
-
- /* The last four bytes of the key are different from R. Convert the
- ** last four bytes of the key into an integer and push it onto the
- ** stack. (These bytes are the record number of an entry that
- ** violates a UNIQUE constraint.)
- */
- pTos++;
- pTos->i = v;
- pTos->flags = MEM_Int;
- }
- break;
-}
-
-/* Opcode: NotExists P1 P2 *
-**
-** Use the top of the stack as a integer key. If a record with that key
-** does not exist in table of P1, then jump to P2. If the record
-** does exist, then fall thru. The cursor is left pointing to the
-** record if it exists. The integer key is popped from the stack.
-**
-** The difference between this operation and NotFound is that this
-** operation assumes the key is an integer and NotFound assumes it
-** is a string.
-**
-** See also: Distinct, Found, MoveTo, NotFound, IsUnique
-*/
-case OP_NotExists: {
- int i = pOp->p1;
- BtCursor *pCrsr;
- assert( pTos>=p->aStack );
- assert( i>=0 && i<p->nCursor );
- if( (pCrsr = p->aCsr[i].pCursor)!=0 ){
- int res, rx, iKey;
- assert( pTos->flags & MEM_Int );
- iKey = intToKey(pTos->i);
- rx = sqliteBtreeMoveto(pCrsr, (char*)&iKey, sizeof(int), &res);
- p->aCsr[i].lastRecno = pTos->i;
- p->aCsr[i].recnoIsValid = res==0;
- p->aCsr[i].nullRow = 0;
- if( rx!=SQLITE_OK || res!=0 ){
- pc = pOp->p2 - 1;
- p->aCsr[i].recnoIsValid = 0;
- }
- }
- Release(pTos);
- pTos--;
- break;
-}
-
-/* Opcode: NewRecno P1 * *
-**
-** Get a new integer record number used as the key to a table.
-** The record number is not previously used as a key in the database
-** table that cursor P1 points to. The new record number is pushed
-** onto the stack.
-*/
-case OP_NewRecno: {
- int i = pOp->p1;
- int v = 0;
- Cursor *pC;
- assert( i>=0 && i<p->nCursor );
- if( (pC = &p->aCsr[i])->pCursor==0 ){
- v = 0;
- }else{
- /* The next rowid or record number (different terms for the same
- ** thing) is obtained in a two-step algorithm.
- **
- ** First we attempt to find the largest existing rowid and add one
- ** to that. But if the largest existing rowid is already the maximum
- ** positive integer, we have to fall through to the second
- ** probabilistic algorithm
- **
- ** The second algorithm is to select a rowid at random and see if
- ** it already exists in the table. If it does not exist, we have
- ** succeeded. If the random rowid does exist, we select a new one
- ** and try again, up to 1000 times.
- **
- ** For a table with less than 2 billion entries, the probability
- ** of not finding a unused rowid is about 1.0e-300. This is a
- ** non-zero probability, but it is still vanishingly small and should
- ** never cause a problem. You are much, much more likely to have a
- ** hardware failure than for this algorithm to fail.
- **
- ** The analysis in the previous paragraph assumes that you have a good
- ** source of random numbers. Is a library function like lrand48()
- ** good enough? Maybe. Maybe not. It's hard to know whether there
- ** might be subtle bugs is some implementations of lrand48() that
- ** could cause problems. To avoid uncertainty, SQLite uses its own
- ** random number generator based on the RC4 algorithm.
- **
- ** To promote locality of reference for repetitive inserts, the
- ** first few attempts at chosing a random rowid pick values just a little
- ** larger than the previous rowid. This has been shown experimentally
- ** to double the speed of the COPY operation.
- */
- int res, rx, cnt, x;
- cnt = 0;
- if( !pC->useRandomRowid ){
- if( pC->nextRowidValid ){
- v = pC->nextRowid;
- }else{
- rx = sqliteBtreeLast(pC->pCursor, &res);
- if( res ){
- v = 1;
- }else{
- sqliteBtreeKey(pC->pCursor, 0, sizeof(v), (void*)&v);
- v = keyToInt(v);
- if( v==0x7fffffff ){
- pC->useRandomRowid = 1;
- }else{
- v++;
- }
- }
- }
- if( v<0x7fffffff ){
- pC->nextRowidValid = 1;
- pC->nextRowid = v+1;
- }else{
- pC->nextRowidValid = 0;
- }
- }
- if( pC->useRandomRowid ){
- v = db->priorNewRowid;
- cnt = 0;
- do{
- if( v==0 || cnt>2 ){
- sqliteRandomness(sizeof(v), &v);
- if( cnt<5 ) v &= 0xffffff;
- }else{
- unsigned char r;
- sqliteRandomness(1, &r);
- v += r + 1;
- }
- if( v==0 ) continue;
- x = intToKey(v);
- rx = sqliteBtreeMoveto(pC->pCursor, &x, sizeof(int), &res);
- cnt++;
- }while( cnt<1000 && rx==SQLITE_OK && res==0 );
- db->priorNewRowid = v;
- if( rx==SQLITE_OK && res==0 ){
- rc = SQLITE_FULL;
- goto abort_due_to_error;
- }
- }
- pC->recnoIsValid = 0;
- pC->deferredMoveto = 0;
- }
- pTos++;
- pTos->i = v;
- pTos->flags = MEM_Int;
- break;
-}
-
-/* Opcode: PutIntKey P1 P2 *
-**
-** Write an entry into the table of cursor P1. A new entry is
-** created if it doesn't already exist or the data for an existing
-** entry is overwritten. The data is the value on the top of the
-** stack. The key is the next value down on the stack. The key must
-** be an integer. The stack is popped twice by this instruction.
-**
-** If the OPFLAG_NCHANGE flag of P2 is set, then the row change count is
-** incremented (otherwise not). If the OPFLAG_CSCHANGE flag is set,
-** then the current statement change count is incremented (otherwise not).
-** If the OPFLAG_LASTROWID flag of P2 is set, then rowid is
-** stored for subsequent return by the sqlite_last_insert_rowid() function
-** (otherwise it's unmodified).
-*/
-/* Opcode: PutStrKey P1 * *
-**
-** Write an entry into the table of cursor P1. A new entry is
-** created if it doesn't already exist or the data for an existing
-** entry is overwritten. The data is the value on the top of the
-** stack. The key is the next value down on the stack. The key must
-** be a string. The stack is popped twice by this instruction.
-**
-** P1 may not be a pseudo-table opened using the OpenPseudo opcode.
-*/
-case OP_PutIntKey:
-case OP_PutStrKey: {
- Mem *pNos = &pTos[-1];
- int i = pOp->p1;
- Cursor *pC;
- assert( pNos>=p->aStack );
- assert( i>=0 && i<p->nCursor );
- if( ((pC = &p->aCsr[i])->pCursor!=0 || pC->pseudoTable) ){
- char *zKey;
- int nKey, iKey;
- if( pOp->opcode==OP_PutStrKey ){
- Stringify(pNos);
- nKey = pNos->n;
- zKey = pNos->z;
- }else{
- assert( pNos->flags & MEM_Int );
- nKey = sizeof(int);
- iKey = intToKey(pNos->i);
- zKey = (char*)&iKey;
- if( pOp->p2 & OPFLAG_NCHANGE ) db->nChange++;
- if( pOp->p2 & OPFLAG_LASTROWID ) db->lastRowid = pNos->i;
- if( pOp->p2 & OPFLAG_CSCHANGE ) db->csChange++;
- if( pC->nextRowidValid && pTos->i>=pC->nextRowid ){
- pC->nextRowidValid = 0;
- }
- }
- if( pTos->flags & MEM_Null ){
- pTos->z = 0;
- pTos->n = 0;
- }else{
- assert( pTos->flags & MEM_Str );
- }
- if( pC->pseudoTable ){
- /* PutStrKey does not work for pseudo-tables.
- ** The following assert makes sure we are not trying to use
- ** PutStrKey on a pseudo-table
- */
- assert( pOp->opcode==OP_PutIntKey );
- sqliteFree(pC->pData);
- pC->iKey = iKey;
- pC->nData = pTos->n;
- if( pTos->flags & MEM_Dyn ){
- pC->pData = pTos->z;
- pTos->flags = MEM_Null;
- }else{
- pC->pData = sqliteMallocRaw( pC->nData );
- if( pC->pData ){
- memcpy(pC->pData, pTos->z, pC->nData);
- }
- }
- pC->nullRow = 0;
- }else{
- rc = sqliteBtreeInsert(pC->pCursor, zKey, nKey, pTos->z, pTos->n);
- }
- pC->recnoIsValid = 0;
- pC->deferredMoveto = 0;
- }
- popStack(&pTos, 2);
- break;
-}
-
-/* Opcode: Delete P1 P2 *
-**
-** Delete the record at which the P1 cursor is currently pointing.
-**
-** The cursor will be left pointing at either the next or the previous
-** record in the table. If it is left pointing at the next record, then
-** the next Next instruction will be a no-op. Hence it is OK to delete
-** a record from within an Next loop.
-**
-** If the OPFLAG_NCHANGE flag of P2 is set, then the row change count is
-** incremented (otherwise not). If OPFLAG_CSCHANGE flag is set,
-** then the current statement change count is incremented (otherwise not).
-**
-** If P1 is a pseudo-table, then this instruction is a no-op.
-*/
-case OP_Delete: {
- int i = pOp->p1;
- Cursor *pC;
- assert( i>=0 && i<p->nCursor );
- pC = &p->aCsr[i];
- if( pC->pCursor!=0 ){
- sqliteVdbeCursorMoveto(pC);
- rc = sqliteBtreeDelete(pC->pCursor);
- pC->nextRowidValid = 0;
- }
- if( pOp->p2 & OPFLAG_NCHANGE ) db->nChange++;
- if( pOp->p2 & OPFLAG_CSCHANGE ) db->csChange++;
- break;
-}
-
-/* Opcode: SetCounts * * *
-**
-** Called at end of statement. Updates lsChange (last statement change count)
-** and resets csChange (current statement change count) to 0.
-*/
-case OP_SetCounts: {
- db->lsChange=db->csChange;
- db->csChange=0;
- break;
-}
-
-/* Opcode: KeyAsData P1 P2 *
-**
-** Turn the key-as-data mode for cursor P1 either on (if P2==1) or
-** off (if P2==0). In key-as-data mode, the OP_Column opcode pulls
-** data off of the key rather than the data. This is used for
-** processing compound selects.
-*/
-case OP_KeyAsData: {
- int i = pOp->p1;
- assert( i>=0 && i<p->nCursor );
- p->aCsr[i].keyAsData = pOp->p2;
- break;
-}
-
-/* Opcode: RowData P1 * *
-**
-** Push onto the stack the complete row data for cursor P1.
-** There is no interpretation of the data. It is just copied
-** onto the stack exactly as it is found in the database file.
-**
-** If the cursor is not pointing to a valid row, a NULL is pushed
-** onto the stack.
-*/
-/* Opcode: RowKey P1 * *
-**
-** Push onto the stack the complete row key for cursor P1.
-** There is no interpretation of the key. It is just copied
-** onto the stack exactly as it is found in the database file.
-**
-** If the cursor is not pointing to a valid row, a NULL is pushed
-** onto the stack.
-*/
-case OP_RowKey:
-case OP_RowData: {
- int i = pOp->p1;
- Cursor *pC;
- int n;
-
- pTos++;
- assert( i>=0 && i<p->nCursor );
- pC = &p->aCsr[i];
- if( pC->nullRow ){
- pTos->flags = MEM_Null;
- }else if( pC->pCursor!=0 ){
- BtCursor *pCrsr = pC->pCursor;
- sqliteVdbeCursorMoveto(pC);
- if( pC->nullRow ){
- pTos->flags = MEM_Null;
- break;
- }else if( pC->keyAsData || pOp->opcode==OP_RowKey ){
- sqliteBtreeKeySize(pCrsr, &n);
- }else{
- sqliteBtreeDataSize(pCrsr, &n);
- }
- pTos->n = n;
- if( n<=NBFS ){
- pTos->flags = MEM_Str | MEM_Short;
- pTos->z = pTos->zShort;
- }else{
- char *z = sqliteMallocRaw( n );
- if( z==0 ) goto no_mem;
- pTos->flags = MEM_Str | MEM_Dyn;
- pTos->z = z;
- }
- if( pC->keyAsData || pOp->opcode==OP_RowKey ){
- sqliteBtreeKey(pCrsr, 0, n, pTos->z);
- }else{
- sqliteBtreeData(pCrsr, 0, n, pTos->z);
- }
- }else if( pC->pseudoTable ){
- pTos->n = pC->nData;
- pTos->z = pC->pData;
- pTos->flags = MEM_Str|MEM_Ephem;
- }else{
- pTos->flags = MEM_Null;
- }
- break;
-}
-
-/* Opcode: Column P1 P2 *
-**
-** Interpret the data that cursor P1 points to as
-** a structure built using the MakeRecord instruction.
-** (See the MakeRecord opcode for additional information about
-** the format of the data.)
-** Push onto the stack the value of the P2-th column contained
-** in the data.
-**
-** If the KeyAsData opcode has previously executed on this cursor,
-** then the field might be extracted from the key rather than the
-** data.
-**
-** If P1 is negative, then the record is stored on the stack rather
-** than in a table. For P1==-1, the top of the stack is used.
-** For P1==-2, the next on the stack is used. And so forth. The
-** value pushed is always just a pointer into the record which is
-** stored further down on the stack. The column value is not copied.
-*/
-case OP_Column: {
- int amt, offset, end, payloadSize;
- int i = pOp->p1;
- int p2 = pOp->p2;
- Cursor *pC;
- char *zRec;
- BtCursor *pCrsr;
- int idxWidth;
- unsigned char aHdr[10];
-
- assert( i<p->nCursor );
- pTos++;
- if( i<0 ){
- assert( &pTos[i]>=p->aStack );
- assert( pTos[i].flags & MEM_Str );
- zRec = pTos[i].z;
- payloadSize = pTos[i].n;
- }else if( (pC = &p->aCsr[i])->pCursor!=0 ){
- sqliteVdbeCursorMoveto(pC);
- zRec = 0;
- pCrsr = pC->pCursor;
- if( pC->nullRow ){
- payloadSize = 0;
- }else if( pC->keyAsData ){
- sqliteBtreeKeySize(pCrsr, &payloadSize);
- }else{
- sqliteBtreeDataSize(pCrsr, &payloadSize);
- }
- }else if( pC->pseudoTable ){
- payloadSize = pC->nData;
- zRec = pC->pData;
- assert( payloadSize==0 || zRec!=0 );
- }else{
- payloadSize = 0;
- }
-
- /* Figure out how many bytes in the column data and where the column
- ** data begins.
- */
- if( payloadSize==0 ){
- pTos->flags = MEM_Null;
- break;
- }else if( payloadSize<256 ){
- idxWidth = 1;
- }else if( payloadSize<65536 ){
- idxWidth = 2;
- }else{
- idxWidth = 3;
- }
-
- /* Figure out where the requested column is stored and how big it is.
- */
- if( payloadSize < idxWidth*(p2+1) ){
- rc = SQLITE_CORRUPT;
- goto abort_due_to_error;
- }
- if( zRec ){
- memcpy(aHdr, &zRec[idxWidth*p2], idxWidth*2);
- }else if( pC->keyAsData ){
- sqliteBtreeKey(pCrsr, idxWidth*p2, idxWidth*2, (char*)aHdr);
- }else{
- sqliteBtreeData(pCrsr, idxWidth*p2, idxWidth*2, (char*)aHdr);
- }
- offset = aHdr[0];
- end = aHdr[idxWidth];
- if( idxWidth>1 ){
- offset |= aHdr[1]<<8;
- end |= aHdr[idxWidth+1]<<8;
- if( idxWidth>2 ){
- offset |= aHdr[2]<<16;
- end |= aHdr[idxWidth+2]<<16;
- }
- }
- amt = end - offset;
- if( amt<0 || offset<0 || end>payloadSize ){
- rc = SQLITE_CORRUPT;
- goto abort_due_to_error;
- }
-
- /* amt and offset now hold the offset to the start of data and the
- ** amount of data. Go get the data and put it on the stack.
- */
- pTos->n = amt;
- if( amt==0 ){
- pTos->flags = MEM_Null;
- }else if( zRec ){
- pTos->flags = MEM_Str | MEM_Ephem;
- pTos->z = &zRec[offset];
- }else{
- if( amt<=NBFS ){
- pTos->flags = MEM_Str | MEM_Short;
- pTos->z = pTos->zShort;
- }else{
- char *z = sqliteMallocRaw( amt );
- if( z==0 ) goto no_mem;
- pTos->flags = MEM_Str | MEM_Dyn;
- pTos->z = z;
- }
- if( pC->keyAsData ){
- sqliteBtreeKey(pCrsr, offset, amt, pTos->z);
- }else{
- sqliteBtreeData(pCrsr, offset, amt, pTos->z);
- }
- }
- break;
-}
-
-/* Opcode: Recno P1 * *
-**
-** Push onto the stack an integer which is the first 4 bytes of the
-** the key to the current entry in a sequential scan of the database
-** file P1. The sequential scan should have been started using the
-** Next opcode.
-*/
-case OP_Recno: {
- int i = pOp->p1;
- Cursor *pC;
- int v;
-
- assert( i>=0 && i<p->nCursor );
- pC = &p->aCsr[i];
- sqliteVdbeCursorMoveto(pC);
- pTos++;
- if( pC->recnoIsValid ){
- v = pC->lastRecno;
- }else if( pC->pseudoTable ){
- v = keyToInt(pC->iKey);
- }else if( pC->nullRow || pC->pCursor==0 ){
- pTos->flags = MEM_Null;
- break;
- }else{
- assert( pC->pCursor!=0 );
- sqliteBtreeKey(pC->pCursor, 0, sizeof(u32), (char*)&v);
- v = keyToInt(v);
- }
- pTos->i = v;
- pTos->flags = MEM_Int;
- break;
-}
-
-/* Opcode: FullKey P1 * *
-**
-** Extract the complete key from the record that cursor P1 is currently
-** pointing to and push the key onto the stack as a string.
-**
-** Compare this opcode to Recno. The Recno opcode extracts the first
-** 4 bytes of the key and pushes those bytes onto the stack as an
-** integer. This instruction pushes the entire key as a string.
-**
-** This opcode may not be used on a pseudo-table.
-*/
-case OP_FullKey: {
- int i = pOp->p1;
- BtCursor *pCrsr;
-
- assert( p->aCsr[i].keyAsData );
- assert( !p->aCsr[i].pseudoTable );
- assert( i>=0 && i<p->nCursor );
- pTos++;
- if( (pCrsr = p->aCsr[i].pCursor)!=0 ){
- int amt;
- char *z;
-
- sqliteVdbeCursorMoveto(&p->aCsr[i]);
- sqliteBtreeKeySize(pCrsr, &amt);
- if( amt<=0 ){
- rc = SQLITE_CORRUPT;
- goto abort_due_to_error;
- }
- if( amt>NBFS ){
- z = sqliteMallocRaw( amt );
- if( z==0 ) goto no_mem;
- pTos->flags = MEM_Str | MEM_Dyn;
- }else{
- z = pTos->zShort;
- pTos->flags = MEM_Str | MEM_Short;
- }
- sqliteBtreeKey(pCrsr, 0, amt, z);
- pTos->z = z;
- pTos->n = amt;
- }
- break;
-}
-
-/* Opcode: NullRow P1 * *
-**
-** Move the cursor P1 to a null row. Any OP_Column operations
-** that occur while the cursor is on the null row will always push
-** a NULL onto the stack.
-*/
-case OP_NullRow: {
- int i = pOp->p1;
-
- assert( i>=0 && i<p->nCursor );
- p->aCsr[i].nullRow = 1;
- p->aCsr[i].recnoIsValid = 0;
- break;
-}
-
-/* Opcode: Last P1 P2 *
-**
-** The next use of the Recno or Column or Next instruction for P1
-** will refer to the last entry in the database table or index.
-** If the table or index is empty and P2>0, then jump immediately to P2.
-** If P2 is 0 or if the table or index is not empty, fall through
-** to the following instruction.
-*/
-case OP_Last: {
- int i = pOp->p1;
- Cursor *pC;
- BtCursor *pCrsr;
-
- assert( i>=0 && i<p->nCursor );
- pC = &p->aCsr[i];
- if( (pCrsr = pC->pCursor)!=0 ){
- int res;
- rc = sqliteBtreeLast(pCrsr, &res);
- pC->nullRow = res;
- pC->deferredMoveto = 0;
- if( res && pOp->p2>0 ){
- pc = pOp->p2 - 1;
- }
- }else{
- pC->nullRow = 0;
- }
- break;
-}
-
-/* Opcode: Rewind P1 P2 *
-**
-** The next use of the Recno or Column or Next instruction for P1
-** will refer to the first entry in the database table or index.
-** If the table or index is empty and P2>0, then jump immediately to P2.
-** If P2 is 0 or if the table or index is not empty, fall through
-** to the following instruction.
-*/
-case OP_Rewind: {
- int i = pOp->p1;
- Cursor *pC;
- BtCursor *pCrsr;
-
- assert( i>=0 && i<p->nCursor );
- pC = &p->aCsr[i];
- if( (pCrsr = pC->pCursor)!=0 ){
- int res;
- rc = sqliteBtreeFirst(pCrsr, &res);
- pC->atFirst = res==0;
- pC->nullRow = res;
- pC->deferredMoveto = 0;
- if( res && pOp->p2>0 ){
- pc = pOp->p2 - 1;
- }
- }else{
- pC->nullRow = 0;
- }
- break;
-}
-
-/* Opcode: Next P1 P2 *
-**
-** Advance cursor P1 so that it points to the next key/data pair in its
-** table or index. If there are no more key/value pairs then fall through
-** to the following instruction. But if the cursor advance was successful,
-** jump immediately to P2.
-**
-** See also: Prev
-*/
-/* Opcode: Prev P1 P2 *
-**
-** Back up cursor P1 so that it points to the previous key/data pair in its
-** table or index. If there is no previous key/value pairs then fall through
-** to the following instruction. But if the cursor backup was successful,
-** jump immediately to P2.
-*/
-case OP_Prev:
-case OP_Next: {
- Cursor *pC;
- BtCursor *pCrsr;
-
- CHECK_FOR_INTERRUPT;
- assert( pOp->p1>=0 && pOp->p1<p->nCursor );
- pC = &p->aCsr[pOp->p1];
- if( (pCrsr = pC->pCursor)!=0 ){
- int res;
- if( pC->nullRow ){
- res = 1;
- }else{
- assert( pC->deferredMoveto==0 );
- rc = pOp->opcode==OP_Next ? sqliteBtreeNext(pCrsr, &res) :
- sqliteBtreePrevious(pCrsr, &res);
- pC->nullRow = res;
- }
- if( res==0 ){
- pc = pOp->p2 - 1;
- sqlite_search_count++;
- }
- }else{
- pC->nullRow = 1;
- }
- pC->recnoIsValid = 0;
- break;
-}
-
-/* Opcode: IdxPut P1 P2 P3
-**
-** The top of the stack holds a SQL index key made using the
-** MakeIdxKey instruction. This opcode writes that key into the
-** index P1. Data for the entry is nil.
-**
-** If P2==1, then the key must be unique. If the key is not unique,
-** the program aborts with a SQLITE_CONSTRAINT error and the database
-** is rolled back. If P3 is not null, then it becomes part of the
-** error message returned with the SQLITE_CONSTRAINT.
-*/
-case OP_IdxPut: {
- int i = pOp->p1;
- BtCursor *pCrsr;
- assert( pTos>=p->aStack );
- assert( i>=0 && i<p->nCursor );
- assert( pTos->flags & MEM_Str );
- if( (pCrsr = p->aCsr[i].pCursor)!=0 ){
- int nKey = pTos->n;
- const char *zKey = pTos->z;
- if( pOp->p2 ){
- int res, n;
- assert( nKey >= 4 );
- rc = sqliteBtreeMoveto(pCrsr, zKey, nKey-4, &res);
- if( rc!=SQLITE_OK ) goto abort_due_to_error;
- while( res!=0 ){
- int c;
- sqliteBtreeKeySize(pCrsr, &n);
- if( n==nKey
- && sqliteBtreeKeyCompare(pCrsr, zKey, nKey-4, 4, &c)==SQLITE_OK
- && c==0
- ){
- rc = SQLITE_CONSTRAINT;
- if( pOp->p3 && pOp->p3[0] ){
- sqliteSetString(&p->zErrMsg, pOp->p3, (char*)0);
- }
- goto abort_due_to_error;
- }
- if( res<0 ){
- sqliteBtreeNext(pCrsr, &res);
- res = +1;
- }else{
- break;
- }
- }
- }
- rc = sqliteBtreeInsert(pCrsr, zKey, nKey, "", 0);
- assert( p->aCsr[i].deferredMoveto==0 );
- }
- Release(pTos);
- pTos--;
- break;
-}
-
-/* Opcode: IdxDelete P1 * *
-**
-** The top of the stack is an index key built using the MakeIdxKey opcode.
-** This opcode removes that entry from the index.
-*/
-case OP_IdxDelete: {
- int i = pOp->p1;
- BtCursor *pCrsr;
- assert( pTos>=p->aStack );
- assert( pTos->flags & MEM_Str );
- assert( i>=0 && i<p->nCursor );
- if( (pCrsr = p->aCsr[i].pCursor)!=0 ){
- int rx, res;
- rx = sqliteBtreeMoveto(pCrsr, pTos->z, pTos->n, &res);
- if( rx==SQLITE_OK && res==0 ){
- rc = sqliteBtreeDelete(pCrsr);
- }
- assert( p->aCsr[i].deferredMoveto==0 );
- }
- Release(pTos);
- pTos--;
- break;
-}
-
-/* Opcode: IdxRecno P1 * *
-**
-** Push onto the stack an integer which is the last 4 bytes of the
-** the key to the current entry in index P1. These 4 bytes should
-** be the record number of the table entry to which this index entry
-** points.
-**
-** See also: Recno, MakeIdxKey.
-*/
-case OP_IdxRecno: {
- int i = pOp->p1;
- BtCursor *pCrsr;
-
- assert( i>=0 && i<p->nCursor );
- pTos++;
- if( (pCrsr = p->aCsr[i].pCursor)!=0 ){
- int v;
- int sz;
- assert( p->aCsr[i].deferredMoveto==0 );
- sqliteBtreeKeySize(pCrsr, &sz);
- if( sz<sizeof(u32) ){
- pTos->flags = MEM_Null;
- }else{
- sqliteBtreeKey(pCrsr, sz - sizeof(u32), sizeof(u32), (char*)&v);
- v = keyToInt(v);
- pTos->i = v;
- pTos->flags = MEM_Int;
- }
- }else{
- pTos->flags = MEM_Null;
- }
- break;
-}
-
-/* Opcode: IdxGT P1 P2 *
-**
-** Compare the top of the stack against the key on the index entry that
-** cursor P1 is currently pointing to. Ignore the last 4 bytes of the
-** index entry. If the index entry is greater than the top of the stack
-** then jump to P2. Otherwise fall through to the next instruction.
-** In either case, the stack is popped once.
-*/
-/* Opcode: IdxGE P1 P2 *
-**
-** Compare the top of the stack against the key on the index entry that
-** cursor P1 is currently pointing to. Ignore the last 4 bytes of the
-** index entry. If the index entry is greater than or equal to
-** the top of the stack
-** then jump to P2. Otherwise fall through to the next instruction.
-** In either case, the stack is popped once.
-*/
-/* Opcode: IdxLT P1 P2 *
-**
-** Compare the top of the stack against the key on the index entry that
-** cursor P1 is currently pointing to. Ignore the last 4 bytes of the
-** index entry. If the index entry is less than the top of the stack
-** then jump to P2. Otherwise fall through to the next instruction.
-** In either case, the stack is popped once.
-*/
-case OP_IdxLT:
-case OP_IdxGT:
-case OP_IdxGE: {
- int i= pOp->p1;
- BtCursor *pCrsr;
-
- assert( i>=0 && i<p->nCursor );
- assert( pTos>=p->aStack );
- if( (pCrsr = p->aCsr[i].pCursor)!=0 ){
- int res, rc;
-
- Stringify(pTos);
- assert( p->aCsr[i].deferredMoveto==0 );
- rc = sqliteBtreeKeyCompare(pCrsr, pTos->z, pTos->n, 4, &res);
- if( rc!=SQLITE_OK ){
- break;
- }
- if( pOp->opcode==OP_IdxLT ){
- res = -res;
- }else if( pOp->opcode==OP_IdxGE ){
- res++;
- }
- if( res>0 ){
- pc = pOp->p2 - 1 ;
- }
- }
- Release(pTos);
- pTos--;
- break;
-}
-
-/* Opcode: IdxIsNull P1 P2 *
-**
-** The top of the stack contains an index entry such as might be generated
-** by the MakeIdxKey opcode. This routine looks at the first P1 fields of
-** that key. If any of the first P1 fields are NULL, then a jump is made
-** to address P2. Otherwise we fall straight through.
-**
-** The index entry is always popped from the stack.
-*/
-case OP_IdxIsNull: {
- int i = pOp->p1;
- int k, n;
- const char *z;
-
- assert( pTos>=p->aStack );
- assert( pTos->flags & MEM_Str );
- z = pTos->z;
- n = pTos->n;
- for(k=0; k<n && i>0; i--){
- if( z[k]=='a' ){
- pc = pOp->p2-1;
- break;
- }
- while( k<n && z[k] ){ k++; }
- k++;
- }
- Release(pTos);
- pTos--;
- break;
-}
-
-/* Opcode: Destroy P1 P2 *
-**
-** Delete an entire database table or index whose root page in the database
-** file is given by P1.
-**
-** The table being destroyed is in the main database file if P2==0. If
-** P2==1 then the table to be clear is in the auxiliary database file
-** that is used to store tables create using CREATE TEMPORARY TABLE.
-**
-** See also: Clear
-*/
-case OP_Destroy: {
- rc = sqliteBtreeDropTable(db->aDb[pOp->p2].pBt, pOp->p1);
- break;
-}
-
-/* Opcode: Clear P1 P2 *
-**
-** Delete all contents of the database table or index whose root page
-** in the database file is given by P1. But, unlike Destroy, do not
-** remove the table or index from the database file.
-**
-** The table being clear is in the main database file if P2==0. If
-** P2==1 then the table to be clear is in the auxiliary database file
-** that is used to store tables create using CREATE TEMPORARY TABLE.
-**
-** See also: Destroy
-*/
-case OP_Clear: {
- rc = sqliteBtreeClearTable(db->aDb[pOp->p2].pBt, pOp->p1);
- break;
-}
-
-/* Opcode: CreateTable * P2 P3
-**
-** Allocate a new table in the main database file if P2==0 or in the
-** auxiliary database file if P2==1. Push the page number
-** for the root page of the new table onto the stack.
-**
-** The root page number is also written to a memory location that P3
-** points to. This is the mechanism is used to write the root page
-** number into the parser's internal data structures that describe the
-** new table.
-**
-** The difference between a table and an index is this: A table must
-** have a 4-byte integer key and can have arbitrary data. An index
-** has an arbitrary key but no data.
-**
-** See also: CreateIndex
-*/
-/* Opcode: CreateIndex * P2 P3
-**
-** Allocate a new index in the main database file if P2==0 or in the
-** auxiliary database file if P2==1. Push the page number of the
-** root page of the new index onto the stack.
-**
-** See documentation on OP_CreateTable for additional information.
-*/
-case OP_CreateIndex:
-case OP_CreateTable: {
- int pgno;
- assert( pOp->p3!=0 && pOp->p3type==P3_POINTER );
- assert( pOp->p2>=0 && pOp->p2<db->nDb );
- assert( db->aDb[pOp->p2].pBt!=0 );
- if( pOp->opcode==OP_CreateTable ){
- rc = sqliteBtreeCreateTable(db->aDb[pOp->p2].pBt, &pgno);
- }else{
- rc = sqliteBtreeCreateIndex(db->aDb[pOp->p2].pBt, &pgno);
- }
- pTos++;
- if( rc==SQLITE_OK ){
- pTos->i = pgno;
- pTos->flags = MEM_Int;
- *(u32*)pOp->p3 = pgno;
- pOp->p3 = 0;
- }else{
- pTos->flags = MEM_Null;
- }
- break;
-}
-
-/* Opcode: IntegrityCk P1 P2 *
-**
-** Do an analysis of the currently open database. Push onto the
-** stack the text of an error message describing any problems.
-** If there are no errors, push a "ok" onto the stack.
-**
-** P1 is the index of a set that contains the root page numbers
-** for all tables and indices in the main database file. The set
-** is cleared by this opcode. In other words, after this opcode
-** has executed, the set will be empty.
-**
-** If P2 is not zero, the check is done on the auxiliary database
-** file, not the main database file.
-**
-** This opcode is used for testing purposes only.
-*/
-case OP_IntegrityCk: {
- int nRoot;
- int *aRoot;
- int iSet = pOp->p1;
- Set *pSet;
- int j;
- HashElem *i;
- char *z;
-
- assert( iSet>=0 && iSet<p->nSet );
- pTos++;
- pSet = &p->aSet[iSet];
- nRoot = sqliteHashCount(&pSet->hash);
- aRoot = sqliteMallocRaw( sizeof(int)*(nRoot+1) );
- if( aRoot==0 ) goto no_mem;
- for(j=0, i=sqliteHashFirst(&pSet->hash); i; i=sqliteHashNext(i), j++){
- toInt((char*)sqliteHashKey(i), &aRoot[j]);
- }
- aRoot[j] = 0;
- sqliteHashClear(&pSet->hash);
- pSet->prev = 0;
- z = sqliteBtreeIntegrityCheck(db->aDb[pOp->p2].pBt, aRoot, nRoot);
- if( z==0 || z[0]==0 ){
- if( z ) sqliteFree(z);
- pTos->z = "ok";
- pTos->n = 3;
- pTos->flags = MEM_Str | MEM_Static;
- }else{
- pTos->z = z;
- pTos->n = strlen(z) + 1;
- pTos->flags = MEM_Str | MEM_Dyn;
- }
- sqliteFree(aRoot);
- break;
-}
-
-/* Opcode: ListWrite * * *
-**
-** Write the integer on the top of the stack
-** into the temporary storage list.
-*/
-case OP_ListWrite: {
- Keylist *pKeylist;
- assert( pTos>=p->aStack );
- pKeylist = p->pList;
- if( pKeylist==0 || pKeylist->nUsed>=pKeylist->nKey ){
- pKeylist = sqliteMallocRaw( sizeof(Keylist)+999*sizeof(pKeylist->aKey[0]) );
- if( pKeylist==0 ) goto no_mem;
- pKeylist->nKey = 1000;
- pKeylist->nRead = 0;
- pKeylist->nUsed = 0;
- pKeylist->pNext = p->pList;
- p->pList = pKeylist;
- }
- Integerify(pTos);
- pKeylist->aKey[pKeylist->nUsed++] = pTos->i;
- Release(pTos);
- pTos--;
- break;
-}
-
-/* Opcode: ListRewind * * *
-**
-** Rewind the temporary buffer back to the beginning.
-*/
-case OP_ListRewind: {
- /* What this opcode codes, really, is reverse the order of the
- ** linked list of Keylist structures so that they are read out
- ** in the same order that they were read in. */
- Keylist *pRev, *pTop;
- pRev = 0;
- while( p->pList ){
- pTop = p->pList;
- p->pList = pTop->pNext;
- pTop->pNext = pRev;
- pRev = pTop;
- }
- p->pList = pRev;
- break;
-}
-
-/* Opcode: ListRead * P2 *
-**
-** Attempt to read an integer from the temporary storage buffer
-** and push it onto the stack. If the storage buffer is empty,
-** push nothing but instead jump to P2.
-*/
-case OP_ListRead: {
- Keylist *pKeylist;
- CHECK_FOR_INTERRUPT;
- pKeylist = p->pList;
- if( pKeylist!=0 ){
- assert( pKeylist->nRead>=0 );
- assert( pKeylist->nRead<pKeylist->nUsed );
- assert( pKeylist->nRead<pKeylist->nKey );
- pTos++;
- pTos->i = pKeylist->aKey[pKeylist->nRead++];
- pTos->flags = MEM_Int;
- if( pKeylist->nRead>=pKeylist->nUsed ){
- p->pList = pKeylist->pNext;
- sqliteFree(pKeylist);
- }
- }else{
- pc = pOp->p2 - 1;
- }
- break;
-}
-
-/* Opcode: ListReset * * *
-**
-** Reset the temporary storage buffer so that it holds nothing.
-*/
-case OP_ListReset: {
- if( p->pList ){
- sqliteVdbeKeylistFree(p->pList);
- p->pList = 0;
- }
- break;
-}
-
-/* Opcode: ListPush * * *
-**
-** Save the current Vdbe list such that it can be restored by a ListPop
-** opcode. The list is empty after this is executed.
-*/
-case OP_ListPush: {
- p->keylistStackDepth++;
- assert(p->keylistStackDepth > 0);
- p->keylistStack = sqliteRealloc(p->keylistStack,
- sizeof(Keylist *) * p->keylistStackDepth);
- if( p->keylistStack==0 ) goto no_mem;
- p->keylistStack[p->keylistStackDepth - 1] = p->pList;
- p->pList = 0;
- break;
-}
-
-/* Opcode: ListPop * * *
-**
-** Restore the Vdbe list to the state it was in when ListPush was last
-** executed.
-*/
-case OP_ListPop: {
- assert(p->keylistStackDepth > 0);
- p->keylistStackDepth--;
- sqliteVdbeKeylistFree(p->pList);
- p->pList = p->keylistStack[p->keylistStackDepth];
- p->keylistStack[p->keylistStackDepth] = 0;
- if( p->keylistStackDepth == 0 ){
- sqliteFree(p->keylistStack);
- p->keylistStack = 0;
- }
- break;
-}
-
-/* Opcode: ContextPush * * *
-**
-** Save the current Vdbe context such that it can be restored by a ContextPop
-** opcode. The context stores the last insert row id, the last statement change
-** count, and the current statement change count.
-*/
-case OP_ContextPush: {
- p->contextStackDepth++;
- assert(p->contextStackDepth > 0);
- p->contextStack = sqliteRealloc(p->contextStack,
- sizeof(Context) * p->contextStackDepth);
- if( p->contextStack==0 ) goto no_mem;
- p->contextStack[p->contextStackDepth - 1].lastRowid = p->db->lastRowid;
- p->contextStack[p->contextStackDepth - 1].lsChange = p->db->lsChange;
- p->contextStack[p->contextStackDepth - 1].csChange = p->db->csChange;
- break;
-}
-
-/* Opcode: ContextPop * * *
-**
-** Restore the Vdbe context to the state it was in when contextPush was last
-** executed. The context stores the last insert row id, the last statement
-** change count, and the current statement change count.
-*/
-case OP_ContextPop: {
- assert(p->contextStackDepth > 0);
- p->contextStackDepth--;
- p->db->lastRowid = p->contextStack[p->contextStackDepth].lastRowid;
- p->db->lsChange = p->contextStack[p->contextStackDepth].lsChange;
- p->db->csChange = p->contextStack[p->contextStackDepth].csChange;
- if( p->contextStackDepth == 0 ){
- sqliteFree(p->contextStack);
- p->contextStack = 0;
- }
- break;
-}
-
-/* Opcode: SortPut * * *
-**
-** The TOS is the key and the NOS is the data. Pop both from the stack
-** and put them on the sorter. The key and data should have been
-** made using SortMakeKey and SortMakeRec, respectively.
-*/
-case OP_SortPut: {
- Mem *pNos = &pTos[-1];
- Sorter *pSorter;
- assert( pNos>=p->aStack );
- if( Dynamicify(pTos) || Dynamicify(pNos) ) goto no_mem;
- pSorter = sqliteMallocRaw( sizeof(Sorter) );
- if( pSorter==0 ) goto no_mem;
- pSorter->pNext = p->pSort;
- p->pSort = pSorter;
- assert( pTos->flags & MEM_Dyn );
- pSorter->nKey = pTos->n;
- pSorter->zKey = pTos->z;
- assert( pNos->flags & MEM_Dyn );
- pSorter->nData = pNos->n;
- pSorter->pData = pNos->z;
- pTos -= 2;
- break;
-}
-
-/* Opcode: SortMakeRec P1 * *
-**
-** The top P1 elements are the arguments to a callback. Form these
-** elements into a single data entry that can be stored on a sorter
-** using SortPut and later fed to a callback using SortCallback.
-*/
-case OP_SortMakeRec: {
- char *z;
- char **azArg;
- int nByte;
- int nField;
- int i;
- Mem *pRec;
-
- nField = pOp->p1;
- pRec = &pTos[1-nField];
- assert( pRec>=p->aStack );
- nByte = 0;
- for(i=0; i<nField; i++, pRec++){
- if( (pRec->flags & MEM_Null)==0 ){
- Stringify(pRec);
- nByte += pRec->n;
- }
- }
- nByte += sizeof(char*)*(nField+1);
- azArg = sqliteMallocRaw( nByte );
- if( azArg==0 ) goto no_mem;
- z = (char*)&azArg[nField+1];
- for(pRec=&pTos[1-nField], i=0; i<nField; i++, pRec++){
- if( pRec->flags & MEM_Null ){
- azArg[i] = 0;
- }else{
- azArg[i] = z;
- memcpy(z, pRec->z, pRec->n);
- z += pRec->n;
- }
- }
- popStack(&pTos, nField);
- pTos++;
- pTos->n = nByte;
- pTos->z = (char*)azArg;
- pTos->flags = MEM_Str | MEM_Dyn;
- break;
-}
-
-/* Opcode: SortMakeKey * * P3
-**
-** Convert the top few entries of the stack into a sort key. The
-** number of stack entries consumed is the number of characters in
-** the string P3. One character from P3 is prepended to each entry.
-** The first character of P3 is prepended to the element lowest in
-** the stack and the last character of P3 is prepended to the top of
-** the stack. All stack entries are separated by a \000 character
-** in the result. The whole key is terminated by two \000 characters
-** in a row.
-**
-** "N" is substituted in place of the P3 character for NULL values.
-**
-** See also the MakeKey and MakeIdxKey opcodes.
-*/
-case OP_SortMakeKey: {
- char *zNewKey;
- int nByte;
- int nField;
- int i, j, k;
- Mem *pRec;
-
- nField = strlen(pOp->p3);
- pRec = &pTos[1-nField];
- nByte = 1;
- for(i=0; i<nField; i++, pRec++){
- if( pRec->flags & MEM_Null ){
- nByte += 2;
- }else{
- Stringify(pRec);
- nByte += pRec->n+2;
- }
- }
- zNewKey = sqliteMallocRaw( nByte );
- if( zNewKey==0 ) goto no_mem;
- j = 0;
- k = 0;
- for(pRec=&pTos[1-nField], i=0; i<nField; i++, pRec++){
- if( pRec->flags & MEM_Null ){
- zNewKey[j++] = 'N';
- zNewKey[j++] = 0;
- k++;
- }else{
- zNewKey[j++] = pOp->p3[k++];
- memcpy(&zNewKey[j], pRec->z, pRec->n-1);
- j += pRec->n-1;
- zNewKey[j++] = 0;
- }
- }
- zNewKey[j] = 0;
- assert( j<nByte );
- popStack(&pTos, nField);
- pTos++;
- pTos->n = nByte;
- pTos->flags = MEM_Str|MEM_Dyn;
- pTos->z = zNewKey;
- break;
-}
-
-/* Opcode: Sort * * *
-**
-** Sort all elements on the sorter. The algorithm is a
-** mergesort.
-*/
-case OP_Sort: {
- int i;
- Sorter *pElem;
- Sorter *apSorter[NSORT];
- for(i=0; i<NSORT; i++){
- apSorter[i] = 0;
- }
- while( p->pSort ){
- pElem = p->pSort;
- p->pSort = pElem->pNext;
- pElem->pNext = 0;
- for(i=0; i<NSORT-1; i++){
- if( apSorter[i]==0 ){
- apSorter[i] = pElem;
- break;
- }else{
- pElem = Merge(apSorter[i], pElem);
- apSorter[i] = 0;
- }
- }
- if( i>=NSORT-1 ){
- apSorter[NSORT-1] = Merge(apSorter[NSORT-1],pElem);
- }
- }
- pElem = 0;
- for(i=0; i<NSORT; i++){
- pElem = Merge(apSorter[i], pElem);
- }
- p->pSort = pElem;
- break;
-}
-
-/* Opcode: SortNext * P2 *
-**
-** Push the data for the topmost element in the sorter onto the
-** stack, then remove the element from the sorter. If the sorter
-** is empty, push nothing on the stack and instead jump immediately
-** to instruction P2.
-*/
-case OP_SortNext: {
- Sorter *pSorter = p->pSort;
- CHECK_FOR_INTERRUPT;
- if( pSorter!=0 ){
- p->pSort = pSorter->pNext;
- pTos++;
- pTos->z = pSorter->pData;
- pTos->n = pSorter->nData;
- pTos->flags = MEM_Str|MEM_Dyn;
- sqliteFree(pSorter->zKey);
- sqliteFree(pSorter);
- }else{
- pc = pOp->p2 - 1;
- }
- break;
-}
-
-/* Opcode: SortCallback P1 * *
-**
-** The top of the stack contains a callback record built using
-** the SortMakeRec operation with the same P1 value as this
-** instruction. Pop this record from the stack and invoke the
-** callback on it.
-*/
-case OP_SortCallback: {
- assert( pTos>=p->aStack );
- assert( pTos->flags & MEM_Str );
- p->nCallback++;
- p->pc = pc+1;
- p->azResColumn = (char**)pTos->z;
- assert( p->nResColumn==pOp->p1 );
- p->popStack = 1;
- p->pTos = pTos;
- return SQLITE_ROW;
-}
-
-/* Opcode: SortReset * * *
-**
-** Remove any elements that remain on the sorter.
-*/
-case OP_SortReset: {
- sqliteVdbeSorterReset(p);
- break;
-}
-
-/* Opcode: FileOpen * * P3
-**
-** Open the file named by P3 for reading using the FileRead opcode.
-** If P3 is "stdin" then open standard input for reading.
-*/
-case OP_FileOpen: {
- assert( pOp->p3!=0 );
- if( p->pFile ){
- if( p->pFile!=stdin ) fclose(p->pFile);
- p->pFile = 0;
- }
- if( sqliteStrICmp(pOp->p3,"stdin")==0 ){
- p->pFile = stdin;
- }else{
- p->pFile = fopen(pOp->p3, "r");
- }
- if( p->pFile==0 ){
- sqliteSetString(&p->zErrMsg,"unable to open file: ", pOp->p3, (char*)0);
- rc = SQLITE_ERROR;
- }
- break;
-}
-
-/* Opcode: FileRead P1 P2 P3
-**
-** Read a single line of input from the open file (the file opened using
-** FileOpen). If we reach end-of-file, jump immediately to P2. If
-** we are able to get another line, split the line apart using P3 as
-** a delimiter. There should be P1 fields. If the input line contains
-** more than P1 fields, ignore the excess. If the input line contains
-** fewer than P1 fields, assume the remaining fields contain NULLs.
-**
-** Input ends if a line consists of just "\.". A field containing only
-** "\N" is a null field. The backslash \ character can be used be used
-** to escape newlines or the delimiter.
-*/
-case OP_FileRead: {
- int n, eol, nField, i, c, nDelim;
- char *zDelim, *z;
- CHECK_FOR_INTERRUPT;
- if( p->pFile==0 ) goto fileread_jump;
- nField = pOp->p1;
- if( nField<=0 ) goto fileread_jump;
- if( nField!=p->nField || p->azField==0 ){
- char **azField = sqliteRealloc(p->azField, sizeof(char*)*nField+1);
- if( azField==0 ){ goto no_mem; }
- p->azField = azField;
- p->nField = nField;
- }
- n = 0;
- eol = 0;
- while( eol==0 ){
- if( p->zLine==0 || n+200>p->nLineAlloc ){
- char *zLine;
- p->nLineAlloc = p->nLineAlloc*2 + 300;
- zLine = sqliteRealloc(p->zLine, p->nLineAlloc);
- if( zLine==0 ){
- p->nLineAlloc = 0;
- sqliteFree(p->zLine);
- p->zLine = 0;
- goto no_mem;
- }
- p->zLine = zLine;
- }
- if( vdbe_fgets(&p->zLine[n], p->nLineAlloc-n, p->pFile)==0 ){
- eol = 1;
- p->zLine[n] = 0;
- }else{
- int c;
- while( (c = p->zLine[n])!=0 ){
- if( c=='\\' ){
- if( p->zLine[n+1]==0 ) break;
- n += 2;
- }else if( c=='\n' ){
- p->zLine[n] = 0;
- eol = 1;
- break;
- }else{
- n++;
- }
- }
- }
- }
- if( n==0 ) goto fileread_jump;
- z = p->zLine;
- if( z[0]=='\\' && z[1]=='.' && z[2]==0 ){
- goto fileread_jump;
- }
- zDelim = pOp->p3;
- if( zDelim==0 ) zDelim = "\t";
- c = zDelim[0];
- nDelim = strlen(zDelim);
- p->azField[0] = z;
- for(i=1; *z!=0 && i<=nField; i++){
- int from, to;
- from = to = 0;
- if( z[0]=='\\' && z[1]=='N'
- && (z[2]==0 || strncmp(&z[2],zDelim,nDelim)==0) ){
- if( i<=nField ) p->azField[i-1] = 0;
- z += 2 + nDelim;
- if( i<nField ) p->azField[i] = z;
- continue;
- }
- while( z[from] ){
- if( z[from]=='\\' && z[from+1]!=0 ){
- int tx = z[from+1];
- switch( tx ){
- case 'b': tx = '\b'; break;
- case 'f': tx = '\f'; break;
- case 'n': tx = '\n'; break;
- case 'r': tx = '\r'; break;
- case 't': tx = '\t'; break;
- case 'v': tx = '\v'; break;
- default: break;
- }
- z[to++] = tx;
- from += 2;
- continue;
- }
- if( z[from]==c && strncmp(&z[from],zDelim,nDelim)==0 ) break;
- z[to++] = z[from++];
- }
- if( z[from] ){
- z[to] = 0;
- z += from + nDelim;
- if( i<nField ) p->azField[i] = z;
- }else{
- z[to] = 0;
- z = "";
- }
- }
- while( i<nField ){
- p->azField[i++] = 0;
- }
- break;
-
- /* If we reach end-of-file, or if anything goes wrong, jump here.
- ** This code will cause a jump to P2 */
-fileread_jump:
- pc = pOp->p2 - 1;
- break;
-}
-
-/* Opcode: FileColumn P1 * *
-**
-** Push onto the stack the P1-th column of the most recently read line
-** from the input file.
-*/
-case OP_FileColumn: {
- int i = pOp->p1;
- char *z;
- assert( i>=0 && i<p->nField );
- if( p->azField ){
- z = p->azField[i];
- }else{
- z = 0;
- }
- pTos++;
- if( z ){
- pTos->n = strlen(z) + 1;
- pTos->z = z;
- pTos->flags = MEM_Str | MEM_Ephem;
- }else{
- pTos->flags = MEM_Null;
- }
- break;
-}
-
-/* Opcode: MemStore P1 P2 *
-**
-** Write the top of the stack into memory location P1.
-** P1 should be a small integer since space is allocated
-** for all memory locations between 0 and P1 inclusive.
-**
-** After the data is stored in the memory location, the
-** stack is popped once if P2 is 1. If P2 is zero, then
-** the original data remains on the stack.
-*/
-case OP_MemStore: {
- int i = pOp->p1;
- Mem *pMem;
- assert( pTos>=p->aStack );
- if( i>=p->nMem ){
- int nOld = p->nMem;
- Mem *aMem;
- p->nMem = i + 5;
- aMem = sqliteRealloc(p->aMem, p->nMem*sizeof(p->aMem[0]));
- if( aMem==0 ) goto no_mem;
- if( aMem!=p->aMem ){
- int j;
- for(j=0; j<nOld; j++){
- if( aMem[j].flags & MEM_Short ){
- aMem[j].z = aMem[j].zShort;
- }
- }
- }
- p->aMem = aMem;
- if( nOld<p->nMem ){
- memset(&p->aMem[nOld], 0, sizeof(p->aMem[0])*(p->nMem-nOld));
- }
- }
- Deephemeralize(pTos);
- pMem = &p->aMem[i];
- Release(pMem);
- *pMem = *pTos;
- if( pMem->flags & MEM_Dyn ){
- if( pOp->p2 ){
- pTos->flags = MEM_Null;
- }else{
- pMem->z = sqliteMallocRaw( pMem->n );
- if( pMem->z==0 ) goto no_mem;
- memcpy(pMem->z, pTos->z, pMem->n);
- }
- }else if( pMem->flags & MEM_Short ){
- pMem->z = pMem->zShort;
- }
- if( pOp->p2 ){
- Release(pTos);
- pTos--;
- }
- break;
-}
-
-/* Opcode: MemLoad P1 * *
-**
-** Push a copy of the value in memory location P1 onto the stack.
-**
-** If the value is a string, then the value pushed is a pointer to
-** the string that is stored in the memory location. If the memory
-** location is subsequently changed (using OP_MemStore) then the
-** value pushed onto the stack will change too.
-*/
-case OP_MemLoad: {
- int i = pOp->p1;
- assert( i>=0 && i<p->nMem );
- pTos++;
- memcpy(pTos, &p->aMem[i], sizeof(pTos[0])-NBFS);;
- if( pTos->flags & MEM_Str ){
- pTos->flags |= MEM_Ephem;
- pTos->flags &= ~(MEM_Dyn|MEM_Static|MEM_Short);
- }
- break;
-}
-
-/* Opcode: MemIncr P1 P2 *
-**
-** Increment the integer valued memory cell P1 by 1. If P2 is not zero
-** and the result after the increment is greater than zero, then jump
-** to P2.
-**
-** This instruction throws an error if the memory cell is not initially
-** an integer.
-*/
-case OP_MemIncr: {
- int i = pOp->p1;
- Mem *pMem;
- assert( i>=0 && i<p->nMem );
- pMem = &p->aMem[i];
- assert( pMem->flags==MEM_Int );
- pMem->i++;
- if( pOp->p2>0 && pMem->i>0 ){
- pc = pOp->p2 - 1;
- }
- break;
-}
-
-/* Opcode: AggReset * P2 *
-**
-** Reset the aggregator so that it no longer contains any data.
-** Future aggregator elements will contain P2 values each.
-*/
-case OP_AggReset: {
- sqliteVdbeAggReset(&p->agg);
- p->agg.nMem = pOp->p2;
- p->agg.apFunc = sqliteMalloc( p->agg.nMem*sizeof(p->agg.apFunc[0]) );
- if( p->agg.apFunc==0 ) goto no_mem;
- break;
-}
-
-/* Opcode: AggInit * P2 P3
-**
-** Initialize the function parameters for an aggregate function.
-** The aggregate will operate out of aggregate column P2.
-** P3 is a pointer to the FuncDef structure for the function.
-*/
-case OP_AggInit: {
- int i = pOp->p2;
- assert( i>=0 && i<p->agg.nMem );
- p->agg.apFunc[i] = (FuncDef*)pOp->p3;
- break;
-}
-
-/* Opcode: AggFunc * P2 P3
-**
-** Execute the step function for an aggregate. The
-** function has P2 arguments. P3 is a pointer to the FuncDef
-** structure that specifies the function.
-**
-** The top of the stack must be an integer which is the index of
-** the aggregate column that corresponds to this aggregate function.
-** Ideally, this index would be another parameter, but there are
-** no free parameters left. The integer is popped from the stack.
-*/
-case OP_AggFunc: {
- int n = pOp->p2;
- int i;
- Mem *pMem, *pRec;
- char **azArgv = p->zArgv;
- sqlite_func ctx;
-
- assert( n>=0 );
- assert( pTos->flags==MEM_Int );
- pRec = &pTos[-n];
- assert( pRec>=p->aStack );
- for(i=0; i<n; i++, pRec++){
- if( pRec->flags & MEM_Null ){
- azArgv[i] = 0;
- }else{
- Stringify(pRec);
- azArgv[i] = pRec->z;
- }
- }
- i = pTos->i;
- assert( i>=0 && i<p->agg.nMem );
- ctx.pFunc = (FuncDef*)pOp->p3;
- pMem = &p->agg.pCurrent->aMem[i];
- ctx.s.z = pMem->zShort; /* Space used for small aggregate contexts */
- ctx.pAgg = pMem->z;
- ctx.cnt = ++pMem->i;
- ctx.isError = 0;
- ctx.isStep = 1;
- (ctx.pFunc->xStep)(&ctx, n, (const char**)azArgv);
- pMem->z = ctx.pAgg;
- pMem->flags = MEM_AggCtx;
- popStack(&pTos, n+1);
- if( ctx.isError ){
- rc = SQLITE_ERROR;
- }
- break;
-}
-
-/* Opcode: AggFocus * P2 *
-**
-** Pop the top of the stack and use that as an aggregator key. If
-** an aggregator with that same key already exists, then make the
-** aggregator the current aggregator and jump to P2. If no aggregator
-** with the given key exists, create one and make it current but
-** do not jump.
-**
-** The order of aggregator opcodes is important. The order is:
-** AggReset AggFocus AggNext. In other words, you must execute
-** AggReset first, then zero or more AggFocus operations, then
-** zero or more AggNext operations. You must not execute an AggFocus
-** in between an AggNext and an AggReset.
-*/
-case OP_AggFocus: {
- AggElem *pElem;
- char *zKey;
- int nKey;
-
- assert( pTos>=p->aStack );
- Stringify(pTos);
- zKey = pTos->z;
- nKey = pTos->n;
- pElem = sqliteHashFind(&p->agg.hash, zKey, nKey);
- if( pElem ){
- p->agg.pCurrent = pElem;
- pc = pOp->p2 - 1;
- }else{
- AggInsert(&p->agg, zKey, nKey);
- if( sqlite_malloc_failed ) goto no_mem;
- }
- Release(pTos);
- pTos--;
- break;
-}
-
-/* Opcode: AggSet * P2 *
-**
-** Move the top of the stack into the P2-th field of the current
-** aggregate. String values are duplicated into new memory.
-*/
-case OP_AggSet: {
- AggElem *pFocus = AggInFocus(p->agg);
- Mem *pMem;
- int i = pOp->p2;
- assert( pTos>=p->aStack );
- if( pFocus==0 ) goto no_mem;
- assert( i>=0 && i<p->agg.nMem );
- Deephemeralize(pTos);
- pMem = &pFocus->aMem[i];
- Release(pMem);
- *pMem = *pTos;
- if( pMem->flags & MEM_Dyn ){
- pTos->flags = MEM_Null;
- }else if( pMem->flags & MEM_Short ){
- pMem->z = pMem->zShort;
- }
- Release(pTos);
- pTos--;
- break;
-}
-
-/* Opcode: AggGet * P2 *
-**
-** Push a new entry onto the stack which is a copy of the P2-th field
-** of the current aggregate. Strings are not duplicated so
-** string values will be ephemeral.
-*/
-case OP_AggGet: {
- AggElem *pFocus = AggInFocus(p->agg);
- Mem *pMem;
- int i = pOp->p2;
- if( pFocus==0 ) goto no_mem;
- assert( i>=0 && i<p->agg.nMem );
- pTos++;
- pMem = &pFocus->aMem[i];
- *pTos = *pMem;
- if( pTos->flags & MEM_Str ){
- pTos->flags &= ~(MEM_Dyn|MEM_Static|MEM_Short);
- pTos->flags |= MEM_Ephem;
- }
- break;
-}
-
-/* Opcode: AggNext * P2 *
-**
-** Make the next aggregate value the current aggregate. The prior
-** aggregate is deleted. If all aggregate values have been consumed,
-** jump to P2.
-**
-** The order of aggregator opcodes is important. The order is:
-** AggReset AggFocus AggNext. In other words, you must execute
-** AggReset first, then zero or more AggFocus operations, then
-** zero or more AggNext operations. You must not execute an AggFocus
-** in between an AggNext and an AggReset.
-*/
-case OP_AggNext: {
- CHECK_FOR_INTERRUPT;
- if( p->agg.pSearch==0 ){
- p->agg.pSearch = sqliteHashFirst(&p->agg.hash);
- }else{
- p->agg.pSearch = sqliteHashNext(p->agg.pSearch);
- }
- if( p->agg.pSearch==0 ){
- pc = pOp->p2 - 1;
- } else {
- int i;
- sqlite_func ctx;
- Mem *aMem;
- p->agg.pCurrent = sqliteHashData(p->agg.pSearch);
- aMem = p->agg.pCurrent->aMem;
- for(i=0; i<p->agg.nMem; i++){
- int freeCtx;
- if( p->agg.apFunc[i]==0 ) continue;
- if( p->agg.apFunc[i]->xFinalize==0 ) continue;
- ctx.s.flags = MEM_Null;
- ctx.s.z = aMem[i].zShort;
- ctx.pAgg = (void*)aMem[i].z;
- freeCtx = aMem[i].z && aMem[i].z!=aMem[i].zShort;
- ctx.cnt = aMem[i].i;
- ctx.isStep = 0;
- ctx.pFunc = p->agg.apFunc[i];
- (*p->agg.apFunc[i]->xFinalize)(&ctx);
- if( freeCtx ){
- sqliteFree( aMem[i].z );
- }
- aMem[i] = ctx.s;
- if( aMem[i].flags & MEM_Short ){
- aMem[i].z = aMem[i].zShort;
- }
- }
- }
- break;
-}
-
-/* Opcode: SetInsert P1 * P3
-**
-** If Set P1 does not exist then create it. Then insert value
-** P3 into that set. If P3 is NULL, then insert the top of the
-** stack into the set.
-*/
-case OP_SetInsert: {
- int i = pOp->p1;
- if( p->nSet<=i ){
- int k;
- Set *aSet = sqliteRealloc(p->aSet, (i+1)*sizeof(p->aSet[0]) );
- if( aSet==0 ) goto no_mem;
- p->aSet = aSet;
- for(k=p->nSet; k<=i; k++){
- sqliteHashInit(&p->aSet[k].hash, SQLITE_HASH_BINARY, 1);
- }
- p->nSet = i+1;
- }
- if( pOp->p3 ){
- sqliteHashInsert(&p->aSet[i].hash, pOp->p3, strlen(pOp->p3)+1, p);
- }else{
- assert( pTos>=p->aStack );
- Stringify(pTos);
- sqliteHashInsert(&p->aSet[i].hash, pTos->z, pTos->n, p);
- Release(pTos);
- pTos--;
- }
- if( sqlite_malloc_failed ) goto no_mem;
- break;
-}
-
-/* Opcode: SetFound P1 P2 *
-**
-** Pop the stack once and compare the value popped off with the
-** contents of set P1. If the element popped exists in set P1,
-** then jump to P2. Otherwise fall through.
-*/
-case OP_SetFound: {
- int i = pOp->p1;
- assert( pTos>=p->aStack );
- Stringify(pTos);
- if( i>=0 && i<p->nSet && sqliteHashFind(&p->aSet[i].hash, pTos->z, pTos->n)){
- pc = pOp->p2 - 1;
- }
- Release(pTos);
- pTos--;
- break;
-}
-
-/* Opcode: SetNotFound P1 P2 *
-**
-** Pop the stack once and compare the value popped off with the
-** contents of set P1. If the element popped does not exists in
-** set P1, then jump to P2. Otherwise fall through.
-*/
-case OP_SetNotFound: {
- int i = pOp->p1;
- assert( pTos>=p->aStack );
- Stringify(pTos);
- if( i<0 || i>=p->nSet ||
- sqliteHashFind(&p->aSet[i].hash, pTos->z, pTos->n)==0 ){
- pc = pOp->p2 - 1;
- }
- Release(pTos);
- pTos--;
- break;
-}
-
-/* Opcode: SetFirst P1 P2 *
-**
-** Read the first element from set P1 and push it onto the stack. If the
-** set is empty, push nothing and jump immediately to P2. This opcode is
-** used in combination with OP_SetNext to loop over all elements of a set.
-*/
-/* Opcode: SetNext P1 P2 *
-**
-** Read the next element from set P1 and push it onto the stack. If there
-** are no more elements in the set, do not do the push and fall through.
-** Otherwise, jump to P2 after pushing the next set element.
-*/
-case OP_SetFirst:
-case OP_SetNext: {
- Set *pSet;
- CHECK_FOR_INTERRUPT;
- if( pOp->p1<0 || pOp->p1>=p->nSet ){
- if( pOp->opcode==OP_SetFirst ) pc = pOp->p2 - 1;
- break;
- }
- pSet = &p->aSet[pOp->p1];
- if( pOp->opcode==OP_SetFirst ){
- pSet->prev = sqliteHashFirst(&pSet->hash);
- if( pSet->prev==0 ){
- pc = pOp->p2 - 1;
- break;
- }
- }else{
- if( pSet->prev ){
- pSet->prev = sqliteHashNext(pSet->prev);
- }
- if( pSet->prev==0 ){
- break;
- }else{
- pc = pOp->p2 - 1;
- }
- }
- pTos++;
- pTos->z = sqliteHashKey(pSet->prev);
- pTos->n = sqliteHashKeysize(pSet->prev);
- pTos->flags = MEM_Str | MEM_Ephem;
- break;
-}
-
-/* Opcode: Vacuum * * *
-**
-** Vacuum the entire database. This opcode will cause other virtual
-** machines to be created and run. It may not be called from within
-** a transaction.
-*/
-case OP_Vacuum: {
- if( sqliteSafetyOff(db) ) goto abort_due_to_misuse;
- rc = sqliteRunVacuum(&p->zErrMsg, db);
- if( sqliteSafetyOn(db) ) goto abort_due_to_misuse;
- break;
-}
-
-/* Opcode: StackDepth * * *
-**
-** Push an integer onto the stack which is the depth of the stack prior
-** to that integer being pushed.
-*/
-case OP_StackDepth: {
- int depth = (&pTos[1]) - p->aStack;
- pTos++;
- pTos->i = depth;
- pTos->flags = MEM_Int;
- break;
-}
-
-/* Opcode: StackReset * * *
-**
-** Pop a single integer off of the stack. Then pop the stack
-** as many times as necessary to get the depth of the stack down
-** to the value of the integer that was popped.
-*/
-case OP_StackReset: {
- int depth, goal;
- assert( pTos>=p->aStack );
- Integerify(pTos);
- goal = pTos->i;
- depth = (&pTos[1]) - p->aStack;
- assert( goal<depth );
- popStack(&pTos, depth-goal);
- break;
-}
-
-/* An other opcode is illegal...
-*/
-default: {
- sqlite_snprintf(sizeof(zBuf),zBuf,"%d",pOp->opcode);
- sqliteSetString(&p->zErrMsg, "unknown opcode ", zBuf, (char*)0);
- rc = SQLITE_INTERNAL;
- break;
-}
-
-/*****************************************************************************
-** The cases of the switch statement above this line should all be indented
-** by 6 spaces. But the left-most 6 spaces have been removed to improve the
-** readability. From this point on down, the normal indentation rules are
-** restored.
-*****************************************************************************/
- }
-
-#ifdef VDBE_PROFILE
- {
- long long elapse = hwtime() - start;
- pOp->cycles += elapse;
- pOp->cnt++;
-#if 0
- fprintf(stdout, "%10lld ", elapse);
- sqliteVdbePrintOp(stdout, origPc, &p->aOp[origPc]);
-#endif
- }
-#endif
-
- /* The following code adds nothing to the actual functionality
- ** of the program. It is only here for testing and debugging.
- ** On the other hand, it does burn CPU cycles every time through
- ** the evaluator loop. So we can leave it out when NDEBUG is defined.
- */
-#ifndef NDEBUG
- /* Sanity checking on the top element of the stack */
- if( pTos>=p->aStack ){
- assert( pTos->flags!=0 ); /* Must define some type */
- if( pTos->flags & MEM_Str ){
- int x = pTos->flags & (MEM_Static|MEM_Dyn|MEM_Ephem|MEM_Short);
- assert( x!=0 ); /* Strings must define a string subtype */
- assert( (x & (x-1))==0 ); /* Only one string subtype can be defined */
- assert( pTos->z!=0 ); /* Strings must have a value */
- /* Mem.z points to Mem.zShort iff the subtype is MEM_Short */
- assert( (pTos->flags & MEM_Short)==0 || pTos->z==pTos->zShort );
- assert( (pTos->flags & MEM_Short)!=0 || pTos->z!=pTos->zShort );
- }else{
- /* Cannot define a string subtype for non-string objects */
- assert( (pTos->flags & (MEM_Static|MEM_Dyn|MEM_Ephem|MEM_Short))==0 );
- }
- /* MEM_Null excludes all other types */
- assert( pTos->flags==MEM_Null || (pTos->flags&MEM_Null)==0 );
- }
- if( pc<-1 || pc>=p->nOp ){
- sqliteSetString(&p->zErrMsg, "jump destination out of range", (char*)0);
- rc = SQLITE_INTERNAL;
- }
- if( p->trace && pTos>=p->aStack ){
- int i;
- fprintf(p->trace, "Stack:");
- for(i=0; i>-5 && &pTos[i]>=p->aStack; i--){
- if( pTos[i].flags & MEM_Null ){
- fprintf(p->trace, " NULL");
- }else if( (pTos[i].flags & (MEM_Int|MEM_Str))==(MEM_Int|MEM_Str) ){
- fprintf(p->trace, " si:%d", pTos[i].i);
- }else if( pTos[i].flags & MEM_Int ){
- fprintf(p->trace, " i:%d", pTos[i].i);
- }else if( pTos[i].flags & MEM_Real ){
- fprintf(p->trace, " r:%g", pTos[i].r);
- }else if( pTos[i].flags & MEM_Str ){
- int j, k;
- char zBuf[100];
- zBuf[0] = ' ';
- if( pTos[i].flags & MEM_Dyn ){
- zBuf[1] = 'z';
- assert( (pTos[i].flags & (MEM_Static|MEM_Ephem))==0 );
- }else if( pTos[i].flags & MEM_Static ){
- zBuf[1] = 't';
- assert( (pTos[i].flags & (MEM_Dyn|MEM_Ephem))==0 );
- }else if( pTos[i].flags & MEM_Ephem ){
- zBuf[1] = 'e';
- assert( (pTos[i].flags & (MEM_Static|MEM_Dyn))==0 );
- }else{
- zBuf[1] = 's';
- }
- zBuf[2] = '[';
- k = 3;
- for(j=0; j<20 && j<pTos[i].n; j++){
- int c = pTos[i].z[j];
- if( c==0 && j==pTos[i].n-1 ) break;
- if( isprint(c) && !isspace(c) ){
- zBuf[k++] = c;
- }else{
- zBuf[k++] = '.';
- }
- }
- zBuf[k++] = ']';
- zBuf[k++] = 0;
- fprintf(p->trace, "%s", zBuf);
- }else{
- fprintf(p->trace, " ???");
- }
- }
- if( rc!=0 ) fprintf(p->trace," rc=%d",rc);
- fprintf(p->trace,"\n");
- }
-#endif
- } /* The end of the for(;;) loop the loops through opcodes */
-
- /* If we reach this point, it means that execution is finished.
- */
-vdbe_halt:
- CHECK_FOR_INTERRUPT
- if( rc ){
- p->rc = rc;
- rc = SQLITE_ERROR;
- }else{
- rc = SQLITE_DONE;
- }
- p->magic = VDBE_MAGIC_HALT;
- p->pTos = pTos;
- return rc;
-
- /* Jump to here if a malloc() fails. It's hard to get a malloc()
- ** to fail on a modern VM computer, so this code is untested.
- */
-no_mem:
- sqliteSetString(&p->zErrMsg, "out of memory", (char*)0);
- rc = SQLITE_NOMEM;
- goto vdbe_halt;
-
- /* Jump to here for an SQLITE_MISUSE error.
- */
-abort_due_to_misuse:
- rc = SQLITE_MISUSE;
- /* Fall thru into abort_due_to_error */
-
- /* Jump to here for any other kind of fatal error. The "rc" variable
- ** should hold the error number.
- */
-abort_due_to_error:
- if( p->zErrMsg==0 ){
- if( sqlite_malloc_failed ) rc = SQLITE_NOMEM;
- sqliteSetString(&p->zErrMsg, sqlite_error_string(rc), (char*)0);
- }
- goto vdbe_halt;
-
- /* Jump to here if the sqlite_interrupt() API sets the interrupt
- ** flag.
- */
-abort_due_to_interrupt:
- assert( db->flags & SQLITE_Interrupt );
- db->flags &= ~SQLITE_Interrupt;
- if( db->magic!=SQLITE_MAGIC_BUSY ){
- rc = SQLITE_MISUSE;
- }else{
- rc = SQLITE_INTERRUPT;
- }
- sqliteSetString(&p->zErrMsg, sqlite_error_string(rc), (char*)0);
- goto vdbe_halt;
-}
+++ /dev/null
-/*
-** 2001 September 15
-**
-** The author disclaims copyright to this source code. In place of
-** a legal notice, here is a blessing:
-**
-** May you do good and not evil.
-** May you find forgiveness for yourself and forgive others.
-** May you share freely, never taking more than you give.
-**
-*************************************************************************
-** Header file for the Virtual DataBase Engine (VDBE)
-**
-** This header defines the interface to the virtual database engine
-** or VDBE. The VDBE implements an abstract machine that runs a
-** simple program to access and modify the underlying database.
-**
-** $Id: vdbe.h,v 1.1.1.1 2004/08/08 15:03:58 matt Exp $
-*/
-#ifndef _SQLITE_VDBE_H_
-#define _SQLITE_VDBE_H_
-#include <stdio.h>
-
-/*
-** A single VDBE is an opaque structure named "Vdbe". Only routines
-** in the source file sqliteVdbe.c are allowed to see the insides
-** of this structure.
-*/
-typedef struct Vdbe Vdbe;
-
-/*
-** A single instruction of the virtual machine has an opcode
-** and as many as three operands. The instruction is recorded
-** as an instance of the following structure:
-*/
-struct VdbeOp {
- u8 opcode; /* What operation to perform */
- int p1; /* First operand */
- int p2; /* Second parameter (often the jump destination) */
- char *p3; /* Third parameter */
- int p3type; /* P3_STATIC, P3_DYNAMIC or P3_POINTER */
-#ifdef VDBE_PROFILE
- int cnt; /* Number of times this instruction was executed */
- long long cycles; /* Total time spend executing this instruction */
-#endif
-};
-typedef struct VdbeOp VdbeOp;
-
-/*
-** A smaller version of VdbeOp used for the VdbeAddOpList() function because
-** it takes up less space.
-*/
-struct VdbeOpList {
- u8 opcode; /* What operation to perform */
- signed char p1; /* First operand */
- short int p2; /* Second parameter (often the jump destination) */
- char *p3; /* Third parameter */
-};
-typedef struct VdbeOpList VdbeOpList;
-
-/*
-** Allowed values of VdbeOp.p3type
-*/
-#define P3_NOTUSED 0 /* The P3 parameter is not used */
-#define P3_DYNAMIC (-1) /* Pointer to a string obtained from sqliteMalloc() */
-#define P3_STATIC (-2) /* Pointer to a static string */
-#define P3_POINTER (-3) /* P3 is a pointer to some structure or object */
-
-/*
-** The following macro converts a relative address in the p2 field
-** of a VdbeOp structure into a negative number so that
-** sqliteVdbeAddOpList() knows that the address is relative. Calling
-** the macro again restores the address.
-*/
-#define ADDR(X) (-1-(X))
-
-/*
-** The makefile scans the vdbe.c source file and creates the "opcodes.h"
-** header file that defines a number for each opcode used by the VDBE.
-*/
-#include "opcodes.h"
-
-/*
-** Prototypes for the VDBE interface. See comments on the implementation
-** for a description of what each of these routines does.
-*/
-Vdbe *sqliteVdbeCreate(sqlite*);
-void sqliteVdbeCreateCallback(Vdbe*, int*);
-int sqliteVdbeAddOp(Vdbe*,int,int,int);
-int sqliteVdbeOp3(Vdbe*,int,int,int,const char *zP3,int);
-int sqliteVdbeCode(Vdbe*,...);
-int sqliteVdbeAddOpList(Vdbe*, int nOp, VdbeOpList const *aOp);
-void sqliteVdbeChangeP1(Vdbe*, int addr, int P1);
-void sqliteVdbeChangeP2(Vdbe*, int addr, int P2);
-void sqliteVdbeChangeP3(Vdbe*, int addr, const char *zP1, int N);
-void sqliteVdbeDequoteP3(Vdbe*, int addr);
-int sqliteVdbeFindOp(Vdbe*, int, int);
-VdbeOp *sqliteVdbeGetOp(Vdbe*, int);
-int sqliteVdbeMakeLabel(Vdbe*);
-void sqliteVdbeDelete(Vdbe*);
-void sqliteVdbeMakeReady(Vdbe*,int,int);
-int sqliteVdbeExec(Vdbe*);
-int sqliteVdbeList(Vdbe*);
-int sqliteVdbeFinalize(Vdbe*,char**);
-void sqliteVdbeResolveLabel(Vdbe*, int);
-int sqliteVdbeCurrentAddr(Vdbe*);
-void sqliteVdbeTrace(Vdbe*,FILE*);
-void sqliteVdbeCompressSpace(Vdbe*,int);
-int sqliteVdbeReset(Vdbe*,char **);
-int sqliteVdbeSetVariables(Vdbe*,int,const char**);
-
-#endif
+++ /dev/null
-/*
-** 2003 September 6
-**
-** The author disclaims copyright to this source code. In place of
-** a legal notice, here is a blessing:
-**
-** May you do good and not evil.
-** May you find forgiveness for yourself and forgive others.
-** May you share freely, never taking more than you give.
-**
-*************************************************************************
-** This is the header file for information that is private to the
-** VDBE. This information used to all be at the top of the single
-** source code file "vdbe.c". When that file became too big (over
-** 6000 lines long) it was split up into several smaller files and
-** this header information was factored out.
-*/
-
-/*
-** When converting from the native format to the key format and back
-** again, in addition to changing the byte order we invert the high-order
-** bit of the most significant byte. This causes negative numbers to
-** sort before positive numbers in the memcmp() function.
-*/
-#define keyToInt(X) (sqliteVdbeByteSwap(X) ^ 0x80000000)
-#define intToKey(X) (sqliteVdbeByteSwap((X) ^ 0x80000000))
-
-/*
-** The makefile scans this source file and creates the following
-** array of string constants which are the names of all VDBE opcodes.
-** This array is defined in a separate source code file named opcode.c
-** which is automatically generated by the makefile.
-*/
-extern char *sqliteOpcodeNames[];
-
-/*
-** SQL is translated into a sequence of instructions to be
-** executed by a virtual machine. Each instruction is an instance
-** of the following structure.
-*/
-typedef struct VdbeOp Op;
-
-/*
-** Boolean values
-*/
-typedef unsigned char Bool;
-
-/*
-** A cursor is a pointer into a single BTree within a database file.
-** The cursor can seek to a BTree entry with a particular key, or
-** loop over all entries of the Btree. You can also insert new BTree
-** entries or retrieve the key or data from the entry that the cursor
-** is currently pointing to.
-**
-** Every cursor that the virtual machine has open is represented by an
-** instance of the following structure.
-**
-** If the Cursor.isTriggerRow flag is set it means that this cursor is
-** really a single row that represents the NEW or OLD pseudo-table of
-** a row trigger. The data for the row is stored in Cursor.pData and
-** the rowid is in Cursor.iKey.
-*/
-struct Cursor {
- BtCursor *pCursor; /* The cursor structure of the backend */
- int lastRecno; /* Last recno from a Next or NextIdx operation */
- int nextRowid; /* Next rowid returned by OP_NewRowid */
- Bool recnoIsValid; /* True if lastRecno is valid */
- Bool keyAsData; /* The OP_Column command works on key instead of data */
- Bool atFirst; /* True if pointing to first entry */
- Bool useRandomRowid; /* Generate new record numbers semi-randomly */
- Bool nullRow; /* True if pointing to a row with no data */
- Bool nextRowidValid; /* True if the nextRowid field is valid */
- Bool pseudoTable; /* This is a NEW or OLD pseudo-tables of a trigger */
- Bool deferredMoveto; /* A call to sqliteBtreeMoveto() is needed */
- int movetoTarget; /* Argument to the deferred sqliteBtreeMoveto() */
- Btree *pBt; /* Separate file holding temporary table */
- int nData; /* Number of bytes in pData */
- char *pData; /* Data for a NEW or OLD pseudo-table */
- int iKey; /* Key for the NEW or OLD pseudo-table row */
-};
-typedef struct Cursor Cursor;
-
-/*
-** A sorter builds a list of elements to be sorted. Each element of
-** the list is an instance of the following structure.
-*/
-typedef struct Sorter Sorter;
-struct Sorter {
- int nKey; /* Number of bytes in the key */
- char *zKey; /* The key by which we will sort */
- int nData; /* Number of bytes in the data */
- char *pData; /* The data associated with this key */
- Sorter *pNext; /* Next in the list */
-};
-
-/*
-** Number of buckets used for merge-sort.
-*/
-#define NSORT 30
-
-/*
-** Number of bytes of string storage space available to each stack
-** layer without having to malloc. NBFS is short for Number of Bytes
-** For Strings.
-*/
-#define NBFS 32
-
-/*
-** A single level of the stack or a single memory cell
-** is an instance of the following structure.
-*/
-struct Mem {
- int i; /* Integer value */
- int n; /* Number of characters in string value, including '\0' */
- int flags; /* Some combination of MEM_Null, MEM_Str, MEM_Dyn, etc. */
- double r; /* Real value */
- char *z; /* String value */
- char zShort[NBFS]; /* Space for short strings */
-};
-typedef struct Mem Mem;
-
-/*
-** Allowed values for Mem.flags
-*/
-#define MEM_Null 0x0001 /* Value is NULL */
-#define MEM_Str 0x0002 /* Value is a string */
-#define MEM_Int 0x0004 /* Value is an integer */
-#define MEM_Real 0x0008 /* Value is a real number */
-#define MEM_Dyn 0x0010 /* Need to call sqliteFree() on Mem.z */
-#define MEM_Static 0x0020 /* Mem.z points to a static string */
-#define MEM_Ephem 0x0040 /* Mem.z points to an ephemeral string */
-#define MEM_Short 0x0080 /* Mem.z points to Mem.zShort */
-
-/* The following MEM_ value appears only in AggElem.aMem.s.flag fields.
-** It indicates that the corresponding AggElem.aMem.z points to a
-** aggregate function context that needs to be finalized.
-*/
-#define MEM_AggCtx 0x0100 /* Mem.z points to an agg function context */
-
-/*
-** The "context" argument for a installable function. A pointer to an
-** instance of this structure is the first argument to the routines used
-** implement the SQL functions.
-**
-** There is a typedef for this structure in sqlite.h. So all routines,
-** even the public interface to SQLite, can use a pointer to this structure.
-** But this file is the only place where the internal details of this
-** structure are known.
-**
-** This structure is defined inside of vdbe.c because it uses substructures
-** (Mem) which are only defined there.
-*/
-struct sqlite_func {
- FuncDef *pFunc; /* Pointer to function information. MUST BE FIRST */
- Mem s; /* The return value is stored here */
- void *pAgg; /* Aggregate context */
- u8 isError; /* Set to true for an error */
- u8 isStep; /* Current in the step function */
- int cnt; /* Number of times that the step function has been called */
-};
-
-/*
-** An Agg structure describes an Aggregator. Each Agg consists of
-** zero or more Aggregator elements (AggElem). Each AggElem contains
-** a key and one or more values. The values are used in processing
-** aggregate functions in a SELECT. The key is used to implement
-** the GROUP BY clause of a select.
-*/
-typedef struct Agg Agg;
-typedef struct AggElem AggElem;
-struct Agg {
- int nMem; /* Number of values stored in each AggElem */
- AggElem *pCurrent; /* The AggElem currently in focus */
- HashElem *pSearch; /* The hash element for pCurrent */
- Hash hash; /* Hash table of all aggregate elements */
- FuncDef **apFunc; /* Information about aggregate functions */
-};
-struct AggElem {
- char *zKey; /* The key to this AggElem */
- int nKey; /* Number of bytes in the key, including '\0' at end */
- Mem aMem[1]; /* The values for this AggElem */
-};
-
-/*
-** A Set structure is used for quick testing to see if a value
-** is part of a small set. Sets are used to implement code like
-** this:
-** x.y IN ('hi','hoo','hum')
-*/
-typedef struct Set Set;
-struct Set {
- Hash hash; /* A set is just a hash table */
- HashElem *prev; /* Previously accessed hash elemen */
-};
-
-/*
-** A Keylist is a bunch of keys into a table. The keylist can
-** grow without bound. The keylist stores the ROWIDs of database
-** records that need to be deleted or updated.
-*/
-typedef struct Keylist Keylist;
-struct Keylist {
- int nKey; /* Number of slots in aKey[] */
- int nUsed; /* Next unwritten slot in aKey[] */
- int nRead; /* Next unread slot in aKey[] */
- Keylist *pNext; /* Next block of keys */
- int aKey[1]; /* One or more keys. Extra space allocated as needed */
-};
-
-/*
-** A Context stores the last insert rowid, the last statement change count,
-** and the current statement change count (i.e. changes since last statement).
-** Elements of Context structure type make up the ContextStack, which is
-** updated by the ContextPush and ContextPop opcodes (used by triggers)
-*/
-typedef struct Context Context;
-struct Context {
- int lastRowid; /* Last insert rowid (from db->lastRowid) */
- int lsChange; /* Last statement change count (from db->lsChange) */
- int csChange; /* Current statement change count (from db->csChange) */
-};
-
-/*
-** An instance of the virtual machine. This structure contains the complete
-** state of the virtual machine.
-**
-** The "sqlite_vm" structure pointer that is returned by sqlite_compile()
-** is really a pointer to an instance of this structure.
-*/
-struct Vdbe {
- sqlite *db; /* The whole database */
- Vdbe *pPrev,*pNext; /* Linked list of VDBEs with the same Vdbe.db */
- FILE *trace; /* Write an execution trace here, if not NULL */
- int nOp; /* Number of instructions in the program */
- int nOpAlloc; /* Number of slots allocated for aOp[] */
- Op *aOp; /* Space to hold the virtual machine's program */
- int nLabel; /* Number of labels used */
- int nLabelAlloc; /* Number of slots allocated in aLabel[] */
- int *aLabel; /* Space to hold the labels */
- Mem *aStack; /* The operand stack, except string values */
- Mem *pTos; /* Top entry in the operand stack */
- char **zArgv; /* Text values used by the callback */
- char **azColName; /* Becomes the 4th parameter to callbacks */
- int nCursor; /* Number of slots in aCsr[] */
- Cursor *aCsr; /* One element of this array for each open cursor */
- Sorter *pSort; /* A linked list of objects to be sorted */
- FILE *pFile; /* At most one open file handler */
- int nField; /* Number of file fields */
- char **azField; /* Data for each file field */
- int nVar; /* Number of entries in azVariable[] */
- char **azVar; /* Values for the OP_Variable opcode */
- int *anVar; /* Length of each value in azVariable[] */
- u8 *abVar; /* TRUE if azVariable[i] needs to be sqliteFree()ed */
- char *zLine; /* A single line from the input file */
- int nLineAlloc; /* Number of spaces allocated for zLine */
- int magic; /* Magic number for sanity checking */
- int nMem; /* Number of memory locations currently allocated */
- Mem *aMem; /* The memory locations */
- Agg agg; /* Aggregate information */
- int nSet; /* Number of sets allocated */
- Set *aSet; /* An array of sets */
- int nCallback; /* Number of callbacks invoked so far */
- Keylist *pList; /* A list of ROWIDs */
- int keylistStackDepth; /* The size of the "keylist" stack */
- Keylist **keylistStack; /* The stack used by opcodes ListPush & ListPop */
- int contextStackDepth; /* The size of the "context" stack */
- Context *contextStack; /* Stack used by opcodes ContextPush & ContextPop*/
- int pc; /* The program counter */
- int rc; /* Value to return */
- unsigned uniqueCnt; /* Used by OP_MakeRecord when P2!=0 */
- int errorAction; /* Recovery action to do in case of an error */
- int undoTransOnError; /* If error, either ROLLBACK or COMMIT */
- int inTempTrans; /* True if temp database is transactioned */
- int returnStack[100]; /* Return address stack for OP_Gosub & OP_Return */
- int returnDepth; /* Next unused element in returnStack[] */
- int nResColumn; /* Number of columns in one row of the result set */
- char **azResColumn; /* Values for one row of result */
- int popStack; /* Pop the stack this much on entry to VdbeExec() */
- char *zErrMsg; /* Error message written here */
- u8 explain; /* True if EXPLAIN present on SQL command */
-};
-
-/*
-** The following are allowed values for Vdbe.magic
-*/
-#define VDBE_MAGIC_INIT 0x26bceaa5 /* Building a VDBE program */
-#define VDBE_MAGIC_RUN 0xbdf20da3 /* VDBE is ready to execute */
-#define VDBE_MAGIC_HALT 0x519c2973 /* VDBE has completed execution */
-#define VDBE_MAGIC_DEAD 0xb606c3c8 /* The VDBE has been deallocated */
-
-/*
-** Function prototypes
-*/
-void sqliteVdbeCleanupCursor(Cursor*);
-void sqliteVdbeSorterReset(Vdbe*);
-void sqliteVdbeAggReset(Agg*);
-void sqliteVdbeKeylistFree(Keylist*);
-void sqliteVdbePopStack(Vdbe*,int);
-int sqliteVdbeCursorMoveto(Cursor*);
-int sqliteVdbeByteSwap(int);
-#if !defined(NDEBUG) || defined(VDBE_PROFILE)
-void sqliteVdbePrintOp(FILE*, int, Op*);
-#endif
+++ /dev/null
-/*
-** 2003 September 6
-**
-** The author disclaims copyright to this source code. In place of
-** a legal notice, here is a blessing:
-**
-** May you do good and not evil.
-** May you find forgiveness for yourself and forgive others.
-** May you share freely, never taking more than you give.
-**
-*************************************************************************
-** This file contains code used for creating, destroying, and populating
-** a VDBE (or an "sqlite_vm" as it is known to the outside world.) Prior
-** to version 2.8.7, all this code was combined into the vdbe.c source file.
-** But that file was getting too big so this subroutines were split out.
-*/
-#include "sqliteInt.h"
-#include "os.h"
-#include <ctype.h>
-#include "vdbeInt.h"
-
-
-/*
-** When debugging the code generator in a symbolic debugger, one can
-** set the sqlite_vdbe_addop_trace to 1 and all opcodes will be printed
-** as they are added to the instruction stream.
-*/
-#ifndef NDEBUG
-int sqlite_vdbe_addop_trace = 0;
-#endif
-
-
-/*
-** Create a new virtual database engine.
-*/
-Vdbe *sqliteVdbeCreate(sqlite *db){
- Vdbe *p;
- p = sqliteMalloc( sizeof(Vdbe) );
- if( p==0 ) return 0;
- p->db = db;
- if( db->pVdbe ){
- db->pVdbe->pPrev = p;
- }
- p->pNext = db->pVdbe;
- p->pPrev = 0;
- db->pVdbe = p;
- p->magic = VDBE_MAGIC_INIT;
- return p;
-}
-
-/*
-** Turn tracing on or off
-*/
-void sqliteVdbeTrace(Vdbe *p, FILE *trace){
- p->trace = trace;
-}
-
-/*
-** Add a new instruction to the list of instructions current in the
-** VDBE. Return the address of the new instruction.
-**
-** Parameters:
-**
-** p Pointer to the VDBE
-**
-** op The opcode for this instruction
-**
-** p1, p2 First two of the three possible operands.
-**
-** Use the sqliteVdbeResolveLabel() function to fix an address and
-** the sqliteVdbeChangeP3() function to change the value of the P3
-** operand.
-*/
-int sqliteVdbeAddOp(Vdbe *p, int op, int p1, int p2){
- int i;
- VdbeOp *pOp;
-
- i = p->nOp;
- p->nOp++;
- assert( p->magic==VDBE_MAGIC_INIT );
- if( i>=p->nOpAlloc ){
- int oldSize = p->nOpAlloc;
- Op *aNew;
- p->nOpAlloc = p->nOpAlloc*2 + 100;
- aNew = sqliteRealloc(p->aOp, p->nOpAlloc*sizeof(Op));
- if( aNew==0 ){
- p->nOpAlloc = oldSize;
- return 0;
- }
- p->aOp = aNew;
- memset(&p->aOp[oldSize], 0, (p->nOpAlloc-oldSize)*sizeof(Op));
- }
- pOp = &p->aOp[i];
- pOp->opcode = op;
- pOp->p1 = p1;
- if( p2<0 && (-1-p2)<p->nLabel && p->aLabel[-1-p2]>=0 ){
- p2 = p->aLabel[-1-p2];
- }
- pOp->p2 = p2;
- pOp->p3 = 0;
- pOp->p3type = P3_NOTUSED;
-#ifndef NDEBUG
- if( sqlite_vdbe_addop_trace ) sqliteVdbePrintOp(0, i, &p->aOp[i]);
-#endif
- return i;
-}
-
-/*
-** Add an opcode that includes the p3 value.
-*/
-int sqliteVdbeOp3(Vdbe *p, int op, int p1, int p2, const char *zP3, int p3type){
- int addr = sqliteVdbeAddOp(p, op, p1, p2);
- sqliteVdbeChangeP3(p, addr, zP3, p3type);
- return addr;
-}
-
-/*
-** Add multiple opcodes. The list is terminated by an opcode of 0.
-*/
-int sqliteVdbeCode(Vdbe *p, ...){
- int addr;
- va_list ap;
- int opcode, p1, p2;
- va_start(ap, p);
- addr = p->nOp;
- while( (opcode = va_arg(ap,int))!=0 ){
- p1 = va_arg(ap,int);
- p2 = va_arg(ap,int);
- sqliteVdbeAddOp(p, opcode, p1, p2);
- }
- va_end(ap);
- return addr;
-}
-
-
-
-/*
-** Create a new symbolic label for an instruction that has yet to be
-** coded. The symbolic label is really just a negative number. The
-** label can be used as the P2 value of an operation. Later, when
-** the label is resolved to a specific address, the VDBE will scan
-** through its operation list and change all values of P2 which match
-** the label into the resolved address.
-**
-** The VDBE knows that a P2 value is a label because labels are
-** always negative and P2 values are suppose to be non-negative.
-** Hence, a negative P2 value is a label that has yet to be resolved.
-*/
-int sqliteVdbeMakeLabel(Vdbe *p){
- int i;
- i = p->nLabel++;
- assert( p->magic==VDBE_MAGIC_INIT );
- if( i>=p->nLabelAlloc ){
- int *aNew;
- p->nLabelAlloc = p->nLabelAlloc*2 + 10;
- aNew = sqliteRealloc( p->aLabel, p->nLabelAlloc*sizeof(p->aLabel[0]));
- if( aNew==0 ){
- sqliteFree(p->aLabel);
- }
- p->aLabel = aNew;
- }
- if( p->aLabel==0 ){
- p->nLabel = 0;
- p->nLabelAlloc = 0;
- return 0;
- }
- p->aLabel[i] = -1;
- return -1-i;
-}
-
-/*
-** Resolve label "x" to be the address of the next instruction to
-** be inserted. The parameter "x" must have been obtained from
-** a prior call to sqliteVdbeMakeLabel().
-*/
-void sqliteVdbeResolveLabel(Vdbe *p, int x){
- int j;
- assert( p->magic==VDBE_MAGIC_INIT );
- if( x<0 && (-x)<=p->nLabel && p->aOp ){
- if( p->aLabel[-1-x]==p->nOp ) return;
- assert( p->aLabel[-1-x]<0 );
- p->aLabel[-1-x] = p->nOp;
- for(j=0; j<p->nOp; j++){
- if( p->aOp[j].p2==x ) p->aOp[j].p2 = p->nOp;
- }
- }
-}
-
-/*
-** Return the address of the next instruction to be inserted.
-*/
-int sqliteVdbeCurrentAddr(Vdbe *p){
- assert( p->magic==VDBE_MAGIC_INIT );
- return p->nOp;
-}
-
-/*
-** Add a whole list of operations to the operation stack. Return the
-** address of the first operation added.
-*/
-int sqliteVdbeAddOpList(Vdbe *p, int nOp, VdbeOpList const *aOp){
- int addr;
- assert( p->magic==VDBE_MAGIC_INIT );
- if( p->nOp + nOp >= p->nOpAlloc ){
- int oldSize = p->nOpAlloc;
- Op *aNew;
- p->nOpAlloc = p->nOpAlloc*2 + nOp + 10;
- aNew = sqliteRealloc(p->aOp, p->nOpAlloc*sizeof(Op));
- if( aNew==0 ){
- p->nOpAlloc = oldSize;
- return 0;
- }
- p->aOp = aNew;
- memset(&p->aOp[oldSize], 0, (p->nOpAlloc-oldSize)*sizeof(Op));
- }
- addr = p->nOp;
- if( nOp>0 ){
- int i;
- VdbeOpList const *pIn = aOp;
- for(i=0; i<nOp; i++, pIn++){
- int p2 = pIn->p2;
- VdbeOp *pOut = &p->aOp[i+addr];
- pOut->opcode = pIn->opcode;
- pOut->p1 = pIn->p1;
- pOut->p2 = p2<0 ? addr + ADDR(p2) : p2;
- pOut->p3 = pIn->p3;
- pOut->p3type = pIn->p3 ? P3_STATIC : P3_NOTUSED;
-#ifndef NDEBUG
- if( sqlite_vdbe_addop_trace ){
- sqliteVdbePrintOp(0, i+addr, &p->aOp[i+addr]);
- }
-#endif
- }
- p->nOp += nOp;
- }
- return addr;
-}
-
-/*
-** Change the value of the P1 operand for a specific instruction.
-** This routine is useful when a large program is loaded from a
-** static array using sqliteVdbeAddOpList but we want to make a
-** few minor changes to the program.
-*/
-void sqliteVdbeChangeP1(Vdbe *p, int addr, int val){
- assert( p->magic==VDBE_MAGIC_INIT );
- if( p && addr>=0 && p->nOp>addr && p->aOp ){
- p->aOp[addr].p1 = val;
- }
-}
-
-/*
-** Change the value of the P2 operand for a specific instruction.
-** This routine is useful for setting a jump destination.
-*/
-void sqliteVdbeChangeP2(Vdbe *p, int addr, int val){
- assert( val>=0 );
- assert( p->magic==VDBE_MAGIC_INIT );
- if( p && addr>=0 && p->nOp>addr && p->aOp ){
- p->aOp[addr].p2 = val;
- }
-}
-
-/*
-** Change the value of the P3 operand for a specific instruction.
-** This routine is useful when a large program is loaded from a
-** static array using sqliteVdbeAddOpList but we want to make a
-** few minor changes to the program.
-**
-** If n>=0 then the P3 operand is dynamic, meaning that a copy of
-** the string is made into memory obtained from sqliteMalloc().
-** A value of n==0 means copy bytes of zP3 up to and including the
-** first null byte. If n>0 then copy n+1 bytes of zP3.
-**
-** If n==P3_STATIC it means that zP3 is a pointer to a constant static
-** string and we can just copy the pointer. n==P3_POINTER means zP3 is
-** a pointer to some object other than a string.
-**
-** If addr<0 then change P3 on the most recently inserted instruction.
-*/
-void sqliteVdbeChangeP3(Vdbe *p, int addr, const char *zP3, int n){
- Op *pOp;
- assert( p->magic==VDBE_MAGIC_INIT );
- if( p==0 || p->aOp==0 ) return;
- if( addr<0 || addr>=p->nOp ){
- addr = p->nOp - 1;
- if( addr<0 ) return;
- }
- pOp = &p->aOp[addr];
- if( pOp->p3 && pOp->p3type==P3_DYNAMIC ){
- sqliteFree(pOp->p3);
- pOp->p3 = 0;
- }
- if( zP3==0 ){
- pOp->p3 = 0;
- pOp->p3type = P3_NOTUSED;
- }else if( n<0 ){
- pOp->p3 = (char*)zP3;
- pOp->p3type = n;
- }else{
- sqliteSetNString(&pOp->p3, zP3, n, 0);
- pOp->p3type = P3_DYNAMIC;
- }
-}
-
-/*
-** If the P3 operand to the specified instruction appears
-** to be a quoted string token, then this procedure removes
-** the quotes.
-**
-** The quoting operator can be either a grave ascent (ASCII 0x27)
-** or a double quote character (ASCII 0x22). Two quotes in a row
-** resolve to be a single actual quote character within the string.
-*/
-void sqliteVdbeDequoteP3(Vdbe *p, int addr){
- Op *pOp;
- assert( p->magic==VDBE_MAGIC_INIT );
- if( p->aOp==0 ) return;
- if( addr<0 || addr>=p->nOp ){
- addr = p->nOp - 1;
- if( addr<0 ) return;
- }
- pOp = &p->aOp[addr];
- if( pOp->p3==0 || pOp->p3[0]==0 ) return;
- if( pOp->p3type==P3_POINTER ) return;
- if( pOp->p3type!=P3_DYNAMIC ){
- pOp->p3 = sqliteStrDup(pOp->p3);
- pOp->p3type = P3_DYNAMIC;
- }
- sqliteDequote(pOp->p3);
-}
-
-/*
-** On the P3 argument of the given instruction, change all
-** strings of whitespace characters into a single space and
-** delete leading and trailing whitespace.
-*/
-void sqliteVdbeCompressSpace(Vdbe *p, int addr){
- unsigned char *z;
- int i, j;
- Op *pOp;
- assert( p->magic==VDBE_MAGIC_INIT );
- if( p->aOp==0 || addr<0 || addr>=p->nOp ) return;
- pOp = &p->aOp[addr];
- if( pOp->p3type==P3_POINTER ){
- return;
- }
- if( pOp->p3type!=P3_DYNAMIC ){
- pOp->p3 = sqliteStrDup(pOp->p3);
- pOp->p3type = P3_DYNAMIC;
- }
- z = (unsigned char*)pOp->p3;
- if( z==0 ) return;
- i = j = 0;
- while( isspace(z[i]) ){ i++; }
- while( z[i] ){
- if( isspace(z[i]) ){
- z[j++] = ' ';
- while( isspace(z[++i]) ){}
- }else{
- z[j++] = z[i++];
- }
- }
- while( j>0 && isspace(z[j-1]) ){ j--; }
- z[j] = 0;
-}
-
-/*
-** Search for the current program for the given opcode and P2
-** value. Return the address plus 1 if found and 0 if not found.
-*/
-int sqliteVdbeFindOp(Vdbe *p, int op, int p2){
- int i;
- assert( p->magic==VDBE_MAGIC_INIT );
- for(i=0; i<p->nOp; i++){
- if( p->aOp[i].opcode==op && p->aOp[i].p2==p2 ) return i+1;
- }
- return 0;
-}
-
-/*
-** Return the opcode for a given address.
-*/
-VdbeOp *sqliteVdbeGetOp(Vdbe *p, int addr){
- assert( p->magic==VDBE_MAGIC_INIT );
- assert( addr>=0 && addr<p->nOp );
- return &p->aOp[addr];
-}
-
-/*
-** The following group or routines are employed by installable functions
-** to return their results.
-**
-** The sqlite_set_result_string() routine can be used to return a string
-** value or to return a NULL. To return a NULL, pass in NULL for zResult.
-** A copy is made of the string before this routine returns so it is safe
-** to pass in an ephemeral string.
-**
-** sqlite_set_result_error() works like sqlite_set_result_string() except
-** that it signals a fatal error. The string argument, if any, is the
-** error message. If the argument is NULL a generic substitute error message
-** is used.
-**
-** The sqlite_set_result_int() and sqlite_set_result_double() set the return
-** value of the user function to an integer or a double.
-**
-** These routines are defined here in vdbe.c because they depend on knowing
-** the internals of the sqlite_func structure which is only defined in
-** this source file.
-*/
-char *sqlite_set_result_string(sqlite_func *p, const char *zResult, int n){
- assert( !p->isStep );
- if( p->s.flags & MEM_Dyn ){
- sqliteFree(p->s.z);
- }
- if( zResult==0 ){
- p->s.flags = MEM_Null;
- n = 0;
- p->s.z = 0;
- p->s.n = 0;
- }else{
- if( n<0 ) n = strlen(zResult);
- if( n<NBFS-1 ){
- memcpy(p->s.zShort, zResult, n);
- p->s.zShort[n] = 0;
- p->s.flags = MEM_Str | MEM_Short;
- p->s.z = p->s.zShort;
- }else{
- p->s.z = sqliteMallocRaw( n+1 );
- if( p->s.z ){
- memcpy(p->s.z, zResult, n);
- p->s.z[n] = 0;
- }
- p->s.flags = MEM_Str | MEM_Dyn;
- }
- p->s.n = n+1;
- }
- return p->s.z;
-}
-void sqlite_set_result_int(sqlite_func *p, int iResult){
- assert( !p->isStep );
- if( p->s.flags & MEM_Dyn ){
- sqliteFree(p->s.z);
- }
- p->s.i = iResult;
- p->s.flags = MEM_Int;
-}
-void sqlite_set_result_double(sqlite_func *p, double rResult){
- assert( !p->isStep );
- if( p->s.flags & MEM_Dyn ){
- sqliteFree(p->s.z);
- }
- p->s.r = rResult;
- p->s.flags = MEM_Real;
-}
-void sqlite_set_result_error(sqlite_func *p, const char *zMsg, int n){
- assert( !p->isStep );
- sqlite_set_result_string(p, zMsg, n);
- p->isError = 1;
-}
-
-/*
-** Extract the user data from a sqlite_func structure and return a
-** pointer to it.
-*/
-void *sqlite_user_data(sqlite_func *p){
- assert( p && p->pFunc );
- return p->pFunc->pUserData;
-}
-
-/*
-** Allocate or return the aggregate context for a user function. A new
-** context is allocated on the first call. Subsequent calls return the
-** same context that was returned on prior calls.
-**
-** This routine is defined here in vdbe.c because it depends on knowing
-** the internals of the sqlite_func structure which is only defined in
-** this source file.
-*/
-void *sqlite_aggregate_context(sqlite_func *p, int nByte){
- assert( p && p->pFunc && p->pFunc->xStep );
- if( p->pAgg==0 ){
- if( nByte<=NBFS ){
- p->pAgg = (void*)p->s.z;
- memset(p->pAgg, 0, nByte);
- }else{
- p->pAgg = sqliteMalloc( nByte );
- }
- }
- return p->pAgg;
-}
-
-/*
-** Return the number of times the Step function of a aggregate has been
-** called.
-**
-** This routine is defined here in vdbe.c because it depends on knowing
-** the internals of the sqlite_func structure which is only defined in
-** this source file.
-*/
-int sqlite_aggregate_count(sqlite_func *p){
- assert( p && p->pFunc && p->pFunc->xStep );
- return p->cnt;
-}
-
-#if !defined(NDEBUG) || defined(VDBE_PROFILE)
-/*
-** Print a single opcode. This routine is used for debugging only.
-*/
-void sqliteVdbePrintOp(FILE *pOut, int pc, Op *pOp){
- char *zP3;
- char zPtr[40];
- if( pOp->p3type==P3_POINTER ){
- sprintf(zPtr, "ptr(%#lx)", (long)pOp->p3);
- zP3 = zPtr;
- }else{
- zP3 = pOp->p3;
- }
- if( pOut==0 ) pOut = stdout;
- fprintf(pOut,"%4d %-12s %4d %4d %s\n",
- pc, sqliteOpcodeNames[pOp->opcode], pOp->p1, pOp->p2, zP3 ? zP3 : "");
- fflush(pOut);
-}
-#endif
-
-/*
-** Give a listing of the program in the virtual machine.
-**
-** The interface is the same as sqliteVdbeExec(). But instead of
-** running the code, it invokes the callback once for each instruction.
-** This feature is used to implement "EXPLAIN".
-*/
-int sqliteVdbeList(
- Vdbe *p /* The VDBE */
-){
- sqlite *db = p->db;
- int i;
- int rc = SQLITE_OK;
- static char *azColumnNames[] = {
- "addr", "opcode", "p1", "p2", "p3",
- "int", "text", "int", "int", "text",
- 0
- };
-
- assert( p->popStack==0 );
- assert( p->explain );
- p->azColName = azColumnNames;
- p->azResColumn = p->zArgv;
- for(i=0; i<5; i++) p->zArgv[i] = p->aStack[i].zShort;
- i = p->pc;
- if( i>=p->nOp ){
- p->rc = SQLITE_OK;
- rc = SQLITE_DONE;
- }else if( db->flags & SQLITE_Interrupt ){
- db->flags &= ~SQLITE_Interrupt;
- if( db->magic!=SQLITE_MAGIC_BUSY ){
- p->rc = SQLITE_MISUSE;
- }else{
- p->rc = SQLITE_INTERRUPT;
- }
- rc = SQLITE_ERROR;
- sqliteSetString(&p->zErrMsg, sqlite_error_string(p->rc), (char*)0);
- }else{
- sprintf(p->zArgv[0],"%d",i);
- sprintf(p->zArgv[2],"%d", p->aOp[i].p1);
- sprintf(p->zArgv[3],"%d", p->aOp[i].p2);
- if( p->aOp[i].p3type==P3_POINTER ){
- sprintf(p->aStack[4].zShort, "ptr(%#lx)", (long)p->aOp[i].p3);
- p->zArgv[4] = p->aStack[4].zShort;
- }else{
- p->zArgv[4] = p->aOp[i].p3;
- }
- p->zArgv[1] = sqliteOpcodeNames[p->aOp[i].opcode];
- p->pc = i+1;
- p->azResColumn = p->zArgv;
- p->nResColumn = 5;
- p->rc = SQLITE_OK;
- rc = SQLITE_ROW;
- }
- return rc;
-}
-
-/*
-** Prepare a virtual machine for execution. This involves things such
-** as allocating stack space and initializing the program counter.
-** After the VDBE has be prepped, it can be executed by one or more
-** calls to sqliteVdbeExec().
-*/
-void sqliteVdbeMakeReady(
- Vdbe *p, /* The VDBE */
- int nVar, /* Number of '?' see in the SQL statement */
- int isExplain /* True if the EXPLAIN keywords is present */
-){
- int n;
-
- assert( p!=0 );
- assert( p->magic==VDBE_MAGIC_INIT );
-
- /* Add a HALT instruction to the very end of the program.
- */
- if( p->nOp==0 || (p->aOp && p->aOp[p->nOp-1].opcode!=OP_Halt) ){
- sqliteVdbeAddOp(p, OP_Halt, 0, 0);
- }
-
- /* No instruction ever pushes more than a single element onto the
- ** stack. And the stack never grows on successive executions of the
- ** same loop. So the total number of instructions is an upper bound
- ** on the maximum stack depth required.
- **
- ** Allocation all the stack space we will ever need.
- */
- if( p->aStack==0 ){
- p->nVar = nVar;
- assert( nVar>=0 );
- n = isExplain ? 10 : p->nOp;
- p->aStack = sqliteMalloc(
- n*(sizeof(p->aStack[0]) + 2*sizeof(char*)) /* aStack and zArgv */
- + p->nVar*(sizeof(char*)+sizeof(int)+1) /* azVar, anVar, abVar */
- );
- p->zArgv = (char**)&p->aStack[n];
- p->azColName = (char**)&p->zArgv[n];
- p->azVar = (char**)&p->azColName[n];
- p->anVar = (int*)&p->azVar[p->nVar];
- p->abVar = (u8*)&p->anVar[p->nVar];
- }
-
- sqliteHashInit(&p->agg.hash, SQLITE_HASH_BINARY, 0);
- p->agg.pSearch = 0;
-#ifdef MEMORY_DEBUG
- if( sqliteOsFileExists("vdbe_trace") ){
- p->trace = stdout;
- }
-#endif
- p->pTos = &p->aStack[-1];
- p->pc = 0;
- p->rc = SQLITE_OK;
- p->uniqueCnt = 0;
- p->returnDepth = 0;
- p->errorAction = OE_Abort;
- p->undoTransOnError = 0;
- p->popStack = 0;
- p->explain |= isExplain;
- p->magic = VDBE_MAGIC_RUN;
-#ifdef VDBE_PROFILE
- {
- int i;
- for(i=0; i<p->nOp; i++){
- p->aOp[i].cnt = 0;
- p->aOp[i].cycles = 0;
- }
- }
-#endif
-}
-
-
-/*
-** Remove any elements that remain on the sorter for the VDBE given.
-*/
-void sqliteVdbeSorterReset(Vdbe *p){
- while( p->pSort ){
- Sorter *pSorter = p->pSort;
- p->pSort = pSorter->pNext;
- sqliteFree(pSorter->zKey);
- sqliteFree(pSorter->pData);
- sqliteFree(pSorter);
- }
-}
-
-/*
-** Reset an Agg structure. Delete all its contents.
-**
-** For installable aggregate functions, if the step function has been
-** called, make sure the finalizer function has also been called. The
-** finalizer might need to free memory that was allocated as part of its
-** private context. If the finalizer has not been called yet, call it
-** now.
-*/
-void sqliteVdbeAggReset(Agg *pAgg){
- int i;
- HashElem *p;
- for(p = sqliteHashFirst(&pAgg->hash); p; p = sqliteHashNext(p)){
- AggElem *pElem = sqliteHashData(p);
- assert( pAgg->apFunc!=0 );
- for(i=0; i<pAgg->nMem; i++){
- Mem *pMem = &pElem->aMem[i];
- if( pAgg->apFunc[i] && (pMem->flags & MEM_AggCtx)!=0 ){
- sqlite_func ctx;
- ctx.pFunc = pAgg->apFunc[i];
- ctx.s.flags = MEM_Null;
- ctx.pAgg = pMem->z;
- ctx.cnt = pMem->i;
- ctx.isStep = 0;
- ctx.isError = 0;
- (*pAgg->apFunc[i]->xFinalize)(&ctx);
- if( pMem->z!=0 && pMem->z!=pMem->zShort ){
- sqliteFree(pMem->z);
- }
- if( ctx.s.flags & MEM_Dyn ){
- sqliteFree(ctx.s.z);
- }
- }else if( pMem->flags & MEM_Dyn ){
- sqliteFree(pMem->z);
- }
- }
- sqliteFree(pElem);
- }
- sqliteHashClear(&pAgg->hash);
- sqliteFree(pAgg->apFunc);
- pAgg->apFunc = 0;
- pAgg->pCurrent = 0;
- pAgg->pSearch = 0;
- pAgg->nMem = 0;
-}
-
-/*
-** Delete a keylist
-*/
-void sqliteVdbeKeylistFree(Keylist *p){
- while( p ){
- Keylist *pNext = p->pNext;
- sqliteFree(p);
- p = pNext;
- }
-}
-
-/*
-** Close a cursor and release all the resources that cursor happens
-** to hold.
-*/
-void sqliteVdbeCleanupCursor(Cursor *pCx){
- if( pCx->pCursor ){
- sqliteBtreeCloseCursor(pCx->pCursor);
- }
- if( pCx->pBt ){
- sqliteBtreeClose(pCx->pBt);
- }
- sqliteFree(pCx->pData);
- memset(pCx, 0, sizeof(Cursor));
-}
-
-/*
-** Close all cursors
-*/
-static void closeAllCursors(Vdbe *p){
- int i;
- for(i=0; i<p->nCursor; i++){
- sqliteVdbeCleanupCursor(&p->aCsr[i]);
- }
- sqliteFree(p->aCsr);
- p->aCsr = 0;
- p->nCursor = 0;
-}
-
-/*
-** Clean up the VM after execution.
-**
-** This routine will automatically close any cursors, lists, and/or
-** sorters that were left open. It also deletes the values of
-** variables in the azVariable[] array.
-*/
-static void Cleanup(Vdbe *p){
- int i;
- if( p->aStack ){
- Mem *pTos = p->pTos;
- while( pTos>=p->aStack ){
- if( pTos->flags & MEM_Dyn ){
- sqliteFree(pTos->z);
- }
- pTos--;
- }
- p->pTos = pTos;
- }
- closeAllCursors(p);
- if( p->aMem ){
- for(i=0; i<p->nMem; i++){
- if( p->aMem[i].flags & MEM_Dyn ){
- sqliteFree(p->aMem[i].z);
- }
- }
- }
- sqliteFree(p->aMem);
- p->aMem = 0;
- p->nMem = 0;
- if( p->pList ){
- sqliteVdbeKeylistFree(p->pList);
- p->pList = 0;
- }
- sqliteVdbeSorterReset(p);
- if( p->pFile ){
- if( p->pFile!=stdin ) fclose(p->pFile);
- p->pFile = 0;
- }
- if( p->azField ){
- sqliteFree(p->azField);
- p->azField = 0;
- }
- p->nField = 0;
- if( p->zLine ){
- sqliteFree(p->zLine);
- p->zLine = 0;
- }
- p->nLineAlloc = 0;
- sqliteVdbeAggReset(&p->agg);
- if( p->aSet ){
- for(i=0; i<p->nSet; i++){
- sqliteHashClear(&p->aSet[i].hash);
- }
- }
- sqliteFree(p->aSet);
- p->aSet = 0;
- p->nSet = 0;
- if( p->keylistStack ){
- int ii;
- for(ii = 0; ii < p->keylistStackDepth; ii++){
- sqliteVdbeKeylistFree(p->keylistStack[ii]);
- }
- sqliteFree(p->keylistStack);
- p->keylistStackDepth = 0;
- p->keylistStack = 0;
- }
- sqliteFree(p->contextStack);
- p->contextStack = 0;
- sqliteFree(p->zErrMsg);
- p->zErrMsg = 0;
-}
-
-/*
-** Clean up a VDBE after execution but do not delete the VDBE just yet.
-** Write any error messages into *pzErrMsg. Return the result code.
-**
-** After this routine is run, the VDBE should be ready to be executed
-** again.
-*/
-int sqliteVdbeReset(Vdbe *p, char **pzErrMsg){
- sqlite *db = p->db;
- int i;
-
- if( p->magic!=VDBE_MAGIC_RUN && p->magic!=VDBE_MAGIC_HALT ){
- sqliteSetString(pzErrMsg, sqlite_error_string(SQLITE_MISUSE), (char*)0);
- return SQLITE_MISUSE;
- }
- if( p->zErrMsg ){
- if( pzErrMsg && *pzErrMsg==0 ){
- *pzErrMsg = p->zErrMsg;
- }else{
- sqliteFree(p->zErrMsg);
- }
- p->zErrMsg = 0;
- }else if( p->rc ){
- sqliteSetString(pzErrMsg, sqlite_error_string(p->rc), (char*)0);
- }
- Cleanup(p);
- if( p->rc!=SQLITE_OK ){
- switch( p->errorAction ){
- case OE_Abort: {
- if( !p->undoTransOnError ){
- for(i=0; i<db->nDb; i++){
- if( db->aDb[i].pBt ){
- sqliteBtreeRollbackCkpt(db->aDb[i].pBt);
- }
- }
- break;
- }
- /* Fall through to ROLLBACK */
- }
- case OE_Rollback: {
- sqliteRollbackAll(db);
- db->flags &= ~SQLITE_InTrans;
- db->onError = OE_Default;
- break;
- }
- default: {
- if( p->undoTransOnError ){
- sqliteRollbackAll(db);
- db->flags &= ~SQLITE_InTrans;
- db->onError = OE_Default;
- }
- break;
- }
- }
- sqliteRollbackInternalChanges(db);
- }
- for(i=0; i<db->nDb; i++){
- if( db->aDb[i].pBt && db->aDb[i].inTrans==2 ){
- sqliteBtreeCommitCkpt(db->aDb[i].pBt);
- db->aDb[i].inTrans = 1;
- }
- }
- assert( p->pTos<&p->aStack[p->pc] || sqlite_malloc_failed==1 );
-#ifdef VDBE_PROFILE
- {
- FILE *out = fopen("vdbe_profile.out", "a");
- if( out ){
- int i;
- fprintf(out, "---- ");
- for(i=0; i<p->nOp; i++){
- fprintf(out, "%02x", p->aOp[i].opcode);
- }
- fprintf(out, "\n");
- for(i=0; i<p->nOp; i++){
- fprintf(out, "%6d %10lld %8lld ",
- p->aOp[i].cnt,
- p->aOp[i].cycles,
- p->aOp[i].cnt>0 ? p->aOp[i].cycles/p->aOp[i].cnt : 0
- );
- sqliteVdbePrintOp(out, i, &p->aOp[i]);
- }
- fclose(out);
- }
- }
-#endif
- p->magic = VDBE_MAGIC_INIT;
- return p->rc;
-}
-
-/*
-** Clean up and delete a VDBE after execution. Return an integer which is
-** the result code. Write any error message text into *pzErrMsg.
-*/
-int sqliteVdbeFinalize(Vdbe *p, char **pzErrMsg){
- int rc;
- sqlite *db;
-
- if( p->magic!=VDBE_MAGIC_RUN && p->magic!=VDBE_MAGIC_HALT ){
- sqliteSetString(pzErrMsg, sqlite_error_string(SQLITE_MISUSE), (char*)0);
- return SQLITE_MISUSE;
- }
- db = p->db;
- rc = sqliteVdbeReset(p, pzErrMsg);
- sqliteVdbeDelete(p);
- if( db->want_to_close && db->pVdbe==0 ){
- sqlite_close(db);
- }
- if( rc==SQLITE_SCHEMA ){
- sqliteResetInternalSchema(db, 0);
- }
- return rc;
-}
-
-/*
-** Set the values of all variables. Variable $1 in the original SQL will
-** be the string azValue[0]. $2 will have the value azValue[1]. And
-** so forth. If a value is out of range (for example $3 when nValue==2)
-** then its value will be NULL.
-**
-** This routine overrides any prior call.
-*/
-int sqlite_bind(sqlite_vm *pVm, int i, const char *zVal, int len, int copy){
- Vdbe *p = (Vdbe*)pVm;
- if( p->magic!=VDBE_MAGIC_RUN || p->pc!=0 ){
- return SQLITE_MISUSE;
- }
- if( i<1 || i>p->nVar ){
- return SQLITE_RANGE;
- }
- i--;
- if( p->abVar[i] ){
- sqliteFree(p->azVar[i]);
- }
- if( zVal==0 ){
- copy = 0;
- len = 0;
- }
- if( len<0 ){
- len = strlen(zVal)+1;
- }
- if( copy ){
- p->azVar[i] = sqliteMalloc( len );
- if( p->azVar[i] ) memcpy(p->azVar[i], zVal, len);
- }else{
- p->azVar[i] = (char*)zVal;
- }
- p->abVar[i] = copy;
- p->anVar[i] = len;
- return SQLITE_OK;
-}
-
-
-/*
-** Delete an entire VDBE.
-*/
-void sqliteVdbeDelete(Vdbe *p){
- int i;
- if( p==0 ) return;
- Cleanup(p);
- if( p->pPrev ){
- p->pPrev->pNext = p->pNext;
- }else{
- assert( p->db->pVdbe==p );
- p->db->pVdbe = p->pNext;
- }
- if( p->pNext ){
- p->pNext->pPrev = p->pPrev;
- }
- p->pPrev = p->pNext = 0;
- if( p->nOpAlloc==0 ){
- p->aOp = 0;
- p->nOp = 0;
- }
- for(i=0; i<p->nOp; i++){
- if( p->aOp[i].p3type==P3_DYNAMIC ){
- sqliteFree(p->aOp[i].p3);
- }
- }
- for(i=0; i<p->nVar; i++){
- if( p->abVar[i] ) sqliteFree(p->azVar[i]);
- }
- sqliteFree(p->aOp);
- sqliteFree(p->aLabel);
- sqliteFree(p->aStack);
- p->magic = VDBE_MAGIC_DEAD;
- sqliteFree(p);
-}
-
-/*
-** Convert an integer in between the native integer format and
-** the bigEndian format used as the record number for tables.
-**
-** The bigEndian format (most significant byte first) is used for
-** record numbers so that records will sort into the correct order
-** even though memcmp() is used to compare the keys. On machines
-** whose native integer format is little endian (ex: i486) the
-** order of bytes is reversed. On native big-endian machines
-** (ex: Alpha, Sparc, Motorola) the byte order is the same.
-**
-** This function is its own inverse. In other words
-**
-** X == byteSwap(byteSwap(X))
-*/
-int sqliteVdbeByteSwap(int x){
- union {
- char zBuf[sizeof(int)];
- int i;
- } ux;
- ux.zBuf[3] = x&0xff;
- ux.zBuf[2] = (x>>8)&0xff;
- ux.zBuf[1] = (x>>16)&0xff;
- ux.zBuf[0] = (x>>24)&0xff;
- return ux.i;
-}
-
-/*
-** If a MoveTo operation is pending on the given cursor, then do that
-** MoveTo now. Return an error code. If no MoveTo is pending, this
-** routine does nothing and returns SQLITE_OK.
-*/
-int sqliteVdbeCursorMoveto(Cursor *p){
- if( p->deferredMoveto ){
- int res;
- extern int sqlite_search_count;
- sqliteBtreeMoveto(p->pCursor, (char*)&p->movetoTarget, sizeof(int), &res);
- p->lastRecno = keyToInt(p->movetoTarget);
- p->recnoIsValid = res==0;
- if( res<0 ){
- sqliteBtreeNext(p->pCursor, &res);
- }
- sqlite_search_count++;
- p->deferredMoveto = 0;
- }
- return SQLITE_OK;
-}
+++ /dev/null
-/*
-** 2001 September 15
-**
-** The author disclaims copyright to this source code. In place of
-** a legal notice, here is a blessing:
-**
-** May you do good and not evil.
-** May you find forgiveness for yourself and forgive others.
-** May you share freely, never taking more than you give.
-**
-*************************************************************************
-** This module contains C code that generates VDBE code used to process
-** the WHERE clause of SQL statements.
-**
-** $Id: where.c,v 1.1.1.1 2004/08/08 15:03:58 matt Exp $
-*/
-#include "sqliteInt.h"
-
-/*
-** The query generator uses an array of instances of this structure to
-** help it analyze the subexpressions of the WHERE clause. Each WHERE
-** clause subexpression is separated from the others by an AND operator.
-*/
-typedef struct ExprInfo ExprInfo;
-struct ExprInfo {
- Expr *p; /* Pointer to the subexpression */
- u8 indexable; /* True if this subexprssion is usable by an index */
- short int idxLeft; /* p->pLeft is a column in this table number. -1 if
- ** p->pLeft is not the column of any table */
- short int idxRight; /* p->pRight is a column in this table number. -1 if
- ** p->pRight is not the column of any table */
- unsigned prereqLeft; /* Bitmask of tables referenced by p->pLeft */
- unsigned prereqRight; /* Bitmask of tables referenced by p->pRight */
- unsigned prereqAll; /* Bitmask of tables referenced by p */
-};
-
-/*
-** An instance of the following structure keeps track of a mapping
-** between VDBE cursor numbers and bitmasks. The VDBE cursor numbers
-** are small integers contained in SrcList_item.iCursor and Expr.iTable
-** fields. For any given WHERE clause, we want to track which cursors
-** are being used, so we assign a single bit in a 32-bit word to track
-** that cursor. Then a 32-bit integer is able to show the set of all
-** cursors being used.
-*/
-typedef struct ExprMaskSet ExprMaskSet;
-struct ExprMaskSet {
- int n; /* Number of assigned cursor values */
- int ix[31]; /* Cursor assigned to each bit */
-};
-
-/*
-** Determine the number of elements in an array.
-*/
-#define ARRAYSIZE(X) (sizeof(X)/sizeof(X[0]))
-
-/*
-** This routine is used to divide the WHERE expression into subexpressions
-** separated by the AND operator.
-**
-** aSlot[] is an array of subexpressions structures.
-** There are nSlot spaces left in this array. This routine attempts to
-** split pExpr into subexpressions and fills aSlot[] with those subexpressions.
-** The return value is the number of slots filled.
-*/
-static int exprSplit(int nSlot, ExprInfo *aSlot, Expr *pExpr){
- int cnt = 0;
- if( pExpr==0 || nSlot<1 ) return 0;
- if( nSlot==1 || pExpr->op!=TK_AND ){
- aSlot[0].p = pExpr;
- return 1;
- }
- if( pExpr->pLeft->op!=TK_AND ){
- aSlot[0].p = pExpr->pLeft;
- cnt = 1 + exprSplit(nSlot-1, &aSlot[1], pExpr->pRight);
- }else{
- cnt = exprSplit(nSlot, aSlot, pExpr->pLeft);
- cnt += exprSplit(nSlot-cnt, &aSlot[cnt], pExpr->pRight);
- }
- return cnt;
-}
-
-/*
-** Initialize an expression mask set
-*/
-#define initMaskSet(P) memset(P, 0, sizeof(*P))
-
-/*
-** Return the bitmask for the given cursor. Assign a new bitmask
-** if this is the first time the cursor has been seen.
-*/
-static int getMask(ExprMaskSet *pMaskSet, int iCursor){
- int i;
- for(i=0; i<pMaskSet->n; i++){
- if( pMaskSet->ix[i]==iCursor ) return 1<<i;
- }
- if( i==pMaskSet->n && i<ARRAYSIZE(pMaskSet->ix) ){
- pMaskSet->n++;
- pMaskSet->ix[i] = iCursor;
- return 1<<i;
- }
- return 0;
-}
-
-/*
-** Destroy an expression mask set
-*/
-#define freeMaskSet(P) /* NO-OP */
-
-/*
-** This routine walks (recursively) an expression tree and generates
-** a bitmask indicating which tables are used in that expression
-** tree.
-**
-** In order for this routine to work, the calling function must have
-** previously invoked sqliteExprResolveIds() on the expression. See
-** the header comment on that routine for additional information.
-** The sqliteExprResolveIds() routines looks for column names and
-** sets their opcodes to TK_COLUMN and their Expr.iTable fields to
-** the VDBE cursor number of the table.
-*/
-static int exprTableUsage(ExprMaskSet *pMaskSet, Expr *p){
- unsigned int mask = 0;
- if( p==0 ) return 0;
- if( p->op==TK_COLUMN ){
- mask = getMask(pMaskSet, p->iTable);
- if( mask==0 ) mask = -1;
- return mask;
- }
- if( p->pRight ){
- mask = exprTableUsage(pMaskSet, p->pRight);
- }
- if( p->pLeft ){
- mask |= exprTableUsage(pMaskSet, p->pLeft);
- }
- if( p->pList ){
- int i;
- for(i=0; i<p->pList->nExpr; i++){
- mask |= exprTableUsage(pMaskSet, p->pList->a[i].pExpr);
- }
- }
- return mask;
-}
-
-/*
-** Return TRUE if the given operator is one of the operators that is
-** allowed for an indexable WHERE clause. The allowed operators are
-** "=", "<", ">", "<=", ">=", and "IN".
-*/
-static int allowedOp(int op){
- switch( op ){
- case TK_LT:
- case TK_LE:
- case TK_GT:
- case TK_GE:
- case TK_EQ:
- case TK_IN:
- return 1;
- default:
- return 0;
- }
-}
-
-/*
-** The input to this routine is an ExprInfo structure with only the
-** "p" field filled in. The job of this routine is to analyze the
-** subexpression and populate all the other fields of the ExprInfo
-** structure.
-*/
-static void exprAnalyze(ExprMaskSet *pMaskSet, ExprInfo *pInfo){
- Expr *pExpr = pInfo->p;
- pInfo->prereqLeft = exprTableUsage(pMaskSet, pExpr->pLeft);
- pInfo->prereqRight = exprTableUsage(pMaskSet, pExpr->pRight);
- pInfo->prereqAll = exprTableUsage(pMaskSet, pExpr);
- pInfo->indexable = 0;
- pInfo->idxLeft = -1;
- pInfo->idxRight = -1;
- if( allowedOp(pExpr->op) && (pInfo->prereqRight & pInfo->prereqLeft)==0 ){
- if( pExpr->pRight && pExpr->pRight->op==TK_COLUMN ){
- pInfo->idxRight = pExpr->pRight->iTable;
- pInfo->indexable = 1;
- }
- if( pExpr->pLeft->op==TK_COLUMN ){
- pInfo->idxLeft = pExpr->pLeft->iTable;
- pInfo->indexable = 1;
- }
- }
-}
-
-/*
-** pOrderBy is an ORDER BY clause from a SELECT statement. pTab is the
-** left-most table in the FROM clause of that same SELECT statement and
-** the table has a cursor number of "base".
-**
-** This routine attempts to find an index for pTab that generates the
-** correct record sequence for the given ORDER BY clause. The return value
-** is a pointer to an index that does the job. NULL is returned if the
-** table has no index that will generate the correct sort order.
-**
-** If there are two or more indices that generate the correct sort order
-** and pPreferredIdx is one of those indices, then return pPreferredIdx.
-**
-** nEqCol is the number of columns of pPreferredIdx that are used as
-** equality constraints. Any index returned must have exactly this same
-** set of columns. The ORDER BY clause only matches index columns beyond the
-** the first nEqCol columns.
-**
-** All terms of the ORDER BY clause must be either ASC or DESC. The
-** *pbRev value is set to 1 if the ORDER BY clause is all DESC and it is
-** set to 0 if the ORDER BY clause is all ASC.
-*/
-static Index *findSortingIndex(
- Table *pTab, /* The table to be sorted */
- int base, /* Cursor number for pTab */
- ExprList *pOrderBy, /* The ORDER BY clause */
- Index *pPreferredIdx, /* Use this index, if possible and not NULL */
- int nEqCol, /* Number of index columns used with == constraints */
- int *pbRev /* Set to 1 if ORDER BY is DESC */
-){
- int i, j;
- Index *pMatch;
- Index *pIdx;
- int sortOrder;
-
- assert( pOrderBy!=0 );
- assert( pOrderBy->nExpr>0 );
- sortOrder = pOrderBy->a[0].sortOrder & SQLITE_SO_DIRMASK;
- for(i=0; i<pOrderBy->nExpr; i++){
- Expr *p;
- if( (pOrderBy->a[i].sortOrder & SQLITE_SO_DIRMASK)!=sortOrder ){
- /* Indices can only be used if all ORDER BY terms are either
- ** DESC or ASC. Indices cannot be used on a mixture. */
- return 0;
- }
- if( (pOrderBy->a[i].sortOrder & SQLITE_SO_TYPEMASK)!=SQLITE_SO_UNK ){
- /* Do not sort by index if there is a COLLATE clause */
- return 0;
- }
- p = pOrderBy->a[i].pExpr;
- if( p->op!=TK_COLUMN || p->iTable!=base ){
- /* Can not use an index sort on anything that is not a column in the
- ** left-most table of the FROM clause */
- return 0;
- }
- }
-
- /* If we get this far, it means the ORDER BY clause consists only of
- ** ascending columns in the left-most table of the FROM clause. Now
- ** check for a matching index.
- */
- pMatch = 0;
- for(pIdx=pTab->pIndex; pIdx; pIdx=pIdx->pNext){
- int nExpr = pOrderBy->nExpr;
- if( pIdx->nColumn < nEqCol || pIdx->nColumn < nExpr ) continue;
- for(i=j=0; i<nEqCol; i++){
- if( pPreferredIdx->aiColumn[i]!=pIdx->aiColumn[i] ) break;
- if( j<nExpr && pOrderBy->a[j].pExpr->iColumn==pIdx->aiColumn[i] ){ j++; }
- }
- if( i<nEqCol ) continue;
- for(i=0; i+j<nExpr; i++){
- if( pOrderBy->a[i+j].pExpr->iColumn!=pIdx->aiColumn[i+nEqCol] ) break;
- }
- if( i+j>=nExpr ){
- pMatch = pIdx;
- if( pIdx==pPreferredIdx ) break;
- }
- }
- if( pMatch && pbRev ){
- *pbRev = sortOrder==SQLITE_SO_DESC;
- }
- return pMatch;
-}
-
-/*
-** Disable a term in the WHERE clause. Except, do not disable the term
-** if it controls a LEFT OUTER JOIN and it did not originate in the ON
-** or USING clause of that join.
-**
-** Consider the term t2.z='ok' in the following queries:
-**
-** (1) SELECT * FROM t1 LEFT JOIN t2 ON t1.a=t2.x WHERE t2.z='ok'
-** (2) SELECT * FROM t1 LEFT JOIN t2 ON t1.a=t2.x AND t2.z='ok'
-** (3) SELECT * FROM t1, t2 WHERE t1.a=t2.x AND t2.z='ok'
-**
-** The t2.z='ok' is disabled in the in (2) because it did not originate
-** in the ON clause. The term is disabled in (3) because it is not part
-** of a LEFT OUTER JOIN. In (1), the term is not disabled.
-**
-** Disabling a term causes that term to not be tested in the inner loop
-** of the join. Disabling is an optimization. We would get the correct
-** results if nothing were ever disabled, but joins might run a little
-** slower. The trick is to disable as much as we can without disabling
-** too much. If we disabled in (1), we'd get the wrong answer.
-** See ticket #813.
-*/
-static void disableTerm(WhereLevel *pLevel, Expr **ppExpr){
- Expr *pExpr = *ppExpr;
- if( pLevel->iLeftJoin==0 || ExprHasProperty(pExpr, EP_FromJoin) ){
- *ppExpr = 0;
- }
-}
-
-/*
-** Generate the beginning of the loop used for WHERE clause processing.
-** The return value is a pointer to an (opaque) structure that contains
-** information needed to terminate the loop. Later, the calling routine
-** should invoke sqliteWhereEnd() with the return value of this function
-** in order to complete the WHERE clause processing.
-**
-** If an error occurs, this routine returns NULL.
-**
-** The basic idea is to do a nested loop, one loop for each table in
-** the FROM clause of a select. (INSERT and UPDATE statements are the
-** same as a SELECT with only a single table in the FROM clause.) For
-** example, if the SQL is this:
-**
-** SELECT * FROM t1, t2, t3 WHERE ...;
-**
-** Then the code generated is conceptually like the following:
-**
-** foreach row1 in t1 do \ Code generated
-** foreach row2 in t2 do |-- by sqliteWhereBegin()
-** foreach row3 in t3 do /
-** ...
-** end \ Code generated
-** end |-- by sqliteWhereEnd()
-** end /
-**
-** There are Btree cursors associated with each table. t1 uses cursor
-** number pTabList->a[0].iCursor. t2 uses the cursor pTabList->a[1].iCursor.
-** And so forth. This routine generates code to open those VDBE cursors
-** and sqliteWhereEnd() generates the code to close them.
-**
-** If the WHERE clause is empty, the foreach loops must each scan their
-** entire tables. Thus a three-way join is an O(N^3) operation. But if
-** the tables have indices and there are terms in the WHERE clause that
-** refer to those indices, a complete table scan can be avoided and the
-** code will run much faster. Most of the work of this routine is checking
-** to see if there are indices that can be used to speed up the loop.
-**
-** Terms of the WHERE clause are also used to limit which rows actually
-** make it to the "..." in the middle of the loop. After each "foreach",
-** terms of the WHERE clause that use only terms in that loop and outer
-** loops are evaluated and if false a jump is made around all subsequent
-** inner loops (or around the "..." if the test occurs within the inner-
-** most loop)
-**
-** OUTER JOINS
-**
-** An outer join of tables t1 and t2 is conceptally coded as follows:
-**
-** foreach row1 in t1 do
-** flag = 0
-** foreach row2 in t2 do
-** start:
-** ...
-** flag = 1
-** end
-** if flag==0 then
-** move the row2 cursor to a null row
-** goto start
-** fi
-** end
-**
-** ORDER BY CLAUSE PROCESSING
-**
-** *ppOrderBy is a pointer to the ORDER BY clause of a SELECT statement,
-** if there is one. If there is no ORDER BY clause or if this routine
-** is called from an UPDATE or DELETE statement, then ppOrderBy is NULL.
-**
-** If an index can be used so that the natural output order of the table
-** scan is correct for the ORDER BY clause, then that index is used and
-** *ppOrderBy is set to NULL. This is an optimization that prevents an
-** unnecessary sort of the result set if an index appropriate for the
-** ORDER BY clause already exists.
-**
-** If the where clause loops cannot be arranged to provide the correct
-** output order, then the *ppOrderBy is unchanged.
-*/
-WhereInfo *sqliteWhereBegin(
- Parse *pParse, /* The parser context */
- SrcList *pTabList, /* A list of all tables to be scanned */
- Expr *pWhere, /* The WHERE clause */
- int pushKey, /* If TRUE, leave the table key on the stack */
- ExprList **ppOrderBy /* An ORDER BY clause, or NULL */
-){
- int i; /* Loop counter */
- WhereInfo *pWInfo; /* Will become the return value of this function */
- Vdbe *v = pParse->pVdbe; /* The virtual database engine */
- int brk, cont = 0; /* Addresses used during code generation */
- int nExpr; /* Number of subexpressions in the WHERE clause */
- int loopMask; /* One bit set for each outer loop */
- int haveKey; /* True if KEY is on the stack */
- ExprMaskSet maskSet; /* The expression mask set */
- int iDirectEq[32]; /* Term of the form ROWID==X for the N-th table */
- int iDirectLt[32]; /* Term of the form ROWID<X or ROWID<=X */
- int iDirectGt[32]; /* Term of the form ROWID>X or ROWID>=X */
- ExprInfo aExpr[101]; /* The WHERE clause is divided into these expressions */
-
- /* pushKey is only allowed if there is a single table (as in an INSERT or
- ** UPDATE statement)
- */
- assert( pushKey==0 || pTabList->nSrc==1 );
-
- /* Split the WHERE clause into separate subexpressions where each
- ** subexpression is separated by an AND operator. If the aExpr[]
- ** array fills up, the last entry might point to an expression which
- ** contains additional unfactored AND operators.
- */
- initMaskSet(&maskSet);
- memset(aExpr, 0, sizeof(aExpr));
- nExpr = exprSplit(ARRAYSIZE(aExpr), aExpr, pWhere);
- if( nExpr==ARRAYSIZE(aExpr) ){
- sqliteErrorMsg(pParse, "WHERE clause too complex - no more "
- "than %d terms allowed", (int)ARRAYSIZE(aExpr)-1);
- return 0;
- }
-
- /* Allocate and initialize the WhereInfo structure that will become the
- ** return value.
- */
- pWInfo = sqliteMalloc( sizeof(WhereInfo) + pTabList->nSrc*sizeof(WhereLevel));
- if( sqlite_malloc_failed ){
- sqliteFree(pWInfo);
- return 0;
- }
- pWInfo->pParse = pParse;
- pWInfo->pTabList = pTabList;
- pWInfo->peakNTab = pWInfo->savedNTab = pParse->nTab;
- pWInfo->iBreak = sqliteVdbeMakeLabel(v);
-
- /* Special case: a WHERE clause that is constant. Evaluate the
- ** expression and either jump over all of the code or fall thru.
- */
- if( pWhere && (pTabList->nSrc==0 || sqliteExprIsConstant(pWhere)) ){
- sqliteExprIfFalse(pParse, pWhere, pWInfo->iBreak, 1);
- pWhere = 0;
- }
-
- /* Analyze all of the subexpressions.
- */
- for(i=0; i<nExpr; i++){
- exprAnalyze(&maskSet, &aExpr[i]);
-
- /* If we are executing a trigger body, remove all references to
- ** new.* and old.* tables from the prerequisite masks.
- */
- if( pParse->trigStack ){
- int x;
- if( (x = pParse->trigStack->newIdx) >= 0 ){
- int mask = ~getMask(&maskSet, x);
- aExpr[i].prereqRight &= mask;
- aExpr[i].prereqLeft &= mask;
- aExpr[i].prereqAll &= mask;
- }
- if( (x = pParse->trigStack->oldIdx) >= 0 ){
- int mask = ~getMask(&maskSet, x);
- aExpr[i].prereqRight &= mask;
- aExpr[i].prereqLeft &= mask;
- aExpr[i].prereqAll &= mask;
- }
- }
- }
-
- /* Figure out what index to use (if any) for each nested loop.
- ** Make pWInfo->a[i].pIdx point to the index to use for the i-th nested
- ** loop where i==0 is the outer loop and i==pTabList->nSrc-1 is the inner
- ** loop.
- **
- ** If terms exist that use the ROWID of any table, then set the
- ** iDirectEq[], iDirectLt[], or iDirectGt[] elements for that table
- ** to the index of the term containing the ROWID. We always prefer
- ** to use a ROWID which can directly access a table rather than an
- ** index which requires reading an index first to get the rowid then
- ** doing a second read of the actual database table.
- **
- ** Actually, if there are more than 32 tables in the join, only the
- ** first 32 tables are candidates for indices. This is (again) due
- ** to the limit of 32 bits in an integer bitmask.
- */
- loopMask = 0;
- for(i=0; i<pTabList->nSrc && i<ARRAYSIZE(iDirectEq); i++){
- int j;
- int iCur = pTabList->a[i].iCursor; /* The cursor for this table */
- int mask = getMask(&maskSet, iCur); /* Cursor mask for this table */
- Table *pTab = pTabList->a[i].pTab;
- Index *pIdx;
- Index *pBestIdx = 0;
- int bestScore = 0;
-
- /* Check to see if there is an expression that uses only the
- ** ROWID field of this table. For terms of the form ROWID==expr
- ** set iDirectEq[i] to the index of the term. For terms of the
- ** form ROWID<expr or ROWID<=expr set iDirectLt[i] to the term index.
- ** For terms like ROWID>expr or ROWID>=expr set iDirectGt[i].
- **
- ** (Added:) Treat ROWID IN expr like ROWID=expr.
- */
- pWInfo->a[i].iCur = -1;
- iDirectEq[i] = -1;
- iDirectLt[i] = -1;
- iDirectGt[i] = -1;
- for(j=0; j<nExpr; j++){
- if( aExpr[j].idxLeft==iCur && aExpr[j].p->pLeft->iColumn<0
- && (aExpr[j].prereqRight & loopMask)==aExpr[j].prereqRight ){
- switch( aExpr[j].p->op ){
- case TK_IN:
- case TK_EQ: iDirectEq[i] = j; break;
- case TK_LE:
- case TK_LT: iDirectLt[i] = j; break;
- case TK_GE:
- case TK_GT: iDirectGt[i] = j; break;
- }
- }
- if( aExpr[j].idxRight==iCur && aExpr[j].p->pRight->iColumn<0
- && (aExpr[j].prereqLeft & loopMask)==aExpr[j].prereqLeft ){
- switch( aExpr[j].p->op ){
- case TK_EQ: iDirectEq[i] = j; break;
- case TK_LE:
- case TK_LT: iDirectGt[i] = j; break;
- case TK_GE:
- case TK_GT: iDirectLt[i] = j; break;
- }
- }
- }
- if( iDirectEq[i]>=0 ){
- loopMask |= mask;
- pWInfo->a[i].pIdx = 0;
- continue;
- }
-
- /* Do a search for usable indices. Leave pBestIdx pointing to
- ** the "best" index. pBestIdx is left set to NULL if no indices
- ** are usable.
- **
- ** The best index is determined as follows. For each of the
- ** left-most terms that is fixed by an equality operator, add
- ** 8 to the score. The right-most term of the index may be
- ** constrained by an inequality. Add 1 if for an "x<..." constraint
- ** and add 2 for an "x>..." constraint. Chose the index that
- ** gives the best score.
- **
- ** This scoring system is designed so that the score can later be
- ** used to determine how the index is used. If the score&7 is 0
- ** then all constraints are equalities. If score&1 is not 0 then
- ** there is an inequality used as a termination key. (ex: "x<...")
- ** If score&2 is not 0 then there is an inequality used as the
- ** start key. (ex: "x>..."). A score or 4 is the special case
- ** of an IN operator constraint. (ex: "x IN ...").
- **
- ** The IN operator (as in "<expr> IN (...)") is treated the same as
- ** an equality comparison except that it can only be used on the
- ** left-most column of an index and other terms of the WHERE clause
- ** cannot be used in conjunction with the IN operator to help satisfy
- ** other columns of the index.
- */
- for(pIdx=pTab->pIndex; pIdx; pIdx=pIdx->pNext){
- int eqMask = 0; /* Index columns covered by an x=... term */
- int ltMask = 0; /* Index columns covered by an x<... term */
- int gtMask = 0; /* Index columns covered by an x>... term */
- int inMask = 0; /* Index columns covered by an x IN .. term */
- int nEq, m, score;
-
- if( pIdx->nColumn>32 ) continue; /* Ignore indices too many columns */
- for(j=0; j<nExpr; j++){
- if( aExpr[j].idxLeft==iCur
- && (aExpr[j].prereqRight & loopMask)==aExpr[j].prereqRight ){
- int iColumn = aExpr[j].p->pLeft->iColumn;
- int k;
- for(k=0; k<pIdx->nColumn; k++){
- if( pIdx->aiColumn[k]==iColumn ){
- switch( aExpr[j].p->op ){
- case TK_IN: {
- if( k==0 ) inMask |= 1;
- break;
- }
- case TK_EQ: {
- eqMask |= 1<<k;
- break;
- }
- case TK_LE:
- case TK_LT: {
- ltMask |= 1<<k;
- break;
- }
- case TK_GE:
- case TK_GT: {
- gtMask |= 1<<k;
- break;
- }
- default: {
- /* CANT_HAPPEN */
- assert( 0 );
- break;
- }
- }
- break;
- }
- }
- }
- if( aExpr[j].idxRight==iCur
- && (aExpr[j].prereqLeft & loopMask)==aExpr[j].prereqLeft ){
- int iColumn = aExpr[j].p->pRight->iColumn;
- int k;
- for(k=0; k<pIdx->nColumn; k++){
- if( pIdx->aiColumn[k]==iColumn ){
- switch( aExpr[j].p->op ){
- case TK_EQ: {
- eqMask |= 1<<k;
- break;
- }
- case TK_LE:
- case TK_LT: {
- gtMask |= 1<<k;
- break;
- }
- case TK_GE:
- case TK_GT: {
- ltMask |= 1<<k;
- break;
- }
- default: {
- /* CANT_HAPPEN */
- assert( 0 );
- break;
- }
- }
- break;
- }
- }
- }
- }
-
- /* The following loop ends with nEq set to the number of columns
- ** on the left of the index with == constraints.
- */
- for(nEq=0; nEq<pIdx->nColumn; nEq++){
- m = (1<<(nEq+1))-1;
- if( (m & eqMask)!=m ) break;
- }
- score = nEq*8; /* Base score is 8 times number of == constraints */
- m = 1<<nEq;
- if( m & ltMask ) score++; /* Increase score for a < constraint */
- if( m & gtMask ) score+=2; /* Increase score for a > constraint */
- if( score==0 && inMask ) score = 4; /* Default score for IN constraint */
- if( score>bestScore ){
- pBestIdx = pIdx;
- bestScore = score;
- }
- }
- pWInfo->a[i].pIdx = pBestIdx;
- pWInfo->a[i].score = bestScore;
- pWInfo->a[i].bRev = 0;
- loopMask |= mask;
- if( pBestIdx ){
- pWInfo->a[i].iCur = pParse->nTab++;
- pWInfo->peakNTab = pParse->nTab;
- }
- }
-
- /* Check to see if the ORDER BY clause is or can be satisfied by the
- ** use of an index on the first table.
- */
- if( ppOrderBy && *ppOrderBy && pTabList->nSrc>0 ){
- Index *pSortIdx;
- Index *pIdx;
- Table *pTab;
- int bRev = 0;
-
- pTab = pTabList->a[0].pTab;
- pIdx = pWInfo->a[0].pIdx;
- if( pIdx && pWInfo->a[0].score==4 ){
- /* If there is already an IN index on the left-most table,
- ** it will not give the correct sort order.
- ** So, pretend that no suitable index is found.
- */
- pSortIdx = 0;
- }else if( iDirectEq[0]>=0 || iDirectLt[0]>=0 || iDirectGt[0]>=0 ){
- /* If the left-most column is accessed using its ROWID, then do
- ** not try to sort by index.
- */
- pSortIdx = 0;
- }else{
- int nEqCol = (pWInfo->a[0].score+4)/8;
- pSortIdx = findSortingIndex(pTab, pTabList->a[0].iCursor,
- *ppOrderBy, pIdx, nEqCol, &bRev);
- }
- if( pSortIdx && (pIdx==0 || pIdx==pSortIdx) ){
- if( pIdx==0 ){
- pWInfo->a[0].pIdx = pSortIdx;
- pWInfo->a[0].iCur = pParse->nTab++;
- pWInfo->peakNTab = pParse->nTab;
- }
- pWInfo->a[0].bRev = bRev;
- *ppOrderBy = 0;
- }
- }
-
- /* Open all tables in the pTabList and all indices used by those tables.
- */
- for(i=0; i<pTabList->nSrc; i++){
- Table *pTab;
- Index *pIx;
-
- pTab = pTabList->a[i].pTab;
- if( pTab->isTransient || pTab->pSelect ) continue;
- sqliteVdbeAddOp(v, OP_Integer, pTab->iDb, 0);
- sqliteVdbeOp3(v, OP_OpenRead, pTabList->a[i].iCursor, pTab->tnum,
- pTab->zName, P3_STATIC);
- sqliteCodeVerifySchema(pParse, pTab->iDb);
- if( (pIx = pWInfo->a[i].pIdx)!=0 ){
- sqliteVdbeAddOp(v, OP_Integer, pIx->iDb, 0);
- sqliteVdbeOp3(v, OP_OpenRead, pWInfo->a[i].iCur, pIx->tnum, pIx->zName,0);
- }
- }
-
- /* Generate the code to do the search
- */
- loopMask = 0;
- for(i=0; i<pTabList->nSrc; i++){
- int j, k;
- int iCur = pTabList->a[i].iCursor;
- Index *pIdx;
- WhereLevel *pLevel = &pWInfo->a[i];
-
- /* If this is the right table of a LEFT OUTER JOIN, allocate and
- ** initialize a memory cell that records if this table matches any
- ** row of the left table of the join.
- */
- if( i>0 && (pTabList->a[i-1].jointype & JT_LEFT)!=0 ){
- if( !pParse->nMem ) pParse->nMem++;
- pLevel->iLeftJoin = pParse->nMem++;
- sqliteVdbeAddOp(v, OP_String, 0, 0);
- sqliteVdbeAddOp(v, OP_MemStore, pLevel->iLeftJoin, 1);
- }
-
- pIdx = pLevel->pIdx;
- pLevel->inOp = OP_Noop;
- if( i<ARRAYSIZE(iDirectEq) && iDirectEq[i]>=0 ){
- /* Case 1: We can directly reference a single row using an
- ** equality comparison against the ROWID field. Or
- ** we reference multiple rows using a "rowid IN (...)"
- ** construct.
- */
- k = iDirectEq[i];
- assert( k<nExpr );
- assert( aExpr[k].p!=0 );
- assert( aExpr[k].idxLeft==iCur || aExpr[k].idxRight==iCur );
- brk = pLevel->brk = sqliteVdbeMakeLabel(v);
- if( aExpr[k].idxLeft==iCur ){
- Expr *pX = aExpr[k].p;
- if( pX->op!=TK_IN ){
- sqliteExprCode(pParse, aExpr[k].p->pRight);
- }else if( pX->pList ){
- sqliteVdbeAddOp(v, OP_SetFirst, pX->iTable, brk);
- pLevel->inOp = OP_SetNext;
- pLevel->inP1 = pX->iTable;
- pLevel->inP2 = sqliteVdbeCurrentAddr(v);
- }else{
- assert( pX->pSelect );
- sqliteVdbeAddOp(v, OP_Rewind, pX->iTable, brk);
- sqliteVdbeAddOp(v, OP_KeyAsData, pX->iTable, 1);
- pLevel->inP2 = sqliteVdbeAddOp(v, OP_FullKey, pX->iTable, 0);
- pLevel->inOp = OP_Next;
- pLevel->inP1 = pX->iTable;
- }
- }else{
- sqliteExprCode(pParse, aExpr[k].p->pLeft);
- }
- disableTerm(pLevel, &aExpr[k].p);
- cont = pLevel->cont = sqliteVdbeMakeLabel(v);
- sqliteVdbeAddOp(v, OP_MustBeInt, 1, brk);
- haveKey = 0;
- sqliteVdbeAddOp(v, OP_NotExists, iCur, brk);
- pLevel->op = OP_Noop;
- }else if( pIdx!=0 && pLevel->score>0 && pLevel->score%4==0 ){
- /* Case 2: There is an index and all terms of the WHERE clause that
- ** refer to the index use the "==" or "IN" operators.
- */
- int start;
- int testOp;
- int nColumn = (pLevel->score+4)/8;
- brk = pLevel->brk = sqliteVdbeMakeLabel(v);
- for(j=0; j<nColumn; j++){
- for(k=0; k<nExpr; k++){
- Expr *pX = aExpr[k].p;
- if( pX==0 ) continue;
- if( aExpr[k].idxLeft==iCur
- && (aExpr[k].prereqRight & loopMask)==aExpr[k].prereqRight
- && pX->pLeft->iColumn==pIdx->aiColumn[j]
- ){
- if( pX->op==TK_EQ ){
- sqliteExprCode(pParse, pX->pRight);
- disableTerm(pLevel, &aExpr[k].p);
- break;
- }
- if( pX->op==TK_IN && nColumn==1 ){
- if( pX->pList ){
- sqliteVdbeAddOp(v, OP_SetFirst, pX->iTable, brk);
- pLevel->inOp = OP_SetNext;
- pLevel->inP1 = pX->iTable;
- pLevel->inP2 = sqliteVdbeCurrentAddr(v);
- }else{
- assert( pX->pSelect );
- sqliteVdbeAddOp(v, OP_Rewind, pX->iTable, brk);
- sqliteVdbeAddOp(v, OP_KeyAsData, pX->iTable, 1);
- pLevel->inP2 = sqliteVdbeAddOp(v, OP_FullKey, pX->iTable, 0);
- pLevel->inOp = OP_Next;
- pLevel->inP1 = pX->iTable;
- }
- disableTerm(pLevel, &aExpr[k].p);
- break;
- }
- }
- if( aExpr[k].idxRight==iCur
- && aExpr[k].p->op==TK_EQ
- && (aExpr[k].prereqLeft & loopMask)==aExpr[k].prereqLeft
- && aExpr[k].p->pRight->iColumn==pIdx->aiColumn[j]
- ){
- sqliteExprCode(pParse, aExpr[k].p->pLeft);
- disableTerm(pLevel, &aExpr[k].p);
- break;
- }
- }
- }
- pLevel->iMem = pParse->nMem++;
- cont = pLevel->cont = sqliteVdbeMakeLabel(v);
- sqliteVdbeAddOp(v, OP_NotNull, -nColumn, sqliteVdbeCurrentAddr(v)+3);
- sqliteVdbeAddOp(v, OP_Pop, nColumn, 0);
- sqliteVdbeAddOp(v, OP_Goto, 0, brk);
- sqliteVdbeAddOp(v, OP_MakeKey, nColumn, 0);
- sqliteAddIdxKeyType(v, pIdx);
- if( nColumn==pIdx->nColumn || pLevel->bRev ){
- sqliteVdbeAddOp(v, OP_MemStore, pLevel->iMem, 0);
- testOp = OP_IdxGT;
- }else{
- sqliteVdbeAddOp(v, OP_Dup, 0, 0);
- sqliteVdbeAddOp(v, OP_IncrKey, 0, 0);
- sqliteVdbeAddOp(v, OP_MemStore, pLevel->iMem, 1);
- testOp = OP_IdxGE;
- }
- if( pLevel->bRev ){
- /* Scan in reverse order */
- sqliteVdbeAddOp(v, OP_IncrKey, 0, 0);
- sqliteVdbeAddOp(v, OP_MoveLt, pLevel->iCur, brk);
- start = sqliteVdbeAddOp(v, OP_MemLoad, pLevel->iMem, 0);
- sqliteVdbeAddOp(v, OP_IdxLT, pLevel->iCur, brk);
- pLevel->op = OP_Prev;
- }else{
- /* Scan in the forward order */
- sqliteVdbeAddOp(v, OP_MoveTo, pLevel->iCur, brk);
- start = sqliteVdbeAddOp(v, OP_MemLoad, pLevel->iMem, 0);
- sqliteVdbeAddOp(v, testOp, pLevel->iCur, brk);
- pLevel->op = OP_Next;
- }
- sqliteVdbeAddOp(v, OP_RowKey, pLevel->iCur, 0);
- sqliteVdbeAddOp(v, OP_IdxIsNull, nColumn, cont);
- sqliteVdbeAddOp(v, OP_IdxRecno, pLevel->iCur, 0);
- if( i==pTabList->nSrc-1 && pushKey ){
- haveKey = 1;
- }else{
- sqliteVdbeAddOp(v, OP_MoveTo, iCur, 0);
- haveKey = 0;
- }
- pLevel->p1 = pLevel->iCur;
- pLevel->p2 = start;
- }else if( i<ARRAYSIZE(iDirectLt) && (iDirectLt[i]>=0 || iDirectGt[i]>=0) ){
- /* Case 3: We have an inequality comparison against the ROWID field.
- */
- int testOp = OP_Noop;
- int start;
-
- brk = pLevel->brk = sqliteVdbeMakeLabel(v);
- cont = pLevel->cont = sqliteVdbeMakeLabel(v);
- if( iDirectGt[i]>=0 ){
- k = iDirectGt[i];
- assert( k<nExpr );
- assert( aExpr[k].p!=0 );
- assert( aExpr[k].idxLeft==iCur || aExpr[k].idxRight==iCur );
- if( aExpr[k].idxLeft==iCur ){
- sqliteExprCode(pParse, aExpr[k].p->pRight);
- }else{
- sqliteExprCode(pParse, aExpr[k].p->pLeft);
- }
- sqliteVdbeAddOp(v, OP_ForceInt,
- aExpr[k].p->op==TK_LT || aExpr[k].p->op==TK_GT, brk);
- sqliteVdbeAddOp(v, OP_MoveTo, iCur, brk);
- disableTerm(pLevel, &aExpr[k].p);
- }else{
- sqliteVdbeAddOp(v, OP_Rewind, iCur, brk);
- }
- if( iDirectLt[i]>=0 ){
- k = iDirectLt[i];
- assert( k<nExpr );
- assert( aExpr[k].p!=0 );
- assert( aExpr[k].idxLeft==iCur || aExpr[k].idxRight==iCur );
- if( aExpr[k].idxLeft==iCur ){
- sqliteExprCode(pParse, aExpr[k].p->pRight);
- }else{
- sqliteExprCode(pParse, aExpr[k].p->pLeft);
- }
- /* sqliteVdbeAddOp(v, OP_MustBeInt, 0, sqliteVdbeCurrentAddr(v)+1); */
- pLevel->iMem = pParse->nMem++;
- sqliteVdbeAddOp(v, OP_MemStore, pLevel->iMem, 1);
- if( aExpr[k].p->op==TK_LT || aExpr[k].p->op==TK_GT ){
- testOp = OP_Ge;
- }else{
- testOp = OP_Gt;
- }
- disableTerm(pLevel, &aExpr[k].p);
- }
- start = sqliteVdbeCurrentAddr(v);
- pLevel->op = OP_Next;
- pLevel->p1 = iCur;
- pLevel->p2 = start;
- if( testOp!=OP_Noop ){
- sqliteVdbeAddOp(v, OP_Recno, iCur, 0);
- sqliteVdbeAddOp(v, OP_MemLoad, pLevel->iMem, 0);
- sqliteVdbeAddOp(v, testOp, 0, brk);
- }
- haveKey = 0;
- }else if( pIdx==0 ){
- /* Case 4: There is no usable index. We must do a complete
- ** scan of the entire database table.
- */
- int start;
-
- brk = pLevel->brk = sqliteVdbeMakeLabel(v);
- cont = pLevel->cont = sqliteVdbeMakeLabel(v);
- sqliteVdbeAddOp(v, OP_Rewind, iCur, brk);
- start = sqliteVdbeCurrentAddr(v);
- pLevel->op = OP_Next;
- pLevel->p1 = iCur;
- pLevel->p2 = start;
- haveKey = 0;
- }else{
- /* Case 5: The WHERE clause term that refers to the right-most
- ** column of the index is an inequality. For example, if
- ** the index is on (x,y,z) and the WHERE clause is of the
- ** form "x=5 AND y<10" then this case is used. Only the
- ** right-most column can be an inequality - the rest must
- ** use the "==" operator.
- **
- ** This case is also used when there are no WHERE clause
- ** constraints but an index is selected anyway, in order
- ** to force the output order to conform to an ORDER BY.
- */
- int score = pLevel->score;
- int nEqColumn = score/8;
- int start;
- int leFlag, geFlag;
- int testOp;
-
- /* Evaluate the equality constraints
- */
- for(j=0; j<nEqColumn; j++){
- for(k=0; k<nExpr; k++){
- if( aExpr[k].p==0 ) continue;
- if( aExpr[k].idxLeft==iCur
- && aExpr[k].p->op==TK_EQ
- && (aExpr[k].prereqRight & loopMask)==aExpr[k].prereqRight
- && aExpr[k].p->pLeft->iColumn==pIdx->aiColumn[j]
- ){
- sqliteExprCode(pParse, aExpr[k].p->pRight);
- disableTerm(pLevel, &aExpr[k].p);
- break;
- }
- if( aExpr[k].idxRight==iCur
- && aExpr[k].p->op==TK_EQ
- && (aExpr[k].prereqLeft & loopMask)==aExpr[k].prereqLeft
- && aExpr[k].p->pRight->iColumn==pIdx->aiColumn[j]
- ){
- sqliteExprCode(pParse, aExpr[k].p->pLeft);
- disableTerm(pLevel, &aExpr[k].p);
- break;
- }
- }
- }
-
- /* Duplicate the equality term values because they will all be
- ** used twice: once to make the termination key and once to make the
- ** start key.
- */
- for(j=0; j<nEqColumn; j++){
- sqliteVdbeAddOp(v, OP_Dup, nEqColumn-1, 0);
- }
-
- /* Labels for the beginning and end of the loop
- */
- cont = pLevel->cont = sqliteVdbeMakeLabel(v);
- brk = pLevel->brk = sqliteVdbeMakeLabel(v);
-
- /* Generate the termination key. This is the key value that
- ** will end the search. There is no termination key if there
- ** are no equality terms and no "X<..." term.
- **
- ** 2002-Dec-04: On a reverse-order scan, the so-called "termination"
- ** key computed here really ends up being the start key.
- */
- if( (score & 1)!=0 ){
- for(k=0; k<nExpr; k++){
- Expr *pExpr = aExpr[k].p;
- if( pExpr==0 ) continue;
- if( aExpr[k].idxLeft==iCur
- && (pExpr->op==TK_LT || pExpr->op==TK_LE)
- && (aExpr[k].prereqRight & loopMask)==aExpr[k].prereqRight
- && pExpr->pLeft->iColumn==pIdx->aiColumn[j]
- ){
- sqliteExprCode(pParse, pExpr->pRight);
- leFlag = pExpr->op==TK_LE;
- disableTerm(pLevel, &aExpr[k].p);
- break;
- }
- if( aExpr[k].idxRight==iCur
- && (pExpr->op==TK_GT || pExpr->op==TK_GE)
- && (aExpr[k].prereqLeft & loopMask)==aExpr[k].prereqLeft
- && pExpr->pRight->iColumn==pIdx->aiColumn[j]
- ){
- sqliteExprCode(pParse, pExpr->pLeft);
- leFlag = pExpr->op==TK_GE;
- disableTerm(pLevel, &aExpr[k].p);
- break;
- }
- }
- testOp = OP_IdxGE;
- }else{
- testOp = nEqColumn>0 ? OP_IdxGE : OP_Noop;
- leFlag = 1;
- }
- if( testOp!=OP_Noop ){
- int nCol = nEqColumn + (score & 1);
- pLevel->iMem = pParse->nMem++;
- sqliteVdbeAddOp(v, OP_NotNull, -nCol, sqliteVdbeCurrentAddr(v)+3);
- sqliteVdbeAddOp(v, OP_Pop, nCol, 0);
- sqliteVdbeAddOp(v, OP_Goto, 0, brk);
- sqliteVdbeAddOp(v, OP_MakeKey, nCol, 0);
- sqliteAddIdxKeyType(v, pIdx);
- if( leFlag ){
- sqliteVdbeAddOp(v, OP_IncrKey, 0, 0);
- }
- if( pLevel->bRev ){
- sqliteVdbeAddOp(v, OP_MoveLt, pLevel->iCur, brk);
- }else{
- sqliteVdbeAddOp(v, OP_MemStore, pLevel->iMem, 1);
- }
- }else if( pLevel->bRev ){
- sqliteVdbeAddOp(v, OP_Last, pLevel->iCur, brk);
- }
-
- /* Generate the start key. This is the key that defines the lower
- ** bound on the search. There is no start key if there are no
- ** equality terms and if there is no "X>..." term. In
- ** that case, generate a "Rewind" instruction in place of the
- ** start key search.
- **
- ** 2002-Dec-04: In the case of a reverse-order search, the so-called
- ** "start" key really ends up being used as the termination key.
- */
- if( (score & 2)!=0 ){
- for(k=0; k<nExpr; k++){
- Expr *pExpr = aExpr[k].p;
- if( pExpr==0 ) continue;
- if( aExpr[k].idxLeft==iCur
- && (pExpr->op==TK_GT || pExpr->op==TK_GE)
- && (aExpr[k].prereqRight & loopMask)==aExpr[k].prereqRight
- && pExpr->pLeft->iColumn==pIdx->aiColumn[j]
- ){
- sqliteExprCode(pParse, pExpr->pRight);
- geFlag = pExpr->op==TK_GE;
- disableTerm(pLevel, &aExpr[k].p);
- break;
- }
- if( aExpr[k].idxRight==iCur
- && (pExpr->op==TK_LT || pExpr->op==TK_LE)
- && (aExpr[k].prereqLeft & loopMask)==aExpr[k].prereqLeft
- && pExpr->pRight->iColumn==pIdx->aiColumn[j]
- ){
- sqliteExprCode(pParse, pExpr->pLeft);
- geFlag = pExpr->op==TK_LE;
- disableTerm(pLevel, &aExpr[k].p);
- break;
- }
- }
- }else{
- geFlag = 1;
- }
- if( nEqColumn>0 || (score&2)!=0 ){
- int nCol = nEqColumn + ((score&2)!=0);
- sqliteVdbeAddOp(v, OP_NotNull, -nCol, sqliteVdbeCurrentAddr(v)+3);
- sqliteVdbeAddOp(v, OP_Pop, nCol, 0);
- sqliteVdbeAddOp(v, OP_Goto, 0, brk);
- sqliteVdbeAddOp(v, OP_MakeKey, nCol, 0);
- sqliteAddIdxKeyType(v, pIdx);
- if( !geFlag ){
- sqliteVdbeAddOp(v, OP_IncrKey, 0, 0);
- }
- if( pLevel->bRev ){
- pLevel->iMem = pParse->nMem++;
- sqliteVdbeAddOp(v, OP_MemStore, pLevel->iMem, 1);
- testOp = OP_IdxLT;
- }else{
- sqliteVdbeAddOp(v, OP_MoveTo, pLevel->iCur, brk);
- }
- }else if( pLevel->bRev ){
- testOp = OP_Noop;
- }else{
- sqliteVdbeAddOp(v, OP_Rewind, pLevel->iCur, brk);
- }
-
- /* Generate the the top of the loop. If there is a termination
- ** key we have to test for that key and abort at the top of the
- ** loop.
- */
- start = sqliteVdbeCurrentAddr(v);
- if( testOp!=OP_Noop ){
- sqliteVdbeAddOp(v, OP_MemLoad, pLevel->iMem, 0);
- sqliteVdbeAddOp(v, testOp, pLevel->iCur, brk);
- }
- sqliteVdbeAddOp(v, OP_RowKey, pLevel->iCur, 0);
- sqliteVdbeAddOp(v, OP_IdxIsNull, nEqColumn + (score & 1), cont);
- sqliteVdbeAddOp(v, OP_IdxRecno, pLevel->iCur, 0);
- if( i==pTabList->nSrc-1 && pushKey ){
- haveKey = 1;
- }else{
- sqliteVdbeAddOp(v, OP_MoveTo, iCur, 0);
- haveKey = 0;
- }
-
- /* Record the instruction used to terminate the loop.
- */
- pLevel->op = pLevel->bRev ? OP_Prev : OP_Next;
- pLevel->p1 = pLevel->iCur;
- pLevel->p2 = start;
- }
- loopMask |= getMask(&maskSet, iCur);
-
- /* Insert code to test every subexpression that can be completely
- ** computed using the current set of tables.
- */
- for(j=0; j<nExpr; j++){
- if( aExpr[j].p==0 ) continue;
- if( (aExpr[j].prereqAll & loopMask)!=aExpr[j].prereqAll ) continue;
- if( pLevel->iLeftJoin && !ExprHasProperty(aExpr[j].p,EP_FromJoin) ){
- continue;
- }
- if( haveKey ){
- haveKey = 0;
- sqliteVdbeAddOp(v, OP_MoveTo, iCur, 0);
- }
- sqliteExprIfFalse(pParse, aExpr[j].p, cont, 1);
- aExpr[j].p = 0;
- }
- brk = cont;
-
- /* For a LEFT OUTER JOIN, generate code that will record the fact that
- ** at least one row of the right table has matched the left table.
- */
- if( pLevel->iLeftJoin ){
- pLevel->top = sqliteVdbeCurrentAddr(v);
- sqliteVdbeAddOp(v, OP_Integer, 1, 0);
- sqliteVdbeAddOp(v, OP_MemStore, pLevel->iLeftJoin, 1);
- for(j=0; j<nExpr; j++){
- if( aExpr[j].p==0 ) continue;
- if( (aExpr[j].prereqAll & loopMask)!=aExpr[j].prereqAll ) continue;
- if( haveKey ){
- /* Cannot happen. "haveKey" can only be true if pushKey is true
- ** an pushKey can only be true for DELETE and UPDATE and there are
- ** no outer joins with DELETE and UPDATE.
- */
- haveKey = 0;
- sqliteVdbeAddOp(v, OP_MoveTo, iCur, 0);
- }
- sqliteExprIfFalse(pParse, aExpr[j].p, cont, 1);
- aExpr[j].p = 0;
- }
- }
- }
- pWInfo->iContinue = cont;
- if( pushKey && !haveKey ){
- sqliteVdbeAddOp(v, OP_Recno, pTabList->a[0].iCursor, 0);
- }
- freeMaskSet(&maskSet);
- return pWInfo;
-}
-
-/*
-** Generate the end of the WHERE loop. See comments on
-** sqliteWhereBegin() for additional information.
-*/
-void sqliteWhereEnd(WhereInfo *pWInfo){
- Vdbe *v = pWInfo->pParse->pVdbe;
- int i;
- WhereLevel *pLevel;
- SrcList *pTabList = pWInfo->pTabList;
-
- for(i=pTabList->nSrc-1; i>=0; i--){
- pLevel = &pWInfo->a[i];
- sqliteVdbeResolveLabel(v, pLevel->cont);
- if( pLevel->op!=OP_Noop ){
- sqliteVdbeAddOp(v, pLevel->op, pLevel->p1, pLevel->p2);
- }
- sqliteVdbeResolveLabel(v, pLevel->brk);
- if( pLevel->inOp!=OP_Noop ){
- sqliteVdbeAddOp(v, pLevel->inOp, pLevel->inP1, pLevel->inP2);
- }
- if( pLevel->iLeftJoin ){
- int addr;
- addr = sqliteVdbeAddOp(v, OP_MemLoad, pLevel->iLeftJoin, 0);
- sqliteVdbeAddOp(v, OP_NotNull, 1, addr+4 + (pLevel->iCur>=0));
- sqliteVdbeAddOp(v, OP_NullRow, pTabList->a[i].iCursor, 0);
- if( pLevel->iCur>=0 ){
- sqliteVdbeAddOp(v, OP_NullRow, pLevel->iCur, 0);
- }
- sqliteVdbeAddOp(v, OP_Goto, 0, pLevel->top);
- }
- }
- sqliteVdbeResolveLabel(v, pWInfo->iBreak);
- for(i=0; i<pTabList->nSrc; i++){
- Table *pTab = pTabList->a[i].pTab;
- assert( pTab!=0 );
- if( pTab->isTransient || pTab->pSelect ) continue;
- pLevel = &pWInfo->a[i];
- sqliteVdbeAddOp(v, OP_Close, pTabList->a[i].iCursor, 0);
- if( pLevel->pIdx!=0 ){
- sqliteVdbeAddOp(v, OP_Close, pLevel->iCur, 0);
- }
- }
-#if 0 /* Never reuse a cursor */
- if( pWInfo->pParse->nTab==pWInfo->peakNTab ){
- pWInfo->pParse->nTab = pWInfo->savedNTab;
- }
-#endif
- sqliteFree(pWInfo);
- return;
-}
+++ /dev/null
-# DBI - The Perl Database Interface.
-
-[](http://travis-ci.org/perl5-dbi/dbi/)
-
-See [COPYRIGHT](https://metacpan.org/module/DBI#COPYRIGHT)
-section in DBI.pm for usage and distribution rights.
-
-See [GETTING HELP](https://metacpan.org/module/DBI#GETTING-HELP)
-section in DBI.pm for how to get help.
-
-# QUICK START GUIDE:
-
- The DBI requires one or more 'driver' modules to talk to databases,
- but they are not needed to build or install the DBI.
-
- Check that a DBD::* module exists for the database you wish to use.
-
- Install the DBI using a installer like cpanm, cpanplus, cpan,
- or whatever is recommened by the perl distribution you're using.
- Make sure the DBI tests run successfully before installing.
-
- Use the 'perldoc DBI' command to read the DBI documentation.
-
- Install the DBD::* driver module you wish to use in the same way.
- It is often important to read the driver README file carefully.
- Make sure the driver tests run successfully before installing.
-
-The DBI.pm file contains the DBI specification and other documentation.
-PLEASE READ IT. It'll save you asking questions on the mailing list
-which you will be told are already answered in the documentation.
-
-For more information and to keep informed about progress you can join
-the a mailing list via mailto:dbi-users-help@perl.org
-You can post to the mailing list without subscribing. (Your first post may be
-delayed a day or so while it's being moderated.)
-
-To help you make the best use of the dbi-users mailing list,
-and any other lists or forums you may use, I strongly
-recommend that you read "How To Ask Questions The Smart Way"
-by Eric Raymond:
-
- http://www.catb.org/~esr/faqs/smart-questions.html
-
-Much useful information and online archives of the mailing lists can be
-found at http://dbi.perl.org/
-
-See also http://metacpan.org/
-
-
-# IF YOU HAVE PROBLEMS:
-
-First, read the notes in the INSTALL file.
-
-If you can't fix it your self please post details to dbi-users@perl.org.
-Please include:
-
-1. A complete log of a complete build, e.g.:
-
- perl Makefile.PL (do a make realclean first)
- make
- make test
- make test TEST_VERBOSE=1 (if any of the t/* tests fail)
-
-2. The output of perl -V
-
-3. If you get a core dump, try to include a stack trace from it.
-
- Try installing the Devel::CoreStack module to get a stack trace.
- If the stack trace mentions XS_DynaLoader_dl_load_file then rerun
- make test after setting the environment variable PERL_DL_DEBUG to 2.
-
-4. If your installation succeeds, but your script does not behave
- as you expect, the problem is possibly in your script.
-
- Before sending to dbi-users, try writing a small, easy to use test case to
- reproduce your problem. Also, use the DBI->trace method to trace your
- database calls.
-
-Please don't post problems to usenet, google groups or perl5-porters.
-This software is supported via the dbi-users mailing list. For more
-information and to keep informed about progress you can join the
-mailing list via mailto:dbi-users-help@perl.org
-(please note that I do not run or manage the mailing list).
-
-It is important to check that you are using the latest version before
-posting. If you're not then we're very likely to simply say "upgrade to
-the latest". You would do yourself a favour by upgrading beforehand.
-
-Please remember that we're all busy. Try to help yourself first,
-then try to help us help you by following these guidelines carefully.
-
-Regards,
-Tim Bunce and the perl5-dbi team.
+++ /dev/null
-=head1 NAME
-
-DBI::Changes - List of significant changes to the DBI
-
-=encoding ISO8859-1
-
-=cut
-
-=head2 Changes in DBI 1.641 - 19th March 2018
-
- Remove dependency on Storable 2.16 introduced in DBI 1.639
- thanks to Ribasushi #60
- Avoid compiler warnings in Driver.xst #59
- thanks to pali #59
-
-=head2 Changes in DBI 1.640 - 28th January 2018
-
- Fix test t/91_store_warning.t for perl 5.10.0
- thanks to pali #57
-
- Add Perl 5.10.0 and 5.8.1 specific versions to Travis testing
- thanks to pali #57
- Add registration of mariadb_ prefix for new DBD::MariaDB driver
- thanks to pali #56
-
-=head2 Changes in DBI 1.639 - 28th December 2017
-
- Fix UTF-8 support for warn/croak calls within DBI internals,
- thanks to pali #53
- Fix dependency on Storable for perl older than 5.8.9,
- thanks to H.Merijn Brand.
-
- Add DBD::Mem driver, a pure-perl in-memory driver using DBI::DBD::SqlEngine,
- thanks to Jens Rehsack #42
-
- Corrected missing semicolon in example in documentation,
- thanks to pali #55
-
-=head2 Changes in DBI 1.637 - 16th August 2017
-
- Fix use of externally controlled format string (CWE-134) thanks to pali #44
- This could cause a crash if, for example, a db error contained a %.
- https://cwe.mitre.org/data/definitions/134.html
- Fix extension detection for DBD::File related drivers
- Fix tests for perl without dot in @INC RT#120443
- Fix loss of error message on parent handle, thanks to charsbar #34
- Fix disappearing $_ inside callbacks, thanks to robschaber #47
- Fix dependency on Storable for perl older than 5.8.9
-
- Allow objects to be used as passwords without throwing an error, thanks to demerphq #40
- Allow $sth NAME_* attributes to be set from Perl code, re #45
- Added support for DBD::XMLSimple thanks to nigelhorne #38
-
- Documentation updates:
- Improve examples using eval to be more correct, thanks to pali #39
- Add cautionary note to prepare_cached docs re refs in %attr #46
- Small POD changes (Getting Help -> Online) thanks to openstrike #33
- Adds links to more module names and fix typo, thanks to oalders #43
- Typo fix thanks to bor #37
-
-=head2 Changes in DBI 1.636 - 24th April 2016
-
- Fix compilation for threaded perl <= 5.12 broken in 1.635 RT#113955
- Revert change to DBI::PurePerl DESTROY in 1.635
- Change t/16destroy.t to avoid race hazard RT#113951
- Output perl version and archname in t/01basics.t
- Add perl 5.22 and 5.22-extras to travis-ci config
-
-=head2 Changes in DBI 1.635 - 24th April 2016
-
- Fixed RaiseError/PrintError for UTF-8 errors/warnings. RT#102404
- Fixed cases where ShowErrorStatement might show incorrect Statement RT#97434
- Fixed DBD::Gofer for UTF-8-enabled STDIN/STDOUT
- thanks to mauke PR#32
- Fixed fetchall_arrayref({}) behavior with no columns
- thanks to Dan McGee PR#31
- Fixed tied CachedKids ref leak in attribute cache by weakening
- thanks to Michael Conrad RT#113852
- Fixed "panic: attempt to copy freed scalar" upon commit() or rollback()
- thanks to fbriere for detailed bug report RT#102791
- Ceased to ignore DESTROY of outer handle in DBI::PurePerl
- Treat undef in DBI::Profile Path as string "undef"
- thanks to fREW Schmidt RT#113298
- Fix SQL::Nano parser to ignore trailing semicolon
- thanks to H.Merijn Brand.
-
- Added @ary = $dbh->selectall_array(...) method
- thanks to Ed Avis RT#106411
- Added appveyor support (Travis like CI for windows)
- thanks to mbeijen PR#30
-
- Corrected spelling errors in pod
- thanks to Gregor Herrmann RT#107838
- Corrected and/or removed broken links to SQL standards
- thanks to David Pottage RT#111437
- Corrected doc example to use dbi: instead of DBI: in DSN
- thanks to Michael R. Davis RT#101181
- Removed/updated broken links in docs
- thanks to mbeijen PR#29
- Clarified docs for DBI::hash($string)
- Removed the ancient DBI::FAQ module RT#102714
- Fixed t/pod.t to require Test::Pod >= 1.41 RT#101769
-
-This release was developed at the Perl QA Hackathon 2016
-L<http://act.qa-hackathon.org/qa2016/>
-which was made possible by the generosity of many sponsors:
-
-L<https://www.fastmail.com> FastMail,
-L<https://www.ziprecruiter.com> ZipRecruiter,
-L<http://www.activestate.com> ActiveState,
-L<http://www.opusvl.com> OpusVL,
-L<https://www.strato.com> Strato,
-L<http://www.surevoip.co.uk> SureVoIP,
-L<http://www.cv-library.co.uk> CV-Library,
-L<https://www.iinteractive.com/> Infinity,
-L<https://opensource.careers/perl-careers/> Perl Careers,
-L<https://www.mongodb.com> MongoDB,
-L<https://www.thinkproject.com> thinkproject!,
-L<https://www.dreamhost.com/> Dreamhost,
-L<http://www.perl6.org/> Perl 6,
-L<http://www.perl-services.de/> Perl Services,
-L<https://www.evozon.com/> Evozon,
-L<http://www.booking.com> Booking,
-L<http://eligo.co.uk> Eligo,
-L<http://www.oetiker.ch/> Oetiker+Partner,
-L<http://capside.com/en/> CAPSiDE,
-L<https://www.procura.nl/> Procura,
-L<https://constructor.io/> Constructor.io,
-L<https://metacpan.org/author/BABF> Robbie Bow,
-L<https://metacpan.org/author/RSAVAGE> Ron Savage,
-L<https://metacpan.org/author/ITCHARLIE> Charlie Gonzalez,
-L<https://twitter.com/jscook2345> Justin Cook.
-
-=head2 Changes in DBI 1.634 - 3rd August 2015
-
- Enabled strictures on all modules (Jose Luis Perez Diez) #22
- Note that this might cause new exceptions in existing code.
- Please take time for extra testing before deploying to production.
- Improved handling of row counts for compiled drivers and enable them to
- return larger row counts (IV type) by defining new *_iv macros.
- Fixed quote_identifier that was adding a trailing separator when there
- was only a catalog (Martin J. Evans)
-
- Removed redundant keys() call in fetchall_arrayref with hash slice (ilmari) #24
- Corrected pod xref to Placeholders section (Matthew D. Fuller)
- Corrected pod grammar (Nick Tonkin) #25
-
- Added support for tables('', '', '', '%') special case (Martin J. Evans)
- Added support for DBD prefixes with numbers (Jens Rehsack) #19
- Added extra initializer for DBI::DBD::SqlEngine based DBD's (Jens Rehsack)
- Added Memory Leaks section to the DBI docs (Tim)
- Added Artistic v1 & GPL v1 LICENSE file (Jose Luis Perez Diez) #21
-
-=head2 Changes in DBI 1.633 - 11th Jan 2015
-
- Fixed selectrow_*ref to return undef on error in list context
- instead if an empty list.
- Changed t/42prof_data.t more informative
- Changed $sth->{TYPE} to be NUMERIC in DBD::File drivers as per the
- DBI docs. Note TYPE_NAME is now also available. [H.Merijn Brand]
- Fixed compilation error on bleadperl due DEFSV no longer being an lvalue
- [Dagfinn Ilmari Mannsåker]
-
- Added docs for escaping placeholders using a backslash.
- Added docs for get_info(9000) indicating ability to escape placeholders.
- Added multi_ prefix for DBD::Multi (Dan Wright) and ad2_ prefix for
- DBD::AnyData2
-
-=head2 Changes in DBI 1.632 - 9th Nov 2014
-
- Fixed risk of memory corruption with many arguments to methods
- originally reported by OSCHWALD for Callbacks but may apply
- to other functionality in DBI method dispatch RT#86744.
- Fixed DBD::PurePerl to not set $sth->{Active} true by default
- drivers are expected to set it true as needed.
- Fixed DBI::DBD::SqlEngine to complain loudly when prerequite
- driver_prefix is not fulfilled (RT#93204) [Jens Rehsack]
- Fixed redundant sprintf argument warning RT#97062 [Reini Urban]
- Fixed security issue where DBD::File drivers would open files
- from folders other than specifically passed using the
- f_dir attribute RT#99508 [H.Merijn Brand]
-
- Changed delete $h->{$key} to work for keys with 'private_' prefix
- per request in RT#83156. local $h->{$key} works as before.
-
- Added security notice to DBD::Proxy and DBI::ProxyServer because they
- use Storable which is insecure. Thanks to ppisar@redhat.com RT#90475
- Added note to AutoInactiveDestroy docs strongly recommending that it
- is enabled in all new code.
-
-=head2 Changes in DBI 1.631 - 20th Jan 2014
-
-NOTE: This release changes the handle passed to Callbacks from being an 'inner'
-handle to being an 'outer' handle. If you have code that makes use of Callbacks,
-ensure that you understand what this change means and review your callback code.
-
- Fixed err_hash handling of integer err RT#92172 [Dagfinn Ilmari]
- Fixed use of \Q vs \E in t/70callbacks.t
-
- Changed the handle passed to Callbacks from being an 'inner'
- handle to being an 'outer' handle.
-
- Improved reliability of concurrent testing
- PR#8 [Peter Rabbitson]
- Changed optional dependencies to "suggest"
- PR#9 [Karen Etheridge]
- Changed to avoid mg_get in neatsvpv during global destruction
- PR#10 [Matt Phillips]
-
-=head2 Changes in DBI 1.630 - 28th Oct 2013
-
-NOTE: This release enables PrintWarn by default regardless of $^W.
-Your applications may generate more log messages than before.
-
- Fixed err for new drh to be undef not to 0 [Martin J. Evans]
- Fixed RT#83132 - moved DBIstcf* constants to util
- export tag [Martin J. Evans]
- PrintWarn is now triggered by warnings recorded in methods like STORE
- that don't clear err RT#89015 [Tim Bunce]
-
- Changed tracing to no longer show quote and quote_identifier calls
- at trace level 1.
- Changed DBD::Gofer ping while disconnected set_err from warn to info.
- Clarified wording of log message when err is cleared.
- Changed bootstrap to use $XS_VERSION RT#89618 [Andreas Koenig]
-
- Added connect_cached.connected Callback PR#3 [David E. Wheeler]
-
- Clarified effect of refs in connect_cached attributes [David E. Wheeler]
- Extended ReadOnly attribute docs for when the driver cannot
- ensure read only [Martin J. Evans]
- Corrected SQL_BIGINT docs to say ODBC value is used PR#5 [ilmari]
-
-There was no DBI 1.629 release.
-
-=head2 Changes in DBI 1.628 - 22nd July 2013
-
- Fixed missing fields on partial insert via DBI::DBD::SqlEngine
- engines (DBD::CSV, DBD::DBM etc.) [H.Merijn Brand, Jens Rehsack]
- Fixed stack corruption on callbacks RT#85562 RT#84974 [Aaron Schweiger]
- Fixed DBI::SQL::Nano_::Statement handling of "0" [Jens Rehsack]
- Fixed exit op precedence in test RT#87029 [Reni Urban]
-
- Added support for finding tables in multiple directories
- via new DBD::File f_dir_search attribute [H.Merijn Brand]
- Enable compiling by C++ RT#84285 [Kurt Jaeger]
-
- Typo fixes in pod and comment [David Steinbrunner]
- Change DBI's docs to refer to git not svn [H.Merijn Brand]
- Clarify bind_col TYPE attribute is sticky [Martin J. Evans]
- Fixed reference to $sth in selectall_arrayref docs RT#84873
- Spelling fixes [Ville Skyttä]
- Changed $VERSIONs to hardcoded strings [H.Merijn Brand]
-
-=head2 Changes in DBI 1.627 - 16th May 2013
-
- Fixed VERSION regression in DBI::SQL::Nano [Tim Bunce]
-
-=head2 Changes in DBI 1.626 - 15th May 2013
-
- Fixed pod text/link was reversed in a few cases RT#85168
- [H.Merijn Brand]
-
- Handle aliasing of STORE'd attributes in DBI::DBD::SqlEngine
- [Jens Rehsack]
-
- Updated repository URI to git [Jens Rehsack]
-
- Fixed skip() count arg in t/48dbi_dbd_sqlengine.t [Tim Bunce]
-
-=head2 Changes in DBI 1.625 (svn r15595) 28th March 2013
-
- Fixed heap-use-after-free during global destruction RT#75614
- thanks to Reini Urban.
- Fixed ignoring RootClass attribute during connect() by
- DBI::DBD::SqlEngine reported in RT#84260 by Michael Schout
-
-=head2 Changes in DBI 1.624 (svn r15576) 22nd March 2013
-
- Fixed Gofer for hash randomization in perl 5.17.10+ RT#84146
-
- Clarify docs for can() re RT#83207
-
-=head2 Changes in DBI 1.623 (svn r15547) 2nd Jan 2013
-
- Fixed RT#64330 - ping wipes out errstr (Martin J. Evans).
- Fixed RT#75868 - DBD::Proxy shouldn't call connected() on the server.
- Fixed RT#80474 - segfault in DESTROY with threads.
- Fixed RT#81516 - Test failures due to hash randomisation in perl 5.17.6
- thanks to Jens Rehsack and H.Merijn Brand and feedback on IRC
- Fixed RT#81724 - Handle copy-on-write scalars (sprout)
- Fixed unused variable / self-assignment compiler warnings.
- Fixed default table_info in DBI::DBD::SqlEngine which passed NAMES
- attribute instead of NAME to DBD::Sponge RT72343 (Martin J. Evans)
-
- Corrected a spelling error thanks to Chris Sanders.
- Corrected typo in DBI->installed_versions docs RT#78825
- thanks to Jan Dubois.
-
- Refactored table meta information management from DBD::File into
- DBI::DBD::SqlEngine (H.Merijn Brand, Jens Rehsack)
- Prevent undefined f_dir being used in opendir (H.Merijn Brand)
-
- Added logic to force destruction of children before parents
- during global destruction. See RT#75614.
- Added DBD::File Plugin-Support for table names and data sources
- (Jens Rehsack, #dbi Team)
- Added new tests to 08keeperr for RT#64330
- thanks to Kenichi Ishigaki.
- Added extra internal handle type check, RT#79952
- thanks to Reini Urban.
- Added cubrid_ registered prefix for DBD::cubrid, RT#78453
-
- Removed internal _not_impl method (Martin J. Evans).
-
- NOTE: The "old-style" DBD::DBM attributes 'dbm_ext' and 'dbm_lockfile'
- have been deprecated for several years and their use will now generate
- a warning.
-
-=head2 Changes in DBI 1.622 (svn r15327) 6th June 2012
-
- Fixed lack of =encoding in non-ASCII pod docs. RT#77588
-
- Corrected typo in DBI::ProfileDumper thanks to Finn Hakansson.
-
-=head2 Changes in DBI 1.621 (svn r15315) 21st May 2012
-
- Fixed segmentation fault when a thread is created from
- within another thread RT#77137, thanks to Dave Mitchell.
- Updated previous Changes to credit Booking.com for sponsoring
- Dave Mitchell's recent DBI optimization work.
-
-=head2 Changes in DBI 1.620 (svn r15300) 25th April 2012
-
- Modified column renaming in fetchall_arrayref, added in 1.619,
- to work on column index numbers not names (an incompatible change).
- Reworked the fetchall_arrayref documentation.
- Hash slices in fetchall_arrayref now detect invalid column names.
-
-=head2 Changes in DBI 1.619 (svn r15294) 23rd April 2012
-
- Fixed the connected method to stop showing the password in
- trace file (Martin J. Evans).
- Fixed _install_method to set CvFILE correctly
- thanks to sprout RT#76296
- Fixed SqlEngine "list_tables" thanks to David McMath
- and Norbert Gruener. RT#67223 RT#69260
-
- Optimized DBI method dispatch thanks to Dave Mitchell.
- Optimized driver access to DBI internal state thanks to Dave Mitchell.
- Optimized driver access to handle data thanks to Dave Mitchell.
- Dave's work on these optimizations was sponsored by Booking.com.
- Optimized fetchall_arrayref with hash slice thanks
- to Dagfinn Ilmari Mannsåker. RT#76520
- Allow renaming columns in fetchall_arrayref hash slices
- thanks to Dagfinn Ilmari Mannsåker. RT#76572
- Reserved snmp_ and tree_ for DBD::SNMP and DBD::TreeData
-
-=head2 Changes in DBI 1.618 (svn r15170) 25rd February 2012
-
- Fixed compiler warnings in Driver_xst.h (Martin J. Evans)
- Fixed compiler warning in DBI.xs (H.Merijn Brand)
- Fixed Gofer tests failing on Windows RT74975 (Manoj Kumar)
- Fixed my_ctx compile errors on Windows (Dave Mitchell)
-
- Significantly optimized method dispatch via cache (Dave Mitchell)
- Significantly optimized DBI internals for threads (Dave Mitchell)
- Dave's work on these optimizations was sponsored by Booking.com.
- Xsub to xsub calling optimization now enabled for threaded perls.
- Corrected typo in example in docs (David Precious)
- Added note that calling clone() without an arg may warn in future.
- Minor changes to the install_method() docs in DBI::DBD.
- Updated dbipport.h from Devel::PPPort 3.20
-
-=head2 Changes in DBI 1.617 (svn r15107) 30th January 2012
-
- NOTE: The officially supported minimum perl version will change
- from perl 5.8.1 (2003) to perl 5.8.3 (2004) in a future release.
- (The last change, from perl 5.6 to 5.8.1, was announced
- in July 2008 and implemented in DBI 1.611 in April 2010.)
-
- Fixed ParamTypes example in the pod (Martin J. Evans)
- Fixed the definition of ArrayTupleStatus and remove confusion over
- rows affected in list context of execute_array (Martin J. Evans)
- Fixed sql_type_cast example and typo in errors (Martin J. Evans)
- Fixed Gofer error handling for keeperr methods like ping (Tim Bunce)
- Fixed $dbh->clone({}) RT73250 (Tim Bunce)
- Fixed is_nested_call logic error RT73118 (Reini Urban)
-
- Enhanced performance for threaded perls (Dave Mitchell, Tim Bunce)
- Dave's work on this optimization was sponsored by Booking.com.
- Enhanced and standardized driver trace level mechanism (Tim Bunce)
- Removed old code that was an inneffective attempt to detect
- people doing DBI->{Attrib}.
- Clear ParamValues on bind_param param count error RT66127 (Tim Bunce)
- Changed DBI::ProxyServer to require DBI at compile-time RT62672 (Tim Bunce)
-
- Added pod for default_user to DBI::DBD (Martin J. Evans)
- Added CON, ENC and DBD trace flags and extended 09trace.t (Martin J. Evans)
- Added TXN trace flags and applied CON and TXN to relevant methods (Tim Bunce)
- Added some more fetchall_arrayref(..., $maxrows) tests (Tim Bunce)
- Clarified docs for fetchall_arrayref called on an inactive handle.
- Clarified docs for clone method (Tim Bunce)
- Added note to DBI::Profile about async queries (Marcel Grünauer).
- Reserved spatialite_ as a driver prefix for DBD::Spatialite
- Reserved mo_ as a driver prefix for DBD::MO
- Updated link to the SQL Reunion 95 docs, RT69577 (Ash Daminato)
- Changed links for DBI recipes. RT73286 (Martin J. Evans)
-
-=head2 Changes in DBI 1.616 (svn r14616) 30th December 2010
-
- Fixed spurious dbi_profile lines written to the log when
- profiling is enabled and a trace flag, like SQL, is used.
- Fixed to recognize SQL::Statement errors even if instantiated
- with RaiseError=0 (Jens Rehsack)
- Fixed RT#61513 by catching attribute assignment to tied table access
- interface (Jens Rehsack)
- Fixing some misbehavior of DBD::File when running within the Gofer
- server.
- Fixed compiler warnings RT#62640
-
- Optimized connect() to remove redundant FETCH of \%attrib values.
- Improved initialization phases in DBI::DBD::SqlEngine (Jens Rehsack)
-
- Added DBD::Gofer::Transport::corostream. An experimental proof-of-concept
- transport that enables asynchronous database calls with few code changes.
- It enables asynchronous use of DBI frameworks like DBIx::Class.
-
- Added additional notes on DBDs which avoid creating a statement in
- the do() method and the effects on error handlers (Martin J. Evans)
- Adding new attribute "sql_dialect" to DBI::DBD::SqlEngine to allow
- users control used SQL dialect (ANSI, CSV or AnyData), defaults to
- CSV (Jens Rehsack)
- Add documentation for DBI::DBD::SqlEngine attributes (Jens Rehsack)
- Documented dbd_st_execute return (Martin J. Evans)
- Fixed typo in InactiveDestroy thanks to Emmanuel Rodriguez.
-
-=head2 Changes in DBI 1.615 (svn r14438) 21st September 2010
-
- Fixed t/51dbm_file for file/directory names with whitespaces in them
- RT#61445 (Jens Rehsack)
- Fixed compiler warnings from ignored hv_store result (Martin J. Evans)
- Fixed portability to VMS (Craig A. Berry)
-
-=head2 Changes in DBI 1.614 (svn r14408) 17th September 2010
-
- Fixed bind_param () in DBI::DBD::SqlEngine (rt#61281)
- Fixed internals to not refer to old perl symbols that
- will no longer be visible in perl >5.13.3 (Andreas Koenig)
- Many compiled drivers are likely to need updating.
- Fixed issue in DBD::File when absolute filename is used as table name
- (Jens Rehsack)
- Croak manually when file after tie doesn't exists in DBD::DBM
- when it have to exists (Jens Rehsack)
- Fixed issue in DBD::File when users set individual file name for tables
- via f_meta compatibility interface - reported by H.Merijn Brand while
- working on RT#61168 (Jens Rehsack)
-
- Changed 50dbm_simple to simplify and fix problems (Martin J. Evans)
- Changed 50dbm_simple to skip aggregation tests when not using
- SQL::Statement (Jens Rehsack)
- Minor speed improvements in DBD::File (Jens Rehsack)
-
- Added $h->{AutoInactiveDestroy} as simpler safer form of
- $h->{InactiveDestroy} (David E. Wheeler)
- Added ability for parallel testing "prove -j4 ..." (Jens Rehsack)
- Added tests for delete in DBM (H.Merijn Brand)
- Added test for absolute filename as table to 51dbm_file (Jens Rehsack)
- Added two initialization phases to DBI::DBD::SqlEngine (Jens Rehsack)
- Added improved developers documentation for DBI::DBD::SqlEngine
- (Jens Rehsack)
- Added guides how to write DBI drivers using DBI::DBD::SqlEngine
- or DBD::File (Jens Rehsack)
- Added register_compat_map() and table_meta_attr_changed() to
- DBD::File::Table to support clean fix of RT#61168 (Jens Rehsack)
-
-=head2 Changes in DBI 1.613 (svn r14271) 22nd July 2010
-
- Fixed Win32 prerequisite module from PathTools to File::Spec.
-
- Changed attribute headings and fixed references in DBI pod (Martin J. Evans)
- Corrected typos in DBI::FAQ and DBI::ProxyServer (Ansgar Burchardt)
-
-=head2 Changes in DBI 1.612 (svn r14254) 16th July 2010
-
-NOTE: This is a minor release for the DBI core but a major release for
-DBD::File and drivers that depend on it, like DBD::DBM and DBD::CSV.
-
-This is also the first release where the bulk of the development work
-has been done by other people. I'd like to thank (in no particular order)
-Jens Rehsack, Martin J. Evans, and H.Merijn Brand for all their contributions.
-
- Fixed DBD::File's {ChopBlank} handling (it stripped \s instead of space
- only as documented in DBI) (H.Merijn Brand)
- Fixed DBD::DBM breakage with SQL::Statement (Jens Rehsack, fixes RT#56561)
- Fixed DBD::File file handle leak (Jens Rehsack)
- Fixed problems in 50dbm.t when running tests with multiple
- dbms (Martin J. Evans)
- Fixed DBD::DBM bugs found during tests (Jens Rehsack)
- Fixed DBD::File doesn't find files without extensions under some
- circumstances (Jens Rehsack, H.Merijn Brand, fixes RT#59038)
-
- Changed Makefile.PL to modernize with CONFLICTS, recommended dependencies
- and resources (Jens Rehsack)
- Changed DBI::ProfileDumper to rename any existing profile file by
- appending .prev, instead of overwriting it.
- Changed DBI::ProfileDumper::Apache to work in more configurations
- including vhosts using PerlOptions +Parent.
- Add driver_prefix method to DBI (Jens Rehsack)
-
- Added more tests to 50dbm_simple.t to prove optimizations in
- DBI::SQL::Nano and SQL::Statement (Jens Rehsack)
- Updated tests to cover optional installed SQL::Statement (Jens Rehsack)
- Synchronize API between SQL::Statement and DBI::SQL::Nano (Jens Rehsack)
- Merged some optimizations from SQL::Statement into DBI::SQL::Nano
- (Jens Rehsack)
- Added basic test for DBD::File (H.Merijn Brand, Jens Rehsack)
- Extract dealing with Perl SQL engines from DBD::File into
- DBI::DBD::SqlEngine for better subclassing of 3rd party non-db DBDs
- (Jens Rehsack)
-
- Updated and clarified documentation for finish method (Tim Bunce).
- Changes to DBD::File for better English and hopefully better
- explanation (Martin J. Evans)
- Update documentation of DBD::DBM to cover current implementation,
- tried to explain some things better and changes most examples to
- preferred style of Merijn and myself (Jens Rehsack)
- Added developer documentation (including a roadmap of future plans)
- for DBD::File
-
-=head2 Changes in DBI 1.611 (svn r13935) 29th April 2010
-
- NOTE: minimum perl version is now 5.8.1 (as announced in DBI 1.607)
-
- Fixed selectcol_arrayref MaxRows attribute to count rows not values
- thanks to Vernon Lyon.
- Fixed DBI->trace(0, *STDERR); (H.Merijn Brand)
- which tried to open a file named "*main::STDERR" in perl-5.10.x
- Fixes in DBD::DBM for use under threads (Jens Rehsack)
-
- Changed "Issuing rollback() due to DESTROY without explicit disconnect"
- warning to not be issued if ReadOnly set for that dbh.
-
- Added f_lock and f_encoding support to DBD::File (H.Merijn Brand)
- Added ChildCallbacks => { ... } to Callbacks as a way to
- specify Callbacks for child handles.
- With tests added by David E. Wheeler.
- Added DBI::sql_type_cast($value, $type, $flags) to cast a string value
- to an SQL type. e.g. SQL_INTEGER effectively does $value += 0;
- Has other options plus an internal interface for drivers.
-
- Documentation changes:
- Small fixes in the documentation of DBD::DBM (H.Merijn Brand)
- Documented specification of type casting behaviour for bind_col()
- based on DBI::sql_type_cast() and two new bind_col attributes
- StrictlyTyped and DiscardString. Thanks to Martin Evans.
- Document fetchrow_hashref() behaviour for functions,
- aliases and duplicate names (H.Merijn Brand)
- Updated DBI::Profile and DBD::File docs to fix pod nits
- thanks to Frank Wiegand.
- Corrected typos in Gopher documentation reported by Jan Krynicky.
- Documented the Callbacks attribute thanks to David E. Wheeler.
- Corrected the Timeout examples as per rt 50621 (Martin J. Evans).
- Removed some internal broken links in the pod (Martin J. Evans)
- Added Note to column_info for drivers which do not
- support it (Martin J. Evans)
- Updated dbipport.h to Devel::PPPort 3.19 (H.Merijn Brand)
-
-=head2 Changes in DBI 1.609 (svn r12816) 8th June 2009
-
- Fixes to DBD::File (H.Merijn Brand)
- added f_schema attribute
- table names case sensitive when quoted, insensitive when unquoted
- workaround a bug in SQL::Statement (temporary fix) related
- to the "You passed x parameters where y required" error
-
- Added ImplementorClass and Name info to the "Issuing rollback() due to
- DESTROY without explicit disconnect" warning to identify the handle.
- Applies to compiled drivers when they are recompiled.
- Added DBI->visit_handles($coderef) method.
- Added $h->visit_child_handles($coderef) method.
- Added docs for column_info()'s COLUMN_DEF value.
- Clarified docs on stickyness of data type via bind_param().
- Clarified docs on stickyness of data type via bind_col().
-
-=head2 Changes in DBI 1.608 (svn r12742) 5th May 2009
-
- Fixes to DBD::File (H.Merijn Brand)
- bind_param () now honors the attribute argument
- added f_ext attribute
- File::Spec is always required. (CORE since 5.00405)
- Fail and set errstr on parameter count mismatch in execute ()
- Fixed two small memory leaks when running in mod_perl
- one in DBI->connect and one in DBI::Gofer::Execute.
- Both due to "local $ENV{...};" leaking memory.
- Fixed DBD_ATTRIB_DELETE macro for driver authors
- and updated DBI::DBD docs thanks to Martin J. Evans.
- Fixed 64bit issues in trace messages thanks to Charles Jardine.
- Fixed FETCH_many() method to work with drivers that incorrectly return
- an empty list from $h->FETCH. Affected gofer.
-
- Added 'sqlite_' as registered prefix for DBD::SQLite.
- Corrected many typos in DBI docs thanks to Martin J. Evans.
- Improved DBI::DBD docs thanks to H.Merijn Brand.
-
-=head2 Changes in DBI 1.607 (svn r11571) 22nd July 2008
-
- NOTE: Perl 5.8.1 is now the minimum supported version.
- If you need support for earlier versions send me a patch.
-
- Fixed missing import of carp in DBI::Gofer::Execute.
-
- Added note to docs about effect of execute(@empty_array).
- Clarified docs for ReadOnly thanks to Martin Evans.
-
-=head2 Changes in DBI 1.605 (svn r11434) 16th June 2008
-
- Fixed broken DBIS macro with threads on big-endian machines
- with 64bit ints but 32bit pointers. Ticket #32309.
- Fixed the selectall_arrayref, selectrow_arrayref, and selectrow_array
- methods that get embedded into compiled drivers to use the
- inner sth handle when passed a $sth instead of an sql string.
- Drivers will need to be recompiled to pick up this change.
- Fixed leak in neat() for some kinds of values thanks to Rudolf Lippan.
- Fixed DBI::PurePerl neat() to behave more like XS neat().
-
- Increased default $DBI::neat_maxlen from 400 to 1000.
- Increased timeout on tests to accommodate very slow systems.
- Changed behaviour of trace levels 1..4 to show less information
- at lower levels.
- Changed the format of the key used for $h->{CachedKids}
- (which is undocumented so you shouldn't depend on it anyway)
- Changed gofer error handling to avoid duplicate error text in errstr.
- Clarified docs re ":N" style placeholders.
- Improved gofer retry-on-error logic and refactored to aid subclassing.
- Improved gofer trace output in assorted ways.
-
- Removed the beeps "\a" from Makefile.PL warnings.
- Removed check for PlRPC-modules from Makefile.PL
-
- Added sorting of ParamValues reported by ShowErrorStatement
- thanks to to Rudolf Lippan.
- Added cache miss trace message to DBD::Gofer transport class.
- Added $drh->dbixs_revision method.
- Added explicit LICENSE specification (perl) to META.yaml
-
-=head2 Changes in DBI 1.604 (svn rev 10994) 24th March 2008
-
- Fixed fetchall_arrayref with $max_rows argument broken in 1.603,
- thanks to Greg Sabino Mullane.
- Fixed a few harmless compiler warnings on cygwin.
-
-=head2 Changes in DBI 1.603
-
- Fixed pure-perl fetchall_arrayref with $max_rows argument
- to not error when fetching after all rows already fetched.
- (Was fixed for compiled drivers back in DBI 1.31.)
- Thanks to Mark Overmeer.
- Fixed C sprintf formats and casts, fixing compiler warnings.
-
- Changed dbi_profile() to accept a hash of profiles and apply to all.
- Changed gofer stream transport to improve error reporting.
- Changed gofer test timeout to avoid spurious failures on slow systems.
-
- Added options to t/85gofer.t so it's more useful for manual testing.
-
-=head2 Changes in DBI 1.602 (svn rev 10706) 8th February 2008
-
- Fixed potential coredump if stack reallocated while calling back
- into perl from XS code. Thanks to John Gardiner Myers.
- Fixed DBI::Util::CacheMemory->new to not clear the cache.
- Fixed avg in DBI::Profile as_text() thanks to Abe Ingersoll.
- Fixed DBD::DBM bug in push_names thanks to J M Davitt.
- Fixed take_imp_data for some platforms thanks to Jeffrey Klein.
- Fixed docs tie'ing CacheKids (ie LRU cache) thanks to Peter John Edwards.
-
- Expanded DBI::DBD docs for driver authors thanks to Martin Evans.
- Enhanced t/80proxy.t test script.
- Enhanced t/85gofer.t test script thanks to Stig.
- Enhanced t/10examp.t test script thanks to David Cantrell.
- Documented $DBI::stderr as the default value of err for internal errors.
-
- Gofer changes:
- track_recent now also keeps track of N most recent errors.
- The connect method is now also counted in stats.
-
-=head2 Changes in DBI 1.601 (svn rev 10103), 21st October 2007
-
- Fixed t/05thrclone.t to work with Test::More >= 0.71
- thanks to Jerry D. Hedden and Michael G Schwern.
- Fixed DBI for VMS thanks to Peter (Stig) Edwards.
-
- Added client-side caching to DBD::Gofer. Can use any cache with
- get($k)/set($k,$v) methods, including all the Cache and Cache::Cache
- distribution modules plus Cache::Memcached, Cache::FastMmap etc.
- Works for all transports. Overridable per handle.
-
- Added DBI::Util::CacheMemory for use with DBD::Gofer caching.
- It's a very fast and small strict subset of Cache::Memory.
-
-=head2 Changes in DBI 1.59 (svn rev 9874), 23rd August 2007
-
- Fixed DBI::ProfileData to unescape headers lines read from data file.
- Fixed DBI::ProfileData to not clobber $_, thanks to Alexey Tourbin.
- Fixed DBI::SQL::Nano to not clobber $_, thanks to Alexey Tourbin.
- Fixed DBI::PurePerl to return undef for ChildHandles if weaken not available.
- Fixed DBD::Proxy disconnect error thanks to Philip Dye.
- Fixed DBD::Gofer::Transport::Base bug (typo) in timeout code.
- Fixed DBD::Proxy rows method thanks to Philip Dye.
- Fixed dbiprof compile errors, thanks to Alexey Tourbin.
- Fixed t/03handle.t to skip some tests if ChildHandles not available.
-
- Added check_response_sub to DBI::Gofer::Execute
-
-=head2 Changes in DBI 1.58 (svn rev 9678), 25th June 2007
-
- Fixed code triggering fatal error in bleadperl, thanks to Steve Hay.
- Fixed compiler warning thanks to Jerry D. Hedden.
- Fixed t/40profile.t to use int(dbi_time()) for systems like Cygwin where
- time() seems to be rounded not truncated from the high resolution time.
- Removed dump_results() test from t/80proxy.t.
-
-=head2 Changes in DBI 1.57 (svn rev 9639), 13th June 2007
-
- Note: this release includes a change to the DBI::hash() function which will
- now produce different values than before *if* your perl was built with 64-bit
- 'int' type (i.e. "perl -V:intsize" says intsize='8'). It's relatively rare
- for perl to be configured that way, even on 64-bit systems.
-
- Fixed XS versions of select*_*() methods to call execute()
- fetch() etc., with inner handle instead of outer.
- Fixed execute_for_fetch() to not cache errstr values
- thanks to Bart Degryse.
- Fixed unused var compiler warning thanks to JDHEDDEN.
- Fixed t/86gofer_fail tests to be less likely to fail falsely.
-
- Changed DBI::hash to return 'I32' type instead of 'int' so results are
- portable/consistent regardless of size of the int type.
- Corrected timeout example in docs thanks to Egmont Koblinger.
- Changed t/01basic.t to warn instead of failing when it detects
- a problem with Math::BigInt (some recent versions had problems).
-
- Added support for !Time and !Time~N to DBI::Profile Path. See docs.
- Added extra trace info to connect_cached thanks to Walery Studennikov.
- Added non-random (deterministic) mode to DBI_GOFER_RANDOM mechanism.
- Added DBIXS_REVISION macro that drivers can use.
- Added more docs for private_attribute_info() method.
-
- DBI::Profile changes:
- dbi_profile() now returns ref to relevant leaf node.
- Don't profile DESTROY during global destruction.
- Added as_node_path_list() and as_text() methods.
- DBI::ProfileDumper changes:
- Don't write file if there's no profile data.
- Uses full natural precision when saving data (was using %.6f)
- Optimized flush_to_disk().
- Locks the data file while writing.
- Enabled filename to be a code ref for dynamic names.
- DBI::ProfileDumper::Apache changes:
- Added Quiet=>1 to avoid write to STDERR in flush_to_disk().
- Added Dir=>... to specify a writable destination directory.
- Enabled DBI_PROFILE_APACHE_LOG_DIR for mod_perl 1 as well as 2.
- Added parent pid to default data file name.
- DBI::ProfileData changes:
- Added DeleteFiles option to rename & delete files once read.
- Locks the data files while reading.
- Added ability to sort by Path elements.
- dbiprof changes:
- Added --dumpnodes and --delete options.
- Added/updated docs for both DBI::ProfileDumper && ::Apache.
-
-=head2 Changes in DBI 1.56 (svn rev 9660), 18th June 2007
-
- Fixed printf arg warnings thanks to JDHEDDEN.
- Fixed returning driver-private sth attributes via gofer.
-
- Changed pod docs docs to use =head3 instead of =item
- so now in html you get links to individual methods etc.
- Changed default gofer retry_limit from 2 to 0.
- Changed tests to workaround Math::BigInt broken versions.
- Changed dbi_profile_merge() to dbi_profile_merge_nodes()
- old name still works as an alias for the new one.
- Removed old DBI internal sanity check that's no longer valid
- causing "panic: DESTROY (dbih_clearcom)" when tracing enabled
-
- Added DBI_GOFER_RANDOM env var that can be use to trigger random
- failures and delays when executing gofer requests. Designed to help
- test automatic retry on failures and timeout handling.
- Added lots more docs to all the DBD::Gofer and DBI::Gofer classes.
-
-=head2 Changes in DBI 1.55 (svn rev 9504), 4th May 2007
-
- Fixed set_err() so HandleSetErr hook is executed reliably, if set.
- Fixed accuracy of profiling when perl configured to use long doubles.
- Fixed 42prof_data.t on fast systems with poor timers thanks to Malcolm Nooning.
- Fixed potential corruption in selectall_arrayref and selectrow_arrayref
- for compiled drivers, thanks to Rob Davies.
- Rebuild your compiled drivers after installing DBI.
-
- Changed some handle creation code from perl to C code,
- to reduce handle creation cost by ~20%.
- Changed internal implementation of the CachedKids attribute
- so it's a normal handle attribute (and initially undef).
- Changed connect_cached and prepare_cached to avoid a FETCH method call,
- and thereby reduced cost by ~5% and ~30% respectively.
- Changed _set_fbav to not croak when given a wrongly sized array,
- it now warns and adjusts the row buffer to match.
- Changed some internals to improve performance with threaded perls.
- Changed DBD::NullP to be slightly more useful for testing.
- Changed File::Spec prerequisite to not require a minimum version.
- Changed tests to work with other DBMs thanks to ZMAN.
- Changed ex/perl_dbi_nulls_test.pl to be more descriptive.
-
- Added more functionality to the (undocumented) Callback mechanism.
- Callbacks can now elect to provide a value to be returned, in which case
- the method won't be called. A callback for "*" is applied to all methods
- that don't have their own callback.
- Added $h->{ReadOnly} attribute.
- Added support for DBI Profile Path to contain refs to scalars
- which will be de-ref'd for each profile sample.
- Added dbilogstrip utility to edit DBI logs for diff'ing (gets installed)
- Added details for SQLite 3.3 to NULL handling docs thanks to Alex Teslik.
- Added take_imp_data() to DBI::PurePerl.
-
- Gofer related changes:
- Fixed gofer pipeone & stream transports to avoid risk of hanging.
- Improved error handling and tracing significantly.
- Added way to generate random 1-in-N failures for methods.
- Added automatic retry-on-error mechanism to gofer transport base class.
- Added tests to show automatic retry mechanism works a treat!
- Added go_retry_hook callback hook so apps can fine-tune retry behaviour.
- Added header to request and response packets for sanity checking
- and to enable version skew between client and server.
- Added forced_single_resultset, max_cached_sth_per_dbh and max_cached_dbh_per_drh
- to gofer executor config.
- Driver-private methods installed with install_method are now proxied.
- No longer does a round-trip to the server for methods it knows
- have not been overridden by the remote driver.
- Most significant aspects of gofer behaviour are controlled by policy mechanism.
- Added policy-controlled caching of results for some methods, such as schema metadata.
- The connect_cached and prepare_cached methods cache on client and server.
- The bind_param_array and execute_array methods are now supported.
- Worked around a DBD::Sybase bind_param bug (which is fixed in DBD::Sybase 1.07)
- Added goferperf.pl utility (doesn't get installed).
- Many other assorted Gofer related bug fixes, enhancements and docs.
- The http and mod_perl transports have been remove to their own distribution.
- Client and server will need upgrading together for this release.
-
-=head2 Changes in DBI 1.54 (svn rev 9157), 23rd February 2007
-
- NOTE: This release includes the 'next big thing': DBD::Gofer.
- Take a look!
-
- WARNING: This version has some subtle changes in DBI internals.
- It's possible, though doubtful, that some may affect your code.
- I recommend some extra testing before using this release.
- Or perhaps I'm just being over cautious...
-
- Fixed type_info when called for multiple dbh thanks to Cosimo Streppone.
- Fixed compile warnings in bleadperl on freebsd-6.1-release
- and solaris 10g thanks to Philip M. Gollucci.
- Fixed to compile for perl built with -DNO_MATHOMS thanks to Jerry D. Hedden.
- Fixed to work for bleadperl (r29544) thanks to Nicholas Clark.
- Users of Perl >= 5.9.5 will require DBI >= 1.54.
- Fixed rare error when profiling access to $DBI::err etc tied variables.
- Fixed DBI::ProfileDumper to not be affected by changes to $/ and $,
- thanks to Michael Schwern.
-
- Changed t/40profile.t to skip tests for perl < 5.8.0.
- Changed setting trace file to no longer write "Trace file set" to new file.
- Changed 'handle cleared whilst still active' warning for dbh
- to only be given for dbh that have active sth or are not AutoCommit.
- Changed take_imp_data to call finish on all Active child sth.
- Changed DBI::PurePerl trace() method to be more consistent.
- Changed set_err method to effectively not append to errstr if the new errstr
- is the same as the current one.
- Changed handle factory methods, like connect, prepare, and table_info,
- to copy any error/warn/info state of the handle being returned
- up into the handle the method was called on.
- Changed row buffer handling to not alter NUM_OF_FIELDS if it's
- inconsistent with number of elements in row buffer array.
- Updated DBI::DBD docs re handling multiple result sets.
- Updated DBI::DBD docs for driver authors thanks to Ammon Riley
- and Dean Arnold.
- Updated column_info docs to note that if a table doesn't exist
- you get an sth for an empty result set and not an error.
-
- Added new DBD::Gofer 'stateless proxy' driver and framework,
- and the DBI test suite is now also executed via DBD::Gofer,
- and DBD::Gofer+DBI::PurePerl, in addition to DBI::PurePerl.
- Added ability for trace() to support filehandle argument,
- including tracing into a string, thanks to Dean Arnold.
- Added ability for drivers to implement func() method
- so proxy drivers can proxy the func method itself.
- Added SQL_BIGINT type code (resolved to the ODBC/JDBC value (-5))
- Added $h->private_attribute_info method.
-
-=head2 Changes in DBI 1.53 (svn rev 7995), 31st October 2006
-
- Fixed checks for weaken to work with early 5.8.x versions
- Fixed DBD::Proxy handling of some methods, including commit and rollback.
- Fixed t/40profile.t to be more insensitive to long double precision.
- Fixed t/40profile.t to be insensitive to small negative shifts in time
- thanks to Jamie McCarthy.
- Fixed t/40profile.t to skip tests for perl < 5.8.0.
- Fixed to work with current 'bleadperl' (~5.9.5) thanks to Steve Peters.
- Users of Perl >= 5.9.5 will require DBI >= 1.53.
- Fixed to be more robust against drivers not handling multiple result
- sets properly, thanks to Gisle Aas.
-
- Added array context support to execute_array and execute_for_fetch
- methods which returns executed tuples and rows affected.
- Added Tie::Cache::LRU example to docs thanks to Brandon Black.
-
-=head2 Changes in DBI 1.52 (svn rev 6840), 30th July 2006
-
- Fixed memory leak (per handle) thanks to Nicholas Clark and Ephraim Dan.
- Fixed memory leak (16 bytes per sth) thanks to Doru Theodor Petrescu.
- Fixed execute_for_fetch/execute_array to RaiseError thanks to Martin J. Evans.
- Fixed for perl 5.9.4. Users of Perl >= 5.9.4 will require DBI >= 1.52.
-
- Updated DBD::File to 0.35 to match the latest release on CPAN.
-
- Added $dbh->statistics_info specification thanks to Brandon Black.
-
- Many changes and additions to profiling:
- Profile Path can now uses sane strings instead of obscure numbers,
- can refer to attributes, assorted magical values, and even code refs!
- Parsing of non-numeric DBI_PROFILE env var values has changed.
- Changed DBI::Profile docs extensively - many new features.
- See DBI::Profile docs for more information.
-
-=head2 Changes in DBI 1.51 (svn rev 6475), 6th June 2006
-
- Fixed $dbh->clone method 'signature' thanks to Jeffrey Klein.
- Fixed default ping() method to return false if !$dbh->{Active}.
- Fixed t/40profile.t to be insensitive to long double precision.
- Fixed for perl 5.8.0's more limited weaken() function.
- Fixed DBD::Proxy to not alter $@ in disconnect or AUTOLOADd methods.
- Fixed bind_columns() to use return set_err(...) instead of die()
- to report incorrect number of parameters, thanks to Ben Thul.
- Fixed bind_col() to ignore undef as bind location, thanks to David Wheeler.
- Fixed for perl 5.9.x for non-threaded builds thanks to Nicholas Clark.
- Users of Perl >= 5.9.x will require DBI >= 1.51.
- Fixed fetching of rows as hash refs to preserve utf8 on field names
- from $sth->{NAME} thanks to Alexey Gaidukov.
- Fixed build on Win32 (dbd_postamble) thanks to David Golden.
-
- Improved performance for thread-enabled perls thanks to Gisle Aas.
- Drivers can now use PERL_NO_GET_CONTEXT thanks to Gisle Aas.
- Driver authors please read the notes in the DBI::DBD docs.
- Changed DBI::Profile format to always include a percentage,
- if not exiting then uses time between the first and last DBI call.
- Changed DBI::ProfileData to be more forgiving of systems with
- unstable clocks (where time may go backwards occasionally).
- Clarified the 'Subclassing the DBI' docs.
- Assorted minor changes to docs from comments on annocpan.org.
- Changed Makefile.PL to avoid incompatible options for old gcc.
-
- Added 'fetch array of hash refs' example to selectall_arrayref
- docs thanks to Tom Schindl.
- Added docs for $sth->{ParamArrays} thanks to Martin J. Evans.
- Added reference to $DBI::neat_maxlen in TRACING section of docs.
- Added ability for DBI::Profile Path to include attributes
- and a summary of where the code was called from.
-
-=head2 Changes in DBI 1.50 (svn rev 2307), 13 December 2005
-
- Fixed Makefile.PL options for gcc bug introduced in 1.49.
- Fixed handle magic order to keep DBD::Oracle happy.
- Fixed selectrow_array to return empty list on error.
-
- Changed dbi_profile_merge() to be able to recurse and merge
- sub-trees of profile data.
-
- Added documentation for dbi_profile_merge(), including how to
- measure the time spent inside the DBI for an http request.
-
-=head2 Changes in DBI 1.49 (svn rev 2287), 29th November 2005
-
- Fixed assorted attribute handling bugs in DBD::Proxy.
- Fixed croak() in DBD::NullP thanks to Sergey Skvortsov.
- Fixed handling of take_imp_data() and dbi_imp_data attribute.
- Fixed bugs in DBD::DBM thanks to Jeff Zucker.
- Fixed bug in DBI::ProfileDumper thanks to Sam Tregar.
- Fixed ping in DBD::Proxy thanks to George Campbell.
- Fixed dangling ref in $sth after parent $dbh destroyed
- with thanks to il@rol.ru for the bug report #13151
- Fixed prerequisites to include Storable thanks to Michael Schwern.
- Fixed take_imp_data to be more practical.
-
- Change to require perl 5.6.1 (as advertised in 2003) not 5.6.0.
- Changed internals to be more strictly coded thanks to Andy Lester.
- Changed warning about multiple copies of Driver.xst found in @INC
- to ignore duplicated directories thanks to Ed Avis.
- Changed Driver.xst to enable drivers to define an dbd_st_prepare_sv
- function where the statement parameter is an SV. That enables
- compiled drivers to support SQL strings that are UTF-8.
- Changed "use DBI" to only set $DBI::connect_via if not already set.
- Changed docs to clarify pre-method clearing of err values.
-
- Added ability for DBI::ProfileData to edit profile path on loading.
- This enables aggregation of different SQL statements into the same
- profile node - very handy when not using placeholders or when working
- multiple separate tables for the same thing (ie logtable_2005_11_28)
- Added $sth->{ParamTypes} specification thanks to Dean Arnold.
- Added $h->{Callbacks} attribute to enable code hooks to be invoked
- when certain methods are called. For example:
- $dbh->{Callbacks}->{prepare} = sub { ... };
- With thanks to David Wheeler for the kick start.
- Added $h->{ChildHandles} (using weakrefs) thanks to Sam Tregar
- I've recoded it in C so there's no significant performance impact.
- Added $h->{Type} docs (returns 'dr', 'db', or 'st')
- Adding trace message in DESTROY if InactiveDestroy enabled.
- Added %drhs = DBI->installed_drivers();
-
- Ported DBI::ProfileDumper::Apache to mod_perl2 RC5+
- thanks to Philip M. Golluci
-
-=head2 Changes in DBI 1.48 (svn rev 928), 14th March 2005
-
- Fixed DBI::DBD::Metadata generation of type_info_all thanks to Steffen Goeldner
- (driver authors who have used it should rerun it).
-
- Updated docs for NULL Value placeholders thanks to Brian Campbell.
-
- Added multi-keyfield nested hash fetching to fetchall_hashref()
- thanks to Zhuang (John) Li for polishing up my draft.
- Added registered driver prefixes: amzn_ for DBD::Amazon and yaswi_ for DBD::Yaswi.
-
-
-=head2 Changes in DBI 1.47 (svn rev 854), 2nd February 2005
-
- Fixed DBI::ProxyServer to not create pid files by default.
- References: Ubuntu Security Notice USN-70-1, CAN-2005-0077
- Thanks to Javier Fernández-Sanguino Peña from the
- Debian Security Audit Project, and Jonathan Leffler.
- Fixed some tests to work with older Test::More versions.
- Fixed setting $DBI::err/errstr in DBI::PurePerl.
- Fixed potential undef warning from connect_cached().
- Fixed $DBI::lasth handling for DESTROY so lasth points to
- parent even if DESTROY called other methods.
- Fixed DBD::Proxy method calls to not alter $@.
- Fixed DBD::File problem with encoding pragma thanks to Erik Rijkers.
-
- Changed error handling so undef errstr doesn't cause warning.
- Changed DBI::DBD docs to use =head3/=head4 pod thanks to
- Jonathan Leffler. This may generate warnings for perl 5.6.
- Changed DBI::PurePerl to set autoflush on trace filehandle.
- Changed DBD::Proxy to treat Username as a local attribute
- so recent DBI version can be used with old DBI::ProxyServer.
- Changed driver handle caching in DBD::File.
- Added $GetInfoType{SQL_DATABASE_NAME} thanks to Steffen Goeldner.
-
- Updated docs to recommend some common DSN string attributes.
- Updated connect_cached() docs with issues and suggestions.
- Updated docs for NULL Value placeholders thanks to Brian Campbell.
- Updated docs for primary_key_info and primary_keys.
- Updated docs to clarify that the default fetchrow_hashref behaviour,
- of returning a ref to a new hash for each row, will not change.
- Updated err/errstr/state docs for DBD authors thanks to Steffen Goeldner.
- Updated handle/attribute docs for DBD authors thanks to Steffen Goeldner.
- Corrected and updated LongReadLen docs thanks to Bart Lateur.
- Added DBD::JDBC as a registered driver.
-
-=head2 Changes in DBI 1.46 (svn rev 584), 16th November 2004
-
- Fixed parsing bugs in DBI::SQL::Nano thanks to Jeff Zucker.
- Fixed a couple of bad links in docs thanks to Graham Barr.
- Fixed test.pl Win32 undef warning thanks to H.Merijn Brand & David Repko.
- Fixed minor issues in DBI::DBD::Metadata thanks to Steffen Goeldner.
- Fixed DBI::PurePerl neat() to use double quotes for utf8.
-
- Changed execute_array() definition, and default implementation,
- to not consider scalar values for execute tuple count. See docs.
- Changed DBD::File to enable ShowErrorStatement by default,
- which affects DBD::File subclasses such as DBD::CSV and DBD::DBM.
- Changed use DBI qw(:utils) tag to include $neat_maxlen.
- Updated Roadmap and ToDo.
-
- Added data_string_diff() data_string_desc() and data_diff()
- utility functions to help diagnose Unicode issues.
- All can be imported via the use DBI qw(:utils) tag.
-
-=head2 Changes in DBI 1.45 (svn rev 480), 6th October 2004
-
- Fixed DBI::DBD code for drivers broken in 1.44.
- Fixed "Free to wrong pool"/"Attempt to free unreferenced scalar" in FETCH.
-
-=head2 Changes in DBI 1.44 (svn rev 478), 5th October 2004
-
- Fixed build issues on VMS thanks to Jakob Snoer.
- Fixed DBD::File finish() method to return 1 thanks to Jan Dubois.
- Fixed rare core dump during global destruction thanks to Mark Jason Dominus.
- Fixed risk of utf8 flag persisting from one row to the next.
-
- Changed bind_param_array() so it doesn't require all bind arrays
- to have the same number of elements.
- Changed bind_param_array() to error if placeholder number <= 0.
- Changed execute_array() definition, and default implementation,
- to effectively NULL-pad shorter bind arrays.
- Changed execute_array() to return "0E0" for 0 as per the docs.
- Changed execute_for_fetch() definition, and default implementation,
- to return "0E0" for 0 like execute() and execute_array().
- Changed Test::More prerequisite to Test::Simple (which is also the name
- of the distribution both are packaged in) to work around ppm behaviour.
-
- Corrected docs to say that get/set of unknown attribute generates
- a warning and is no longer fatal. Thanks to Vadim.
- Corrected fetchall_arrayref() docs example thanks to Drew Broadley.
-
- Added $h1->swap_inner_handle($h2) sponsored by BizRate.com
-
-
-=head2 Changes in DBI 1.43 (svn rev 377), 2nd July 2004
-
- Fixed connect() and connect_cached() RaiseError/PrintError
- which would sometimes show "(no error string)" as the error.
- Fixed compiler warning thanks to Paul Marquess.
- Fixed "trace level set to" trace message thanks to H.Merijn Brand.
- Fixed DBD::DBM $dbh->{dbm_tables}->{...} to be keyed by the
- table name not the file name thanks to Jeff Zucker.
- Fixed last_insert_id(...) thanks to Rudy Lippan.
- Fixed propagation of scalar/list context into proxied methods.
- Fixed DBI::Profile::DESTROY to not alter $@.
- Fixed DBI::ProfileDumper new() docs thanks to Michael Schwern.
- Fixed _load_class to propagate $@ thanks to Drew Taylor.
- Fixed compile warnings on Win32 thanks to Robert Baron.
- Fixed problem building with recent versions of MakeMaker.
- Fixed DBD::Sponge not to generate warning with threads.
- Fixed DBI_AUTOPROXY to work more than once thanks to Steven Hirsch.
-
- Changed TraceLevel 1 to not show recursive/nested calls.
- Changed getting or setting an invalid attribute to no longer be
- a fatal error but generate a warning instead.
- Changed selectall_arrayref() to call finish() if
- $attr->{MaxRows} is defined.
- Changed all tests to use Test::More and enhanced the tests thanks
- to Stevan Little and Andy Lester. See http://qa.perl.org/phalanx/
- Changed Test::More minimum prerequisite version to 0.40 (2001).
- Changed DBI::Profile header to include the date and time.
-
- Added DBI->parse_dsn($dsn) method.
- Added warning if build directory path contains white space.
- Added docs for parse_trace_flags() and parse_trace_flag().
- Removed "may change" warnings from the docs for table_info(),
- primary_key_info(), and foreign_key_info() methods.
-
-=head2 Changes in DBI 1.42 (svn rev 222), 12th March 2004
-
- Fixed $sth->{NUM_OF_FIELDS} of non-executed statement handle
- to be undef as per the docs (it was 0).
- Fixed t/41prof_dump.t to work with perl5.9.1.
- Fixed DBD_ATTRIB_DELETE macro thanks to Marco Paskamp.
- Fixed DBI::PurePerl looks_like_number() and $DBI::rows.
- Fixed ref($h)->can("foo") to not croak.
-
- Changed attributes (NAME, TYPE etc) of non-executed statement
- handle to be undef instead of triggering an error.
- Changed ShowErrorStatement to apply to more $dbh methods.
- Changed DBI_TRACE env var so just does this at load time:
- DBI->trace(split '=', $ENV{DBI_TRACE}, 2);
- Improved "invalid number of parameters" error message.
- Added DBI::common as base class for DBI::db, DBD::st etc.
- Moved methods common to all handles into DBI::common.
-
- Major tracing enhancement:
-
- Added $h->parse_trace_flags("foo|SQL|7") to map a group of
- trace flags into the corresponding trace flag bits.
- Added automatic calling of parse_trace_flags() if
- setting the trace level to a non-numeric value:
- $h->{TraceLevel}="foo|SQL|7"; $h->trace("foo|SQL|7");
- DBI->connect("dbi:Driver(TraceLevel=SQL|foo):...", ...);
- Currently no trace flags have been defined.
- Added to, and reworked, the trace documentation.
- Added dbivport.h for driver authors to use.
-
- Major driver additions that Jeff Zucker and I have been working on:
-
- Added DBI::SQL::Nano a 'smaller than micro' SQL parser
- with an SQL::Statement compatible API. If SQL::Statement
- is installed then DBI::SQL::Nano becomes an empty subclass
- of SQL::Statement, unless the DBI_SQL_NANO env var is true.
- Added DBD::File, modified to use DBI::SQL::Nano.
- Added DBD::DBM, an SQL interface to DBM files using DBD::File.
-
- Documentation changes:
-
- Corrected typos in docs thanks to Steffen Goeldner.
- Corrected execute_for_fetch example thanks to Dean Arnold.
-
-=head2 Changes in DBI 1.41 (svn rev 130), 22nd February 2004
-
- Fixed execute_for_array() so tuple_status parameter is optional
- as per docs, thanks to Ed Avis.
- Fixed execute_for_array() docs to say that it returns undef if
- any of the execute() calls fail.
- Fixed take_imp_data() test on m68k reported by Christian Hammers.
- Fixed write_typeinfo_pm inconsistencies in DBI::DBD::Metadata
- thanks to Andy Hassall.
- Fixed $h->{TraceLevel} to not return DBI->trace trace level
- which it used to if DBI->trace trace level was higher.
-
- Changed set_err() to append to errstr, with a leading "\n" if it's
- not empty, so that multiple error/warning messages are recorded.
- Changed trace to limit elements dumped when an array reference is
- returned from a method to the max(40, $DBI::neat_maxlen/10)
- so that fetchall_arrayref(), for example, doesn't flood the trace.
- Changed trace level to be a four bit integer (levels 0 thru 15)
- and a set of topic flags (no topics have been assigned yet).
- Changed column_info() to check argument count.
- Extended bind_param() TYPE attribute specification to imply
- standard formating of value, eg SQL_DATE implies 'YYYY-MM-DD'.
-
- Added way for drivers to indicate 'success with info' or 'warning'
- by setting err to "0" for warning and "" for information.
- Both values are false and so don't trigger RaiseError etc.
- Thanks to Steffen Goeldner for the original idea.
- Added $h->{HandleSetErr} = sub { ... } to be called at the
- point that an error, warn, or info state is recorded.
- The code can alter the err, errstr, and state values
- (e.g., to promote an error to a warning, or the reverse).
- Added $h->{PrintWarn} attribute to enable printing of warnings
- recorded by the driver. Defaults to same value as $^W (perl -w).
- Added $h->{ErrCount} attribute, incremented whenever an error is
- recorded by the driver via set_err().
- Added $h->{Executed} attribute, set if do()/execute() called.
- Added \%attr parameter to foreign_key_info() method.
- Added ref count of inner handle to "DESTROY ignored for outer" msg.
- Added Win32 build config checks to DBI::DBD thanks to Andy Hassall.
- Added bind_col to Driver.xst so drivers can define their own.
- Added TYPE attribute to bind_col and specified the expected
- driver behaviour.
-
- Major update to signal handling docs thanks to Lincoln Baxter.
- Corrected dbiproxy usage doc thanks to Christian Hammers.
- Corrected type_info_all index hash docs thanks to Steffen Goeldner.
- Corrected type_info COLUMN_SIZE to chars not bytes thanks to Dean Arnold.
- Corrected get_info() docs to include details of DBI::Const::GetInfoType.
- Clarified that $sth->{PRECISION} is OCTET_LENGTH for char types.
-
-=head2 Changes in DBI 1.40, 7th January 2004
-
- Fixed handling of CachedKids when DESTROYing threaded handles.
- Fixed sql_user_name() in DBI::DBD::Metadata (used by write_getinfo_pm)
- to use $dbh->{Username}. Driver authors please update your code.
-
- Changed connect_cached() when running under Apache::DBI
- to route calls to Apache::DBI::connect().
-
- Added CLONE() to DBD::Sponge and DBD::ExampleP.
- Added warning when starting a new thread about any loaded driver
- which does not have a CLONE() function.
- Added new prepare_cache($sql, \%attr, 3) option to manage Active handles.
- Added SCALE and NULLABLE support to DBD::Sponge.
- Added missing execute() in fetchall_hashref docs thanks to Iain Truskett.
- Added a CONTRIBUTING section to the docs with notes on creating patches.
-
-=head2 Changes in DBI 1.39, 27th November 2003
-
- Fixed STORE to not clear error during nested DBI call, again/better,
- thanks to Tony Bowden for the report and helpful test case.
- Fixed DBI dispatch to not try to use AUTOLOAD for driver methods unless
- the method has been declared (as methods should be when using AUTOLOAD).
- This fixes a problem when the Attribute::Handlers module is loaded.
- Fixed cwd check code to use $Config{path_sep} thanks to Steve Hay.
- Fixed unqualified croak() calls thanks to Steffen Goeldner.
- Fixed DBD::ExampleP TYPE and PRECISION attributes thanks to Tom Lowery.
- Fixed tracing of methods that only get traced at high trace levels.
-
- The level 1 trace no longer includes nested method calls so it generally
- just shows the methods the application explicitly calls.
- Added line to trace log (level>=4) when err/errstr is cleared.
- Updated docs for InactiveDestroy and point out where and when the
- trace includes the process id.
- Update DBI::DBD docs thanks to Steffen Goeldner.
- Removed docs saying that the DBI->data_sources method could be
- passed a $dbh. The $dbh->data_sources method should be used instead.
- Added link to 'DBI recipes' thanks to Giuseppe Maxia:
- http://gmax.oltrelinux.com/dbirecipes.html (note that this
- is not an endorsement that the recipies are 'optimal')
-
- Note: There is a bug in perl 5.8.2 when configured with threads
- and debugging enabled (bug #24463) which causes a DBI test to fail.
-
-=head2 Changes in DBI 1.38, 21th August 2003
-
- NOTE: The DBI now requires perl version 5.6.0 or later.
- (As per notice in DBI 1.33 released 27th February 2003)
-
- Fixed spurious t/03handles failure on 64bit perls reported by H.Merijn Brand.
- Fixed spurious t/15array failure on some perl versions thanks to Ed Avis.
- Fixed build using dmake on windows thanks to Steffen Goeldner.
- Fixed build on using some shells thanks to Gurusamy Sarathy.
- Fixed ParamValues to only be appended to ShowErrorStatement if not empty.
- Fixed $dbh->{Statement} not being writable by drivers in some cases.
- Fixed occasional undef warnings on connect failures thanks to Ed Avis.
- Fixed small memory leak when using $sth->{NAME..._hash}.
- Fixed 64bit warnings thanks to Marian Jancar.
- Fixed DBD::Proxy::db::DESTROY to not alter $@ thanks to Keith Chapman.
- Fixed Makefile.PL status from WriteMakefile() thanks to Leon Brocard.
-
- Changed "Can't set ...->{Foo}: unrecognised attribute" from an error to a
- warning when running with DBI::ProxyServer to simplify upgrades.
- Changed execute_array() to no longer require ArrayTupleStatus attribute.
- Changed DBI->available_drivers to not hide DBD::Sponge.
- Updated/moved placeholder docs to a better place thanks to Johan Vromans.
- Changed dbd_db_do4 api in Driver.xst to match dbd_st_execute (return int,
- not bool), relevant only to driver authors.
- Changed neat(), and thus trace(), so strings marked as utf8 are presented
- in double quotes instead of single quotes and are not sanitized.
-
- Added $dbh->data_sources method.
- Added $dbh->last_insert_id method.
- Added $sth->execute_for_fetch($fetch_tuple_sub, \@tuple_status) method.
- Added DBI->installed_versions thanks to Jeff Zucker.
- Added $DBI::Profile::ON_DESTROY_DUMP variable.
- Added docs for DBD::Sponge thanks to Mark Stosberg.
-
-=head2 Changes in DBI 1.37, 15th May 2003
-
- Fixed "Can't get dbh->{Statement}: unrecognised attribute" error in test
- caused by change to perl internals in 5.8.0
- Fixed to build with latest development perl (5.8.1@19525).
- Fixed C code to use all ANSI declarations thanks to Steven Lembark.
-
-=head2 Changes in DBI 1.36, 11th May 2003
-
- Fixed DBI->connect to carp instead of croak on 'old-style' usage.
- Fixed connect(,,, { RootClass => $foo }) to not croak if module not found.
- Fixed code generated by DBI::DBD::Metadata thanks to DARREN@cpan.org (#2270)
- Fixed DBI::PurePerl to not reset $@ during method dispatch.
- Fixed VMS build thanks to Michael Schwern.
- Fixed Proxy disconnect thanks to Steven Hirsch.
- Fixed error in DBI::DBD docs thanks to Andy Hassall.
-
- Changed t/40profile.t to not require Time::HiRes.
- Changed DBI::ProxyServer to load DBI only on first request, which
- helps threaded server mode, thanks to Bob Showalter.
- Changed execute_array() return value from row count to executed
- tuple count, and now the ArrayTupleStatus attribute is mandatory.
- NOTE: That is an API definition change that may affect your code.
- Changed CompatMode attribute to also disable attribute 'quick FETCH'.
- Changed attribute FETCH to be slightly faster thanks to Stas Bekman.
-
- Added workaround for perl bug #17575 tied hash nested FETCH
- thanks to Silvio Wanka.
- Added Username and Password attributes to connect(..., \%attr) and so
- also embedded in DSN like "dbi:Driver(Username=user,Password=pass):..."
- Username and Password can't contain ")", ",", or "=" characters.
- The predence is DSN first, then \%attr, then $user & $pass parameters,
- and finally the DBI_USER & DBI_PASS environment variables.
- The Username attribute is stored in the $dbh but the Password is not.
- Added ProxyServer HOWTO configure restrictions docs thanks to Jochen Wiedmann.
- Added MaxRows attribute to selectcol_arrayref prompted by Wojciech Pietron.
- Added dump_handle as a method not just a DBI:: utility function.
- Added on-demand by-row data feed into execute_array() using code ref,
- or statement handle. For example, to insert from a select:
- $insert_sth->execute_array( { ArrayTupleFetch => $select_sth, ... } )
- Added warning to trace log when $h->{foo}=... is ignored due to
- invalid prefix (e.g., not 'private_').
-
-=head2 Changes in DBI 1.35, 7th March 2003
-
- Fixed memory leak in fetchrow_hashref introduced in DBI 1.33.
- Fixed various DBD::Proxy errors introduced in DBI 1.33.
- Fixed to ANSI C in dbd_dr_data_sources thanks to Jonathan Leffler.
- Fixed $h->can($method_name) to return correct code ref.
- Removed DBI::Format from distribution as it's now part of the
- separate DBI::Shell distribution by Tom Lowery.
- Updated DBI::DBD docs with a note about the CLONE method.
- Updated DBI::DBD docs thanks to Jonathan Leffler.
- Updated DBI::DBD::Metadata for perl 5.5.3 thanks to Jonathan Leffler.
- Added note to install_method docs about setup_driver() method.
-
-=head2 Changes in DBI 1.34, 28th February 2003
-
- Fixed DBI::DBD docs to refer to DBI::DBD::Metadata thanks to Jonathan Leffler.
- Fixed dbi_time() compile using BorlandC on Windows thanks to Steffen Goeldner.
- Fixed profile tests to do enough work to measure on Windows.
- Fixed disconnect_all() to not be required by drivers.
-
- Added $okay = $h->can($method_name) to check if a method exists.
- Added DBD::*::*->install_method($method_name, \%attr) so driver private
- methods can be 'installed' into the DBI dispatcher and no longer
- need to be called using $h->func(..., $method_name).
-
- Enhanced $dbh->clone() and documentation.
- Enhanced docs to note that dbi_time(), and thus profiling, is limited
- to only millisecond (seconds/1000) resolution on Windows.
- Removed old DBI::Shell from distribution and added Tom Lowery's improved
- version to the Bundle::DBI file.
- Updated minimum version numbers for modules in Bundle::DBI.
-
-=head2 Changes in DBI 1.33, 27th February 2003
-
- NOTE: Future versions of the DBI *will not* support perl 5.6.0 or earlier.
- : Perl 5.6.1 will be the minimum supported version.
-
- NOTE: The "old-style" connect: DBI->connect($database, $user, $pass, $driver);
- : has been deprecated for several years and will now generate a warning.
- : It will be removed in a later release. Please change any old connect() calls.
-
- Added $dbh2 = $dbh1->clone to make a new connection to the database
- that is identical to the original one. clone() can be called even after
- the original handle has been disconnected. See the docs for more details.
-
- Fixed merging of profile data to not sum DBIprof_FIRST_TIME values.
- Fixed unescaping of newlines in DBI::ProfileData thanks to Sam Tregar.
- Fixed Taint bug with fetchrow_hashref with help from Bradley Baetz.
- Fixed $dbh->{Active} for DBD::Proxy, reported by Bob Showalter.
- Fixed STORE to not clear error during nested DBI call,
- thanks to Tony Bowden for the report and helpful test case.
- Fixed DBI::PurePerl error clearing behaviour.
- Fixed dbi_time() and thus DBI::Profile on Windows thanks to Smejkal Petr.
- Fixed problem that meant ShowErrorStatement could show wrong statement,
- thanks to Ron Savage for the report and test case.
- Changed Apache::DBI hook to check for $ENV{MOD_PERL} instead of
- $ENV{GATEWAY_INTERFACE} thanks to Ask Bjoern Hansen.
- No longer tries to dup trace logfp when an interpreter is being cloned.
- Database handles no longer inherit shared $h->err/errstr/state storage
- from their drivers, so each $dbh has it's own $h->err etc. values
- and is no longer affected by calls made on other dbh's.
- Now when a dbh is destroyed it's err/errstr/state values are copied
- up to the driver so checking $DBI::errstr still works as expected.
-
- Build / portability fixes:
- Fixed t/40profile.t to not use Time::HiRes.
- Fixed t/06attrs.t to not be locale sensitive, reported by Christian Hammers.
- Fixed sgi compiler warnings, reported by Paul Blake.
- Fixed build using make -j4, reported by Jonathan Leffler.
- Fixed build and tests under VMS thanks to Craig A. Berry.
-
- Documentation changes:
- Documented $high_resolution_time = dbi_time() function.
- Documented that bind_col() can take an attribute hash.
- Clarified documentation for ParamValues attribute hash keys.
- Many good DBI documentation tweaks from Jonathan Leffler,
- including a major update to the DBI::DBD driver author guide.
- Clarified that execute() should itself call finish() if it's
- called on a statement handle that's still active.
- Clarified $sth->{ParamValues}. Driver authors please note.
- Removed "NEW" markers on some methods and attributes and
- added text to each giving the DBI version it was added in,
- if it was added after DBI 1.21 (Feb 2002).
-
- Changes of note for authors of all drivers:
- Added SQL_DATA_TYPE, SQL_DATETIME_SUB, NUM_PREC_RADIX, and
- INTERVAL_PRECISION fields to docs for type_info_all. There were
- already in type_info(), but type_info_all() didn't specify the
- index values. Please check and update your type_info_all() code.
- Added DBI::DBD::Metadata module that auto-generates your drivers
- get_info and type_info_all data and code, thanks mainly to
- Jonathan Leffler and Steffen Goeldner. If you've not implemented
- get_info and type_info_all methods and your database has an ODBC
- driver available then this will do all the hard work for you!
- Drivers should no longer pass Err, Errstr, or State to _new_drh
- or _new_dbh functions.
- Please check that you support the slightly modified behaviour of
- $sth->{ParamValues}, e.g., always return hash with keys if possible.
-
- Changes of note for authors of compiled drivers:
- Added dbd_db_login6 & dbd_st_finish3 prototypes thanks to Jonathan Leffler.
- All dbd_*_*() functions implemented by drivers must have a
- corresponding #define dbd_*_* <driver_prefix>_*_* otherwise
- the driver may not work with a future release of the DBI.
-
- Changes of note for authors of drivers which use Driver.xst:
- Some new method hooks have been added are are enabled by
- defining corresponding macros:
- $drh->data_sources() - dbd_dr_data_sources
- $dbh->do() - dbd_db_do4
- The following methods won't be compiled into the driver unless
- the corresponding macro has been #defined:
- $drh->disconnect_all() - dbd_discon_all
-
-
-=head2 Changes in DBI 1.32, 1st December 2002
-
- Fixed to work with 5.005_03 thanks to Tatsuhiko Miyagawa (I've not tested it).
- Reenabled taint tests (accidentally left disabled) spotted by Bradley Baetz.
- Improved docs for FetchHashKeyName attribute thanks to Ian Barwick.
- Fixed core dump if fetchrow_hashref given bad argument (name of attribute
- with a value that wasn't an array reference), spotted by Ian Barwick.
- Fixed some compiler warnings thanks to David Wheeler.
- Updated Steven Hirsch's enhanced proxy work (seems I left out a bit).
- Made t/40profile.t tests more reliable, reported by Randy, who is part of
- the excellent CPAN testers team: http://testers.cpan.org/
- (Please visit, see the valuable work they do and, ideally, join in!)
-
-=head2 Changes in DBI 1.31, 29th November 2002
-
- The fetchall_arrayref method, when called with a $maxrows parameter,
- no longer gives an error if called again after all rows have been
- fetched. This simplifies application logic when fetching in batches.
- Also added batch-fetch while() loop example to the docs.
- The proxy now supports non-lazy (synchronous) prepare, positioned
- updates (for selects containing 'for update'), PlRPC config set
- via attributes, and accurate propagation of errors, all thanks
- to Steven Hirsch (plus a minor fix from Sean McMurray and doc
- tweaks from Michael A Chase).
- The DBI_AUTOPROXY env var can now hold the full dsn of the proxy driver
- plus attributes, like "dbi:Proxy(proxy_foo=>1):host=...".
- Added TaintIn & TaintOut attributes to give finer control over
- tainting thanks to Bradley Baetz.
- The RootClass attribute no longer ignores failure to load a module,
- but also doesn't try to load a module if the class already exists,
- with thanks to James FitzGibbon.
- HandleError attribute works for connect failures thanks to David Wheeler.
- The connect() RaiseError/PrintError message now includes the username.
- Changed "last handle unknown or destroyed" warning to be a trace message.
- Removed undocumented $h->event() method.
- Further enhancements to DBD::PurePerl accuracy.
- The CursorName attribute now defaults to undef and not an error.
-
- DBI::Profile changes:
- New DBI::ProfileDumper, DBI::ProfileDumper::Apache, and
- DBI::ProfileData modules (to manage the storage and processing
- of profile data), plus dbiprof program for analyzing profile
- data - with many thanks to Sam Tregar.
- Added $DBI::err (etc) tied variable lookup time to profile.
- Added time for DESTROY method into parent handles profile (used to be ignored).
-
- Documentation changes:
- Documented $dbh = $sth->{Database} attribute.
- Documented $dbh->connected(...) post-connection call when subclassing.
- Updated some minor doc issues thanks to H.Merijn Brand.
- Updated Makefile.PL example in DBI::DBD thanks to KAWAI,Takanori.
- Fixed execute_array() example thanks to Peter van Hardenberg.
-
- Changes for driver authors, not required but strongly recommended:
- Change DBIS to DBIc_DBISTATE(imp_xxh) [or imp_dbh, imp_sth etc]
- Change DBILOGFP to DBIc_LOGPIO(imp_xxh) [or imp_dbh, imp_sth etc]
- Any function from which all instances of DBIS and DBILOGFP are
- removed can also have dPERLINTERP removed (a good thing).
- All use of the DBIh_EVENT* macros should be removed.
- Major update to DBI::DBD docs thanks largely to Jonathan Leffler.
- Add these key values: 'Err' => \my $err, 'Errstr' => \my $errstr,
- to the hash passed to DBI::_new_dbh() in your driver source code.
- That will make each $dbh have it's own $h->err and $h->errstr
- values separate from other $dbh belonging to the same driver.
- If you have a ::db or ::st DESTROY methods that do nothing
- you can now remove them - which speeds up handle destruction.
-
-
-=head2 Changes in DBI 1.30, 18th July 2002
-
- Fixed problems with selectrow_array, selectrow_arrayref, and
- selectall_arrayref introduced in DBI 1.29.
- Fixed FETCHing a handle attribute to not clear $DBI::err etc (broken in 1.29).
- Fixed core dump at trace level 9 or above.
- Fixed compilation with perl 5.6.1 + ithreads (i.e. Windows).
- Changed definition of behaviour of selectrow_array when called in a scalar
- context to match fetchrow_array.
- Corrected selectrow_arrayref docs which showed selectrow_array thanks to Paul DuBois.
-
-=head2 Changes in DBI 1.29, 15th July 2002
-
- NOTE: This release changes the specified behaviour for the
- : fetchrow_array method when called in a scalar context:
- : The DBI spec used to say that it would return the FIRST field.
- : Which field it returns (i.e., the first or the last) is now undefined.
- : This does not affect statements that only select one column, which is
- : usually the case when fetchrow_array is called in a scalar context.
- : FYI, this change was triggered by discovering that the fetchrow_array
- : implementation in Driver.xst (used by most compiled drivers)
- : didn't match the DBI specification. Rather than change the code
- : to match, and risk breaking existing applications, I've changed the
- : specification (that part was always of dubious value anyway).
-
- NOTE: Future versions of the DBI may not support for perl 5.5 much longer.
- : If you are still using perl 5.005_03 you should be making plans to
- : upgrade to at least perl 5.6.1, or 5.8.0. Perl 5.8.0 is due to be
- : released in the next week or so. (Although it's a "point 0" release,
- : it is the most thoroughly tested release ever.)
-
- Added XS/C implementations of selectrow_array, selectrow_arrayref, and
- selectall_arrayref to Driver.xst. See DBI 1.26 Changes for more info.
- Removed support for the old (fatally flawed) "5005" threading model.
- Added support for new perl 5.8 iThreads thanks to Gerald Richter.
- (Threading support and safety should still be regarded as beta
- quality until further notice. But it's much better than it was.)
- Updated the "Threads and Thread Safety" section of the docs.
- The trace output can be sent to STDOUT instead of STDERR by using
- "STDOUT" as the name of the file, i.e., $h->trace(..., "STDOUT")
- Added pointer to perlreftut, perldsc, perllol, and perlboot manuals
- into the intro section of the docs, suggested by Brian McCain.
- Fixed DBI::Const::GetInfo::* pod docs thanks to Zack Weinberg.
- Some changes to how $dbh method calls are treated by DBI::Profile:
- Meta-data methods now clear $dbh->{Statement} on entry.
- Some $dbh methods are now profiled as if $dbh->{Statement} was empty
- (because thet're unlikely to actually relate to its contents).
- Updated dbiport.h to ppport.h from perl 5.8.0.
- Tested with perl 5.5.3 (vanilla, Solaris), 5.6.1 (vanilla, Solaris), and
- perl 5.8.0 (RC3@17527 with iThreads & Multiplicity on Solaris and FreeBSD).
-
-=head2 Changes in DBI 1.28, 14th June 2002
-
- Added $sth->{ParamValues} to return a hash of the most recent
- values bound to placeholders via bind_param() or execute().
- Individual drivers need to be updated to support it.
- Enhanced ShowErrorStatement to include ParamValues if available:
- "DBD::foo::st execute failed: errstr [for statement ``...'' with params: 1='foo']"
- Further enhancements to DBD::PurePerl accuracy.
-
-=head2 Changes in DBI 1.27, 13th June 2002
-
- Fixed missing column in C implementation of fetchall_arrayref()
- thanks to Philip Molter for the prompt reporting of the problem.
-
-=head2 Changes in DBI 1.26, 13th June 2002
-
- Fixed t/40profile.t to work on Windows thanks to Smejkal Petr.
- Fixed $h->{Profile} to return undef, not error, if not set.
- Fixed DBI->available_drivers in scalar context thanks to Michael Schwern.
-
- Added C implementations of selectrow_arrayref() and fetchall_arrayref()
- in Driver.xst. All compiled drivers using Driver.xst will now be
- faster making those calls. Most noticeable with fetchall_arrayref for
- many rows or selectrow_arrayref with a fast query. For example, using
- DBD::mysql a selectrow_arrayref for a single row using a primary key
- is ~20% faster, and fetchall_arrayref for 20000 rows is twice as fast!
- Drivers just need to be recompiled and reinstalled to enable it.
- The fetchall_arrayref speed up only applies if $slice parameter is not used.
- Added $max_rows parameter to fetchall_arrayref() to optionally limit
- the number of rows returned. Can now fetch batches of rows.
- Added MaxRows attribute to selectall_arrayref()
- which then passes it to fetchall_arrayref().
- Changed selectrow_array to make use of selectrow_arrayref.
- Trace level 1 now shows first two parameters of all methods
- (used to only for that for some, like prepare,execute,do etc)
- Trace indicator for recursive calls (first char on trace lines)
- now starts at 1 not 2.
-
- Documented that $h->func() does not trigger RaiseError etc
- so applications must explicitly check for errors.
- DBI::Profile with DBI_PROFILE now shows percentage time inside DBI.
- HandleError docs updated to show that handler can edit error message.
- HandleError subroutine interface is now regarded as stable.
-
-=head2 Changes in DBI 1.25, 5th June 2002
-
- Fixed build problem on Windows and some compiler warnings.
- Fixed $dbh->{Driver} and $sth->{Statement} for driver internals
- These are 'inner' handles as per behaviour prior to DBI 1.16.
- Further minor improvements to DBI::PurePerl accuracy.
-
-=head2 Changes in DBI 1.24, 4th June 2002
-
- Fixed reference loop causing a handle/memory leak
- that was introduced in DBI 1.16.
- Fixed DBI::Format to work with 'filehandles' from IO::Scalar
- and similar modules thanks to report by Jeff Boes.
- Fixed $h->func for DBI::PurePerl thanks to Jeff Zucker.
- Fixed $dbh->{Name} for DBI::PurePerl thanks to Dean Arnold.
-
- Added DBI method call profiling and benchmarking.
- This is a major new addition to the DBI.
- See $h->{Profile} attribute and DBI::Profile module.
- For a quick trial, set the DBI_PROFILE environment variable and
- run your favourite DBI script. Try it with DBI_PROFILE set to 1,
- then try 2, 4, 8, 10, and -10. Have fun!
-
- Added execute_array() and bind_param_array() documentation
- with thanks to Dean Arnold.
- Added notes about the DBI having not yet been tested with iThreads
- (testing and patches for SvLOCK etc welcome).
- Removed undocumented Handlers attribute (replaced by HandleError).
- Tested with 5.5.3 and 5.8.0 RC1.
-
-=head2 Changes in DBI 1.23, 25th May 2002
-
- Greatly improved DBI::PurePerl in performance and accuracy.
- Added more detail to DBI::PurePerl docs about what's not supported.
- Fixed undef warnings from t/15array.t and DBD::Sponge.
-
-=head2 Changes in DBI 1.22, 22nd May 2002
-
- Added execute_array() and bind_param_array() with special thanks
- to Dean Arnold. Not yet documented. See t/15array.t for examples.
- All drivers now automatically support these methods.
- Added DBI::PurePerl, a transparent DBI emulation for pure-perl drivers
- with special thanks to Jeff Zucker. Perldoc DBI::PurePerl for details.
- Added DBI::Const::GetInfo* modules thanks to Steffen Goeldner.
- Added write_getinfo_pm utility to DBI::DBD thanks to Steffen Goeldner.
- Added $allow_active==2 mode for prepare_cached() thanks to Stephen Clouse.
-
- Updated DBI::Format to Revision 11.4 thanks to Tom Lowery.
- Use File::Spec in Makefile.PL (helps VMS etc) thanks to Craig Berry.
- Extend $h->{Warn} to commit/rollback ineffective warning thanks to Jeff Baker.
- Extended t/preparse.t and removed "use Devel::Peek" thanks to Scott Hildreth.
- Only copy Changes to blib/lib/Changes.pm once thanks to Jonathan Leffler.
- Updated internals for modern perls thanks to Jonathan Leffler and Jeff Urlwin.
- Tested with perl 5.7.3 (just using default perl config).
-
- Documentation changes:
-
- Added 'Catalog Methods' section to docs thanks to Steffen Goeldner.
- Updated README thanks to Michael Schwern.
- Clarified that driver may choose not to start new transaction until
- next use of $dbh after commit/rollback.
- Clarified docs for finish method.
- Clarified potentials problems with prepare_cached() thanks to Stephen Clouse.
-
-
-=head2 Changes in DBI 1.21, 7th February 2002
-
- The minimum supported perl version is now 5.005_03.
-
- Fixed DBD::Proxy support for AutoCommit thanks to Jochen Wiedmann.
- Fixed DBI::ProxyServer bind_param(_inout) handing thanks to Oleg Mechtcheriakov.
- Fixed DBI::ProxyServer fetch loop thanks to nobull@mail.com.
- Fixed install_driver do-the-right-thing with $@ on error. It, and connect(),
- will leave $@ empty on success and holding the error message on error.
- Thanks to Jay Lawrence, Gavin Sherlock and others for the bug report.
- Fixed fetchrow_hashref to assign columns to the hash left-to-right
- so later fields with the same name overwrite earlier ones
- as per DBI < 1.15, thanks to Kay Roepke.
-
- Changed tables() to use quote_indentifier() if the driver returns a
- true value for $dbh->get_info(29) # SQL_IDENTIFIER_QUOTE_CHAR
- Changed ping() so it no longer triggers RaiseError/PrintError.
- Changed connect() to not call $class->install_driver unless needed.
- Changed DESTROY to catch fatal exceptions and append to $@.
-
- Added ISO SQL/CLI & ODBCv3 data type definitions thanks to Steffen Goeldner.
- Removed the definition of SQL_BIGINT data type constant as the value is
- inconsistent between standards (ODBC=-5, SQL/CLI=25).
- Added $dbh->column_info(...) thanks to Steffen Goeldner.
- Added $dbh->foreign_key_info(...) thanks to Steffen Goeldner.
- Added $dbh->quote_identifier(...) insipred by Simon Oliver.
- Added $dbh->set_err(...) for DBD authors and DBI subclasses
- (actually been there for a while, now expanded and documented).
- Added $h->{HandleError} = sub { ... } addition and/or alternative
- to RaiseError/PrintError. See the docs for more info.
- Added $h->{TraceLevel} = N attribute to set/get trace level of handle
- thus can set trace level via an (eg externally specified) DSN
- using the embedded attribute syntax:
- $dsn = 'dbi:DB2(PrintError=1,TraceLevel=2):dbname';
- Plus, you can also now do: local($h->{TraceLevel}) = N;
- (but that leaks a little memory in some versions of perl).
- Added some call tree information to trace output if trace level >= 3
- With thanks to Graham Barr for the stack walking code.
- Added experimental undocumented $dbh->preparse(), see t/preparse.t
- With thanks to Scott T. Hildreth for much of the work.
- Added Fowler/Noll/Vo hash type as an option to DBI::hash().
-
- Documentation changes:
-
- Added DBI::Changes so now you can "perldoc DBI::Changes", yeah!
- Added selectrow_arrayref & selectrow_hashref docs thanks to Doug Wilson.
- Added 'Standards Reference Information' section to docs to gather
- together all references to relevant on-line standards.
- Added link to poop.sourceforge.net into the docs thanks to Dave Rolsky.
- Added link to hyperlinked BNF for SQL92 thanks to Jeff Zucker.
- Added 'Subclassing the DBI' docs thanks to Stephen Clouse, and
- then changed some of them to reflect the new approach to subclassing.
- Added stronger wording to description of $h->{private_*} attributes.
- Added docs for DBI::hash.
-
- Driver API changes:
-
- Now a COPY of the DBI->connect() attributes is passed to the driver
- connect() method, so it can process and delete any elements it wants.
- Deleting elements reduces/avoids the explicit
- $dbh->{$_} = $attr->{$_} foreach keys %$attr;
- that DBI->connect does after the driver connect() method returns.
-
-
-=head2 Changes in DBI 1.20, 24th August 2001
-
- WARNING: This release contains two changes that may affect your code.
- : Any code using selectall_hashref(), which was added in March 2001, WILL
- : need to be changed. Any code using fetchall_arrayref() with a non-empty
- : hash slice parameter may, in a few rare cases, need to be changed.
- : See the change list below for more information about the changes.
- : See the DBI documentation for a description of current behaviour.
-
- Fixed memory leak thanks to Toni Andjelkovic.
- Changed fetchall_arrayref({ foo=>1, ...}) specification again (sorry):
- The key names of the returned hashes is identical to the letter case of
- the names in the parameter hash, regardless of the L</FetchHashKeyName>
- attribute. The letter case is ignored for matching.
- Changed fetchall_arrayref([...]) array slice syntax specification to
- clarify that the numbers in the array slice are perl index numbers
- (which start at 0) and not column numbers (which start at 1).
- Added { Columns=>... } and { Slice =>... } attributes to selectall_arrayref()
- which is passed to fetchall_arrayref() so it can fetch hashes now.
- Added a { Columns => [...] } attribute to selectcol_arrayref() so that
- the list it returns can be built from more than one column per row.
- Why? Consider my %hash = @{$dbh->selectcol_arrayref($sql,{ Columns=>[1,2]})}
- to return id-value pairs which can be used directly to build a hash.
- Added $hash_ref = $sth->fetchall_hashref( $key_field )
- which returns a ref to a hash with, typically, one element per row.
- $key_field is the name of the field to get the key for each row from.
- The value of the hash for each row is a hash returned by fetchrow_hashref.
- Changed selectall_hashref to return a hash ref (from fetchall_hashref)
- and not an array of hashes as it has since DBI 1.15 (end March 2001).
- WARNING: THIS CHANGE WILL BREAK ANY CODE USING selectall_hashref()!
- Sorry, but I think this is an important regularization of the API.
- To get previous selectall_hashref() behaviour (an array of hash refs)
- change $ary_ref = $dbh->selectall_hashref( $statement, undef, @bind);
- to $ary_ref = $dbh->selectall_arrayref($statement, { Columns=>{} }, @bind);
- Added NAME_lc_hash, NAME_uc_hash, NAME_hash statement handle attributes.
- which return a ref to a hash of field_name => field_index (0..n-1) pairs.
- Fixed select_hash() example thanks to Doug Wilson.
- Removed (unbundled) DBD::ADO and DBD::Multiplex from the DBI distribution.
- The latest versions of those modules are available from CPAN sites.
- Added $dbh->begin_work. This method causes AutoCommit to be turned
- off just until the next commit() or rollback().
- Driver authors: if the DBIcf_BegunWork flag is set when your commit or
- rollback method is called then please turn AutoCommit on and clear the
- DBIcf_BegunWork flag. If you don't then the DBI will but it'll be much
- less efficient and won't handle error conditions very cleanly.
- Retested on perl 5.4.4, but the DBI won't support 5.4.x much longer.
- Added text to SUPPORT section of the docs:
- For direct DBI and DBD::Oracle support, enhancement, and related work
- I am available for consultancy on standard commercial terms.
- Added text to ACKNOWLEDGEMENTS section of the docs:
- Much of the DBI and DBD::Oracle was developed while I was Technical
- Director (CTO) of the Paul Ingram Group (www.ig.co.uk). So I'd
- especially like to thank Paul for his generosity and vision in
- supporting this work for many years.
-
-=head2 Changes in DBI 1.19, 20th July 2001
-
- Made fetchall_arrayref({ foo=>1, ...}) be more strict to the specification
- in relation to wanting hash slice keys to be lowercase names.
- WARNING: If you've used fetchall_arrayref({...}) with a hash slice
- that contains keys with uppercase letters then your code will break.
- (As far as I recall the spec has always said don't do that.)
- Fixed $sth->execute() to update $dbh->{Statement} to $sth->{Statement}.
- Added row number to trace output for fetch method calls.
- Trace level 1 no longer shows fetches with row>1 (to reduce output volume).
- Added $h->{FetchHashKeyName} = 'NAME_lc' or 'NAME_uc' to alter
- behaviour of fetchrow_hashref() method. See docs.
- Added type_info quote caching to quote() method thanks to Dean Kopesky.
- Makes using quote() with second data type param much much faster.
- Added type_into_all() caching to type_info(), spotted by Dean Kopesky.
- Added new API definition for table_info() and tables(),
- driver authors please note!
- Added primary_key_info() to DBI API thanks to Steffen Goeldner.
- Added primary_key() to DBI API as simpler interface to primary_key_info().
- Indent and other fixes for DBI::DBD doc thanks to H.Merijn Brand.
- Added prepare_cached() insert_hash() example thanks to Doug Wilson.
- Removed false docs for fetchall_hashref(), use fetchall_arrayref({}).
-
-=head2 Changes in DBI 1.18, 4th June 2001
-
- Fixed that altering ShowErrorStatement also altered AutoCommit!
- Thanks to Jeff Boes for spotting that clanger.
- Fixed DBD::Proxy to handle commit() and rollback(). Long overdue, sorry.
- Fixed incompatibility with perl 5.004 (but no one's using that right? :)
- Fixed connect_cached and prepare_cached to not be affected by the order
- of elements in the attribute hash. Spotted by Mitch Helle-Morrissey.
- Fixed version number of DBI::Shell
- reported by Stuhlpfarrer Gerhard and others.
- Defined and documented table_info() attribute semantics (ODBC compatible)
- thanks to Olga Voronova, who also implemented then in DBD::Oracle.
- Updated Win32::DBIODBC (Win32::ODBC emulation) thanks to Roy Lee.
-
-=head2 Changes in DBI 1.16, 30th May 2001
-
- Reimplemented fetchrow_hashref in C, now fetches about 25% faster!
- Changed behaviour if both PrintError and RaiseError are enabled
- to simply do both (in that order, obviously :)
- Slight reduction in DBI handle creation overhead.
- Fixed $dbh->{Driver} & $sth->{Database} to return 'outer' handles.
- Fixed execute param count check to honour RaiseError spotted by Belinda Giardie.
- Fixed build for perl5.6.1 with PERLIO thanks to H.Merijn Brand.
- Fixed client sql restrictions in ProxyServer.pm thanks to Jochen Wiedmann.
- Fixed batch mode command parsing in Shell thanks to Christian Lemburg.
- Fixed typo in selectcol_arrayref docs thanks to Jonathan Leffler.
- Fixed selectrow_hashref to be available to callers thanks to T.J.Mather.
- Fixed core dump if statement handle didn't define Statement attribute.
- Added bind_param_inout docs to DBI::DBD thanks to Jonathan Leffler.
- Added note to data_sources() method docs that some drivers may
- require a connected database handle to be supplied as an attribute.
- Trace of install_driver method now shows path of driver file loaded.
- Changed many '||' to 'or' in the docs thanks to H.Merijn Brand.
- Updated DBD::ADO again (improvements in error handling) from Tom Lowery.
- Updated Win32::DBIODBC (Win32::ODBC emulation) thanks to Roy Lee.
- Updated email and web addresses in DBI::FAQ thanks to Michael A Chase.
-
-=head2 Changes in DBI 1.15, 28th March 2001
-
- Added selectrow_arrayref
- Added selectrow_hashref
- Added selectall_hashref thanks to Leon Brocard.
- Added DBI->connect(..., { dbi_connect_method => 'method' })
- Added $dbh->{Statement} aliased to most recent child $sth->{Statement}.
- Added $h->{ShowErrorStatement}=1 to cause the appending of the
- relevant Statement text to the RaiseError/PrintError text.
- Modified type_info to always return hash keys in uppercase and
- to not require uppercase 'DATA_TYPE' key from type_info_all.
- Thanks to Jennifer Tong and Rob Douglas.
- Added \%attr param to tables() and table_info() methods.
- Trace method uses warn() if it can't open the new file.
- Trace shows source line and filename during global destruction.
- Updated packages:
- Updated Win32::DBIODBC (Win32::ODBC emulation) thanks to Roy Lee.
- Updated DBD::ADO to much improved version 0.4 from Tom Lowery.
- Updated DBD::Sponge to include $sth->{PRECISION} thanks to Tom Lowery.
- Changed DBD::ExampleP to use lstat() instead of stat().
- Documentation:
- Documented $DBI::lasth (which has been there since day 1).
- Documented SQL_* names.
- Clarified and extended docs for $h->state thanks to Masaaki Hirose.
- Clarified fetchall_arrayref({}) docs (thanks to, er, someone!).
- Clarified type_info_all re lettercase and index values.
- Updated DBI::FAQ to 0.38 thanks to Alligator Descartes.
- Added cute bind_columns example thanks to H.Merijn Brand.
- Extended docs on \%attr arg to data_sources method.
- Makefile.PL
- Removed obscure potential 'rm -rf /' (thanks to Ulrich Pfeifer).
- Removed use of glob and find (thanks to Michael A. Chase).
- Proxy:
- Removed debug messages from DBD::Proxy AUTOLOAD thanks to Brian McCauley.
- Added fix for problem using table_info thanks to Tom Lowery.
- Added better determination of where to put the pid file, and...
- Added KNOWN ISSUES section to DBD::Proxy docs thanks to Jochen Wiedmann.
- Shell:
- Updated DBI::Format to include DBI::Format::String thanks to Tom Lowery.
- Added describe command thanks to Tom Lowery.
- Added columnseparator option thanks to Tom Lowery (I think).
- Added 'raw' format thanks to, er, someone, maybe Tom again.
- Known issues:
- Perl 5.005 and 5.006 both leak memory doing local($handle->{Foo}).
- Perl 5.004 doesn't. The leak is not a DBI or driver bug.
-
-=head2 Changes in DBI 1.14, 14th June 2000
-
- NOTE: This version is the one the DBI book is based on.
- NOTE: This version requires at least Perl 5.004.
- Perl 5.6 ithreads changes with thanks to Doug MacEachern.
- Changed trace output to use PerlIO thanks to Paul Moore.
- Fixed bug in RaiseError/PrintError handling.
- (% chars in the error string could cause a core dump.)
- Fixed Win32 PerlEx IIS concurrency bugs thanks to Murray Nesbitt.
- Major documentation polishing thanks to Linda Mui at O'Reilly.
- Password parameter now shown as **** in trace output.
- Added two fields to type_info and type_info_all.
- Added $dsn to PrintError/RaiseError message from DBI->connect().
- Changed prepare_cached() croak to carp if sth still Active.
- Added prepare_cached() example to the docs.
- Added further DBD::ADO enhancements from Thomas Lowery.
-
-=head2 Changes in DBI 1.13, 11th July 1999
-
- Fixed Win32 PerlEx IIS concurrency bugs thanks to Murray Nesbitt.
- Fixed problems with DBD::ExampleP long_list test mode.
- Added SQL_WCHAR SQL_WVARCHAR SQL_WLONGVARCHAR and SQL_BIT
- to list of known and exportable SQL types.
- Improved data fetch performance of DBD::ADO.
- Added GetTypeInfo to DBD::ADO thanks to Thomas Lowery.
- Actually documented connect_cached thanks to Michael Schwern.
- Fixed user/key/cipher bug in ProxyServer thanks to Joshua Pincus.
-
-=head2 Changes in DBI 1.12, 29th June 1999
-
- Fixed significant DBD::ADO bug (fetch skipped first row).
- Fixed ProxyServer bug handling non-select statements.
- Fixed VMS problem with t/examp.t thanks to Craig Berry.
- Trace only shows calls to trace_msg and _set_fbav at high levels.
- Modified t/examp.t to workaround Cygwin buffering bug.
-
-=head2 Changes in DBI 1.11, 17th June 1999
-
- Fixed bind_columns argument checking to allow a single arg.
- Fixed problems with internal default_user method.
- Fixed broken DBD::ADO.
- Made default $DBI::rows more robust for some obscure cases.
-
-=head2 Changes in DBI 1.10, 14th June 1999
-
- Fixed trace_msg.al error when using Apache.
- Fixed dbd_st_finish enhancement in Driver.xst (internals).
- Enable drivers to define default username and password
- and temporarily disabled warning added in 1.09.
- Thread safety optimised for single thread case.
-
-=head2 Changes in DBI 1.09, 9th June 1999
-
- Added optional minimum trace level parameter to trace_msg().
- Added warning in Makefile.PL that DBI will require 5.004 soon.
- Added $dbh->selectcol_arrayref($statement) method.
- Fixed fetchall_arrayref hash-slice mode undef NAME problem.
- Fixed problem with tainted parameter checking and t/examp.t.
- Fixed problem with thread safety code, including 64 bit machines.
- Thread safety now enabled by default for threaded perls.
- Enhanced code for MULTIPLICITY/PERL_OBJECT from ActiveState.
- Enhanced prepare_cached() method.
- Minor changes to trace levels (less internal info at level 2).
- Trace log now shows "!! ERROR..." before the "<- method" line.
- DBI->connect() now warn's if user / password is undefined and
- DBI_USER / DBI_PASS environment variables are not defined.
- The t/proxy.t test now ignores any /etc/dbiproxy.conf file.
- Added portability fixes for MacOS from Chris Nandor.
- Updated mailing list address from fugue.com to isc.org.
-
-=head2 Changes in DBI 1.08, 12th May 1999
-
- Much improved DBD::ADO driver thanks to Phlip Plumlee and others.
- Connect now allows you to specify attribute settings within the DSN
- E.g., "dbi:Driver(RaiseError=>1,Taint=>1,AutoCommit=>0):dbname"
- The $h->{Taint} attribute now also enables taint checking of
- arguments to almost all DBI methods.
- Improved trace output in various ways.
- Fixed bug where $sth->{NAME_xx} was undef in some situations.
- Fixed code for MULTIPLICITY/PERL_OBJECT thanks to Alex Smishlajev.
- Fixed and documented DBI->connect_cached.
- Workaround for Cygwin32 build problem with help from Jong-Pork Park.
- bind_columns no longer needs undef or hash ref as first parameter.
-
-=head2 Changes in DBI 1.07, 6th May 1999
-
- Trace output now shows contents of array refs returned by DBI.
- Changed names of some result columns from type_info, type_info_all,
- tables and table_info to match ODBC 3.5 / ISO/IEC standards.
- Many fixes for DBD::Proxy and ProxyServer.
- Fixed error reporting in install_driver.
- Major enhancement to DBI::W32ODBC from Patrick Hollins.
- Added $h->{Taint} to taint fetched data if tainting (perl -T).
- Added code for MULTIPLICITY/PERL_OBJECT contributed by ActiveState.
- Added $sth->more_results (undocumented for now).
-
-=head2 Changes in DBI 1.06, 6th January 1999
-
- Fixed Win32 Makefile.PL problem in 1.04 and 1.05.
- Significant DBD::Proxy enhancements and fixes
- including support for bind_param_inout (Jochen and I)
- Added experimental DBI->connect_cached method.
- Added $sth->{NAME_uc} and $sth->{NAME_lc} attributes.
- Enhanced fetchrow_hashref to take an attribute name arg.
-
-=head2 Changes in DBI 1.05, 4th January 1999
-
- Improved DBD::ADO connect (thanks to Phlip Plumlee).
- Improved thread safety (thanks to Jochen Wiedmann).
- [Quick release prompted by truncation of copies on CPAN]
-
-=head2 Changes in DBI 1.04, 3rd January 1999
-
- Fixed error in Driver.xst. DBI build now tests Driver.xst.
- Removed unused variable compiler warnings in Driver.xst.
- DBI::DBD module now tested during DBI build.
- Further clarification in the DBI::DBD driver writers manual.
- Added optional name parameter to $sth->fetchrow_hashref.
-
-=head2 Changes in DBI 1.03, 1st January 1999
-
- Now builds with Perl>=5.005_54 (PERL_POLLUTE in DBIXS.h)
- DBI trace trims path from "at yourfile.pl line nnn".
- Trace level 1 now shows statement passed to prepare.
- Assorted improvements to the DBI manual.
- Assorted improvements to the DBI::DBD driver writers manual.
- Fixed $dbh->quote prototype to include optional $data_type.
- Fixed $dbh->prepare_cached problems.
- $dbh->selectrow_array behaves better in scalar context.
- Added a (very) experimental DBD::ADO driver for Win32 ADO.
- Added experimental thread support (perl Makefile.PL -thread).
- Updated the DBI::FAQ - thanks to Alligator Descartes.
- The following changes were implemented and/or packaged
- by Jochen Wiedmann - thanks Jochen:
- Added a Bundle for CPAN installation of DBI, the DBI proxy
- server and prerequisites (lib/Bundle/DBI.pm).
- DBI->available_drivers uses File::Spec, if available.
- This makes it work on MacOS. (DBI.pm)
- Modified type_info to work with read-only values returned
- by type_info_all. (DBI.pm)
- Added handling of magic values in $sth->execute,
- $sth->bind_param and other methods (Driver.xst)
- Added Perl's CORE directory to the linkers path on Win32,
- required by recent versions of ActiveState Perl.
- Fixed DBD::Sponge to work with empty result sets.
- Complete rewrite of DBI::ProxyServer and DBD::Proxy.
-
-=head2 Changes in DBI 1.02, 2nd September 1998
-
- Fixed DBI::Shell including @ARGV and /current.
- Added basic DBI::Shell test.
- Renamed DBI::Shell /display to /format.
-
-=head2 Changes in DBI 1.01, 2nd September 1998
-
- Many enhancements to Shell (with many contributions from
- Jochen Wiedmann, Tom Lowery and Adam Marks).
- Assorted fixes to DBD::Proxy and DBI::ProxyServer.
- Tidied up trace messages - trace(2) much cleaner now.
- Added $dbh->{RowCacheSize} and $sth->{RowsInCache}.
- Added experimental DBI::Format (mainly for DBI::Shell).
- Fixed fetchall_arrayref($slice_hash).
- DBI->connect now honours PrintError=1 if connect fails.
- Assorted clarifications to the docs.
-
-=head2 Changes in DBI 1.00, 14th August 1998
-
- The DBI is no longer 'alpha' software!
- Added $dbh->tables and $dbh->table_info.
- Documented \%attr arg to data_sources method.
- Added $sth->{TYPE}, $sth->{PRECISION} and $sth->{SCALE}.
- Added $sth->{Statement}.
- DBI::Shell now uses neat_list to print results
- It also escapes "'" chars and converts newlines to spaces.
-
-=head2 Changes in DBI 0.95, 10th August 1998
-
- WARNING: THIS IS AN EXPERIMENTAL RELEASE!
-
- Fixed 0.94 slip so it will build on pre-5.005 again.
- Added DBI_AUTOPROXY environment variable.
- Array ref returned from fetch/fetchrow_arrayref now readonly.
- Improved connect error reporting by DBD::Proxy.
- All trace/debug messages from DBI now go to trace file.
-
-=head2 Changes in DBI 0.94, 9th August 1998
-
- WARNING: THIS IS AN EXPERIMENTAL RELEASE!
-
- Added DBD::Shell and dbish interactive DBI shell. Try it!
- Any database attribs can be set via DBI->connect(,,, \%attr).
- Added _get_fbav and _set_fbav methods for Perl driver developers
- (see ExampleP driver for perl usage). Drivers which don't use
- one of these methods (either via XS or Perl) are not compliant.
- DBI trace now shows adds " at yourfile.pl line nnn"!
- PrintError and RaiseError now prepend driver and method name.
- The available_drivers method no longer returns NullP or Sponge.
- Added $dbh->{Name}.
- Added $dbh->quote($value, $data_type).
- Added more hints to install_driver failure message.
- Added DBD::Proxy and DBI::ProxyServer (from Jochen Wiedmann).
- Added $DBI::neat_maxlen to control truncation of trace output.
- Added $dbh->selectall_arrayref and $dbh->selectrow_array methods.
- Added $dbh->tables.
- Added $dbh->type_info and $dbh->type_info_all.
- Added $h->trace_msg($msg) to write to trace log.
- Added @bool = DBI::looks_like_number(@ary).
- Many assorted improvements to the DBI docs.
-
-=head2 Changes in DBI 0.93, 13th February 1998
-
- Fixed DBI::DBD::dbd_postamble bug causing 'Driver.xsi not found' errors.
- Changes to handling of 'magic' values in neatsvpv (used by trace).
- execute (in Driver.xst) stops binding after first bind error.
- This release requires drivers to be rebuilt.
-
-=head2 Changes in DBI 0.92, 3rd February 1998
-
- Fixed per-handle memory leak (with many thanks to Irving Reid).
- Added $dbh->prepare_cached() caching variant of $dbh->prepare.
- Added some attributes:
- $h->{Active} is the handle 'Active' (vague concept) (boolean)
- $h->{Kids} e.g. number of sth's associated with a dbh
- $h->{ActiveKids} number of the above which are 'Active'
- $dbh->{CachedKids} ref to prepare_cached sth cache
- Added support for general-purpose 'private_' attributes.
- Added experimental support for subclassing the DBI: see t/subclass.t
- Added SQL_ALL_TYPES to exported :sql_types.
- Added dbd_dbi_dir() and dbd_dbi_arch_dir() to DBI::DBD module so that
- DBD Makefile.PLs can work with the DBI installed in non-standard locations.
- Fixed 'Undefined value' warning and &sv_no output from neatsvpv/trace.
- Fixed small 'once per interpreter' leak.
- Assorted minor documentation fixes.
-
-=head2 Changes in DBI 0.91, 10th December 1997
-
- NOTE: This fix may break some existing scripts:
- DBI->connect("dbi:...",$user,$pass) was not setting AutoCommit and PrintError!
- DBI->connect(..., { ... }) no longer sets AutoCommit or PrintError twice.
- DBI->connect(..., { RaiseError=>1 }) now croaks if connect fails.
- Fixed $fh parameter of $sth->dump_results;
- Added default statement DESTROY method which carps.
- Added default driver DESTROY method to silence AUTOLOAD/__DIE__/CGI::Carp
- Added more SQL_* types to %EXPORT_TAGS and @EXPORT_OK.
- Assorted documentation updates (mainly clarifications).
- Added workaround for perl's 'sticky lvalue' bug.
- Added better warning for bind_col(umns) where fields==0.
- Fixed to build okay with 5.004_54 with or without USE_THREADS.
- Note that the DBI has not been tested for thread safety yet.
-
-=head2 Changes in DBI 0.90, 6th September 1997
-
- Can once again be built with Perl 5.003.
- The DBI class can be subclassed more easily now.
- InactiveDestroy fixed for drivers using the *.xst template.
- Slightly faster handle creation.
- Changed prototype for dbd_*_*_attrib() to add extra param.
- Note: 0.90, 0.89 and possibly some other recent versions have
- a small memory leak. This will be fixed in the next release.
-
-=head2 Changes in DBI 0.89, 25th July 1997
-
- Minor fix to neatsvpv (mainly used for debug trace) to workaround
- bug in perl where SvPV removes IOK flag from an SV.
- Minor updates to the docs.
-
-=head2 Changes in DBI 0.88, 22nd July 1997
-
- Fixed build for perl5.003 and Win32 with Borland.
- Fixed documentation formatting.
- Fixed DBI_DSN ignored for old-style connect (with explicit driver).
- Fixed AutoCommit in DBD::ExampleP
- Fixed $h->trace.
- The DBI can now export SQL type values: use DBI ':sql_types';
- Modified Driver.xst and renamed DBDI.h to dbd_xsh.h
-
-=head2 Changes in DBI 0.87, 18th July 1997
-
- Fixed minor type clashes.
- Added more docs about placeholders and bind values.
-
-=head2 Changes in DBI 0.86, 16th July 1997
-
- Fixed failed connect causing 'unblessed ref' and other errors.
- Drivers must handle AutoCommit FETCH and STORE else DBI croaks.
- Added $h->{LongReadLen} and $h->{LongTruncOk} attributes for BLOBS.
- Added DBI_USER and DBI_PASS env vars. See connect docs for usage.
- Added DBI->trace() to set global trace level (like per-handle $h->trace).
- PERL_DBI_DEBUG env var renamed DBI_DEBUG (old name still works for now).
- Updated docs, including commit, rollback, AutoCommit and Transactions sections.
- Added bind_param method and execute(@bind_values) to docs.
- Fixed fetchall_arrayref.
-
- Since the DBIS structure has change the internal version numbers have also
- changed (DBIXS_VERSION == 9 and DBISTATE_VERSION == 9) so drivers will have
- to be recompiled. The test is also now more sensitive and the version
- mismatch error message now more clear about what to do. Old drivers are
- likely to core dump (this time) until recompiled for this DBI. In future
- DBI/DBD version mismatch will always produce a clear error message.
-
- Note that this DBI release contains and documents many new features
- that won't appear in drivers for some time. Driver writers might like
- to read perldoc DBI::DBD and comment on or apply the information given.
-
-=head2 Changes in DBI 0.85, 25th June 1997
-
- NOTE: New-style connect now defaults to AutoCommit mode unless
- { AutoCommit => 0 } specified in connect attributes. See the docs.
- AutoCommit attribute now defined and tracked by DBI core.
- Drivers should use/honour this and not implement their own.
- Added pod doc changes from Andreas and Jonathan.
- New DBI_DSN env var default for connect method. See docs.
- Documented the func method.
- Fixed "Usage: DBD::_::common::DESTROY" error.
- Fixed bug which set some attributes true when there value was fetched.
- Added new internal DBIc_set() macro for drivers to use.
-
-=head2 Changes in DBI 0.84, 20th June 1997
-
- Added $h->{PrintError} attribute which, if set true, causes all errors to
- trigger a warn().
- New-style DBI->connect call now automatically sets PrintError=1 unless
- { PrintError => 0 } specified in the connect attributes. See the docs.
- The old-style connect with a separate driver parameter is deprecated.
- Fixed fetchrow_hashref.
- Renamed $h->debug to $h->trace() and added a trace filename arg.
- Assorted other minor tidy-ups.
-
-=head2 Changes in DBI 0.83, 11th June 1997
-
- Added driver specification syntax to DBI->connect data_source
- parameter: DBI->connect('dbi:driver:...', $user, $passwd);
- The DBI->data_sources method should return data_source
- names with the appropriate 'dbi:driver:' prefix.
- DBI->connect will warn if \%attr is true but not a hash ref.
- Added the new fetchrow methods:
- @row_ary = $sth->fetchrow_array;
- $ary_ref = $sth->fetchrow_arrayref;
- $hash_ref = $sth->fetchrow_hashref;
- The old fetch and fetchrow methods still work.
- Driver implementors should implement the new names for
- fetchrow_array and fetchrow_arrayref ASAP (use the xs ALIAS:
- directive to define aliases for fetch and fetchrow).
- Fixed occasional problems with t/examp.t test.
- Added automatic errstr reporting to the debug trace output.
- Added the DBI FAQ from Alligator Descartes in module form for
- easy reading via "perldoc DBI::FAQ". Needs reformatting.
- Unknown driver specific attribute names no longer croak.
- Fixed problem with internal neatsvpv macro.
-
-=head2 Changes in DBI 0.82, 23rd May 1997
-
- Added $h->{RaiseError} attribute which, if set true, causes all errors to
- trigger a die(). This makes it much easier to implement robust applications
- in terms of higher level eval { ... } blocks and rollbacks.
- Added DBI->data_sources($driver) method for implementation by drivers.
- The quote method now returns the string NULL (without quotes) for undef.
- Added VMS support thanks to Dan Sugalski.
- Added a 'quick start guide' to the README.
- Added neatsvpv function pointer to DBIS structure to make it available for
- use by drivers. A macro defines neatsvpv(sv,len) as (DBIS->neatsvpv(sv,len)).
- Old XS macro SV_YES_NO changes to standard boolSV.
- Since the DBIS structure has change the internal version numbers have also
- changed (DBIXS_VERSION == 8 and DBISTATE_VERSION == 8) so drivers will have
- to be recompiled.
-
-=head2 Changes in DBI 0.81, 7th May 1997
-
- Minor fix to let DBI build using less modern perls.
- Fixed a suprious typo warning.
-
-=head2 Changes in DBI 0.80, 6th May 1997
-
- Builds with no changes on NT using perl5.003_99 (with thanks to Jeffrey Urlwin).
- Automatically supports Apache::DBI (with thanks to Edmund Mergl).
- DBI scripts no longer need to be modified to make use of Apache::DBI.
- Added a ping method and an experimental connect_test_perf method.
- Added a fetchhash and fetch_all methods.
- The func method no longer pre-clears err and errstr.
- Added ChopBlanks attribute (currently defaults to off, that may change).
- Support for the attribute needs to be implemented by individual drivers.
- Reworked tests into standard t/*.t form.
- Added more pod text. Fixed assorted bugs.
-
-
-=head2 Changes in DBI 0.79, 7th Apr 1997
-
- Minor release. Tidied up pod text and added some more descriptions
- (especially disconnect). Minor changes to DBI.xs to remove compiler
- warnings.
-
-=head2 Changes in DBI 0.78, 28th Mar 1997
-
- Greatly extended the pod documentation in DBI.pm, including the under
- used bind_columns method. Use 'perldoc DBI' to read after installing.
- Fixed $h->err. Fetching an attribute value no longer resets err.
- Added $h->{InactiveDestroy}, see documentation for details.
- Improved debugging of cached ('quick') attribute fetches.
- errstr will return err code value if there is no string value.
- Added DBI/W32ODBC to the distribution. This is a pure-perl experimental
- DBI emulation layer for Win32::ODBC. Note that it's unsupported, your
- mileage will vary, and bug reports without fixes will probably be ignored.
-
-=head2 Changes in DBI 0.77, 21st Feb 1997
-
- Removed erroneous $h->errstate and $h->errmsg methods from DBI.pm.
- Added $h->err, $h->errstr and $h->state default methods in DBI.xs.
- Updated informal DBI API notes in DBI.pm. Updated README slightly.
- DBIXS.h now correctly installed into INST_ARCHAUTODIR.
- (DBD authors will need to edit their Makefile.PL's to use
- -I$(INSTALLSITEARCH)/auto/DBI -I$(INSTALLSITEARCH)/DBI)
-
-
-=head2 Changes in DBI 0.76, 3rd Feb 1997
-
- Fixed a compiler type warnings (pedantic IRIX again).
-
-=head2 Changes in DBI 0.75, 27th Jan 1997
-
- Fix problem introduced by a change in Perl5.003_XX.
- Updated README and DBI.pm docs.
-
-=head2 Changes in DBI 0.74, 14th Jan 1997
-
- Dispatch now sets dbi_debug to the level of the current handle
- (this makes tracing/debugging individual handles much easier).
- The '>> DISPATCH' log line now only logged at debug >= 3 (was 2).
- The $csr->NUM_OF_FIELDS attribute can be set if not >0 already.
- You can log to a file using the env var PERL_DBI_DEBUG=/tmp/dbi.log.
- Added a type cast needed by IRIX.
- No longer sets perl_destruct_level unless debug set >= 4.
- Make compatible with PerlIO and sfio.
-
-=head2 Changes in DBI 0.73, 10th Oct 1996
-
- Fixed some compiler type warnings (IRIX).
- Fixed DBI->internal->{DebugLog} = $filename.
- Made debug log file unbuffered.
- Added experimental bind_param_inout method to interface.
- Usage: $dbh->bind_param_inout($param, \$value, $maxlen [, \%attribs ])
- (only currently used by DBD::Oracle at this time.)
-
-=head2 Changes in DBI 0.72, 23 Sep 1996
-
- Using an undefined value as a handle now gives a better
- error message (mainly useful for emulators like Oraperl).
- $dbh->do($sql, @params) now works for binding placeholders.
-
-=head2 Changes in DBI 0.71, 10 July 1996
-
- Removed spurious abort() from invalid handle check.
- Added quote method to DBI interface and added test.
-
-=head2 Changes in DBI 0.70, 16 June 1996
-
- Added extra invalid handle check (dbih_getcom)
- Fixed broken $dbh->quote method.
- Added check for old GCC in Makefile.PL
-
-=head2 Changes in DBI 0.69
-
- Fixed small memory leak.
- Clarified the behaviour of DBI->connect.
- $dbh->do now returns '0E0' instead of 'OK'.
- Fixed "Can't read $DBI::errstr, lost last handle" problem.
-
-
-=head2 Changes in DBI 0.68, 2 Mar 1996
-
- Changes to suit perl5.002 and site_lib directories.
- Detects old versions ahead of new in @INC.
-
-
-=head2 Changes in DBI 0.67, 15 Feb 1996
-
- Trivial change to test suite to fix a problem shown up by the
- Perl5.002gamma release Test::Harness.
-
-
-=head2 Changes in DBI 0.66, 29 Jan 1996
-
- Minor changes to bring the DBI into line with 5.002 mechanisms,
- specifically the xs/pm VERSION checking mechanism.
- No functionality changes. One no-last-handle bug fix (rare problem).
- Requires 5.002 (beta2 or later).
-
-
-=head2 Changes in DBI 0.65, 23 Oct 1995
-
- Added $DBI::state to hold SQL CLI / ODBC SQLSTATE value.
- SQLSTATE "00000" (success) is returned as "" (false), all else is true.
- If a driver does not explicitly initialise it (via $h->{State} or
- DBIc_STATE(imp_xxh) then $DBI::state will automatically return "" if
- $DBI::err is false otherwise "S1000" (general error).
- As always, this is a new feature and liable to change.
-
- The is *no longer* a default error handler!
- You can add your own using push(@{$h->{Handlers}}, sub { ... })
- but be aware that this interface may change (or go away).
-
- The DBI now automatically clears $DBI::err, errstr and state before
- calling most DBI methods. Previously error conditions would persist.
- Added DBIh_CLEAR_ERROR(imp_xxh) macro.
-
- DBI now EXPORT_OK's some utility functions, neat($value),
- neat_list(@values) and dump_results($sth).
-
- Slightly enhanced t/min.t minimal test script in an effort to help
- narrow down the few stray core dumps that some porters still report.
-
- Renamed readblob to blob_read (old name still works but warns).
- Added default blob_copy_to_file method.
-
- Added $sth = $dbh->tables method. This returns an $sth for a query
- which has these columns: TABLE_CATALOGUE, TABLE_OWNER, TABLE_NAME,
- TABLE_TYPE, REMARKS in that order. The TABLE_CATALOGUE column
- should be ignored for now.
-
-
-=head2 Changes in DBI 0.64, 23 Oct 1995
-
- Fixed 'disconnect invalidates 1 associated cursor(s)' problem.
- Drivers using DBIc_ACTIVE_on/off() macros should not need any changes
- other than to test for DBIc_ACTIVE_KIDS() instead of DBIc_KIDS().
- Fixed possible core dump in dbih_clearcom during global destruction.
-
-
-=head2 Changes in DBI 0.63, 1 Sep 1995
-
- Minor update. Fixed uninitialised memory bug in method
- attribute handling and streamlined processing and debugging.
- Revised usage definitions for bind_* methods and readblob.
-
-
-=head2 Changes in DBI 0.62, 26 Aug 1995
-
- Added method redirection method $h->func(..., $method_name).
- This is now the official way to call private driver methods
- that are not part of the DBI standard. E.g.:
- @ary = $sth->func('ora_types');
- It can also be used to call existing methods. Has very low cost.
-
- $sth->bind_col columns now start from 1 (not 0) to match SQL.
- $sth->bind_columns now takes a leading attribute parameter (or undef),
- e.g., $sth->bind_columns($attribs, \$col1 [, \$col2 , ...]);
-
- Added handy DBD_ATTRIBS_CHECK macro to vet attribs in XS.
- Added handy DBD_ATTRIB_GET_SVP, DBD_ATTRIB_GET_BOOL and
- DBD_ATTRIB_GET_IV macros for handling attributes.
-
- Fixed STORE for NUM_OF_FIELDS and NUM_OF_PARAMS.
- Added FETCH for NUM_OF_FIELDS and NUM_OF_PARAMS.
-
- Dispatch no longer bothers to call _untie().
- Faster startup via install_method/_add_dispatch changes.
-
-
-=head2 Changes in DBI 0.61, 22 Aug 1995
-
- Added $sth->bind_col($column, \$var [, \%attribs ]);
-
- This method enables perl variable to be directly and automatically
- updated when a row is fetched. It requires no driver support
- (if the driver has been written to use DBIS->get_fbav).
- Currently \%attribs is unused.
-
- Added $sth->bind_columns(\$var [, \$var , ...]);
-
- This method is a short-cut for bind_col which binds all the
- columns of a query in one go (with no attributes). It also
- requires no driver support.
-
- Added $sth->bind_param($parameter, $var [, \%attribs ]);
-
- This method enables attributes to be specified when values are
- bound to placeholders. It also enables binding to occur away
- from the execute method to improve execute efficiency.
- The DBI does not provide a default implementation of this.
- See the DBD::Oracle module for a detailed example.
-
- The DBI now provides default implementations of both fetch and
- fetchrow. Each is written in terms of the other. A driver is
- expected to implement at least one of them.
-
- More macro and assorted structure changes in DBDXS.h. Sorry!
- The old dbihcom definitions have gone. All fields have macros.
- The imp_xxh_t type is now used within the DBI as well as drivers.
- Drivers must set DBIc_NUM_FIELDS(imp_sth) and DBIc_NUM_PARAMS(imp_sth).
-
- test.pl includes a trivial test of bind_param and bind_columns.
-
-
-=head2 Changes in DBI 0.60, 17 Aug 1995
-
- This release has significant code changes but much less
- dramatic than the previous release. The new implementors data
- handling mechanism has matured significantly (don't be put off
- by all the struct typedefs in DBIXS.h, there's just to make it
- easier for drivers while keeping things type-safe).
-
- The DBI now includes two new methods:
-
- do $dbh->do($statement)
-
- This method prepares, executes and finishes a statement. It is
- designed to be used for executing one-off non-select statements
- where there is no benefit in reusing a prepared statement handle.
-
- fetch $array_ref = $sth->fetch;
-
- This method is the new 'lowest-level' row fetching method. The
- previous @row = $sth->fetchrow method now defaults to calling
- the fetch method and expanding the returned array reference.
-
- The DBI now provides fallback attribute FETCH and STORE functions
- which drivers should call if they don't recognise an attribute.
-
- THIS RELEASE IS A GOOD STARTING POINT FOR DRIVER DEVELOPERS!
- Study DBIXS.h from the DBI and Oracle.xs etc from DBD::Oracle.
- There will be further changes in the interface but nothing
- as dramatic as these last two releases! (I hope :-)
-
-
-=head2 Changes in DBI 0.59 15 Aug 1995
-
- NOTE: THIS IS AN UNSTABLE RELEASE!
-
- Major reworking of internal data management!
- Performance improvements and memory leaks fixed.
- Added a new NullP (empty) driver and a -m flag
- to test.pl to help check for memory leaks.
- Study DBD::Oracle version 0.21 for more details.
- (Comparing parts of v0.21 with v0.20 may be useful.)
-
-
-=head2 Changes in DBI 0.58 21 June 1995
-
- Added DBI->internal->{DebugLog} = $filename;
- Reworked internal logging.
- Added $VERSION.
- Made disconnect_all a compulsory method for drivers.
-
-
-=head1 ANCIENT HISTORY
-
-12th Oct 1994: First public release of the DBI module.
- (for Perl 5.000-beta-3h)
-
-19th Sep 1994: DBperl project renamed to DBI.
-
-29th Sep 1992: DBperl project started.
-
-=cut
+++ /dev/null
-/*
- * This file was generated automatically by ExtUtils::ParseXS version 3.28 from the
- * contents of DBI.xs. Do not edit this file, edit DBI.xs instead.
- *
- * ANY CHANGES MADE HERE WILL BE LOST!
- *
- */
-
-#line 1 "DBI.xs"
-/* vim: ts=8:sw=4:expandtab
- *
- * $Id$
- *
- * Copyright (c) 1994-2012 Tim Bunce Ireland.
- *
- * See COPYRIGHT section in DBI.pm for usage and distribution rights.
- */
-
-#define IN_DBI_XS 1 /* see DBIXS.h */
-#define PERL_NO_GET_CONTEXT
-
-#include "DBIXS.h" /* DBI public interface for DBD's written in C */
-
-# if (defined(_WIN32) && (! defined(HAS_GETTIMEOFDAY)))
-#include <sys/timeb.h>
-# endif
-
-/* The XS dispatcher code can optimize calls to XS driver methods,
- * bypassing the usual call_sv() and argument handling overheads.
- * Just-in-case it causes problems there's an (undocumented) way
- * to disable it by setting an env var.
- */
-static int use_xsbypass = 1; /* set in dbi_bootinit() */
-
-#ifndef CvISXSUB
-#define CvISXSUB(sv) CvXSUB(sv)
-#endif
-
-#define DBI_MAGIC '~'
-
-/* HvMROMETA introduced in 5.9.5, but mro_meta_init not exported in 5.10.0 */
-#if (PERL_VERSION < 10)
-# define MY_cache_gen(stash) 0
-#else
-# if ((PERL_VERSION == 10) && (PERL_SUBVERSION == 0))
-# define MY_cache_gen(stash) \
- (HvAUX(stash)->xhv_mro_meta \
- ? HvAUX(stash)->xhv_mro_meta->cache_gen \
- : 0)
-# else
-# define MY_cache_gen(stash) HvMROMETA(stash)->cache_gen
-# endif
-#endif
-
-/* If the tests fail with errors about 'setlinebuf' then try */
-/* deleting the lines in the block below except the setvbuf one */
-#ifndef PerlIO_setlinebuf
-#ifdef HAS_SETLINEBUF
-#define PerlIO_setlinebuf(f) setlinebuf(f)
-#else
-#ifndef USE_PERLIO
-#define PerlIO_setlinebuf(f) setvbuf(f, Nullch, _IOLBF, 0)
-#endif
-#endif
-#endif
-
-#ifndef CopFILEGV
-# define CopFILEGV(cop) cop->cop_filegv
-# define CopLINE(cop) cop->cop_line
-# define CopSTASH(cop) cop->cop_stash
-# define CopSTASHPV(cop) (CopSTASH(cop) ? HvNAME(CopSTASH(cop)) : Nullch)
-#endif
-#ifndef PERL_GET_THX
-#define PERL_GET_THX ((void*)0)
-#endif
-#ifndef PerlProc_getpid
-#define PerlProc_getpid() getpid()
-extern Pid_t getpid (void);
-#endif
-#ifndef aTHXo_
-#define aTHXo_
-#endif
-
-#if (PERL_VERSION < 8) || ((PERL_VERSION == 8) && (PERL_SUBVERSION == 0))
-#define DBI_save_hv_fetch_ent
-#endif
-
-/* prior to 5.8.9: when a CV is duped, the mg dup method is called,
- * then *afterwards*, any_ptr is copied from the old CV to the new CV.
- * This wipes out anything which the dup method did to any_ptr.
- * This needs working around */
-#if defined(USE_ITHREADS) && (PERL_VERSION == 8) && (PERL_SUBVERSION < 9)
-# define BROKEN_DUP_ANY_PTR
-#endif
-
-#ifndef warn_sv
-static void warn_sv(SV *sv) { dTHX; warn("%" SVf, SVfARG(sv)); }
-#endif
-#ifndef croak_sv
-static void croak_sv(SV *sv) { dTHX; sv_setsv(ERRSV, sv); croak(NULL); }
-#endif
-
-/* types of method name */
-
-typedef enum {
- methtype_ordinary, /* nothing special about this method name */
- methtype_DESTROY,
- methtype_FETCH,
- methtype_can,
- methtype_fetch_star, /* fetch*, i.e. fetch() or fetch_...() */
- methtype_set_err
-} meth_types;
-
-
-static imp_xxh_t *dbih_getcom _((SV *h));
-static imp_xxh_t *dbih_getcom2 _((pTHX_ SV *h, MAGIC **mgp));
-static void dbih_clearcom _((imp_xxh_t *imp_xxh));
-static int dbih_logmsg _((imp_xxh_t *imp_xxh, const char *fmt, ...));
-static SV *dbih_make_com _((SV *parent_h, imp_xxh_t *p_imp_xxh, const char *imp_class, STRLEN imp_size, STRLEN extra, SV *copy));
-static SV *dbih_make_fdsv _((SV *sth, const char *imp_class, STRLEN imp_size, const char *col_name));
-static AV *dbih_get_fbav _((imp_sth_t *imp_sth));
-static SV *dbih_event _((SV *h, const char *name, SV*, SV*));
-static int dbih_set_attr_k _((SV *h, SV *keysv, int dbikey, SV *valuesv));
-static SV *dbih_get_attr_k _((SV *h, SV *keysv, int dbikey));
-static int dbih_sth_bind_col _((SV *sth, SV *col, SV *ref, SV *attribs));
-
-static int set_err_char _((SV *h, imp_xxh_t *imp_xxh, const char *err_c, IV err_i, const char *errstr, const char *state, const char *method));
-static int set_err_sv _((SV *h, imp_xxh_t *imp_xxh, SV *err, SV *errstr, SV *state, SV *method));
-static int quote_type _((int sql_type, int p, int s, int *base_type, void *v));
-static int sql_type_cast_svpv _((pTHX_ SV *sv, int sql_type, U32 flags, void *v));
-static I32 dbi_hash _((const char *string, long i));
-static void dbih_dumphandle _((pTHX_ SV *h, const char *msg, int level));
-static int dbih_dumpcom _((pTHX_ imp_xxh_t *imp_xxh, const char *msg, int level));
-static int dbi_ima_free(pTHX_ SV* sv, MAGIC* mg);
-#if defined(USE_ITHREADS) && !defined(BROKEN_DUP_ANY_PTR)
-static int dbi_ima_dup(pTHX_ MAGIC* mg, CLONE_PARAMS *param);
-#endif
-char *neatsvpv _((SV *sv, STRLEN maxlen));
-SV * preparse(SV *dbh, const char *statement, IV ps_return, IV ps_accept, void *foo);
-static meth_types get_meth_type(const char * const name);
-
-struct imp_drh_st { dbih_drc_t com; };
-struct imp_dbh_st { dbih_dbc_t com; };
-struct imp_sth_st { dbih_stc_t com; };
-struct imp_fdh_st { dbih_fdc_t com; };
-
-/* identify the type of a method name for dispatch behaviour */
-/* (should probably be folded into the IMA flags mechanism) */
-
-static meth_types
-get_meth_type(const char * const name)
-{
- switch (name[0]) {
- case 'D':
- if strEQ(name,"DESTROY")
- return methtype_DESTROY;
- break;
- case 'F':
- if strEQ(name,"FETCH")
- return methtype_FETCH;
- break;
- case 'c':
- if strEQ(name,"can")
- return methtype_can;
- break;
- case 'f':
- if strnEQ(name,"fetch", 5) /* fetch* */
- return methtype_fetch_star;
- break;
- case 's':
- if strEQ(name,"set_err")
- return methtype_set_err;
- break;
- }
- return methtype_ordinary;
-}
-
-
-/* Internal Method Attributes (attached to dispatch methods when installed) */
-/* NOTE: when adding SVs to dbi_ima_t, update dbi_ima_dup() dbi_ima_free()
- * to ensure that they are duped and correctly ref-counted */
-
-typedef struct dbi_ima_st {
- U8 minargs;
- U8 maxargs;
- IV hidearg;
- /* method_trace controls tracing of method calls in the dispatcher:
- - if the current trace flags include a trace flag in method_trace
- then set trace_level to min(2,trace_level) for duration of the call.
- - else, if trace_level < (method_trace & DBIc_TRACE_LEVEL_MASK)
- then don't trace the call
- */
- U32 method_trace;
- const char *usage_msg;
- U32 flags;
- meth_types meth_type;
-
- /* cached outer to inner method mapping */
- HV *stash; /* the stash we found the GV in */
- GV *gv; /* the GV containing the inner sub */
- U32 generation; /* cache invalidation */
-#ifdef BROKEN_DUP_ANY_PTR
- PerlInterpreter *my_perl; /* who owns this struct */
-#endif
-
-} dbi_ima_t;
-
-/* These values are embedded in the data passed to install_method */
-#define IMA_HAS_USAGE 0x00000001 /* check parameter usage */
-#define IMA_FUNC_REDIRECT 0x00000002 /* is $h->func(..., "method") */
-#define IMA_KEEP_ERR 0x00000004 /* don't reset err & errstr */
-#define IMA_KEEP_ERR_SUB 0x00000008 /* '' if in a nested call */
-#define IMA_NO_TAINT_IN 0x00000010 /* don't check for PL_tainted args */
-#define IMA_NO_TAINT_OUT 0x00000020 /* don't taint results */
-#define IMA_COPY_UP_STMT 0x00000040 /* copy sth Statement to dbh */
-#define IMA_END_WORK 0x00000080 /* method is commit or rollback */
-#define IMA_STUB 0x00000100 /* donothing eg $dbh->connected */
-#define IMA_CLEAR_STMT 0x00000200 /* clear Statement before call */
-#define IMA_UNRELATED_TO_STMT 0x00000400 /* profile as empty Statement */
-#define IMA_NOT_FOUND_OKAY 0x00000800 /* no error if not found */
-#define IMA_EXECUTE 0x00001000 /* do/execute: DBIcf_Executed */
-#define IMA_SHOW_ERR_STMT 0x00002000 /* dbh meth relates to Statement*/
-#define IMA_HIDE_ERR_PARAMVALUES 0x00004000 /* ParamValues are not relevant */
-#define IMA_IS_FACTORY 0x00008000 /* new h ie connect and prepare */
-#define IMA_CLEAR_CACHED_KIDS 0x00010000 /* clear CachedKids before call */
-
-#define DBIc_STATE_adjust(imp_xxh, state) \
- (SvOK(state) /* SQLSTATE is implemented by driver */ \
- ? (strEQ(SvPV_nolen(state),"00000") ? &PL_sv_no : sv_mortalcopy(state))\
- : (SvTRUE(DBIc_ERR(imp_xxh)) \
- ? sv_2mortal(newSVpv("S1000",5)) /* General error */ \
- : &PL_sv_no) /* Success ("00000") */ \
- )
-
-#define DBI_LAST_HANDLE g_dbi_last_h /* special fake inner handle */
-#define DBI_IS_LAST_HANDLE(h) ((DBI_LAST_HANDLE) == SvRV(h))
-#define DBI_SET_LAST_HANDLE(h) ((DBI_LAST_HANDLE) = SvRV(h))
-#define DBI_UNSET_LAST_HANDLE ((DBI_LAST_HANDLE) = &PL_sv_undef)
-#define DBI_LAST_HANDLE_OK ((DBI_LAST_HANDLE) != &PL_sv_undef)
-
-#define DBIS_TRACE_LEVEL (DBIS->debug & DBIc_TRACE_LEVEL_MASK)
-#define DBIS_TRACE_FLAGS (DBIS->debug) /* includes level */
-
-#ifdef PERL_LONG_MAX
-#define MAX_LongReadLen PERL_LONG_MAX
-#else
-#define MAX_LongReadLen 2147483647L
-#endif
-
-#ifdef DBI_USE_THREADS
-static char *dbi_build_opt = "-ithread";
-#else
-static char *dbi_build_opt = "-nothread";
-#endif
-
-/* 32 bit magic FNV-0 and FNV-1 prime */
-#define FNV_32_PRIME ((UV)0x01000193)
-
-
-/* perl doesn't know anything about the dbi_ima_t struct attached to the
- * CvXSUBANY(cv).any_ptr slot, so add some magic to the CV to handle
- * duping and freeing.
- */
-
-static MGVTBL dbi_ima_vtbl = { 0, 0, 0, 0, dbi_ima_free,
- 0,
-#if defined(USE_ITHREADS) && !defined(BROKEN_DUP_ANY_PTR)
- dbi_ima_dup
-#else
- 0
-#endif
-#if (PERL_VERSION > 8) || ((PERL_VERSION == 8) && (PERL_SUBVERSION >= 9))
- , 0
-#endif
- };
-
-static int dbi_ima_free(pTHX_ SV* sv, MAGIC* mg)
-{
- dbi_ima_t *ima = (dbi_ima_t *)(CvXSUBANY((CV*)sv).any_ptr);
-#ifdef BROKEN_DUP_ANY_PTR
- if (ima->my_perl != my_perl)
- return 0;
-#endif
- SvREFCNT_dec(ima->stash);
- SvREFCNT_dec(ima->gv);
- Safefree(ima);
- return 0;
-}
-
-#if defined(USE_ITHREADS) && !defined(BROKEN_DUP_ANY_PTR)
-static int dbi_ima_dup(pTHX_ MAGIC* mg, CLONE_PARAMS *param)
-{
- dbi_ima_t *ima, *nima;
- CV *cv = (CV*) mg->mg_ptr;
- CV *ncv = (CV*)ptr_table_fetch(PL_ptr_table, (cv));
-
- PERL_UNUSED_VAR(param);
- mg->mg_ptr = (char *)ncv;
- ima = (dbi_ima_t*) CvXSUBANY(cv).any_ptr;
- Newx(nima, 1, dbi_ima_t);
- *nima = *ima; /* structure copy */
- CvXSUBANY(ncv).any_ptr = nima;
- nima->stash = NULL;
- nima->gv = NULL;
- return 0;
-}
-#endif
-
-
-
-/* --- make DBI safe for multiple perl interpreters --- */
-/* Originally contributed by Murray Nesbitt of ActiveState, */
-/* but later updated to use MY_CTX */
-
-#define MY_CXT_KEY "DBI::_guts" XS_VERSION
-
-typedef struct {
- SV *dbi_last_h; /* maybe better moved into dbistate_t? */
- dbistate_t* dbi_state;
-} my_cxt_t;
-
-START_MY_CXT
-
-#undef DBIS
-#define DBIS (MY_CXT.dbi_state)
-
-#define g_dbi_last_h (MY_CXT.dbi_last_h)
-
-/* allow the 'static' dbi_state struct to be accessed from other files */
-dbistate_t**
-_dbi_state_lval(pTHX)
-{
- dMY_CXT;
- return &(MY_CXT.dbi_state);
-}
-
-
-/* --- */
-
-static void *
-malloc_using_sv(STRLEN len)
-{
- dTHX;
- SV *sv = newSV(len);
- void *p = SvPVX(sv);
- memzero(p, len);
- return p;
-}
-
-static char *
-savepv_using_sv(char *str)
-{
- char *buf = malloc_using_sv(strlen(str));
- strcpy(buf, str);
- return buf;
-}
-
-
-/* --- support functions for concat_hash_sorted --- */
-
-typedef struct str_uv_sort_pair_st {
- char *key;
- UV numeric;
-} str_uv_sort_pair_t;
-
-static int
-_cmp_number(const void *val1, const void *val2)
-{
- UV first = ((str_uv_sort_pair_t *)val1)->numeric;
- UV second = ((str_uv_sort_pair_t *)val2)->numeric;
-
- if (first > second)
- return 1;
- if (first < second)
- return -1;
- /* only likely to reach here if numeric sort forced for non-numeric keys */
- /* fallback to comparing the key strings */
- return strcmp(
- ((str_uv_sort_pair_t *)val1)->key,
- ((str_uv_sort_pair_t *)val2)->key
- );
-}
-
-static int
-_cmp_str (const void *val1, const void *val2)
-{
- return strcmp( *(char **)val1, *(char **)val2);
-}
-
-static char **
-_sort_hash_keys (HV *hash, int num_sort, STRLEN *total_length)
-{
- dTHX;
- I32 hv_len, key_len;
- HE *entry;
- char **keys;
- unsigned int idx = 0;
- STRLEN tot_len = 0;
- bool has_non_numerics = 0;
- str_uv_sort_pair_t *numbers;
-
- hv_len = hv_iterinit(hash);
- if (!hv_len)
- return 0;
-
- Newz(0, keys, hv_len, char *);
- Newz(0, numbers, hv_len, str_uv_sort_pair_t);
-
- while ((entry = hv_iternext(hash))) {
- *(keys+idx) = hv_iterkey(entry, &key_len);
- tot_len += key_len;
-
- if (grok_number(*(keys+idx), key_len, &(numbers+idx)->numeric) != IS_NUMBER_IN_UV) {
- has_non_numerics = 1;
- (numbers+idx)->numeric = 0;
- }
-
- (numbers+idx)->key = *(keys+idx);
- ++idx;
- }
-
- if (total_length)
- *total_length = tot_len;
-
- if (num_sort < 0)
- num_sort = (has_non_numerics) ? 0 : 1;
-
- if (!num_sort) {
- qsort(keys, hv_len, sizeof(char*), _cmp_str);
- }
- else {
- qsort(numbers, hv_len, sizeof(str_uv_sort_pair_t), _cmp_number);
- for (idx = 0; idx < hv_len; ++idx)
- *(keys+idx) = (numbers+idx)->key;
- }
-
- Safefree(numbers);
- return keys;
-}
-
-
-static SV *
-_join_hash_sorted(HV *hash, char *kv_sep, STRLEN kv_sep_len, char *pair_sep, STRLEN pair_sep_len, int use_neat, int num_sort)
-{
- dTHX;
- I32 hv_len;
- STRLEN total_len = 0;
- char **keys;
- unsigned int i = 0;
- SV *return_sv;
-
- keys = _sort_hash_keys(hash, num_sort, &total_len);
- if (!keys)
- return newSVpv("", 0);
-
- if (!kv_sep_len)
- kv_sep_len = strlen(kv_sep);
- if (!pair_sep_len)
- pair_sep_len = strlen(pair_sep);
-
- hv_len = hv_iterinit(hash);
- /* total_len += Separators + quotes + term null */
- total_len += kv_sep_len*hv_len + pair_sep_len*hv_len+2*hv_len+1;
- return_sv = newSV(total_len);
- sv_setpv(return_sv, ""); /* quell undef warnings */
-
- for (i=0; i<hv_len; ++i) {
- SV **hash_svp = hv_fetch(hash, keys[i], strlen(keys[i]), 0);
-
- sv_catpv(return_sv, keys[i]); /* XXX keys can't contain nul chars */
- sv_catpvn(return_sv, kv_sep, kv_sep_len);
-
- if (!hash_svp) { /* should never happen */
- warn("No hash entry with key '%s'", keys[i]);
- sv_catpvn(return_sv, "???", 3);
- continue;
- }
-
- if (use_neat) {
- sv_catpv(return_sv, neatsvpv(*hash_svp,0));
- }
- else {
- if (SvOK(*hash_svp)) {
- STRLEN hv_val_len;
- char *hv_val = SvPV(*hash_svp, hv_val_len);
- sv_catpvn(return_sv, "'", 1);
- sv_catpvn(return_sv, hv_val, hv_val_len);
- sv_catpvn(return_sv, "'", 1);
- }
- else sv_catpvn(return_sv, "undef", 5);
- }
-
- if (i < hv_len-1)
- sv_catpvn(return_sv, pair_sep, pair_sep_len);
- }
-
- Safefree(keys);
-
- return return_sv;
-}
-
-
-
-/* handy for embedding into condition expression for debugging */
-/*
-static int warn1(char *s) { warn("%s", s); return 1; }
-static int dump1(SV *sv) { dTHX; sv_dump(sv); return 1; }
-*/
-
-
-/* --- */
-
-static void
-check_version(const char *name, int dbis_cv, int dbis_cs, int need_dbixs_cv, int drc_s,
- int dbc_s, int stc_s, int fdc_s)
-{
- dTHX;
- dMY_CXT;
- static const char msg[] = "you probably need to rebuild the DBD driver (or possibly the DBI)";
- (void)need_dbixs_cv;
- if (dbis_cv != DBISTATE_VERSION || dbis_cs != sizeof(*DBIS))
- croak("DBI/DBD internal version mismatch (DBI is v%d/s%lu, DBD %s expected v%d/s%d) %s.\n",
- DBISTATE_VERSION, (long unsigned int)sizeof(*DBIS), name, dbis_cv, dbis_cs, msg);
- /* Catch structure size changes - We should probably force a recompile if the DBI */
- /* runtime version is different from the build time. That would be harsh but safe. */
- if (drc_s != sizeof(dbih_drc_t) || dbc_s != sizeof(dbih_dbc_t) ||
- stc_s != sizeof(dbih_stc_t) || fdc_s != sizeof(dbih_fdc_t) )
- croak("%s (dr:%d/%ld, db:%d/%ld, st:%d/%ld, fd:%d/%ld), %s.\n",
- "DBI/DBD internal structure mismatch",
- drc_s, (long)sizeof(dbih_drc_t), dbc_s, (long)sizeof(dbih_dbc_t),
- stc_s, (long)sizeof(dbih_stc_t), fdc_s, (long)sizeof(dbih_fdc_t), msg);
-}
-
-static void
-dbi_bootinit(dbistate_t * parent_dbis)
-{
- dTHX;
- dMY_CXT;
- dbistate_t* DBISx;
-
- DBISx = (struct dbistate_st*)malloc_using_sv(sizeof(struct dbistate_st));
- DBIS = DBISx;
-
- /* make DBIS available to DBD modules the "old" (<= 1.618) way,
- * so that unrecompiled DBD's will still work against a newer DBI */
- sv_setiv(get_sv("DBI::_dbistate", GV_ADDMULTI),
- PTR2IV(MY_CXT.dbi_state));
-
- /* store version and size so we can spot DBI/DBD version mismatch */
- DBIS->check_version = check_version;
- DBIS->version = DBISTATE_VERSION;
- DBIS->size = sizeof(*DBIS);
- DBIS->xs_version = DBIXS_VERSION;
-
- DBIS->logmsg = dbih_logmsg;
- DBIS->logfp = PerlIO_stderr();
- DBIS->debug = (parent_dbis) ? parent_dbis->debug
- : SvIV(get_sv("DBI::dbi_debug",0x5));
- DBIS->neatsvpvlen = (parent_dbis) ? parent_dbis->neatsvpvlen
- : get_sv("DBI::neat_maxlen", GV_ADDMULTI);
-#ifdef DBI_USE_THREADS
- DBIS->thr_owner = PERL_GET_THX;
-#endif
-
- /* store some function pointers so DBD's can call our functions */
- DBIS->getcom = dbih_getcom;
- DBIS->clearcom = dbih_clearcom;
- DBIS->event = dbih_event;
- DBIS->set_attr_k = dbih_set_attr_k;
- DBIS->get_attr_k = dbih_get_attr_k;
- DBIS->get_fbav = dbih_get_fbav;
- DBIS->make_fdsv = dbih_make_fdsv;
- DBIS->neat_svpv = neatsvpv;
- DBIS->bind_as_num = quote_type; /* XXX deprecated */
- DBIS->hash = dbi_hash;
- DBIS->set_err_sv = set_err_sv;
- DBIS->set_err_char= set_err_char;
- DBIS->bind_col = dbih_sth_bind_col;
- DBIS->sql_type_cast_svpv = sql_type_cast_svpv;
-
-
- /* Remember the last handle used. BEWARE! Sneaky stuff here! */
- /* We want a handle reference but we don't want to increment */
- /* the handle's reference count and we don't want perl to try */
- /* to destroy it during global destruction. Take care! */
- DBI_UNSET_LAST_HANDLE; /* ensure setup the correct way */
-
- /* trick to avoid 'possible typo' warnings */
- gv_fetchpv("DBI::state", GV_ADDMULTI, SVt_PV);
- gv_fetchpv("DBI::err", GV_ADDMULTI, SVt_PV);
- gv_fetchpv("DBI::errstr", GV_ADDMULTI, SVt_PV);
- gv_fetchpv("DBI::lasth", GV_ADDMULTI, SVt_PV);
- gv_fetchpv("DBI::rows", GV_ADDMULTI, SVt_PV);
-
- /* we only need to check the env var on the initial boot
- * which is handy because it can core dump during CLONE on windows
- */
- if (!parent_dbis && getenv("PERL_DBI_XSBYPASS"))
- use_xsbypass = atoi(getenv("PERL_DBI_XSBYPASS"));
-}
-
-
-/* ----------------------------------------------------------------- */
-/* Utility functions */
-
-
-static char *
-dbih_htype_name(int htype)
-{
- switch(htype) {
- case DBIt_DR: return "dr";
- case DBIt_DB: return "db";
- case DBIt_ST: return "st";
- case DBIt_FD: return "fd";
- default: return "??";
- }
-}
-
-
-char *
-neatsvpv(SV *sv, STRLEN maxlen) /* return a tidy ascii value, for debugging only */
-{
- dTHX;
- dMY_CXT;
- STRLEN len;
- SV *nsv = Nullsv;
- SV *infosv = Nullsv;
- char *v, *quote;
-
- /* We take care not to alter the supplied sv in any way at all. */
- /* (but if it is SvGMAGICAL we have to call mg_get and that can */
- /* have side effects, especially as it may be called twice overall.) */
-
- if (!sv)
- return "Null!"; /* should never happen */
-
- /* try to do the right thing with magical values */
- if (SvMAGICAL(sv)) {
- if (DBIS_TRACE_LEVEL >= 5) { /* add magic details to help debugging */
- MAGIC* mg;
- infosv = sv_2mortal(newSVpv(" (magic-",0));
- if (SvSMAGICAL(sv)) sv_catpvn(infosv,"s",1);
- if (SvGMAGICAL(sv)) sv_catpvn(infosv,"g",1);
- if (SvRMAGICAL(sv)) sv_catpvn(infosv,"r",1);
- sv_catpvn(infosv,":",1);
- for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic)
- sv_catpvn(infosv, &mg->mg_type, 1);
- sv_catpvn(infosv, ")", 1);
- }
- if (SvGMAGICAL(sv) && !PL_dirty)
- mg_get(sv); /* trigger magic to FETCH the value */
- }
-
- if (!SvOK(sv)) {
- if (SvTYPE(sv) >= SVt_PVAV)
- return (char *)sv_reftype(sv,0); /* raw AV/HV etc, not via a ref */
- if (!infosv)
- return "undef";
- sv_insert(infosv, 0,0, "undef",5);
- return SvPVX(infosv);
- }
-
- if (SvNIOK(sv)) { /* is a numeric value - so no surrounding quotes */
- if (SvPOK(sv)) { /* already has string version of the value, so use it */
- v = SvPV(sv,len);
- if (len == 0) { v="''"; len=2; } /* catch &sv_no style special case */
- if (!infosv)
- return v;
- sv_insert(infosv, 0,0, v, len);
- return SvPVX(infosv);
- }
- /* we don't use SvPV here since we don't want to alter sv in _any_ way */
- if (SvUOK(sv))
- nsv = newSVpvf("%"UVuf, SvUVX(sv));
- else if (SvIOK(sv))
- nsv = newSVpvf("%"IVdf, SvIVX(sv));
- else nsv = newSVpvf("%"NVgf, SvNVX(sv));
- if (infosv)
- sv_catsv(nsv, infosv);
- return SvPVX(sv_2mortal(nsv));
- }
-
- nsv = sv_newmortal();
- sv_upgrade(nsv, SVt_PV);
-
- if (SvROK(sv)) {
- if (!SvAMAGIC(sv)) /* (un-amagic'd) refs get no special treatment */
- v = SvPV(sv,len);
- else {
- /* handle Overload magic refs */
- (void)SvAMAGIC_off(sv); /* should really be done via local scoping */
- v = SvPV(sv,len); /* XXX how does this relate to SvGMAGIC? */
- SvAMAGIC_on(sv);
- }
- sv_setpvn(nsv, v, len);
- if (infosv)
- sv_catsv(nsv, infosv);
- return SvPV(nsv, len);
- }
-
- if (SvPOK(sv)) /* usual simple string case */
- v = SvPV(sv,len);
- else /* handles all else via sv_2pv() */
- v = SvPV(sv,len); /* XXX how does this relate to SvGMAGIC? */
-
- /* for strings we limit the length and translate codes */
- if (maxlen == 0)
- maxlen = SvIV(DBIS->neatsvpvlen);
- if (maxlen < 6) /* handle daft values */
- maxlen = 6;
- maxlen -= 2; /* account for quotes */
-
- quote = (SvUTF8(sv)) ? "\"" : "'";
- if (len > maxlen) {
- SvGROW(nsv, (1+maxlen+1+1));
- sv_setpvn(nsv, quote, 1);
- sv_catpvn(nsv, v, maxlen-3); /* account for three dots */
- sv_catpvn(nsv, "...", 3);
- } else {
- SvGROW(nsv, (1+len+1+1));
- sv_setpvn(nsv, quote, 1);
- sv_catpvn(nsv, v, len);
- }
- sv_catpvn(nsv, quote, 1);
- if (infosv)
- sv_catsv(nsv, infosv);
- v = SvPV(nsv, len);
- if (!SvUTF8(sv)) {
- while(len-- > 0) { /* cleanup string (map control chars to ascii etc) */
- const char c = v[len] & 0x7F; /* ignore top bit for multinational chars */
- if (!isPRINT(c) && !isSPACE(c))
- v[len] = '.';
- }
- }
- return v;
-}
-
-
-static void
-copy_statement_to_parent(pTHX_ SV *h, imp_xxh_t *imp_xxh)
-{
- SV *parent;
- if (PL_dirty)
- return;
- parent = DBIc_PARENT_H(imp_xxh);
- if (parent && SvROK(parent)) {
- SV *tmp_sv = *hv_fetch((HV*)SvRV(h), "Statement", 9, 1);
- if (SvOK(tmp_sv))
- (void)hv_store((HV*)SvRV(parent), "Statement", 9, SvREFCNT_inc(tmp_sv), 0);
- }
-}
-
-
-static int
-set_err_char(SV *h, imp_xxh_t *imp_xxh, const char *err_c, IV err_i, const char *errstr, const char *state, const char *method)
-{
- dTHX;
- char err_buf[28];
- SV *err_sv, *errstr_sv, *state_sv, *method_sv;
- if (!err_c) {
- sprintf(err_buf, "%ld", (long)err_i);
- err_c = &err_buf[0];
- }
- err_sv = (strEQ(err_c,"1")) ? &PL_sv_yes : sv_2mortal(newSVpvn(err_c, strlen(err_c)));
- errstr_sv = sv_2mortal(newSVpvn(errstr, strlen(errstr)));
- state_sv = (state && *state) ? sv_2mortal(newSVpvn(state, strlen(state))) : &PL_sv_undef;
- method_sv = (method && *method) ? sv_2mortal(newSVpvn(method, strlen(method))) : &PL_sv_undef;
- return set_err_sv(h, imp_xxh, err_sv, errstr_sv, state_sv, method_sv);
-}
-
-
-static int
-set_err_sv(SV *h, imp_xxh_t *imp_xxh, SV *err, SV *errstr, SV *state, SV *method)
-{
- dTHX;
- SV *h_err;
- SV *h_errstr;
- SV *h_state;
- SV **hook_svp;
- int err_changed = 0;
-
- if ( DBIc_has(imp_xxh, DBIcf_HandleSetErr)
- && (hook_svp = hv_fetch((HV*)SvRV(h),"HandleSetErr",12,0))
- && hook_svp
- && ((void)(SvGMAGICAL(*hook_svp) && mg_get(*hook_svp)), SvOK(*hook_svp))
- ) {
- dSP;
- IV items;
- SV *response_sv;
- if (SvREADONLY(err)) err = sv_mortalcopy(err);
- if (SvREADONLY(errstr)) errstr = sv_mortalcopy(errstr);
- if (SvREADONLY(state)) state = sv_mortalcopy(state);
- if (SvREADONLY(method)) method = sv_mortalcopy(method);
- if (DBIc_TRACE_LEVEL(imp_xxh) >= 2)
- PerlIO_printf(DBIc_LOGPIO(imp_xxh)," -> HandleSetErr(%s, err=%s, errstr=%s, state=%s, %s)\n",
- neatsvpv(h,0), neatsvpv(err,0), neatsvpv(errstr,0), neatsvpv(state,0),
- neatsvpv(method,0)
- );
- PUSHMARK(SP);
- XPUSHs(sv_2mortal(newRV_inc((SV*)DBIc_MY_H(imp_xxh))));
- XPUSHs(err);
- XPUSHs(errstr);
- XPUSHs(state);
- XPUSHs(method);
- PUTBACK;
- items = call_sv(*hook_svp, G_SCALAR);
- SPAGAIN;
- response_sv = (items) ? POPs : &PL_sv_undef;
- PUTBACK;
- if (DBIc_TRACE_LEVEL(imp_xxh) >= 1)
- PerlIO_printf(DBIc_LOGPIO(imp_xxh)," <- HandleSetErr= %s (err=%s, errstr=%s, state=%s, %s)\n",
- neatsvpv(response_sv,0), neatsvpv(err,0), neatsvpv(errstr,0), neatsvpv(state,0),
- neatsvpv(method,0)
- );
- if (SvTRUE(response_sv)) /* handler says it has handled it, so... */
- return 0;
- }
- else {
- if (DBIc_TRACE_LEVEL(imp_xxh) >= 2)
- PerlIO_printf(DBIc_LOGPIO(imp_xxh)," -- HandleSetErr err=%s, errstr=%s, state=%s, %s\n",
- neatsvpv(err,0), neatsvpv(errstr,0), neatsvpv(state,0), neatsvpv(method,0)
- );
- }
-
- if (!SvOK(err)) { /* clear err / errstr / state */
- DBIh_CLEAR_ERROR(imp_xxh);
- return 1;
- }
-
- /* fetch these after calling HandleSetErr */
- h_err = DBIc_ERR(imp_xxh);
- h_errstr = DBIc_ERRSTR(imp_xxh);
- h_state = DBIc_STATE(imp_xxh);
-
- if (SvTRUE(h_errstr)) {
- /* append current err, if any, to errstr if it's going to change */
- if (SvTRUE(h_err) && SvTRUE(err) && strNE(SvPV_nolen(h_err), SvPV_nolen(err)))
- sv_catpvf(h_errstr, " [err was %s now %s]", SvPV_nolen(h_err), SvPV_nolen(err));
- if (SvTRUE(h_state) && SvTRUE(state) && strNE(SvPV_nolen(h_state), SvPV_nolen(state)))
- sv_catpvf(h_errstr, " [state was %s now %s]", SvPV_nolen(h_state), SvPV_nolen(state));
- if (strNE(SvPV_nolen(h_errstr), SvPV_nolen(errstr))) {
- sv_catpvn(h_errstr, "\n", 1);
- sv_catsv(h_errstr, errstr);
- }
- }
- else
- sv_setsv(h_errstr, errstr);
-
- /* SvTRUE(err) > "0" > "" > undef */
- if (SvTRUE(err) /* new error: so assign */
- || !SvOK(h_err) /* no existing warn/info: so assign */
- /* new warn ("0" len 1) > info ("" len 0): so assign */
- || (SvOK(err) && strlen(SvPV_nolen(err)) > strlen(SvPV_nolen(h_err)))
- ) {
- sv_setsv(h_err, err);
- err_changed = 1;
- if (SvTRUE(h_err)) /* new error */
- ++DBIc_ErrCount(imp_xxh);
- }
-
- if (err_changed) {
- if (SvTRUE(state)) {
- if (strlen(SvPV_nolen(state)) != 5) {
- warn("set_err: state (%s) is not a 5 character string, using 'S1000' instead", neatsvpv(state,0));
- sv_setpv(h_state, "S1000");
- }
- else
- sv_setsv(h_state, state);
- }
- else
- (void)SvOK_off(h_state); /* see DBIc_STATE_adjust */
-
- /* ensure that the parent's Statement attribute reflects the latest error */
- /* so that ShowErrorStatement is reliable */
- copy_statement_to_parent(aTHX_ h, imp_xxh);
- }
-
- return 1;
-}
-
-
-/* err_hash returns a U32 'hash' value representing the current err 'level'
- * (err/warn/info) and errstr. It's used by the dispatcher as a way to detect
- * a new or changed warning during a 'keep err' method like STORE. Always returns >0.
- * The value is 1 for no err/warn/info and guarantees that err > warn > info.
- * (It's a bit of a hack but the original approach in 70fe6bd76 using a new
- * ErrChangeCount attribute would break binary compatibility with drivers.)
- * The chance that two realistic errstr values would hash the same, even with
- * only 30 bits, is deemed to small to even bother documenting.
- */
-static U32
-err_hash(pTHX_ imp_xxh_t *imp_xxh)
-{
- SV *err_sv = DBIc_ERR(imp_xxh);
- SV *errstr_sv;
- I32 hash = 1;
- if (SvOK(err_sv)) {
- errstr_sv = DBIc_ERRSTR(imp_xxh);
- if (SvOK(errstr_sv))
- hash = -dbi_hash(SvPV_nolen(errstr_sv), 0); /* make positive */
- else hash = 0;
- hash >>= 1; /* free up extra bit (top bit is already free) */
- hash |= (SvTRUE(err_sv)) ? 0x80000000 /* err */
- : (SvPOK(err_sv) && !SvCUR(err_sv)) ? 0x20000000 /* '' = info */
- : 0x40000000;/* 0 or '0' = warn */
- }
- return hash;
-}
-
-
-static char *
-mkvname(pTHX_ HV *stash, const char *item, int uplevel) /* construct a variable name */
-{
- SV *sv = sv_newmortal();
- sv_setpv(sv, HvNAME(stash));
- if(uplevel) {
- while(SvCUR(sv) && *SvEND(sv)!=':')
- --SvCUR(sv);
- if (SvCUR(sv))
- --SvCUR(sv);
- }
- sv_catpv(sv, "::");
- sv_catpv(sv, item);
- return SvPV_nolen(sv);
-}
-
-/* 32 bit magic FNV-0 and FNV-1 prime */
-#define FNV_32_PRIME ((UV)0x01000193)
-
-static I32
-dbi_hash(const char *key, long type)
-{
- if (type == 0) {
- STRLEN klen = strlen(key);
- U32 hash = 0;
- while (klen--)
- hash = hash * 33 + *key++;
- hash &= 0x7FFFFFFF; /* limit to 31 bits */
- hash |= 0x40000000; /* set bit 31 */
- return -(I32)hash; /* return negative int */
- }
- else if (type == 1) { /* Fowler/Noll/Vo hash */
- /* see http://www.isthe.com/chongo/tech/comp/fnv/ */
- U32 hash = 0x811c9dc5;
- const unsigned char *s = (unsigned char *)key; /* unsigned string */
- while (*s) {
- /* multiply by the 32 bit FNV magic prime mod 2^32 */
- hash *= FNV_32_PRIME;
- /* xor the bottom with the current octet */
- hash ^= (U32)*s++;
- }
- return hash;
- }
- croak("DBI::hash(%ld): invalid type", type);
- return 0; /* NOT REACHED */
-}
-
-
-static int
-dbih_logmsg(imp_xxh_t *imp_xxh, const char *fmt, ...)
-{
- dTHX;
- va_list args;
-#ifdef I_STDARG
- va_start(args, fmt);
-#else
- va_start(args);
-#endif
- (void) PerlIO_vprintf(DBIc_DBISTATE(imp_xxh)->logfp, fmt, args);
- va_end(args);
- (void)imp_xxh;
- return 1;
-}
-
-static void
-close_trace_file(pTHX)
-{
- dMY_CXT;
- if (DBILOGFP == PerlIO_stderr() || DBILOGFP == PerlIO_stdout())
- return;
-
- if (DBIS->logfp_ref == NULL)
- PerlIO_close(DBILOGFP);
- else {
- /* DAA dec refcount and discard */
- SvREFCNT_dec(DBIS->logfp_ref);
- DBIS->logfp_ref = NULL;
- }
-}
-
-static int
-set_trace_file(SV *file)
-{
- dTHX;
- dMY_CXT;
- const char *filename;
- PerlIO *fp = Nullfp;
- IO *io;
-
- if (!file) /* no arg == no change */
- return 0;
-
- /* DAA check for a filehandle */
- if (SvROK(file)) {
- io = sv_2io(file);
- if (!io || !(fp = IoOFP(io))) {
- warn("DBI trace filehandle is not valid");
- return 0;
- }
- close_trace_file(aTHX);
- (void)SvREFCNT_inc(io);
- DBIS->logfp_ref = io;
- }
- else if (isGV_with_GP(file)) {
- io = GvIO(file);
- if (!io || !(fp = IoOFP(io))) {
- warn("DBI trace filehandle from GLOB is not valid");
- return 0;
- }
- close_trace_file(aTHX);
- (void)SvREFCNT_inc(io);
- DBIS->logfp_ref = io;
- }
- else {
- filename = (SvOK(file)) ? SvPV_nolen(file) : Nullch;
- /* undef arg == reset back to stderr */
- if (!filename || strEQ(filename,"STDERR")
- || strEQ(filename,"*main::STDERR")) {
- close_trace_file(aTHX);
- DBILOGFP = PerlIO_stderr();
- return 1;
- }
- if (strEQ(filename,"STDOUT")) {
- close_trace_file(aTHX);
- DBILOGFP = PerlIO_stdout();
- return 1;
- }
- fp = PerlIO_open(filename, "a+");
- if (fp == Nullfp) {
- warn("Can't open trace file %s: %s", filename, Strerror(errno));
- return 0;
- }
- close_trace_file(aTHX);
- }
- DBILOGFP = fp;
- /* if this line causes your compiler or linker to choke */
- /* then just comment it out, it's not essential. */
- PerlIO_setlinebuf(fp); /* force line buffered output */
- return 1;
-}
-
-static IV
-parse_trace_flags(SV *h, SV *level_sv, IV old_level)
-{
- dTHX;
- IV level;
- if (!level_sv || !SvOK(level_sv))
- level = old_level; /* undef: no change */
- else
- if (SvTRUE(level_sv)) {
- if (looks_like_number(level_sv))
- level = SvIV(level_sv); /* number: number */
- else { /* string: parse it */
- dSP;
- PUSHMARK(sp);
- XPUSHs(h);
- XPUSHs(level_sv);
- PUTBACK;
- if (call_method("parse_trace_flags", G_SCALAR) != 1)
- croak("panic: parse_trace_flags");/* should never happen */
- SPAGAIN;
- level = POPi;
- PUTBACK;
- }
- }
- else /* defined but false: 0 */
- level = 0;
- return level;
-}
-
-
-static int
-set_trace(SV *h, SV *level_sv, SV *file)
-{
- dTHX;
- D_imp_xxh(h);
- int RETVAL = DBIc_DBISTATE(imp_xxh)->debug; /* Return trace level in effect now */
- IV level = parse_trace_flags(h, level_sv, RETVAL);
- set_trace_file(file);
- if (level != RETVAL) { /* set value */
- if ((level & DBIc_TRACE_LEVEL_MASK) > 0) {
- PerlIO_printf(DBIc_LOGPIO(imp_xxh),
- " %s trace level set to 0x%lx/%ld (DBI @ 0x%lx/%ld) in DBI %s%s (pid %d)\n",
- neatsvpv(h,0),
- (long)(level & DBIc_TRACE_FLAGS_MASK),
- (long)(level & DBIc_TRACE_LEVEL_MASK),
- (long)DBIc_TRACE_FLAGS(imp_xxh), (long)DBIc_TRACE_LEVEL(imp_xxh),
- XS_VERSION, dbi_build_opt, (int)PerlProc_getpid());
- if (!PL_dowarn)
- PerlIO_printf(DBIc_LOGPIO(imp_xxh)," Note: perl is running without the recommended perl -w option\n");
- PerlIO_flush(DBIc_LOGPIO(imp_xxh));
- }
- sv_setiv(DBIc_DEBUG(imp_xxh), level);
- }
- return RETVAL;
-}
-
-
-static SV *
-dbih_inner(pTHX_ SV *orv, const char *what)
-{ /* convert outer to inner handle else croak(what) if what is not NULL */
- /* if what is NULL then return NULL for invalid handles */
- MAGIC *mg;
- SV *ohv; /* outer HV after derefing the RV */
- SV *hrv; /* dbi inner handle RV-to-HV */
-
- /* enable a raw HV (not ref-to-HV) to be passed in, eg DBIc_MY_H */
- ohv = SvROK(orv) ? SvRV(orv) : orv;
-
- if (!ohv || SvTYPE(ohv) != SVt_PVHV) {
- if (!what)
- return NULL;
- if (1) {
- dMY_CXT;
- if (DBIS_TRACE_LEVEL)
- sv_dump(orv);
- }
- if (!SvOK(orv))
- croak("%s given an undefined handle %s",
- what, "(perhaps returned from a previous call which failed)");
- croak("%s handle %s is not a DBI handle", what, neatsvpv(orv,0));
- }
- if (!SvMAGICAL(ohv)) {
- if (!what)
- return NULL;
- sv_dump(orv);
- croak("%s handle %s is not a DBI handle (has no magic)",
- what, neatsvpv(orv,0));
- }
-
- if ( (mg=mg_find(ohv,'P')) == NULL) { /* hash tie magic */
- /* not tied, maybe it's already an inner handle... */
- if (mg_find(ohv, DBI_MAGIC) == NULL) {
- if (!what)
- return NULL;
- sv_dump(orv);
- croak("%s handle %s is not a valid DBI handle",
- what, neatsvpv(orv,0));
- }
- hrv = orv; /* was already a DBI handle inner hash */
- }
- else {
- hrv = mg->mg_obj; /* inner hash of tie */
- }
-
- return hrv;
-}
-
-
-
-/* -------------------------------------------------------------------- */
-/* Functions to manage a DBI handle (magic and attributes etc). */
-
-static imp_xxh_t *
-dbih_getcom(SV *hrv) /* used by drivers via DBIS func ptr */
-{
- MAGIC *mg;
- SV *sv;
-
- /* short-cut common case */
- if ( SvROK(hrv)
- && (sv = SvRV(hrv))
- && SvRMAGICAL(sv)
- && (mg = SvMAGIC(sv))
- && mg->mg_type == DBI_MAGIC
- && mg->mg_ptr
- )
- return (imp_xxh_t *) mg->mg_ptr;
-
- {
- dTHX;
- imp_xxh_t *imp_xxh = dbih_getcom2(aTHX_ hrv, 0);
- if (!imp_xxh) /* eg after take_imp_data */
- croak("Invalid DBI handle %s, has no dbi_imp_data", neatsvpv(hrv,0));
- return imp_xxh;
- }
-}
-
-static imp_xxh_t *
-dbih_getcom2(pTHX_ SV *hrv, MAGIC **mgp) /* Get com struct for handle. Must be fast. */
-{
- MAGIC *mg;
- SV *sv;
-
- /* important and quick sanity check (esp non-'safe' Oraperl) */
- if (SvROK(hrv)) /* must at least be a ref */
- sv = SvRV(hrv);
- else {
- dMY_CXT;
- if (hrv == DBI_LAST_HANDLE) /* special for var::FETCH */
- sv = DBI_LAST_HANDLE;
- else if (sv_derived_from(hrv, "DBI::common")) {
- /* probably a class name, if ref($h)->foo() */
- return 0;
- }
- else {
- sv_dump(hrv);
- croak("Invalid DBI handle %s", neatsvpv(hrv,0));
- sv = &PL_sv_undef; /* avoid "might be used uninitialized" warning */
- }
- }
-
- /* Short cut for common case. We assume that a magic var always */
- /* has magic and that DBI_MAGIC, if present, will be the first. */
- if (SvRMAGICAL(sv) && (mg=SvMAGIC(sv))->mg_type == DBI_MAGIC) {
- /* nothing to do here */
- }
- else {
- /* Validate handle (convert outer to inner if required) */
- hrv = dbih_inner(aTHX_ hrv, "dbih_getcom");
- mg = mg_find(SvRV(hrv), DBI_MAGIC);
- }
- if (mgp) /* let caller pickup magic struct for this handle */
- *mgp = mg;
-
- if (!mg) /* may happen during global destruction */
- return (imp_xxh_t *) 0;
-
- return (imp_xxh_t *) mg->mg_ptr;
-}
-
-
-static SV *
-dbih_setup_attrib(pTHX_ SV *h, imp_xxh_t *imp_xxh, char *attrib, SV *parent, int read_only, int optional)
-{
- STRLEN len = strlen(attrib);
- SV **asvp;
-
- asvp = hv_fetch((HV*)SvRV(h), attrib, len, !optional);
- /* we assume that we won't have any existing 'undef' attributes here */
- /* (or, alternately, we take undef to mean 'copy from parent') */
- if (!(asvp && SvOK(*asvp))) { /* attribute doesn't already exists (the common case) */
- SV **psvp;
- if ((!parent || !SvROK(parent)) && !optional) {
- croak("dbih_setup_attrib(%s): %s not set and no parent supplied",
- neatsvpv(h,0), attrib);
- }
- psvp = hv_fetch((HV*)SvRV(parent), attrib, len, 0);
- if (psvp) {
- if (!asvp)
- asvp = hv_fetch((HV*)SvRV(h), attrib, len, 1);
- sv_setsv(*asvp, *psvp); /* copy attribute from parent to handle */
- }
- else {
- if (!optional)
- croak("dbih_setup_attrib(%s): %s not set and not in parent",
- neatsvpv(h,0), attrib);
- }
- }
- if (DBIc_TRACE_LEVEL(imp_xxh) >= 5) {
- PerlIO *logfp = DBIc_LOGPIO(imp_xxh);
- PerlIO_printf(logfp," dbih_setup_attrib(%s, %s, %s)",
- neatsvpv(h,0), attrib, neatsvpv(parent,0));
- if (!asvp)
- PerlIO_printf(logfp," undef (not defined)\n");
- else
- if (SvOK(*asvp))
- PerlIO_printf(logfp," %s (already defined)\n", neatsvpv(*asvp,0));
- else PerlIO_printf(logfp," %s (copied from parent)\n", neatsvpv(*asvp,0));
- }
- if (read_only && asvp)
- SvREADONLY_on(*asvp);
- return asvp ? *asvp : &PL_sv_undef;
-}
-
-
-static SV *
-dbih_make_fdsv(SV *sth, const char *imp_class, STRLEN imp_size, const char *col_name)
-{
- dTHX;
- D_imp_sth(sth);
- const STRLEN cn_len = strlen(col_name);
- imp_fdh_t *imp_fdh;
- SV *fdsv;
- if (imp_size < sizeof(imp_fdh_t) || cn_len<10 || strNE("::fd",&col_name[cn_len-4]))
- croak("panic: dbih_makefdsv %s '%s' imp_size %ld invalid",
- imp_class, col_name, (long)imp_size);
- if (DBIc_TRACE_LEVEL(imp_sth) >= 5)
- PerlIO_printf(DBIc_LOGPIO(imp_sth)," dbih_make_fdsv(%s, %s, %ld, '%s')\n",
- neatsvpv(sth,0), imp_class, (long)imp_size, col_name);
- fdsv = dbih_make_com(sth, (imp_xxh_t*)imp_sth, imp_class, imp_size, cn_len+2, 0);
- imp_fdh = (imp_fdh_t*)(void*)SvPVX(fdsv);
- imp_fdh->com.col_name = ((char*)imp_fdh) + imp_size;
- strcpy(imp_fdh->com.col_name, col_name);
- return fdsv;
-}
-
-
-static SV *
-dbih_make_com(SV *p_h, imp_xxh_t *p_imp_xxh, const char *imp_class, STRLEN imp_size, STRLEN extra, SV* imp_templ)
-{
- dTHX;
- static const char *errmsg = "Can't make DBI com handle for %s: %s";
- HV *imp_stash;
- SV *dbih_imp_sv;
- imp_xxh_t *imp;
- int trace_level;
- PERL_UNUSED_VAR(extra);
-
- if ( (imp_stash = gv_stashpv(imp_class, FALSE)) == NULL)
- croak(errmsg, imp_class, "unknown package");
-
- if (imp_size == 0) {
- /* get size of structure to allocate for common and imp specific data */
- const char *imp_size_name = mkvname(aTHX_ imp_stash, "imp_data_size", 0);
- imp_size = SvIV(get_sv(imp_size_name, 0x05));
- if (imp_size == 0) {
- imp_size = sizeof(imp_sth_t);
- if (sizeof(imp_dbh_t) > imp_size)
- imp_size = sizeof(imp_dbh_t);
- if (sizeof(imp_drh_t) > imp_size)
- imp_size = sizeof(imp_drh_t);
- imp_size += 4;
- }
- }
-
- if (p_imp_xxh) {
- trace_level = DBIc_TRACE_LEVEL(p_imp_xxh);
- }
- else {
- dMY_CXT;
- trace_level = DBIS_TRACE_LEVEL;
- }
- if (trace_level >= 5) {
- dMY_CXT;
- PerlIO_printf(DBILOGFP," dbih_make_com(%s, %p, %s, %ld, %p) thr#%p\n",
- neatsvpv(p_h,0), (void*)p_imp_xxh, imp_class, (long)imp_size, (void*)imp_templ, (void*)PERL_GET_THX);
- }
-
- if (imp_templ && SvOK(imp_templ)) {
- U32 imp_templ_flags;
- /* validate the supplied dbi_imp_data looks reasonable, */
- if (SvCUR(imp_templ) != imp_size)
- croak("Can't use dbi_imp_data of wrong size (%ld not %ld)",
- (long)SvCUR(imp_templ), (long)imp_size);
-
- /* copy the whole template */
- dbih_imp_sv = newSVsv(imp_templ);
- imp = (imp_xxh_t*)(void*)SvPVX(dbih_imp_sv);
-
- /* sanity checks on the supplied imp_data */
- if (DBIc_TYPE(imp) != ((p_imp_xxh) ? DBIc_TYPE(p_imp_xxh)+1 :1) )
- croak("Can't use dbi_imp_data from different type of handle");
- if (!DBIc_has(imp, DBIcf_IMPSET))
- croak("Can't use dbi_imp_data that not from a setup handle");
-
- /* copy flags, zero out our imp_xxh struct, restore some flags */
- imp_templ_flags = DBIc_FLAGS(imp);
- switch ( (p_imp_xxh) ? DBIc_TYPE(p_imp_xxh)+1 : DBIt_DR ) {
- case DBIt_DR: memzero((char*)imp, sizeof(imp_drh_t)); break;
- case DBIt_DB: memzero((char*)imp, sizeof(imp_dbh_t)); break;
- case DBIt_ST: memzero((char*)imp, sizeof(imp_sth_t)); break;
- default: croak("dbih_make_com dbi_imp_data bad h type");
- }
- /* Only pass on DBIcf_IMPSET to indicate to driver that the imp */
- /* structure has been copied and it doesn't need to reconnect. */
- /* Similarly DBIcf_ACTIVE is also passed along but isn't key. */
- DBIc_FLAGS(imp) = imp_templ_flags & (DBIcf_IMPSET|DBIcf_ACTIVE);
- }
- else {
- dbih_imp_sv = newSV(imp_size); /* is grown to at least imp_size+1 */
- imp = (imp_xxh_t*)(void*)SvPVX(dbih_imp_sv);
- memzero((char*)imp, imp_size);
- /* set up SV with SvCUR set ready for take_imp_data */
- SvCUR_set(dbih_imp_sv, imp_size);
- *SvEND(dbih_imp_sv) = '\0';
- }
-
- if (p_imp_xxh) {
- DBIc_DBISTATE(imp) = DBIc_DBISTATE(p_imp_xxh);
- }
- else {
- dMY_CXT;
- DBIc_DBISTATE(imp) = DBIS;
- }
- DBIc_IMP_STASH(imp) = imp_stash;
-
- if (!p_h) { /* only a driver (drh) has no parent */
- DBIc_PARENT_H(imp) = &PL_sv_undef;
- DBIc_PARENT_COM(imp) = NULL;
- DBIc_TYPE(imp) = DBIt_DR;
- DBIc_on(imp,DBIcf_WARN /* set only here, children inherit */
- |DBIcf_ACTIVE /* drivers are 'Active' by default */
- |DBIcf_AutoCommit /* advisory, driver must manage this */
- );
- DBIc_set(imp, DBIcf_PrintWarn, 1);
- }
- else {
- DBIc_PARENT_H(imp) = (SV*)SvREFCNT_inc(p_h); /* ensure it lives */
- DBIc_PARENT_COM(imp) = p_imp_xxh; /* shortcut for speed */
- DBIc_TYPE(imp) = DBIc_TYPE(p_imp_xxh) + 1;
- /* inherit some flags from parent and carry forward some from template */
- DBIc_FLAGS(imp) = (DBIc_FLAGS(p_imp_xxh) & ~DBIcf_INHERITMASK)
- | (DBIc_FLAGS(imp) & (DBIcf_IMPSET|DBIcf_ACTIVE));
- ++DBIc_KIDS(p_imp_xxh);
- }
-#ifdef DBI_USE_THREADS
- DBIc_THR_USER(imp) = PERL_GET_THX ;
-#endif
-
- if (DBIc_TYPE(imp) == DBIt_ST) {
- imp_sth_t *imp_sth = (imp_sth_t*)imp;
- DBIc_ROW_COUNT(imp_sth) = -1;
- }
-
- DBIc_COMSET_on(imp); /* common data now set up */
-
- /* The implementor should DBIc_IMPSET_on(imp) when setting up */
- /* any private data which will need clearing/freeing later. */
-
- return dbih_imp_sv;
-}
-
-
-static void
-dbih_setup_handle(pTHX_ SV *orv, char *imp_class, SV *parent, SV *imp_datasv)
-{
- SV *h;
- char *errmsg = "Can't setup DBI handle of %s to %s: %s";
- SV *dbih_imp_sv;
- SV *dbih_imp_rv;
- SV *dbi_imp_data = Nullsv;
- SV **svp;
- char imp_mem_name[300];
- HV *imp_mem_stash;
- imp_xxh_t *imp;
- imp_xxh_t *parent_imp;
- int trace_level;
-
- h = dbih_inner(aTHX_ orv, "dbih_setup_handle");
- parent = dbih_inner(aTHX_ parent, NULL); /* check parent valid (& inner) */
- if (parent) {
- parent_imp = DBIh_COM(parent);
- trace_level = DBIc_TRACE_LEVEL(parent_imp);
- }
- else {
- dMY_CXT;
- parent_imp = NULL;
- trace_level = DBIS_TRACE_LEVEL;
- }
-
- if (trace_level >= 5) {
- dMY_CXT;
- PerlIO_printf(DBILOGFP," dbih_setup_handle(%s=>%s, %s, %lx, %s)\n",
- neatsvpv(orv,0), neatsvpv(h,0), imp_class, (long)parent, neatsvpv(imp_datasv,0));
- }
-
- if (mg_find(SvRV(h), DBI_MAGIC) != NULL)
- croak(errmsg, neatsvpv(orv,0), imp_class, "already a DBI (or ~magic) handle");
-
- strcpy(imp_mem_name, imp_class);
- strcat(imp_mem_name, "_mem");
- if ( (imp_mem_stash = gv_stashpv(imp_mem_name, FALSE)) == NULL)
- croak(errmsg, neatsvpv(orv,0), imp_mem_name, "unknown _mem package");
-
- if ((svp = hv_fetch((HV*)SvRV(h), "dbi_imp_data", 12, 0))) {
- dbi_imp_data = *svp;
- if (SvGMAGICAL(dbi_imp_data)) /* call FETCH via magic */
- mg_get(dbi_imp_data);
- }
-
- DBI_LOCK;
-
- dbih_imp_sv = dbih_make_com(parent, parent_imp, imp_class, 0, 0, dbi_imp_data);
- imp = (imp_xxh_t*)(void*)SvPVX(dbih_imp_sv);
-
- dbih_imp_rv = newRV_inc(dbih_imp_sv); /* just needed for sv_bless */
- sv_bless(dbih_imp_rv, imp_mem_stash);
- sv_free(dbih_imp_rv);
-
- DBIc_MY_H(imp) = (HV*)SvRV(orv); /* take _copy_ of pointer, not new ref */
- DBIc_IMP_DATA(imp) = (imp_datasv) ? newSVsv(imp_datasv) : &PL_sv_undef;
- _imp2com(imp, std.pid) = (U32)PerlProc_getpid();
-
- if (DBIc_TYPE(imp) <= DBIt_ST) {
- SV **tmp_svp;
- /* Copy some attributes from parent if not defined locally and */
- /* also take address of attributes for speed of direct access. */
- /* parent is null for drh, in which case h must hold the values */
-#define COPY_PARENT(name,ro,opt) SvREFCNT_inc(dbih_setup_attrib(aTHX_ h,imp,(name),parent,ro,opt))
-#define DBIc_ATTR(imp, f) _imp2com(imp, attr.f)
- /* XXX we should validate that these are the right type (refs etc) */
- DBIc_ATTR(imp, Err) = COPY_PARENT("Err",1,0); /* scalar ref */
- DBIc_ATTR(imp, State) = COPY_PARENT("State",1,0); /* scalar ref */
- DBIc_ATTR(imp, Errstr) = COPY_PARENT("Errstr",1,0); /* scalar ref */
- DBIc_ATTR(imp, TraceLevel)=COPY_PARENT("TraceLevel",0,0);/* scalar (int)*/
- DBIc_ATTR(imp, FetchHashKeyName) = COPY_PARENT("FetchHashKeyName",0,0); /* scalar ref */
-
- if (parent) {
- dbih_setup_attrib(aTHX_ h,imp,"HandleSetErr",parent,0,1);
- dbih_setup_attrib(aTHX_ h,imp,"HandleError",parent,0,1);
- dbih_setup_attrib(aTHX_ h,imp,"ReadOnly",parent,0,1);
- dbih_setup_attrib(aTHX_ h,imp,"Profile",parent,0,1);
-
- /* setup Callbacks from parents' ChildCallbacks */
- if (DBIc_has(parent_imp, DBIcf_Callbacks)
- && (tmp_svp = hv_fetch((HV*)SvRV(parent), "Callbacks", 9, 0))
- && SvROK(*tmp_svp) && SvTYPE(SvRV(*tmp_svp)) == SVt_PVHV
- && (tmp_svp = hv_fetch((HV*)SvRV(*tmp_svp), "ChildCallbacks", 14, 0))
- && SvROK(*tmp_svp) && SvTYPE(SvRV(*tmp_svp)) == SVt_PVHV
- ) {
- /* XXX mirrors behaviour of dbih_set_attr_k() of Callbacks */
- (void)hv_store((HV*)SvRV(h), "Callbacks", 9, newRV_inc(SvRV(*tmp_svp)), 0);
- DBIc_set(imp, DBIcf_Callbacks, 1);
- }
-
- DBIc_LongReadLen(imp) = DBIc_LongReadLen(parent_imp);
-#ifdef sv_rvweaken
- if (1) {
- AV *av;
- /* add weakref to new (outer) handle into parents ChildHandles array */
- tmp_svp = hv_fetch((HV*)SvRV(parent), "ChildHandles", 12, 1);
- if (!SvROK(*tmp_svp)) {
- SV *ChildHandles_rvav = newRV_noinc((SV*)newAV());
- sv_setsv(*tmp_svp, ChildHandles_rvav);
- sv_free(ChildHandles_rvav);
- }
- av = (AV*)SvRV(*tmp_svp);
- av_push(av, (SV*)sv_rvweaken(newRV_inc((SV*)SvRV(orv))));
- if (av_len(av) % 120 == 0) {
- /* time to do some housekeeping to remove dead handles */
- I32 i = av_len(av); /* 0 = 1 element */
- while (i-- >= 0) {
- SV *sv = av_shift(av);
- if (SvOK(sv))
- av_push(av, sv);
- else
- sv_free(sv); /* keep it leak-free by Doru Petrescu pdoru.dbi@from.ro */
- }
- }
- }
-#endif
- }
- else {
- DBIc_LongReadLen(imp) = DBIc_LongReadLen_init;
- }
-
- switch (DBIc_TYPE(imp)) {
- case DBIt_DB:
- /* cache _inner_ handle, but also see quick_FETCH */
- (void)hv_store((HV*)SvRV(h), "Driver", 6, newRV_inc(SvRV(parent)), 0);
- (void)hv_fetch((HV*)SvRV(h), "Statement", 9, 1); /* store writable undef */
- break;
- case DBIt_ST:
- DBIc_NUM_FIELDS((imp_sth_t*)imp) = -1;
- /* cache _inner_ handle, but also see quick_FETCH */
- (void)hv_store((HV*)SvRV(h), "Database", 8, newRV_inc(SvRV(parent)), 0);
- /* copy (alias) Statement from the sth up into the dbh */
- tmp_svp = hv_fetch((HV*)SvRV(h), "Statement", 9, 1);
- (void)hv_store((HV*)SvRV(parent), "Statement", 9, SvREFCNT_inc(*tmp_svp), 0);
- break;
- }
- }
- else
- die("panic: invalid DBIc_TYPE");
-
- /* Use DBI magic on inner handle to carry handle attributes */
- /* Note that we store the imp_sv in mg_obj, but as a shortcut, */
- /* also store a direct pointer to imp, aka PVX(dbih_imp_sv), */
- /* in mg_ptr (with mg_len set to null, so it wont be freed) */
- sv_magic(SvRV(h), dbih_imp_sv, DBI_MAGIC, (char*)imp, 0);
- SvREFCNT_dec(dbih_imp_sv); /* since sv_magic() incremented it */
- SvRMAGICAL_on(SvRV(h)); /* so DBI magic gets sv_clear'd ok */
-
- {
- dMY_CXT; /* XXX would be nice to get rid of this */
- DBI_SET_LAST_HANDLE(h);
- }
-
- if (1) {
- /* This is a hack to work-around the fast but poor way old versions of
- * DBD::Oracle (and possibly other drivers) check for a valid handle
- * using (SvMAGIC(SvRV(h)))->mg_type == 'P'). That doesn't work now
- * because the weakref magic is inserted ahead of the tie magic.
- * So here we swap the tie and weakref magic so the tie comes first.
- */
- MAGIC *tie_mg = mg_find(SvRV(orv),'P');
- MAGIC *first = SvMAGIC(SvRV(orv));
- if (tie_mg && first->mg_moremagic == tie_mg && !tie_mg->mg_moremagic) {
- MAGIC *next = tie_mg->mg_moremagic;
- SvMAGIC(SvRV(orv)) = tie_mg;
- tie_mg->mg_moremagic = first;
- first->mg_moremagic = next;
- }
- }
-
- DBI_UNLOCK;
-}
-
-
-static void
-dbih_dumphandle(pTHX_ SV *h, const char *msg, int level)
-{
- D_imp_xxh(h);
- if (level >= 9) {
- sv_dump(h);
- }
- dbih_dumpcom(aTHX_ imp_xxh, msg, level);
-}
-
-static int
-dbih_dumpcom(pTHX_ imp_xxh_t *imp_xxh, const char *msg, int level)
-{
- dMY_CXT;
- SV *flags = sv_2mortal(newSVpv("",0));
- SV *inner;
- static const char pad[] = " ";
- if (!msg)
- msg = "dbih_dumpcom";
- PerlIO_printf(DBILOGFP," %s (%sh 0x%lx, com 0x%lx, imp %s):\n",
- msg, dbih_htype_name(DBIc_TYPE(imp_xxh)),
- (long)DBIc_MY_H(imp_xxh), (long)imp_xxh,
- (PL_dirty) ? "global destruction" : HvNAME(DBIc_IMP_STASH(imp_xxh)));
- if (DBIc_COMSET(imp_xxh)) sv_catpv(flags,"COMSET ");
- if (DBIc_IMPSET(imp_xxh)) sv_catpv(flags,"IMPSET ");
- if (DBIc_ACTIVE(imp_xxh)) sv_catpv(flags,"Active ");
- if (DBIc_WARN(imp_xxh)) sv_catpv(flags,"Warn ");
- if (DBIc_COMPAT(imp_xxh)) sv_catpv(flags,"CompatMode ");
- if (DBIc_is(imp_xxh, DBIcf_ChopBlanks)) sv_catpv(flags,"ChopBlanks ");
- if (DBIc_is(imp_xxh, DBIcf_HandleSetErr)) sv_catpv(flags,"HandleSetErr ");
- if (DBIc_is(imp_xxh, DBIcf_HandleError)) sv_catpv(flags,"HandleError ");
- if (DBIc_is(imp_xxh, DBIcf_RaiseError)) sv_catpv(flags,"RaiseError ");
- if (DBIc_is(imp_xxh, DBIcf_PrintError)) sv_catpv(flags,"PrintError ");
- if (DBIc_is(imp_xxh, DBIcf_PrintWarn)) sv_catpv(flags,"PrintWarn ");
- if (DBIc_is(imp_xxh, DBIcf_ShowErrorStatement)) sv_catpv(flags,"ShowErrorStatement ");
- if (DBIc_is(imp_xxh, DBIcf_AutoCommit)) sv_catpv(flags,"AutoCommit ");
- if (DBIc_is(imp_xxh, DBIcf_BegunWork)) sv_catpv(flags,"BegunWork ");
- if (DBIc_is(imp_xxh, DBIcf_LongTruncOk)) sv_catpv(flags,"LongTruncOk ");
- if (DBIc_is(imp_xxh, DBIcf_MultiThread)) sv_catpv(flags,"MultiThread ");
- if (DBIc_is(imp_xxh, DBIcf_TaintIn)) sv_catpv(flags,"TaintIn ");
- if (DBIc_is(imp_xxh, DBIcf_TaintOut)) sv_catpv(flags,"TaintOut ");
- if (DBIc_is(imp_xxh, DBIcf_Profile)) sv_catpv(flags,"Profile ");
- if (DBIc_is(imp_xxh, DBIcf_Callbacks)) sv_catpv(flags,"Callbacks ");
- PerlIO_printf(DBILOGFP,"%s FLAGS 0x%lx: %s\n", pad, (long)DBIc_FLAGS(imp_xxh), SvPV_nolen(flags));
- if (SvOK(DBIc_ERR(imp_xxh)))
- PerlIO_printf(DBILOGFP,"%s ERR %s\n", pad, neatsvpv((SV*)DBIc_ERR(imp_xxh),0));
- if (SvOK(DBIc_ERR(imp_xxh)))
- PerlIO_printf(DBILOGFP,"%s ERRSTR %s\n", pad, neatsvpv((SV*)DBIc_ERRSTR(imp_xxh),0));
- PerlIO_printf(DBILOGFP,"%s PARENT %s\n", pad, neatsvpv((SV*)DBIc_PARENT_H(imp_xxh),0));
- PerlIO_printf(DBILOGFP,"%s KIDS %ld (%ld Active)\n", pad,
- (long)DBIc_KIDS(imp_xxh), (long)DBIc_ACTIVE_KIDS(imp_xxh));
- if (DBIc_IMP_DATA(imp_xxh) && SvOK(DBIc_IMP_DATA(imp_xxh)))
- PerlIO_printf(DBILOGFP,"%s IMP_DATA %s\n", pad, neatsvpv(DBIc_IMP_DATA(imp_xxh),0));
- if (DBIc_LongReadLen(imp_xxh) != DBIc_LongReadLen_init)
- PerlIO_printf(DBILOGFP,"%s LongReadLen %ld\n", pad, (long)DBIc_LongReadLen(imp_xxh));
-
- if (DBIc_TYPE(imp_xxh) == DBIt_ST) {
- const imp_sth_t *imp_sth = (imp_sth_t*)imp_xxh;
- PerlIO_printf(DBILOGFP,"%s NUM_OF_FIELDS %d\n", pad, DBIc_NUM_FIELDS(imp_sth));
- PerlIO_printf(DBILOGFP,"%s NUM_OF_PARAMS %d\n", pad, DBIc_NUM_PARAMS(imp_sth));
- }
- inner = dbih_inner(aTHX_ (SV*)DBIc_MY_H(imp_xxh), msg);
- if (!inner || !SvROK(inner))
- return 1;
- if (DBIc_TYPE(imp_xxh) <= DBIt_DB) {
- SV **svp = hv_fetch((HV*)SvRV(inner), "CachedKids", 10, 0);
- if (svp && SvROK(*svp) && SvTYPE(SvRV(*svp)) == SVt_PVHV) {
- HV *hv = (HV*)SvRV(*svp);
- PerlIO_printf(DBILOGFP,"%s CachedKids %d\n", pad, (int)HvKEYS(hv));
- }
- }
- if (level > 0) {
- SV* value;
- char *key;
- I32 keylen;
- PerlIO_printf(DBILOGFP,"%s cached attributes:\n", pad);
- while ( (value = hv_iternextsv((HV*)SvRV(inner), &key, &keylen)) ) {
- PerlIO_printf(DBILOGFP,"%s '%s' => %s\n", pad, key, neatsvpv(value,0));
- }
- }
- else if (DBIc_TYPE(imp_xxh) == DBIt_DB) {
- SV **svp = hv_fetch((HV*)SvRV(inner), "Name", 4, 0);
- if (svp && SvOK(*svp))
- PerlIO_printf(DBILOGFP,"%s Name %s\n", pad, neatsvpv(*svp,0));
- }
- else if (DBIc_TYPE(imp_xxh) == DBIt_ST) {
- SV **svp = hv_fetch((HV*)SvRV(inner), "Statement", 9, 0);
- if (svp && SvOK(*svp))
- PerlIO_printf(DBILOGFP,"%s Statement %s\n", pad, neatsvpv(*svp,0));
- }
- return 1;
-}
-
-
-static void
-dbih_clearcom(imp_xxh_t *imp_xxh)
-{
- dTHX;
- dTHR;
- int dump = FALSE;
- int debug = DBIc_TRACE_LEVEL(imp_xxh);
- int auto_dump = (debug >= 6);
- imp_xxh_t * const parent_xxh = DBIc_PARENT_COM(imp_xxh);
- /* Note that we're very much on our own here. DBIc_MY_H(imp_xxh) almost */
- /* certainly points to memory which has been freed. Don't use it! */
-
- /* --- pre-clearing sanity checks --- */
-
-#ifdef DBI_USE_THREADS
- if (DBIc_THR_USER(imp_xxh) != my_perl) { /* don't clear handle that belongs to another thread */
- if (debug >= 3) {
- PerlIO_printf(DBIc_LOGPIO(imp_xxh)," skipped dbih_clearcom: DBI handle (type=%d, %s) is owned by thread %p not current thread %p\n",
- DBIc_TYPE(imp_xxh), HvNAME(DBIc_IMP_STASH(imp_xxh)), (void*)DBIc_THR_USER(imp_xxh), (void*)my_perl) ;
- PerlIO_flush(DBIc_LOGPIO(imp_xxh));
- }
- return;
- }
-#endif
-
- if (!DBIc_COMSET(imp_xxh)) { /* should never happen */
- dbih_dumpcom(aTHX_ imp_xxh, "dbih_clearcom: DBI handle already cleared", 0);
- return;
- }
-
- if (auto_dump)
- dbih_dumpcom(aTHX_ imp_xxh,"DESTROY (dbih_clearcom)", 0);
-
- if (!PL_dirty) {
-
- if (DBIc_ACTIVE(imp_xxh)) { /* bad news, potentially */
- /* warn for sth, warn for dbh only if it has active sth or isn't AutoCommit */
- if (DBIc_TYPE(imp_xxh) >= DBIt_ST
- || (DBIc_ACTIVE_KIDS(imp_xxh) || !DBIc_has(imp_xxh, DBIcf_AutoCommit))
- ) {
- warn("DBI %s handle 0x%lx cleared whilst still active",
- dbih_htype_name(DBIc_TYPE(imp_xxh)), (unsigned long)DBIc_MY_H(imp_xxh));
- dump = TRUE;
- }
- }
-
- /* check that the implementor has done its own housekeeping */
- if (DBIc_IMPSET(imp_xxh)) {
- warn("DBI %s handle 0x%lx has uncleared implementors data",
- dbih_htype_name(DBIc_TYPE(imp_xxh)), (unsigned long)DBIc_MY_H(imp_xxh));
- dump = TRUE;
- }
-
- if (DBIc_KIDS(imp_xxh)) {
- warn("DBI %s handle 0x%lx has %d uncleared child handles",
- dbih_htype_name(DBIc_TYPE(imp_xxh)),
- (unsigned long)DBIc_MY_H(imp_xxh), (int)DBIc_KIDS(imp_xxh));
- dump = TRUE;
- }
- }
-
- if (dump && !auto_dump) /* else was already dumped above */
- dbih_dumpcom(aTHX_ imp_xxh, "dbih_clearcom", 0);
-
- /* --- pre-clearing adjustments --- */
-
- if (!PL_dirty) {
- if (parent_xxh) {
- if (DBIc_ACTIVE(imp_xxh)) /* see also DBIc_ACTIVE_off */
- --DBIc_ACTIVE_KIDS(parent_xxh);
- --DBIc_KIDS(parent_xxh);
- }
- }
-
- /* --- clear fields (may invoke object destructors) --- */
-
- if (DBIc_TYPE(imp_xxh) == DBIt_ST) {
- imp_sth_t *imp_sth = (imp_sth_t*)imp_xxh;
- sv_free((SV*)DBIc_FIELDS_AV(imp_sth));
- }
-
- sv_free(DBIc_IMP_DATA(imp_xxh)); /* do this first */
- if (DBIc_TYPE(imp_xxh) <= DBIt_ST) { /* DBIt_FD doesn't have attr */
- sv_free(_imp2com(imp_xxh, attr.TraceLevel));
- sv_free(_imp2com(imp_xxh, attr.State));
- sv_free(_imp2com(imp_xxh, attr.Err));
- sv_free(_imp2com(imp_xxh, attr.Errstr));
- sv_free(_imp2com(imp_xxh, attr.FetchHashKeyName));
- }
-
-
- sv_free((SV*)DBIc_PARENT_H(imp_xxh)); /* do this last */
-
- DBIc_COMSET_off(imp_xxh);
-
- if (debug >= 4)
- PerlIO_printf(DBIc_LOGPIO(imp_xxh)," dbih_clearcom 0x%lx (com 0x%lx, type %d) done.\n\n",
- (long)DBIc_MY_H(imp_xxh), (long)imp_xxh, DBIc_TYPE(imp_xxh));
-}
-
-
-/* --- Functions for handling field buffer arrays --- */
-
-static AV *
-dbih_setup_fbav(imp_sth_t *imp_sth)
-{
- /* Usually called to setup the row buffer for new sth.
- * Also called if the value of NUM_OF_FIELDS is altered,
- * in which case it adjusts the row buffer to match NUM_OF_FIELDS.
- */
- dTHX;
- I32 i = DBIc_NUM_FIELDS(imp_sth);
- AV *av = DBIc_FIELDS_AV(imp_sth);
-
- if (i < 0)
- i = 0;
-
- if (av) {
- if (av_len(av)+1 == i) /* is existing array the right size? */
- return av;
- /* we need to adjust the size of the array */
- if (DBIc_TRACE_LEVEL(imp_sth) >= 2)
- PerlIO_printf(DBIc_LOGPIO(imp_sth)," dbih_setup_fbav realloc from %ld to %ld fields\n", (long)(av_len(av)+1), (long)i);
- SvREADONLY_off(av);
- if (i < av_len(av)+1) /* trim to size if too big */
- av_fill(av, i-1);
- }
- else {
- if (DBIc_TRACE_LEVEL(imp_sth) >= 5)
- PerlIO_printf(DBIc_LOGPIO(imp_sth)," dbih_setup_fbav alloc for %ld fields\n", (long)i);
- av = newAV();
- DBIc_FIELDS_AV(imp_sth) = av;
-
- /* row_count will need to be manually reset by the driver if the */
- /* sth is re-executed (since this code won't get rerun) */
- DBIc_ROW_COUNT(imp_sth) = 0;
- }
-
- /* load array with writeable SV's. Do this backwards so */
- /* the array only gets extended once. */
- while(i--) /* field 1 stored at index 0 */
- av_store(av, i, newSV(0));
- if (DBIc_TRACE_LEVEL(imp_sth) >= 6)
- PerlIO_printf(DBIc_LOGPIO(imp_sth)," dbih_setup_fbav now %ld fields\n", (long)(av_len(av)+1));
- SvREADONLY_on(av); /* protect against shift @$row etc */
- return av;
-}
-
-
-static AV *
-dbih_get_fbav(imp_sth_t *imp_sth)
-{
- AV *av;
-
- if ( (av = DBIc_FIELDS_AV(imp_sth)) == Nullav) {
- av = dbih_setup_fbav(imp_sth);
- }
- else {
- dTHX;
- int i = av_len(av) + 1;
- if (i != DBIc_NUM_FIELDS(imp_sth)) {
- /*SV *sth = dbih_inner(aTHX_ (SV*)DBIc_MY_H(imp_sth), "_get_fbav");*/
- /* warn via PrintWarn */
- set_err_char(SvRV(DBIc_MY_H(imp_sth)), (imp_xxh_t*)imp_sth,
- "0", 0, "Number of row fields inconsistent with NUM_OF_FIELDS (driver bug)", "", "_get_fbav");
- /*
- DBIc_NUM_FIELDS(imp_sth) = i;
- hv_delete((HV*)SvRV(sth), "NUM_OF_FIELDS", 13, G_DISCARD);
- */
- }
- /* don't let SvUTF8 flag persist from one row to the next */
- /* (only affects drivers that use sv_setpv, but most XS do) */
- /* XXX turn into option later (force on/force off/ignore) */
- while(i--) /* field 1 stored at index 0 */
- SvUTF8_off(AvARRAY(av)[i]);
- }
-
- if (DBIc_is(imp_sth, DBIcf_TaintOut)) {
- dTHX;
- dTHR;
- TAINT; /* affects sv_setsv()'s called within same perl statement */
- }
-
- /* XXX fancy stuff to happen here later (re scrolling etc) */
- ++DBIc_ROW_COUNT(imp_sth);
- return av;
-}
-
-
-static int
-dbih_sth_bind_col(SV *sth, SV *col, SV *ref, SV *attribs)
-{
- dTHX;
- D_imp_sth(sth);
- AV *av;
- int idx = SvIV(col);
- int fields = DBIc_NUM_FIELDS(imp_sth);
-
- if (fields <= 0) {
- PERL_UNUSED_VAR(attribs);
- croak("Statement has no result columns to bind%s",
- DBIc_ACTIVE(imp_sth)
- ? "" : " (perhaps you need to successfully call execute first, or again)");
- }
-
- if ( (av = DBIc_FIELDS_AV(imp_sth)) == Nullav)
- av = dbih_setup_fbav(imp_sth);
-
- if (DBIc_TRACE_LEVEL(imp_sth) >= 5)
- PerlIO_printf(DBIc_LOGPIO(imp_sth)," dbih_sth_bind_col %s => %s %s\n",
- neatsvpv(col,0), neatsvpv(ref,0), neatsvpv(attribs,0));
-
- if (idx < 1 || idx > fields)
- croak("bind_col: column %d is not a valid column (1..%d)",
- idx, fields);
-
- if (!SvOK(ref) && SvREADONLY(ref)) { /* binding to literal undef */
- /* presumably the call is just setting the TYPE or other atribs */
- /* but this default method ignores attribs, so we just return */
- return 1;
- }
-
- /* Write this as > SVt_PVMG because in 5.8.x the next type */
- /* is SVt_PVBM, whereas in 5.9.x it's SVt_PVGV. */
- if (!SvROK(ref) || SvTYPE(SvRV(ref)) > SVt_PVMG) /* XXX LV */
- croak("Can't %s->bind_col(%s, %s,...), need a reference to a scalar",
- neatsvpv(sth,0), neatsvpv(col,0), neatsvpv(ref,0));
-
- /* use supplied scalar as storage for this column */
- SvREADONLY_off(av);
- av_store(av, idx-1, SvREFCNT_inc(SvRV(ref)) );
- SvREADONLY_on(av);
- return 1;
-}
-
-
-static int
-quote_type(int sql_type, int p, int s, int *t, void *v)
-{
- /* Returns true if type should be bound as a number else */
- /* false implying that binding as a string should be okay. */
- /* The true value is either SQL_INTEGER or SQL_DOUBLE which */
- /* can be used as a hint if desired. */
- (void)p;
- (void)s;
- (void)t;
- (void)v;
- /* looks like it's never been used, and doesn't make much sense anyway */
- warn("Use of DBI internal bind_as_num/quote_type function is deprecated");
- switch(sql_type) {
- case SQL_INTEGER:
- case SQL_SMALLINT:
- case SQL_TINYINT:
- case SQL_BIGINT:
- return 0;
- case SQL_FLOAT:
- case SQL_REAL:
- case SQL_DOUBLE:
- return 0;
- case SQL_NUMERIC:
- case SQL_DECIMAL:
- return 0; /* bind as string to attempt to retain precision */
- }
- return 1;
-}
-
-
-/* Convert a simple string representation of a value into a more specific
- * perl type based on an sql_type value.
- * The semantics of SQL standard TYPE values are interpreted _very_ loosely
- * on the basis of "be liberal in what you accept and let's throw in some
- * extra semantics while we're here" :)
- * Returns:
- * -2: sql_type isn't handled, value unchanged
- * -1: sv is undef, value unchanged
- * 0: sv couldn't be cast cleanly and DBIstcf_STRICT was used
- * 1: sv couldn't be cast cleanly and DBIstcf_STRICT was not used
- * 2: sv was cast ok
- */
-
-int
-sql_type_cast_svpv(pTHX_ SV *sv, int sql_type, U32 flags, void *v)
-{
- int cast_ok = 0;
- int grok_flags;
- UV uv;
-
- /* do nothing for undef (NULL) or non-string values */
- if (!sv || !SvOK(sv))
- return -1;
-
- switch(sql_type) {
-
- default:
- return -2; /* not a recognised SQL TYPE, value unchanged */
-
- case SQL_INTEGER:
- /* sv_2iv is liberal, may return SvIV, SvUV, or SvNV */
- sv_2iv(sv);
- /* SvNOK will be set if value is out of range for IV/UV.
- * SvIOK should be set but won't if sv is not numeric (in which
- * case perl would have warn'd already if -w or warnings are in effect)
- */
- cast_ok = (SvIOK(sv) && !SvNOK(sv));
- break;
-
- case SQL_DOUBLE:
- sv_2nv(sv);
- /* SvNOK should be set but won't if sv is not numeric (in which
- * case perl would have warn'd already if -w or warnings are in effect)
- */
- cast_ok = SvNOK(sv);
- break;
-
- /* caller would like IV else UV else NV */
- /* else no error and sv is untouched */
- case SQL_NUMERIC:
- /* based on the code in perl's toke.c */
- uv = 0;
- grok_flags = grok_number(SvPVX(sv), SvCUR(sv), &uv);
- cast_ok = 1;
- if (grok_flags == IS_NUMBER_IN_UV) { /* +ve int */
- if (uv <= IV_MAX) /* prefer IV over UV */
- sv_2iv(sv);
- else sv_2uv(sv);
- }
- else if (grok_flags == (IS_NUMBER_IN_UV | IS_NUMBER_NEG)
- && uv <= IV_MAX
- ) {
- sv_2iv(sv);
- }
- else if (grok_flags) { /* is numeric */
- sv_2nv(sv);
- }
- else
- cast_ok = 0;
- break;
-
-#if 0 /* XXX future possibilities */
- case SQL_BIGINT: /* use Math::BigInt if too large for IV/UV */
-#endif
- }
-
- if (cast_ok) {
-
- if (flags & DBIstcf_DISCARD_STRING
- && SvNIOK(sv) /* we set a numeric value */
- && SvPVX(sv) /* we have a buffer to discard */
- ) {
- SvOOK_off(sv);
- sv_force_normal(sv);
- if (SvLEN(sv))
- Safefree(SvPVX(sv));
- SvPOK_off(sv);
- SvPV_set(sv, NULL);
- SvLEN_set(sv, 0);
- SvCUR_set(sv, 0);
- }
- }
-
- if (cast_ok)
- return 2;
- else if (flags & DBIstcf_STRICT)
- return 0;
- else return 1;
-}
-
-
-
-/* --- Generic Handle Attributes (for all handle types) --- */
-
-static int
-dbih_set_attr_k(SV *h, SV *keysv, int dbikey, SV *valuesv)
-{
- dTHX;
- dTHR;
- D_imp_xxh(h);
- STRLEN keylen;
- const char *key = SvPV(keysv, keylen);
- const int htype = DBIc_TYPE(imp_xxh);
- int on = (SvTRUE(valuesv));
- int internal = 1; /* DBIh_IN_PERL_DBD(imp_xxh); -- for DBD's in perl */
- int cacheit = 0;
- int weakenit = 0; /* eg for CachedKids ref */
- (void)dbikey;
-
- if (DBIc_TRACE_LEVEL(imp_xxh) >= 3)
- PerlIO_printf(DBIc_LOGPIO(imp_xxh)," STORE %s %s => %s\n",
- neatsvpv(h,0), neatsvpv(keysv,0), neatsvpv(valuesv,0));
-
- if (internal && strEQ(key, "Active")) {
- if (on) {
- D_imp_sth(h);
- DBIc_ACTIVE_on(imp_xxh);
- /* for pure-perl drivers on second and subsequent */
- /* execute()'s, else row count keeps rising. */
- if (htype==DBIt_ST && DBIc_FIELDS_AV(imp_sth))
- DBIc_ROW_COUNT(imp_sth) = 0;
- }
- else {
- DBIc_ACTIVE_off(imp_xxh);
- }
- }
- else if (strEQ(key, "FetchHashKeyName")) {
- if (htype >= DBIt_ST)
- croak("Can't set FetchHashKeyName for a statement handle, set in parent before prepare()");
- cacheit = 1; /* just save it */
- }
- else if (strEQ(key, "CompatMode")) {
- (on) ? DBIc_COMPAT_on(imp_xxh) : DBIc_COMPAT_off(imp_xxh);
- }
- else if (strEQ(key, "Warn")) {
- (on) ? DBIc_WARN_on(imp_xxh) : DBIc_WARN_off(imp_xxh);
- }
- else if (strEQ(key, "AutoInactiveDestroy")) {
- (on) ? DBIc_AIADESTROY_on(imp_xxh) : DBIc_AIADESTROY_off(imp_xxh);
- }
- else if (strEQ(key, "InactiveDestroy")) {
- (on) ? DBIc_IADESTROY_on(imp_xxh) : DBIc_IADESTROY_off(imp_xxh);
- }
- else if (strEQ(key, "RootClass")) {
- cacheit = 1; /* just save it */
- }
- else if (strEQ(key, "RowCacheSize")) {
- cacheit = 0; /* ignore it */
- }
- else if (strEQ(key, "Executed")) {
- DBIc_set(imp_xxh, DBIcf_Executed, on);
- }
- else if (strEQ(key, "ChopBlanks")) {
- DBIc_set(imp_xxh, DBIcf_ChopBlanks, on);
- }
- else if (strEQ(key, "ErrCount")) {
- DBIc_ErrCount(imp_xxh) = SvUV(valuesv);
- }
- else if (strEQ(key, "LongReadLen")) {
- if (SvNV(valuesv) < 0 || SvNV(valuesv) > MAX_LongReadLen)
- croak("Can't set LongReadLen < 0 or > %ld",MAX_LongReadLen);
- DBIc_LongReadLen(imp_xxh) = SvIV(valuesv);
- cacheit = 1; /* save it for clone */
- }
- else if (strEQ(key, "LongTruncOk")) {
- DBIc_set(imp_xxh,DBIcf_LongTruncOk, on);
- }
- else if (strEQ(key, "RaiseError")) {
- DBIc_set(imp_xxh,DBIcf_RaiseError, on);
- }
- else if (strEQ(key, "PrintError")) {
- DBIc_set(imp_xxh,DBIcf_PrintError, on);
- }
- else if (strEQ(key, "PrintWarn")) {
- DBIc_set(imp_xxh,DBIcf_PrintWarn, on);
- }
- else if (strEQ(key, "HandleError")) {
- if ( on && (!SvROK(valuesv) || (SvTYPE(SvRV(valuesv)) != SVt_PVCV)) ) {
- croak("Can't set %s to '%s'", "HandleError", neatsvpv(valuesv,0));
- }
- DBIc_set(imp_xxh,DBIcf_HandleError, on);
- cacheit = 1; /* child copy setup by dbih_setup_handle() */
- }
- else if (strEQ(key, "HandleSetErr")) {
- if ( on && (!SvROK(valuesv) || (SvTYPE(SvRV(valuesv)) != SVt_PVCV)) ) {
- croak("Can't set %s to '%s'","HandleSetErr",neatsvpv(valuesv,0));
- }
- DBIc_set(imp_xxh,DBIcf_HandleSetErr, on);
- cacheit = 1; /* child copy setup by dbih_setup_handle() */
- }
- else if (strEQ(key, "ChildHandles")) {
- if ( on && (!SvROK(valuesv) || (SvTYPE(SvRV(valuesv)) != SVt_PVAV)) ) {
- croak("Can't set %s to '%s'", "ChildHandles", neatsvpv(valuesv,0));
- }
- cacheit = 1; /* just save it in the hash */
- }
- else if (strEQ(key, "Profile")) {
- static const char profile_class[] = "DBI::Profile";
- if (on && (!SvROK(valuesv) || (SvTYPE(SvRV(valuesv)) != SVt_PVHV)) ) {
- /* not a hash ref so use DBI::Profile to work out what to do */
- dTHR;
- dSP;
- I32 returns;
- TAINT_NOT; /* the require is presumed innocent till proven guilty */
- perl_require_pv("DBI/Profile.pm");
- if (SvTRUE(ERRSV)) {
- warn("Can't load %s: %s", profile_class, SvPV_nolen(ERRSV));
- valuesv = &PL_sv_undef;
- }
- else {
- PUSHMARK(SP);
- XPUSHs(sv_2mortal(newSVpv(profile_class,0)));
- XPUSHs(valuesv);
- PUTBACK;
- returns = call_method("_auto_new", G_SCALAR);
- if (returns != 1)
- croak("%s _auto_new", profile_class);
- SPAGAIN;
- valuesv = POPs;
- PUTBACK;
- }
- on = SvTRUE(valuesv); /* in case it returns undef */
- }
- if (on && !sv_isobject(valuesv)) {
- /* not blessed already - so default to DBI::Profile */
- HV *stash;
- perl_require_pv(profile_class);
- stash = gv_stashpv(profile_class, GV_ADDWARN);
- sv_bless(valuesv, stash);
- }
- DBIc_set(imp_xxh,DBIcf_Profile, on);
- cacheit = 1; /* child copy setup by dbih_setup_handle() */
- }
- else if (strEQ(key, "ShowErrorStatement")) {
- DBIc_set(imp_xxh,DBIcf_ShowErrorStatement, on);
- }
- else if (strEQ(key, "MultiThread") && internal) {
- /* here to allow pure-perl drivers to set MultiThread */
- DBIc_set(imp_xxh,DBIcf_MultiThread, on);
- if (on && DBIc_WARN(imp_xxh)) {
- warn("MultiThread support not yet implemented in DBI");
- }
- }
- else if (strEQ(key, "Taint")) {
- /* 'Taint' is a shortcut for both in and out mode */
- DBIc_set(imp_xxh,DBIcf_TaintIn|DBIcf_TaintOut, on);
- }
- else if (strEQ(key, "TaintIn")) {
- DBIc_set(imp_xxh,DBIcf_TaintIn, on);
- }
- else if (strEQ(key, "TaintOut")) {
- DBIc_set(imp_xxh,DBIcf_TaintOut, on);
- }
- else if (htype<=DBIt_DB && keylen==10 && strEQ(key, "CachedKids")
- /* only allow hash refs */
- && SvROK(valuesv) && SvTYPE(SvRV(valuesv))==SVt_PVHV
- ) {
- cacheit = 1;
- weakenit = 1;
- }
- else if (keylen==9 && strEQ(key, "Callbacks")) {
- if ( on && (!SvROK(valuesv) || (SvTYPE(SvRV(valuesv)) != SVt_PVHV)) )
- croak("Can't set Callbacks to '%s'",neatsvpv(valuesv,0));
- /* see also dbih_setup_handle for ChildCallbacks handling */
- DBIc_set(imp_xxh, DBIcf_Callbacks, on);
- cacheit = 1;
- }
- else if (htype<=DBIt_DB && keylen==10 && strEQ(key, "AutoCommit")) {
- /* driver should have intercepted this and either handled it */
- /* or set valuesv to either the 'magic' on or off value. */
- if (SvIV(valuesv) != -900 && SvIV(valuesv) != -901)
- croak("DBD driver has not implemented the AutoCommit attribute");
- DBIc_set(imp_xxh,DBIcf_AutoCommit, (SvIV(valuesv)==-901));
- }
- else if (htype==DBIt_DB && keylen==9 && strEQ(key, "BegunWork")) {
- DBIc_set(imp_xxh,DBIcf_BegunWork, on);
- }
- else if (keylen==10 && strEQ(key, "TraceLevel")) {
- set_trace(h, valuesv, Nullsv);
- }
- else if (keylen==9 && strEQ(key, "TraceFile")) { /* XXX undocumented and readonly */
- set_trace_file(valuesv);
- }
- else if (htype==DBIt_ST && strEQ(key, "NUM_OF_FIELDS")) {
- D_imp_sth(h);
- int new_num_fields = (SvOK(valuesv)) ? SvIV(valuesv) : -1;
- DBIc_NUM_FIELDS(imp_sth) = new_num_fields;
- if (DBIc_FIELDS_AV(imp_sth)) { /* modify existing fbav */
- dbih_setup_fbav(imp_sth);
- }
- cacheit = 1;
- }
- else if (htype==DBIt_ST && strEQ(key, "NUM_OF_PARAMS")) {
- D_imp_sth(h);
- DBIc_NUM_PARAMS(imp_sth) = SvIV(valuesv);
- cacheit = 1;
- }
- /* these are here due to clone() needing to set attribs through a public api */
- else if (htype<=DBIt_DB && (strEQ(key, "Name")
- || strEQ(key,"ImplementorClass")
- || strEQ(key,"ReadOnly")
- || strEQ(key,"Statement")
- || strEQ(key,"Username")
- /* these are here for backwards histerical raisons */
- || strEQ(key,"USER") || strEQ(key,"CURRENT_USER")
- ) ) {
- cacheit = 1;
- }
- /* deal with: NAME_(uc|lc), NAME_hash, NAME_(uc|lc)_hash */
- else if ((keylen==7 || keylen==9 || keylen==12)
- && strnEQ(key, "NAME_", 5)
- && ( (keylen==9 && strEQ(key, "NAME_hash"))
- || ((key[5]=='u' || key[5]=='l') && key[6] == 'c'
- && (!key[7] || strnEQ(&key[7], "_hash", 5)))
- )
- ) {
- cacheit = 1;
- }
- else { /* XXX should really be an event ? */
- if (isUPPER(*key)) {
- char *msg = "Can't set %s->{%s}: unrecognised attribute name or invalid value%s";
- char *hint = "";
- if (strEQ(key, "NUM_FIELDS"))
- hint = ", perhaps you meant NUM_OF_FIELDS";
- warn(msg, neatsvpv(h,0), key, hint);
- return FALSE; /* don't store it */
- }
- /* Allow private_* attributes to be stored in the cache. */
- /* This is designed to make life easier for people subclassing */
- /* the DBI classes and may be of use to simple perl DBD's. */
- if (strnNE(key,"private_",8) && strnNE(key,"dbd_",4) && strnNE(key,"dbi_",4)) {
- if (DBIc_TRACE_LEVEL(imp_xxh)) { /* change to DBIc_WARN(imp_xxh) once we can validate prefix against registry */
- PerlIO_printf(DBIc_LOGPIO(imp_xxh),"$h->{%s}=%s ignored for invalid driver-specific attribute\n",
- neatsvpv(keysv,0), neatsvpv(valuesv,0));
- }
- return FALSE;
- }
- cacheit = 1;
- }
- if (cacheit) {
- SV *sv_for_cache = newSVsv(valuesv);
- (void)hv_store((HV*)SvRV(h), key, keylen, sv_for_cache, 0);
- if (weakenit) {
-#ifdef sv_rvweaken
- sv_rvweaken(sv_for_cache);
-#endif
- }
- }
- return TRUE;
-}
-
-
-static SV *
-dbih_get_attr_k(SV *h, SV *keysv, int dbikey)
-{
- dTHX;
- dTHR;
- D_imp_xxh(h);
- STRLEN keylen;
- char *key = SvPV(keysv, keylen);
- int htype = DBIc_TYPE(imp_xxh);
- SV *valuesv = Nullsv;
- int cacheit = FALSE;
- char *p;
- int i;
- SV *sv;
- SV **svp;
- (void)dbikey;
-
- /* DBI quick_FETCH will service some requests (e.g., cached values) */
-
- if (htype == DBIt_ST) {
- switch (*key) {
-
- case 'D':
- if (keylen==8 && strEQ(key, "Database")) {
- D_imp_from_child(imp_dbh, imp_dbh_t, imp_xxh);
- valuesv = newRV_inc((SV*)DBIc_MY_H(imp_dbh));
- cacheit = FALSE; /* else creates ref loop */
- }
- break;
-
- case 'N':
- if (keylen==8 && strEQ(key, "NULLABLE")) {
- valuesv = &PL_sv_undef;
- break;
- }
-
- if (keylen==4 && strEQ(key, "NAME")) {
- valuesv = &PL_sv_undef;
- break;
- }
-
- /* deal with: NAME_(uc|lc), NAME_hash, NAME_(uc|lc)_hash */
- if ((keylen==7 || keylen==9 || keylen==12)
- && strnEQ(key, "NAME_", 5)
- && ( (keylen==9 && strEQ(key, "NAME_hash"))
- || ((key[5]=='u' || key[5]=='l') && key[6] == 'c'
- && (!key[7] || strnEQ(&key[7], "_hash", 5)))
- )
- ) {
- D_imp_sth(h);
- valuesv = &PL_sv_undef;
-
- /* fetch from tied outer handle to trigger FETCH magic */
- svp = hv_fetch((HV*)DBIc_MY_H(imp_sth), "NAME",4, FALSE);
- sv = (svp) ? *svp : &PL_sv_undef;
- if (SvGMAGICAL(sv)) /* call FETCH via magic */
- mg_get(sv);
-
- if (SvROK(sv)) {
- AV *name_av = (AV*)SvRV(sv);
- char *name;
- int upcase = (key[5] == 'u');
- AV *av = Nullav;
- HV *hv = Nullhv;
- int num_fields_mismatch = 0;
-
- if (strEQ(&key[strlen(key)-5], "_hash"))
- hv = newHV();
- else av = newAV();
- i = DBIc_NUM_FIELDS(imp_sth);
-
- /* catch invalid NUM_FIELDS */
- if (i != AvFILL(name_av)+1) {
- /* flag as mismatch, except for "-1 and empty" case */
- if ( ! (i == -1 && 0 == AvFILL(name_av)+1) )
- num_fields_mismatch = 1;
- i = AvFILL(name_av)+1; /* limit for safe iteration over array */
- }
-
- if (DBIc_TRACE_LEVEL(imp_sth) >= 10 || (num_fields_mismatch && DBIc_WARN(imp_xxh))) {
- PerlIO_printf(DBIc_LOGPIO(imp_sth)," FETCH $h->{%s} from $h->{NAME} with $h->{NUM_OF_FIELDS} = %d"
- " and %ld entries in $h->{NAME}%s\n",
- neatsvpv(keysv,0), DBIc_NUM_FIELDS(imp_sth), AvFILL(name_av)+1,
- (num_fields_mismatch) ? " (possible bug in driver)" : "");
- }
-
- while (--i >= 0) {
- sv = newSVsv(AvARRAY(name_av)[i]);
- name = SvPV_nolen(sv);
- if (key[5] != 'h') { /* "NAME_hash" */
- for (p = name; p && *p; ++p) {
-#ifdef toUPPER_LC
- *p = (upcase) ? toUPPER_LC(*p) : toLOWER_LC(*p);
-#else
- *p = (upcase) ? toUPPER(*p) : toLOWER(*p);
-#endif
- }
- }
- if (av)
- av_store(av, i, sv);
- else {
- (void)hv_store(hv, name, SvCUR(sv), newSViv(i), 0);
- sv_free(sv);
- }
- }
- valuesv = newRV_noinc( (av ? (SV*)av : (SV*)hv) );
- cacheit = TRUE; /* can't change */
- }
- }
- else if (keylen==13 && strEQ(key, "NUM_OF_FIELDS")) {
- D_imp_sth(h);
- IV num_fields = DBIc_NUM_FIELDS(imp_sth);
- valuesv = (num_fields < 0) ? &PL_sv_undef : newSViv(num_fields);
- if (num_fields > 0)
- cacheit = TRUE; /* can't change once set (XXX except for multiple result sets) */
- }
- else if (keylen==13 && strEQ(key, "NUM_OF_PARAMS")) {
- D_imp_sth(h);
- valuesv = newSViv(DBIc_NUM_PARAMS(imp_sth));
- cacheit = TRUE; /* can't change */
- }
- break;
-
- case 'P':
- if (strEQ(key, "PRECISION"))
- valuesv = &PL_sv_undef;
- else if (strEQ(key, "ParamValues"))
- valuesv = &PL_sv_undef;
- else if (strEQ(key, "ParamTypes"))
- valuesv = &PL_sv_undef;
- break;
-
- case 'R':
- if (strEQ(key, "RowsInCache"))
- valuesv = &PL_sv_undef;
- break;
-
- case 'S':
- if (strEQ(key, "SCALE"))
- valuesv = &PL_sv_undef;
- break;
-
- case 'T':
- if (strEQ(key, "TYPE"))
- valuesv = &PL_sv_undef;
- break;
- }
-
- }
- else
- if (htype == DBIt_DB) {
- /* this is here but is, sadly, not called because
- * not-preloading them into the handle attrib cache caused
- * wierdness in t/proxy.t that I never got to the bottom
- * of. One day maybe. */
- if (keylen==6 && strEQ(key, "Driver")) {
- D_imp_from_child(imp_dbh, imp_dbh_t, imp_xxh);
- valuesv = newRV_inc((SV*)DBIc_MY_H(imp_dbh));
- cacheit = FALSE; /* else creates ref loop */
- }
- }
-
- if (valuesv == Nullsv && htype <= DBIt_DB) {
- if (keylen==10 && strEQ(key, "AutoCommit")) {
- valuesv = boolSV(DBIc_has(imp_xxh,DBIcf_AutoCommit));
- }
- }
-
- if (valuesv == Nullsv) {
- switch (*key) {
- case 'A':
- if (keylen==6 && strEQ(key, "Active")) {
- valuesv = boolSV(DBIc_ACTIVE(imp_xxh));
- }
- else if (keylen==10 && strEQ(key, "ActiveKids")) {
- valuesv = newSViv(DBIc_ACTIVE_KIDS(imp_xxh));
- }
- else if (strEQ(key, "AutoInactiveDestroy")) {
- valuesv = boolSV(DBIc_AIADESTROY(imp_xxh));
- }
- break;
-
- case 'B':
- if (keylen==9 && strEQ(key, "BegunWork")) {
- valuesv = boolSV(DBIc_has(imp_xxh,DBIcf_BegunWork));
- }
- break;
-
- case 'C':
- if (strEQ(key, "ChildHandles")) {
- svp = hv_fetch((HV*)SvRV(h), key, keylen, FALSE);
- /* if something has been stored then return it.
- * otherwise return a dummy empty array if weakrefs are
- * available, else an undef to indicate that they're not */
- if (svp) {
- valuesv = newSVsv(*svp);
- } else {
-#ifdef sv_rvweaken
- valuesv = newRV_noinc((SV*)newAV());
-#else
- valuesv = &PL_sv_undef;
-#endif
- }
- }
- else if (strEQ(key, "ChopBlanks")) {
- valuesv = boolSV(DBIc_has(imp_xxh,DBIcf_ChopBlanks));
- }
- else if (strEQ(key, "CachedKids")) {
- valuesv = &PL_sv_undef;
- }
- else if (strEQ(key, "CompatMode")) {
- valuesv = boolSV(DBIc_COMPAT(imp_xxh));
- }
- break;
-
- case 'E':
- if (strEQ(key, "Executed")) {
- valuesv = boolSV(DBIc_is(imp_xxh, DBIcf_Executed));
- }
- else if (strEQ(key, "ErrCount")) {
- valuesv = newSVuv(DBIc_ErrCount(imp_xxh));
- }
- break;
-
- case 'I':
- if (strEQ(key, "InactiveDestroy")) {
- valuesv = boolSV(DBIc_IADESTROY(imp_xxh));
- }
- break;
-
- case 'K':
- if (keylen==4 && strEQ(key, "Kids")) {
- valuesv = newSViv(DBIc_KIDS(imp_xxh));
- }
- break;
-
- case 'L':
- if (keylen==11 && strEQ(key, "LongReadLen")) {
- valuesv = newSVnv((NV)DBIc_LongReadLen(imp_xxh));
- }
- else if (keylen==11 && strEQ(key, "LongTruncOk")) {
- valuesv = boolSV(DBIc_has(imp_xxh,DBIcf_LongTruncOk));
- }
- break;
-
- case 'M':
- if (keylen==10 && strEQ(key, "MultiThread")) {
- valuesv = boolSV(DBIc_has(imp_xxh,DBIcf_MultiThread));
- }
- break;
-
- case 'P':
- if (keylen==10 && strEQ(key, "PrintError")) {
- valuesv = boolSV(DBIc_has(imp_xxh,DBIcf_PrintError));
- }
- else if (keylen==9 && strEQ(key, "PrintWarn")) {
- valuesv = boolSV(DBIc_has(imp_xxh,DBIcf_PrintWarn));
- }
- break;
-
- case 'R':
- if (keylen==10 && strEQ(key, "RaiseError")) {
- valuesv = boolSV(DBIc_has(imp_xxh,DBIcf_RaiseError));
- }
- else if (keylen==12 && strEQ(key, "RowCacheSize")) {
- valuesv = &PL_sv_undef;
- }
- break;
-
- case 'S':
- if (keylen==18 && strEQ(key, "ShowErrorStatement")) {
- valuesv = boolSV(DBIc_has(imp_xxh,DBIcf_ShowErrorStatement));
- }
- break;
-
- case 'T':
- if (keylen==4 && strEQ(key, "Type")) {
- char *type = dbih_htype_name(htype);
- valuesv = newSVpv(type,0);
- cacheit = TRUE; /* can't change */
- }
- else if (keylen==10 && strEQ(key, "TraceLevel")) {
- valuesv = newSViv( DBIc_DEBUGIV(imp_xxh) );
- }
- else if (keylen==5 && strEQ(key, "Taint")) {
- valuesv = boolSV(DBIc_has(imp_xxh,DBIcf_TaintIn) &&
- DBIc_has(imp_xxh,DBIcf_TaintOut));
- }
- else if (keylen==7 && strEQ(key, "TaintIn")) {
- valuesv = boolSV(DBIc_has(imp_xxh,DBIcf_TaintIn));
- }
- else if (keylen==8 && strEQ(key, "TaintOut")) {
- valuesv = boolSV(DBIc_has(imp_xxh,DBIcf_TaintOut));
- }
- break;
-
- case 'W':
- if (keylen==4 && strEQ(key, "Warn")) {
- valuesv = boolSV(DBIc_WARN(imp_xxh));
- }
- break;
- }
- }
-
- /* finally check the actual hash */
- if (valuesv == Nullsv) {
- valuesv = &PL_sv_undef;
- cacheit = 0;
- svp = hv_fetch((HV*)SvRV(h), key, keylen, FALSE);
- if (svp)
- valuesv = newSVsv(*svp); /* take copy to mortalize */
- else /* warn unless it's known attribute name */
- if ( !( (*key=='H' && strEQ(key, "HandleError"))
- || (*key=='H' && strEQ(key, "HandleSetErr"))
- || (*key=='S' && strEQ(key, "Statement"))
- || (*key=='P' && strEQ(key, "ParamArrays"))
- || (*key=='P' && strEQ(key, "ParamValues"))
- || (*key=='P' && strEQ(key, "Profile"))
- || (*key=='R' && strEQ(key, "ReadOnly"))
- || (*key=='C' && strEQ(key, "CursorName"))
- || (*key=='C' && strEQ(key, "Callbacks"))
- || (*key=='U' && strEQ(key, "Username"))
- || !isUPPER(*key) /* dbd_*, private_* etc */
- ))
- warn("Can't get %s->{%s}: unrecognised attribute name",neatsvpv(h,0),key);
- }
-
- if (cacheit) {
- (void)hv_store((HV*)SvRV(h), key, keylen, newSVsv(valuesv), 0);
- }
- if (DBIc_TRACE_LEVEL(imp_xxh) >= 3)
- PerlIO_printf(DBIc_LOGPIO(imp_xxh)," .. FETCH %s %s = %s%s\n", neatsvpv(h,0),
- neatsvpv(keysv,0), neatsvpv(valuesv,0), cacheit?" (cached)":"");
- if (valuesv == &PL_sv_yes || valuesv == &PL_sv_no || valuesv == &PL_sv_undef)
- return valuesv; /* no need to mortalize yes or no */
- return sv_2mortal(valuesv);
-}
-
-
-
-/* -------------------------------------------------------------------- */
-/* Functions implementing Error and Event Handling. */
-
-
-static SV *
-dbih_event(SV *hrv, const char *evtype, SV *a1, SV *a2)
-{
- dTHX;
- /* We arrive here via DBIh_EVENT* macros (see DBIXS.h) called from */
- /* DBD driver C code OR $h->event() method (in DBD::_::common) */
- /* XXX VERY OLD INTERFACE/CONCEPT MAY GO SOON */
- /* OR MAY EVOLVE INTO A WAY TO HANDLE 'SUCCESS_WITH_INFO'/'WARNINGS' from db */
- (void)hrv;
- (void)evtype;
- (void)a1;
- (void)a2;
- return &PL_sv_undef;
-}
-
-
-/* ----------------------------------------------------------------- */
-
-
-STATIC I32
-dbi_dopoptosub_at(PERL_CONTEXT *cxstk, I32 startingblock)
-{
- dTHX;
- I32 i;
- register PERL_CONTEXT *cx;
- for (i = startingblock; i >= 0; i--) {
- cx = &cxstk[i];
- switch (CxTYPE(cx)) {
- default:
- continue;
- case CXt_EVAL:
- case CXt_SUB:
-#ifdef CXt_FORMAT
- case CXt_FORMAT:
-#endif
- DEBUG_l( Perl_deb(aTHX_ "(Found sub #%ld)\n", (long)i));
- return i;
- }
- }
- return i;
-}
-
-
-static COP *
-dbi_caller_cop()
-{
- dTHX;
- register I32 cxix;
- register PERL_CONTEXT *cx;
- register PERL_CONTEXT *ccstack = cxstack;
- PERL_SI *top_si = PL_curstackinfo;
- char *stashname;
-
- for ( cxix = dbi_dopoptosub_at(ccstack, cxstack_ix) ;; cxix = dbi_dopoptosub_at(ccstack, cxix - 1)) {
- /* we may be in a higher stacklevel, so dig down deeper */
- while (cxix < 0 && top_si->si_type != PERLSI_MAIN) {
- top_si = top_si->si_prev;
- ccstack = top_si->si_cxstack;
- cxix = dbi_dopoptosub_at(ccstack, top_si->si_cxix);
- }
- if (cxix < 0) {
- break;
- }
- if (PL_DBsub && cxix >= 0 && ccstack[cxix].blk_sub.cv == GvCV(PL_DBsub))
- continue;
- cx = &ccstack[cxix];
- stashname = CopSTASHPV(cx->blk_oldcop);
- if (!stashname)
- continue;
- if (!(stashname[0] == 'D' && stashname[1] == 'B'
- && strchr("DI", stashname[2])
- && (!stashname[3] || (stashname[3] == ':' && stashname[4] == ':'))))
- {
- return cx->blk_oldcop;
- }
- cxix = dbi_dopoptosub_at(ccstack, cxix - 1);
- }
- return NULL;
-}
-
-static void
-dbi_caller_string(SV *buf, COP *cop, char *prefix, int show_line, int show_path)
-{
- dTHX;
- STRLEN len;
- long line = CopLINE(cop);
- char *file = SvPV(GvSV(CopFILEGV(cop)), len);
- if (!show_path) {
- char *sep;
- if ( (sep=strrchr(file,'/')) || (sep=strrchr(file,'\\')))
- file = sep+1;
- }
- if (show_line) {
- sv_catpvf(buf, "%s%s line %ld", (prefix) ? prefix : "", file, line);
- }
- else {
- sv_catpvf(buf, "%s%s", (prefix) ? prefix : "", file);
- }
-}
-
-static char *
-log_where(SV *buf, int append, char *prefix, char *suffix, int show_line, int show_caller, int show_path)
-{
- dTHX;
- dTHR;
- if (!buf)
- buf = sv_2mortal(newSVpv("",0));
- else if (!append)
- sv_setpv(buf,"");
- if (CopLINE(PL_curcop)) {
- COP *cop;
- dbi_caller_string(buf, PL_curcop, prefix, show_line, show_path);
- if (show_caller && (cop = dbi_caller_cop())) {
- SV *via = sv_2mortal(newSVpv("",0));
- dbi_caller_string(via, cop, prefix, show_line, show_path);
- sv_catpvf(buf, " via %s", SvPV_nolen(via));
- }
- }
- if (PL_dirty)
- sv_catpvf(buf, " during global destruction");
- if (suffix)
- sv_catpv(buf, suffix);
- return SvPVX(buf);
-}
-
-
-static void
-clear_cached_kids(pTHX_ SV *h, imp_xxh_t *imp_xxh, const char *meth_name, int trace_level)
-{
- if (DBIc_TYPE(imp_xxh) <= DBIt_DB) {
- SV **svp = hv_fetch((HV*)SvRV(h), "CachedKids", 10, 0);
- if (svp && SvROK(*svp) && SvTYPE(SvRV(*svp)) == SVt_PVHV) {
- HV *hv = (HV*)SvRV(*svp);
- if (HvKEYS(hv)) {
- if (DBIc_TRACE_LEVEL(imp_xxh) > trace_level)
- trace_level = DBIc_TRACE_LEVEL(imp_xxh);
- if (trace_level >= 2) {
- PerlIO_printf(DBIc_LOGPIO(imp_xxh)," >> %s %s clearing %d CachedKids\n",
- meth_name, neatsvpv(h,0), (int)HvKEYS(hv));
- PerlIO_flush(DBIc_LOGPIO(imp_xxh));
- }
- /* This will probably recurse through dispatch to DESTROY the kids */
- /* For drh we should probably explicitly do dbh disconnects */
- hv_clear(hv);
- }
- }
- }
-}
-
-
-static NV
-dbi_time() {
-# ifdef HAS_GETTIMEOFDAY
-# ifdef PERL_IMPLICIT_SYS
- dTHX;
-# endif
- struct timeval when;
- gettimeofday(&when, (struct timezone *) 0);
- return when.tv_sec + (when.tv_usec / 1000000.0);
-# else /* per-second is almost useless */
-# ifdef _WIN32 /* use _ftime() on Win32 (MS Visual C++ 6.0) */
-# if defined(__BORLANDC__)
-# define _timeb timeb
-# define _ftime ftime
-# endif
- struct _timeb when;
- _ftime( &when );
- return when.time + (when.millitm / 1000.0);
-# else
- return time(NULL);
-# endif
-# endif
-}
-
-
-static SV *
-_profile_next_node(SV *node, const char *name)
-{
- /* step one level down profile Data tree and auto-vivify if required */
- dTHX;
- SV *orig_node = node;
- if (SvROK(node))
- node = SvRV(node);
- if (SvTYPE(node) != SVt_PVHV) {
- HV *hv = newHV();
- if (SvOK(node)) {
- char *key = "(demoted)";
- warn("Profile data element %s replaced with new hash ref (for %s) and original value stored with key '%s'",
- neatsvpv(orig_node,0), name, key);
- (void)hv_store(hv, key, strlen(key), SvREFCNT_inc(orig_node), 0);
- }
- sv_setsv(node, newRV_noinc((SV*)hv));
- node = (SV*)hv;
- }
- node = *hv_fetch((HV*)node, name, strlen(name), 1);
- return node;
-}
-
-
-static SV*
-dbi_profile(SV *h, imp_xxh_t *imp_xxh, SV *statement_sv, SV *method, NV t1, NV t2)
-{
-#define DBIprof_MAX_PATH_ELEM 100
-#define DBIprof_COUNT 0
-#define DBIprof_TOTAL_TIME 1
-#define DBIprof_FIRST_TIME 2
-#define DBIprof_MIN_TIME 3
-#define DBIprof_MAX_TIME 4
-#define DBIprof_FIRST_CALLED 5
-#define DBIprof_LAST_CALLED 6
-#define DBIprof_max_index 6
- dTHX;
- NV ti = t2 - t1;
- int src_idx = 0;
- HV *dbh_outer_hv = NULL;
- HV *dbh_inner_hv = NULL;
- char *statement_pv;
- char *method_pv;
- SV *profile;
- SV *tmp;
- SV *dest_node;
- AV *av;
- HV *h_hv;
-
- const int call_depth = DBIc_CALL_DEPTH(imp_xxh);
- const int parent_call_depth = DBIc_PARENT_COM(imp_xxh) ? DBIc_CALL_DEPTH(DBIc_PARENT_COM(imp_xxh)) : 0;
- /* Only count calls originating from the application code */
- if (call_depth > 1 || parent_call_depth > 0)
- return &PL_sv_undef;
-
- if (!DBIc_has(imp_xxh, DBIcf_Profile))
- return &PL_sv_undef;
-
- method_pv = (SvTYPE(method)==SVt_PVCV) ? GvNAME(CvGV(method))
- : isGV(method) ? GvNAME(method)
- : SvOK(method) ? SvPV_nolen(method)
- : "";
-
- /* we don't profile DESTROY during global destruction */
- if (PL_dirty && instr(method_pv, "DESTROY"))
- return &PL_sv_undef;
-
- h_hv = (HV*)SvRV(dbih_inner(aTHX_ h, "dbi_profile"));
-
- profile = *hv_fetch(h_hv, "Profile", 7, 1);
- if (profile && SvMAGICAL(profile))
- mg_get(profile); /* FETCH */
- if (!profile || !SvROK(profile)) {
- DBIc_set(imp_xxh, DBIcf_Profile, 0); /* disable */
- if (SvOK(profile) && !PL_dirty)
- warn("Profile attribute isn't a hash ref (%s,%ld)", neatsvpv(profile,0), (long)SvTYPE(profile));
- return &PL_sv_undef;
- }
-
- /* statement_sv: undef = use $h->{Statement}, "" (&sv_no) = use empty string */
-
- if (!SvOK(statement_sv)) {
- SV **psv = hv_fetch(h_hv, "Statement", 9, 0);
- statement_sv = (psv && SvOK(*psv)) ? *psv : &PL_sv_no;
- }
- statement_pv = SvPV_nolen(statement_sv);
-
- if (DBIc_TRACE_LEVEL(imp_xxh) >= 4)
- PerlIO_printf(DBIc_LOGPIO(imp_xxh), " dbi_profile +%" NVff "s %s %s\n",
- ti, method_pv, neatsvpv(statement_sv,0));
-
- dest_node = _profile_next_node(profile, "Data");
-
- tmp = *hv_fetch((HV*)SvRV(profile), "Path", 4, 1);
- if (SvROK(tmp) && SvTYPE(SvRV(tmp))==SVt_PVAV) {
- int len;
- av = (AV*)SvRV(tmp);
- len = av_len(av); /* -1=empty, 0=one element */
-
- while ( src_idx <= len ) {
- SV *pathsv = AvARRAY(av)[src_idx++];
-
- if (SvROK(pathsv) && SvTYPE(SvRV(pathsv))==SVt_PVCV) {
- /* call sub, use returned list of values as path */
- /* returning a ref to undef vetos this profile data */
- dSP;
- I32 ax;
- SV *code_sv = SvRV(pathsv);
- I32 items;
- I32 item_idx;
- EXTEND(SP, 4);
- PUSHMARK(SP);
- PUSHs(h); /* push inner handle, then others params */
- PUSHs( sv_2mortal(newSVpv(method_pv,0)));
- PUTBACK;
- SAVE_DEFSV; /* local($_) = $statement */
- DEFSV_set(statement_sv);
- items = call_sv(code_sv, G_ARRAY);
- SPAGAIN;
- SP -= items ;
- ax = (SP - PL_stack_base) + 1 ;
- for (item_idx=0; item_idx < items; ++item_idx) {
- SV *item_sv = ST(item_idx);
- if (SvROK(item_sv)) {
- if (!SvOK(SvRV(item_sv)))
- items = -2; /* flag that we're rejecting this profile data */
- else /* other refs reserved */
- warn("Ignored ref returned by code ref in Profile Path");
- break;
- }
- dest_node = _profile_next_node(dest_node, (SvOK(item_sv) ? SvPV_nolen(item_sv) : "undef"));
- }
- PUTBACK;
- if (items == -2) /* this profile data was vetoed */
- return &PL_sv_undef;
- }
- else if (SvROK(pathsv)) {
- /* only meant for refs to scalars currently */
- const char *p = SvPV_nolen(SvRV(pathsv));
- dest_node = _profile_next_node(dest_node, p);
- }
- else if (SvOK(pathsv)) {
- STRLEN len;
- const char *p = SvPV(pathsv,len);
- if (p[0] == '!') { /* special cases */
- if (p[1] == 'S' && strEQ(p, "!Statement")) {
- dest_node = _profile_next_node(dest_node, statement_pv);
- }
- else if (p[1] == 'M' && strEQ(p, "!MethodName")) {
- dest_node = _profile_next_node(dest_node, method_pv);
- }
- else if (p[1] == 'M' && strEQ(p, "!MethodClass")) {
- if (SvTYPE(method) == SVt_PVCV) {
- p = SvPV_nolen((SV*)CvGV(method));
- }
- else if (isGV(method)) {
- /* just using SvPV_nolen(method) sometimes causes an error: */
- /* "Can't coerce GLOB to string" so we use gv_efullname() */
- SV *tmpsv = sv_2mortal(newSVpv("",0));
-#if (PERL_VERSION < 6)
- gv_efullname(tmpsv, (GV*)method);
-#else
- gv_efullname4(tmpsv, (GV*)method, "", TRUE);
-#endif
- p = SvPV_nolen(tmpsv);
- if (*p == '*') ++p; /* skip past leading '*' glob sigil */
- }
- else {
- p = method_pv;
- }
- dest_node = _profile_next_node(dest_node, p);
- }
- else if (p[1] == 'F' && strEQ(p, "!File")) {
- dest_node = _profile_next_node(dest_node, log_where(0, 0, "", "", 0, 0, 0));
- }
- else if (p[1] == 'F' && strEQ(p, "!File2")) {
- dest_node = _profile_next_node(dest_node, log_where(0, 0, "", "", 0, 1, 0));
- }
- else if (p[1] == 'C' && strEQ(p, "!Caller")) {
- dest_node = _profile_next_node(dest_node, log_where(0, 0, "", "", 1, 0, 0));
- }
- else if (p[1] == 'C' && strEQ(p, "!Caller2")) {
- dest_node = _profile_next_node(dest_node, log_where(0, 0, "", "", 1, 1, 0));
- }
- else if (p[1] == 'T' && (strEQ(p, "!Time") || strnEQ(p, "!Time~", 6))) {
- char timebuf[20];
- int factor = 1;
- if (p[5] == '~') {
- factor = atoi(&p[6]);
- if (factor == 0) /* sanity check to avoid div by zero error */
- factor = 3600;
- }
- sprintf(timebuf, "%ld", ((long)(dbi_time()/factor))*factor);
- dest_node = _profile_next_node(dest_node, timebuf);
- }
- else {
- warn("Unknown ! element in DBI::Profile Path: %s", p);
- dest_node = _profile_next_node(dest_node, p);
- }
- }
- else if (p[0] == '{' && p[len-1] == '}') { /* treat as name of dbh attribute to use */
- SV **attr_svp;
- if (!dbh_inner_hv) { /* cache dbh handles the first time we need them */
- imp_dbh_t *imp_dbh = (DBIc_TYPE(imp_xxh) <= DBIt_DB) ? (imp_dbh_t*)imp_xxh : (imp_dbh_t*)DBIc_PARENT_COM(imp_xxh);
- dbh_outer_hv = DBIc_MY_H(imp_dbh);
- if (SvTYPE(dbh_outer_hv) != SVt_PVHV)
- return &PL_sv_undef; /* presumably global destruction - bail */
- dbh_inner_hv = (HV*)SvRV(dbih_inner(aTHX_ (SV*)dbh_outer_hv, "profile"));
- if (SvTYPE(dbh_inner_hv) != SVt_PVHV)
- return &PL_sv_undef; /* presumably global destruction - bail */
- }
- /* fetch from inner first, then outer if key doesn't exist */
- /* (yes, this is an evil premature optimization) */
- p += 1; len -= 2; /* ignore the braces */
- if ((attr_svp = hv_fetch(dbh_inner_hv, p, len, 0)) == NULL) {
- /* try outer (tied) hash - for things like AutoCommit */
- /* (will always return something even for unknowns) */
- if ((attr_svp = hv_fetch(dbh_outer_hv, p, len, 0))) {
- if (SvGMAGICAL(*attr_svp))
- mg_get(*attr_svp); /* FETCH */
- }
- }
- if (!attr_svp)
- p -= 1; /* unignore the braces */
- else if (!SvOK(*attr_svp))
- p = "";
- else if (!SvTRUE(*attr_svp) && SvPOK(*attr_svp) && SvNIOK(*attr_svp))
- p = "0"; /* catch &sv_no style special case */
- else
- p = SvPV_nolen(*attr_svp);
- dest_node = _profile_next_node(dest_node, p);
- }
- else {
- dest_node = _profile_next_node(dest_node, p);
- }
- }
- /* else undef, so ignore */
- }
- }
- else { /* a bad Path value is treated as a Path of just Statement */
- dest_node = _profile_next_node(dest_node, statement_pv);
- }
-
-
- if (!SvOK(dest_node)) {
- av = newAV();
- sv_setsv(dest_node, newRV_noinc((SV*)av));
- av_store(av, DBIprof_COUNT, newSViv(1));
- av_store(av, DBIprof_TOTAL_TIME, newSVnv(ti));
- av_store(av, DBIprof_FIRST_TIME, newSVnv(ti));
- av_store(av, DBIprof_MIN_TIME, newSVnv(ti));
- av_store(av, DBIprof_MAX_TIME, newSVnv(ti));
- av_store(av, DBIprof_FIRST_CALLED, newSVnv(t1));
- av_store(av, DBIprof_LAST_CALLED, newSVnv(t1));
- }
- else {
- tmp = dest_node;
- if (SvROK(tmp))
- tmp = SvRV(tmp);
- if (SvTYPE(tmp) != SVt_PVAV)
- croak("Invalid Profile data leaf element: %s (type %ld)",
- neatsvpv(tmp,0), (long)SvTYPE(tmp));
- av = (AV*)tmp;
- sv_inc( *av_fetch(av, DBIprof_COUNT, 1));
- tmp = *av_fetch(av, DBIprof_TOTAL_TIME, 1);
- sv_setnv(tmp, SvNV(tmp) + ti);
- tmp = *av_fetch(av, DBIprof_MIN_TIME, 1);
- if (ti < SvNV(tmp)) sv_setnv(tmp, ti);
- tmp = *av_fetch(av, DBIprof_MAX_TIME, 1);
- if (ti > SvNV(tmp)) sv_setnv(tmp, ti);
- sv_setnv( *av_fetch(av, DBIprof_LAST_CALLED, 1), t1);
- }
- return dest_node; /* use with caution - copy first, ie sv_mortalcopy() */
-}
-
-
-static void
-dbi_profile_merge_nodes(SV *dest, SV *increment)
-{
- dTHX;
- AV *d_av, *i_av;
- SV *tmp;
- SV *tmp2;
- NV i_nv;
- int i_is_earlier;
-
- if (!SvROK(dest) || SvTYPE(SvRV(dest)) != SVt_PVAV)
- croak("dbi_profile_merge_nodes(%s, ...) requires array ref", neatsvpv(dest,0));
- d_av = (AV*)SvRV(dest);
-
- if (av_len(d_av) < DBIprof_max_index) {
- int idx;
- av_extend(d_av, DBIprof_max_index);
- for(idx=0; idx<=DBIprof_max_index; ++idx) {
- tmp = *av_fetch(d_av, idx, 1);
- if (!SvOK(tmp) && idx != DBIprof_MIN_TIME && idx != DBIprof_FIRST_CALLED)
- sv_setnv(tmp, 0.0); /* leave 'min' values as undef */
- }
- }
-
- if (!SvOK(increment))
- return;
-
- if (SvROK(increment) && SvTYPE(SvRV(increment)) == SVt_PVHV) {
- HV *hv = (HV*)SvRV(increment);
- char *key;
- I32 keylen = 0;
- hv_iterinit(hv);
- while ( (tmp = hv_iternextsv(hv, &key, &keylen)) != NULL ) {
- dbi_profile_merge_nodes(dest, tmp);
- };
- return;
- }
-
- if (!SvROK(increment) || SvTYPE(SvRV(increment)) != SVt_PVAV)
- croak("dbi_profile_merge_nodes: increment %s not an array or hash ref", neatsvpv(increment,0));
- i_av = (AV*)SvRV(increment);
-
- tmp = *av_fetch(d_av, DBIprof_COUNT, 1);
- tmp2 = *av_fetch(i_av, DBIprof_COUNT, 1);
- if (SvIOK(tmp) && SvIOK(tmp2))
- sv_setiv( tmp, SvIV(tmp) + SvIV(tmp2) );
- else
- sv_setnv( tmp, SvNV(tmp) + SvNV(tmp2) );
-
- tmp = *av_fetch(d_av, DBIprof_TOTAL_TIME, 1);
- sv_setnv( tmp, SvNV(tmp) + SvNV( *av_fetch(i_av, DBIprof_TOTAL_TIME, 1)) );
-
- i_nv = SvNV(*av_fetch(i_av, DBIprof_MIN_TIME, 1));
- tmp = *av_fetch(d_av, DBIprof_MIN_TIME, 1);
- if (!SvOK(tmp) || i_nv < SvNV(tmp)) sv_setnv(tmp, i_nv);
-
- i_nv = SvNV(*av_fetch(i_av, DBIprof_MAX_TIME, 1));
- tmp = *av_fetch(d_av, DBIprof_MAX_TIME, 1);
- if (i_nv > SvNV(tmp)) sv_setnv(tmp, i_nv);
-
- i_nv = SvNV(*av_fetch(i_av, DBIprof_FIRST_CALLED, 1));
- tmp = *av_fetch(d_av, DBIprof_FIRST_CALLED, 1);
- i_is_earlier = (!SvOK(tmp) || i_nv < SvNV(tmp));
- if (i_is_earlier)
- sv_setnv(tmp, i_nv);
-
- i_nv = SvNV(*av_fetch(i_av, DBIprof_FIRST_TIME, 1));
- tmp = *av_fetch(d_av, DBIprof_FIRST_TIME, 1);
- if (i_is_earlier || !SvOK(tmp)) {
- /* If the increment has an earlier DBIprof_FIRST_CALLED
- then we set the DBIprof_FIRST_TIME from the increment */
- sv_setnv(tmp, i_nv);
- }
-
- i_nv = SvNV(*av_fetch(i_av, DBIprof_LAST_CALLED, 1));
- tmp = *av_fetch(d_av, DBIprof_LAST_CALLED, 1);
- if (i_nv > SvNV(tmp)) sv_setnv(tmp, i_nv);
-}
-
-
-/* ----------------------------------------------------------------- */
-/* --- The DBI dispatcher. The heart of the perl DBI. --- */
-
-XS(XS_DBI_dispatch); /* prototype to pass -Wmissing-prototypes */
-XS(XS_DBI_dispatch)
-{
- dXSARGS;
- dORIGMARK;
- dMY_CXT;
-
- SV *h = ST(0); /* the DBI handle we are working with */
- SV *st1 = ST(1); /* used in debugging */
- SV *st2 = ST(2); /* used in debugging */
- SV *orig_h = h;
- SV *err_sv;
- SV **tmp_svp;
- SV **hook_svp = 0;
- MAGIC *mg;
- int gimme = GIMME;
- I32 trace_flags = DBIS->debug; /* local copy may change during dispatch */
- I32 trace_level = (trace_flags & DBIc_TRACE_LEVEL_MASK);
- int is_DESTROY;
- meth_types meth_type;
- int is_unrelated_to_Statement = 0;
- U32 keep_error = FALSE;
- UV ErrCount = UV_MAX;
- int i, outitems;
- int call_depth;
- int is_nested_call;
- NV profile_t1 = 0.0;
- int is_orig_method_name = 1;
-
- const char *meth_name = GvNAME(CvGV(cv));
- dbi_ima_t *ima = (dbi_ima_t*)CvXSUBANY(cv).any_ptr;
- U32 ima_flags;
- imp_xxh_t *imp_xxh = NULL;
- SV *imp_msv = Nullsv;
- SV *qsv = Nullsv; /* quick result from a shortcut method */
-
-
-#ifdef BROKEN_DUP_ANY_PTR
- if (ima->my_perl != my_perl) {
- /* we couldn't dup the ima struct at clone time, so do it now */
- dbi_ima_t *nima;
- Newx(nima, 1, dbi_ima_t);
- *nima = *ima; /* structure copy */
- CvXSUBANY(cv).any_ptr = nima;
- nima->stash = NULL;
- nima->gv = NULL;
- nima->my_perl = my_perl;
- ima = nima;
- }
-#endif
-
- ima_flags = ima->flags;
- meth_type = ima->meth_type;
- if (trace_level >= 9) {
- PerlIO *logfp = DBILOGFP;
- PerlIO_printf(logfp,"%c >> %-11s DISPATCH (%s rc%ld/%ld @%ld g%x ima%lx pid#%ld)",
- (PL_dirty?'!':' '), meth_name, neatsvpv(h,0),
- (long)SvREFCNT(h), (SvROK(h) ? (long)SvREFCNT(SvRV(h)) : (long)-1),
- (long)items, (int)gimme, (long)ima_flags, (long)PerlProc_getpid());
- PerlIO_puts(logfp, log_where(0, 0, " at ","\n", 1, (trace_level >= 3), (trace_level >= 4)));
- PerlIO_flush(logfp);
- }
-
- if ( ( (is_DESTROY=(meth_type == methtype_DESTROY))) ) {
- /* note that croak()'s won't propagate, only append to $@ */
- keep_error = TRUE;
- }
-
- /* If h is a tied hash ref, switch to the inner ref 'behind' the tie.
- This means *all* DBI methods work with the inner (non-tied) ref.
- This makes it much easier for methods to access the real hash
- data (without having to go through FETCH and STORE methods) and
- for tie and non-tie methods to call each other.
- */
- if (SvROK(h)
- && SvRMAGICAL(SvRV(h))
- && (
- ((mg=SvMAGIC(SvRV(h)))->mg_type == 'P')
- || ((mg=mg_find(SvRV(h),'P')) != NULL)
- )
- ) {
- if (mg->mg_obj==NULL || !SvOK(mg->mg_obj) || SvRV(mg->mg_obj)==NULL) { /* maybe global destruction */
- if (trace_level >= 3)
- PerlIO_printf(DBILOGFP,
- "%c <> %s for %s ignored (inner handle gone)\n",
- (PL_dirty?'!':' '), meth_name, neatsvpv(h,0));
- XSRETURN(0);
- }
- /* Distinguish DESTROY of tie (outer) from DESTROY of inner ref */
- /* This may one day be used to manually destroy extra internal */
- /* refs if the application ceases to use the handle. */
- if (is_DESTROY) {
- imp_xxh = DBIh_COM(mg->mg_obj);
-#ifdef DBI_USE_THREADS
- if (imp_xxh && DBIc_THR_USER(imp_xxh) != my_perl) {
- goto is_DESTROY_wrong_thread;
- }
-#endif
- if (imp_xxh && DBIc_TYPE(imp_xxh) <= DBIt_DB)
- clear_cached_kids(aTHX_ mg->mg_obj, imp_xxh, meth_name, trace_level);
- /* XXX might be better to move this down to after call_depth has been
- * incremented and then also SvREFCNT_dec(mg->mg_obj) to force an immediate
- * DESTROY of the inner handle if there are no other refs to it.
- * That way the inner DESTROY is properly flagged as a nested call,
- * and the outer DESTROY gets profiled more accurately, and callbacks work.
- */
- if (trace_level >= 3) {
- PerlIO_printf(DBILOGFP,
- "%c <> DESTROY(%s) ignored for outer handle (inner %s has ref cnt %ld)\n",
- (PL_dirty?'!':' '), neatsvpv(h,0), neatsvpv(mg->mg_obj,0),
- (long)SvREFCNT(SvRV(mg->mg_obj))
- );
- }
- /* for now we ignore it since it'll be followed soon by */
- /* a destroy of the inner hash and that'll do the real work */
-
- /* However, we must at least modify DBIc_MY_H() as that is */
- /* pointing (without a refcnt inc) to the scalar that is */
- /* being destroyed, so it'll contain random values later. */
- if (imp_xxh)
- DBIc_MY_H(imp_xxh) = (HV*)SvRV(mg->mg_obj); /* inner (untied) HV */
-
- XSRETURN(0);
- }
- h = mg->mg_obj; /* switch h to inner ref */
- ST(0) = h; /* switch handle on stack to inner ref */
- }
-
- imp_xxh = dbih_getcom2(aTHX_ h, 0); /* get common Internal Handle Attributes */
- if (!imp_xxh) {
- if (meth_type == methtype_can) { /* ref($h)->can("foo") */
- const char *can_meth = SvPV_nolen(st1);
- SV *rv = &PL_sv_undef;
- GV *gv = gv_fetchmethod_autoload(gv_stashsv(orig_h,FALSE), can_meth, FALSE);
- if (gv && isGV(gv))
- rv = sv_2mortal(newRV_inc((SV*)GvCV(gv)));
- if (trace_level >= 1) {
- PerlIO_printf(DBILOGFP," <- %s(%s) = %p\n", meth_name, can_meth, neatsvpv(rv,0));
- }
- ST(0) = rv;
- XSRETURN(1);
- }
- if (trace_level)
- PerlIO_printf(DBILOGFP, "%c <> %s for %s ignored (no imp_data)\n",
- (PL_dirty?'!':' '), meth_name, neatsvpv(h,0));
- if (!is_DESTROY)
- warn("Can't call %s method on handle %s%s", meth_name, neatsvpv(h,0),
- SvROK(h) ? " after take_imp_data()" : " (not a reference)");
- XSRETURN(0);
- }
-
- if (DBIc_has(imp_xxh,DBIcf_Profile)) {
- profile_t1 = dbi_time(); /* just get start time here */
- }
-
-#ifdef DBI_USE_THREADS
-{
- PerlInterpreter * h_perl;
- is_DESTROY_wrong_thread:
- h_perl = DBIc_THR_USER(imp_xxh) ;
- if (h_perl != my_perl) {
- /* XXX could call a 'handle clone' method here?, for dbh's at least */
- if (is_DESTROY) {
- if (trace_level >= 3) {
- PerlIO_printf(DBILOGFP," DESTROY ignored because DBI %sh handle (%s) is owned by thread %p not current thread %p\n",
- dbih_htype_name(DBIc_TYPE(imp_xxh)), HvNAME(DBIc_IMP_STASH(imp_xxh)),
- (void*)DBIc_THR_USER(imp_xxh), (void*)my_perl) ;
- PerlIO_flush(DBILOGFP);
- }
- XSRETURN(0); /* don't DESTROY handle, if it is not our's !*/
- }
- croak("%s %s failed: handle %d is owned by thread %lx not current thread %lx (%s)",
- HvNAME(DBIc_IMP_STASH(imp_xxh)), meth_name, DBIc_TYPE(imp_xxh),
- (unsigned long)h_perl, (unsigned long)my_perl,
- "handles can't be shared between threads and your driver may need a CLONE method added");
- }
-}
-#endif
-
- if ((i = DBIc_DEBUGIV(imp_xxh))) { /* merge handle into global */
- I32 h_trace_level = (i & DBIc_TRACE_LEVEL_MASK);
- if ( h_trace_level > trace_level )
- trace_level = h_trace_level;
- trace_flags = (trace_flags & ~DBIc_TRACE_LEVEL_MASK)
- | ( i & ~DBIc_TRACE_LEVEL_MASK)
- | trace_level;
- }
-
- /* Check method call against Internal Method Attributes */
- if (ima_flags) {
-
- if (ima_flags & (IMA_STUB|IMA_FUNC_REDIRECT|IMA_KEEP_ERR|IMA_KEEP_ERR_SUB|IMA_CLEAR_STMT)) {
-
- if (ima_flags & IMA_STUB) {
- if (meth_type == methtype_can) {
- const char *can_meth = SvPV_nolen(st1);
- SV *dbi_msv = Nullsv;
- /* find handle implementors method (GV or CV) */
- if ( (imp_msv = (SV*)gv_fetchmethod_autoload(DBIc_IMP_STASH(imp_xxh), can_meth, FALSE)) ) {
- /* return DBI's CV, not the implementors CV (else we'd bypass dispatch) */
- /* and anyway, we may have hit a private method not part of the DBI */
- GV *gv = gv_fetchmethod_autoload(SvSTASH(SvRV(orig_h)), can_meth, FALSE);
- if (gv && isGV(gv))
- dbi_msv = (SV*)GvCV(gv);
- }
- if (trace_level >= 1) {
- PerlIO *logfp = DBILOGFP;
- PerlIO_printf(logfp," <- %s(%s) = %p (%s %p)\n", meth_name, can_meth, (void*)dbi_msv,
- (imp_msv && isGV(imp_msv)) ? HvNAME(GvSTASH(imp_msv)) : "?", (void*)imp_msv);
- }
- ST(0) = (dbi_msv) ? sv_2mortal(newRV_inc(dbi_msv)) : &PL_sv_undef;
- XSRETURN(1);
- }
- XSRETURN(0);
- }
- if (ima_flags & IMA_FUNC_REDIRECT) {
- /* XXX this doesn't redispatch, nor consider the IMA of the new method */
- SV *meth_name_sv = POPs;
- PUTBACK;
- --items;
- if (!SvPOK(meth_name_sv) || SvNIOK(meth_name_sv))
- croak("%s->%s() invalid redirect method name %s",
- neatsvpv(h,0), meth_name, neatsvpv(meth_name_sv,0));
- meth_name = SvPV_nolen(meth_name_sv);
- meth_type = get_meth_type(meth_name);
- is_orig_method_name = 0;
- }
- if (ima_flags & IMA_KEEP_ERR)
- keep_error = TRUE;
- if ((ima_flags & IMA_KEEP_ERR_SUB)
- && !PL_dirty
- && DBIc_PARENT_COM(imp_xxh) && DBIc_CALL_DEPTH(DBIc_PARENT_COM(imp_xxh)) > 0)
- keep_error = TRUE;
- if (ima_flags & IMA_CLEAR_STMT) {
- /* don't use SvOK_off: dbh's Statement may be ref to sth's */
- (void)hv_store((HV*)SvRV(h), "Statement", 9, &PL_sv_undef, 0);
- }
- if (ima_flags & IMA_CLEAR_CACHED_KIDS)
- clear_cached_kids(aTHX_ h, imp_xxh, meth_name, trace_flags);
-
- }
-
- if (ima_flags & IMA_HAS_USAGE) {
- const char *err = NULL;
- char msg[200];
-
- if (ima->minargs && (items < ima->minargs
- || (ima->maxargs>0 && items > ima->maxargs))) {
- sprintf(msg,
- "DBI %s: invalid number of arguments: got handle + %ld, expected handle + between %d and %d\n",
- meth_name, (long)items-1, (int)ima->minargs-1, (int)ima->maxargs-1);
- err = msg;
- }
- /* arg type checking could be added here later */
- if (err) {
- croak("%sUsage: %s->%s(%s)", err, "$h", meth_name,
- (ima->usage_msg) ? ima->usage_msg : "...?");
- }
- }
- }
-
- is_unrelated_to_Statement = ( (DBIc_TYPE(imp_xxh) == DBIt_ST) ? 0
- : (DBIc_TYPE(imp_xxh) == DBIt_DR) ? 1
- : (ima_flags & IMA_UNRELATED_TO_STMT) );
-
- if (PL_tainting && items > 1 /* method call has args */
- && DBIc_is(imp_xxh, DBIcf_TaintIn) /* taint checks requested */
- && !(ima_flags & IMA_NO_TAINT_IN)
- ) {
- for(i=1; i < items; ++i) {
- if (SvTAINTED(ST(i))) {
- char buf[100];
- sprintf(buf,"parameter %d of %s->%s method call",
- i, SvPV_nolen(h), meth_name);
- PL_tainted = 1; /* needed for TAINT_PROPER to work */
- TAINT_PROPER(buf); /* die's */
- }
- }
- }
-
- /* record this inner handle for use by DBI::var::FETCH */
- if (is_DESTROY) {
-
- /* force destruction of any outstanding children */
- if ((tmp_svp = hv_fetch((HV*)SvRV(h), "ChildHandles", 12, FALSE)) && SvROK(*tmp_svp)) {
- AV *av = (AV*)SvRV(*tmp_svp);
- I32 kidslots;
- PerlIO *logfp = DBILOGFP;
-
- for (kidslots = AvFILL(av); kidslots >= 0; --kidslots) {
- SV **hp = av_fetch(av, kidslots, FALSE);
- if (!hp || !SvROK(*hp) || SvTYPE(SvRV(*hp))!=SVt_PVHV)
- break;
-
- if (trace_level >= 1) {
- PerlIO_printf(logfp, "on DESTROY handle %s still has child %s (refcnt %ld, obj %d, dirty=%d)\n",
- neatsvpv(h,0), neatsvpv(*hp, 0), (long)SvREFCNT(*hp), !!sv_isobject(*hp), PL_dirty);
- if (trace_level >= 9)
- sv_dump(SvRV(*hp));
- }
- if (sv_isobject(*hp)) { /* call DESTROY on the handle */
- PUSHMARK(SP);
- XPUSHs(*hp);
- PUTBACK;
- call_method("DESTROY", G_VOID|G_EVAL|G_KEEPERR);
- MSPAGAIN;
- }
- else {
- imp_xxh_t *imp_xxh = dbih_getcom2(aTHX_ *hp, 0);
- if (imp_xxh && DBIc_COMSET(imp_xxh)) {
- dbih_clearcom(imp_xxh);
- sv_setsv(*hp, &PL_sv_undef);
- }
- }
- }
- }
-
- if (DBIc_TYPE(imp_xxh) <= DBIt_DB ) { /* is dbh or drh */
- imp_xxh_t *parent_imp;
-
- if (SvOK(DBIc_ERR(imp_xxh)) && (parent_imp = DBIc_PARENT_COM(imp_xxh))
- && !PL_dirty /* XXX - remove? */
- ) {
- /* copy err/errstr/state values to $DBI::err etc still work */
- sv_setsv(DBIc_ERR(parent_imp), DBIc_ERR(imp_xxh));
- sv_setsv(DBIc_ERRSTR(parent_imp), DBIc_ERRSTR(imp_xxh));
- sv_setsv(DBIc_STATE(parent_imp), DBIc_STATE(imp_xxh));
- }
- }
-
- if (DBIc_AIADESTROY(imp_xxh)) { /* wants ineffective destroy after fork */
- if ((U32)PerlProc_getpid() != _imp2com(imp_xxh, std.pid))
- DBIc_set(imp_xxh, DBIcf_IADESTROY, 1);
- }
- if (DBIc_IADESTROY(imp_xxh)) { /* wants ineffective destroy */
- DBIc_ACTIVE_off(imp_xxh);
- }
- call_depth = 0;
- is_nested_call = 0;
- }
- else {
- DBI_SET_LAST_HANDLE(h);
- SAVEINT(DBIc_CALL_DEPTH(imp_xxh));
- call_depth = ++DBIc_CALL_DEPTH(imp_xxh);
-
- if (ima_flags & IMA_COPY_UP_STMT) { /* execute() */
- copy_statement_to_parent(aTHX_ h, imp_xxh);
- }
- is_nested_call =
- (call_depth > 1
- || (!PL_dirty /* not in global destruction [CPAN #75614] */
- && DBIc_PARENT_COM(imp_xxh)
- && DBIc_CALL_DEPTH(DBIc_PARENT_COM(imp_xxh))) >= 1);
-
- }
-
-
- /* --- dispatch --- */
-
- if (!keep_error && meth_type != methtype_set_err) {
- SV *err_sv;
- if (trace_level && SvOK(err_sv=DBIc_ERR(imp_xxh))) {
- PerlIO *logfp = DBILOGFP;
- PerlIO_printf(logfp, " !! The %s '%s' was CLEARED by call to %s method\n",
- SvTRUE(err_sv) ? "ERROR" : strlen(SvPV_nolen(err_sv)) ? "warn" : "info",
- neatsvpv(DBIc_ERR(imp_xxh),0), meth_name);
- }
- DBIh_CLEAR_ERROR(imp_xxh);
- }
- else { /* we check for change in ErrCount/err_hash during call */
- ErrCount = DBIc_ErrCount(imp_xxh);
- if (keep_error)
- keep_error = err_hash(aTHX_ imp_xxh);
- }
-
- if (DBIc_has(imp_xxh,DBIcf_Callbacks)
- && (tmp_svp = hv_fetch((HV*)SvRV(h), "Callbacks", 9, 0))
- && ( (hook_svp = hv_fetch((HV*)SvRV(*tmp_svp), meth_name, strlen(meth_name), 0))
- /* the "*" fallback callback only applies to non-nested calls
- * and also doesn't apply to the 'set_err' or DESTROY methods.
- * Nor during global destruction.
- * Other restrictions may be added over time.
- * It's an undocumented hack.
- */
- || (!is_nested_call && !PL_dirty && meth_type != methtype_set_err &&
- meth_type != methtype_DESTROY &&
- (hook_svp = hv_fetch((HV*)SvRV(*tmp_svp), "*", 1, 0))
- )
- )
- && SvROK(*hook_svp)
- ) {
- SV *orig_defsv;
- SV *temp_defsv;
- SV *code = SvRV(*hook_svp);
- I32 skip_dispatch = 0;
- if (trace_level)
- PerlIO_printf(DBILOGFP, "%c {{ %s callback %s being invoked with %ld args\n",
- (PL_dirty?'!':' '), meth_name, neatsvpv(*hook_svp,0), (long)items);
-
- /* we don't use ENTER,SAVETMPS & FREETMPS,LEAVE because we may need mortal
- * results to live long enough to be returned to our caller
- */
- /* we want to localize $_ for the callback but can't just do that alone
- * because we're not using SAVETMPS & FREETMPS, so we have to get sneaky.
- * We still localize, so we're safe from the callback die-ing,
- * but after the callback we manually restore the original $_.
- */
- orig_defsv = DEFSV; /* remember the current $_ */
- SAVE_DEFSV; /* local($_) = $method_name */
- temp_defsv = sv_2mortal(newSVpv(meth_name,0));
-# ifdef SvTEMP_off
- SvTEMP_off(temp_defsv);
-# endif
- DEFSV_set(temp_defsv);
-
- EXTEND(SP, items+1);
- PUSHMARK(SP);
- PUSHs(orig_h); /* push outer handle, then others params */
- for (i=1; i < items; ++i) { /* start at 1 to skip handle */
- PUSHs( ST(i) );
- }
- PUTBACK;
- outitems = call_sv(code, G_ARRAY); /* call the callback code */
- MSPAGAIN;
-
- /* The callback code can undef $_ to indicate to skip dispatch */
- skip_dispatch = !SvOK(DEFSV);
- /* put $_ back now, but with an incremented ref count to compensate
- * for the ref count decrement that will happen when we exit the scope.
- */
- DEFSV_set(SvREFCNT_inc(orig_defsv));
-
- if (trace_level)
- PerlIO_printf(DBILOGFP, "%c }} %s callback %s returned%s\n",
- (PL_dirty?'!':' '), meth_name, neatsvpv(*hook_svp,0),
- skip_dispatch ? ", actual method will not be called" : ""
- );
- if (skip_dispatch) { /* XXX experimental */
- int ix = outitems;
- /* copy the new items down to the destination list */
- while (ix-- > 0) {
- if(0)warn("\tcopy down %d: %s overwriting %s\n", ix, SvPV_nolen(TOPs), SvPV_nolen(ST(ix)) );
- ST(ix) = POPs;
- }
- imp_msv = *hook_svp; /* for trace and profile */
- goto post_dispatch;
- }
- else {
- if (outitems != 0)
- die("Callback for %s returned %d values but must not return any (temporary restriction in current version)",
- meth_name, (int)outitems);
- /* POP's and PUTBACK? to clear stack */
- }
- }
-
- /* set Executed after Callbacks so it's not set if callback elects to skip the method */
- if (ima_flags & IMA_EXECUTE) {
- imp_xxh_t *parent = DBIc_PARENT_COM(imp_xxh);
- DBIc_on(imp_xxh, DBIcf_Executed);
- if (parent)
- DBIc_on(parent, DBIcf_Executed);
- }
-
- /* The "quick_FETCH" logic... */
- /* Shortcut for fetching attributes to bypass method call overheads */
- if (meth_type == methtype_FETCH && !DBIc_COMPAT(imp_xxh)) {
- STRLEN kl;
- const char *key = SvPV(st1, kl);
- SV **attr_svp;
- if (*key != '_' && (attr_svp=hv_fetch((HV*)SvRV(h), key, kl, 0))) {
- qsv = *attr_svp;
- /* disable FETCH from cache for special attributes */
- if (SvROK(qsv) && SvTYPE(SvRV(qsv))==SVt_PVHV && *key=='D' &&
- ( (kl==6 && DBIc_TYPE(imp_xxh)==DBIt_DB && strEQ(key,"Driver"))
- || (kl==8 && DBIc_TYPE(imp_xxh)==DBIt_ST && strEQ(key,"Database")) )
- ) {
- qsv = Nullsv;
- }
- /* disable profiling of FETCH of Profile data */
- if (*key == 'P' && strEQ(key, "Profile"))
- profile_t1 = 0.0;
- }
- if (qsv) { /* skip real method call if we already have a 'quick' value */
- ST(0) = sv_mortalcopy(qsv);
- outitems = 1;
- goto post_dispatch;
- }
- }
-
- {
- CV *meth_cv;
-#ifdef DBI_save_hv_fetch_ent
- HE save_mh;
- if (meth_type == methtype_FETCH)
- save_mh = PL_hv_fetch_ent_mh; /* XXX nested tied FETCH bug17575 workaround */
-#endif
-
- if (trace_flags) {
- SAVEI32(DBIS->debug); /* fall back to orig value later */
- DBIS->debug = trace_flags; /* make new value global (for now) */
- if (ima) {
- /* enabling trace via flags takes precedence over disabling due to min level */
- if ((trace_flags & DBIc_TRACE_FLAGS_MASK) & (ima->method_trace & DBIc_TRACE_FLAGS_MASK))
- trace_level = (trace_level < 2) ? 2 : trace_level; /* min */
- else
- if (trace_level < (DBIc_TRACE_LEVEL_MASK & ima->method_trace))
- trace_level = 0; /* silence dispatch log for this method */
- }
- }
-
- if (is_orig_method_name
- && ima->stash == DBIc_IMP_STASH(imp_xxh)
- && ima->generation == PL_sub_generation +
- MY_cache_gen(DBIc_IMP_STASH(imp_xxh))
- )
- imp_msv = (SV*)ima->gv;
- else {
- imp_msv = (SV*)gv_fetchmethod_autoload(DBIc_IMP_STASH(imp_xxh),
- meth_name, FALSE);
- if (is_orig_method_name) {
- /* clear stale entry, if any */
- SvREFCNT_dec(ima->stash);
- SvREFCNT_dec(ima->gv);
- if (!imp_msv) {
- ima->stash = NULL;
- ima->gv = NULL;
- }
- else {
- ima->stash = (HV*)SvREFCNT_inc(DBIc_IMP_STASH(imp_xxh));
- ima->gv = (GV*)SvREFCNT_inc(imp_msv);
- ima->generation = PL_sub_generation +
- MY_cache_gen(DBIc_IMP_STASH(imp_xxh));
- }
- }
- }
-
- /* if method was a 'func' then try falling back to real 'func' method */
- if (!imp_msv && (ima_flags & IMA_FUNC_REDIRECT)) {
- imp_msv = (SV*)gv_fetchmethod_autoload(DBIc_IMP_STASH(imp_xxh), "func", FALSE);
- if (imp_msv) {
- /* driver does have func method so undo the earlier 'func' stack changes */
- PUSHs(sv_2mortal(newSVpv(meth_name,0)));
- PUTBACK;
- ++items;
- meth_name = "func";
- meth_type = methtype_ordinary;
- }
- }
-
- if (trace_level >= (is_nested_call ? 4 : 2)) {
- PerlIO *logfp = DBILOGFP;
- /* Full pkg method name (or just meth_name for ANON CODE) */
- const char *imp_meth_name = (imp_msv && isGV(imp_msv)) ? GvNAME(imp_msv) : meth_name;
- HV *imp_stash = DBIc_IMP_STASH(imp_xxh);
- PerlIO_printf(logfp, "%c -> %s ",
- call_depth>1 ? '0'+call_depth-1 : (PL_dirty?'!':' '), imp_meth_name);
- if (imp_meth_name[0] == 'A' && strEQ(imp_meth_name,"AUTOLOAD"))
- PerlIO_printf(logfp, "\"%s\" ", meth_name);
- if (imp_msv && isGV(imp_msv) && GvSTASH(imp_msv) != imp_stash)
- PerlIO_printf(logfp, "in %s ", HvNAME(GvSTASH(imp_msv)));
- PerlIO_printf(logfp, "for %s (%s", HvNAME(imp_stash),
- SvPV_nolen(orig_h));
- if (h != orig_h) /* show inner handle to aid tracing */
- PerlIO_printf(logfp, "~0x%lx", (long)SvRV(h));
- else PerlIO_printf(logfp, "~INNER");
- for(i=1; i<items; ++i) {
- PerlIO_printf(logfp," %s",
- (ima && i==ima->hidearg) ? "****" : neatsvpv(ST(i),0));
- }
-#ifdef DBI_USE_THREADS
- PerlIO_printf(logfp, ") thr#%p\n", (void*)DBIc_THR_USER(imp_xxh));
-#else
- PerlIO_printf(logfp, ")\n");
-#endif
- PerlIO_flush(logfp);
- }
-
- if (!imp_msv || ! ((meth_cv = GvCV(imp_msv))) ) {
- if (PL_dirty || is_DESTROY) {
- outitems = 0;
- goto post_dispatch;
- }
- if (ima_flags & IMA_NOT_FOUND_OKAY) {
- outitems = 0;
- goto post_dispatch;
- }
- croak("Can't locate DBI object method \"%s\" via package \"%s\"",
- meth_name, HvNAME(DBIc_IMP_STASH(imp_xxh)));
- }
-
- PUSHMARK(mark); /* mark arguments again so we can pass them on */
-
- /* Note: the handle on the stack is still an object blessed into a
- * DBI::* class and not the DBD::*::* class whose method is being
- * invoked. This is correct and should be largely transparent.
- */
-
- /* SHORT-CUT ALERT! */
- if (use_xsbypass && CvISXSUB(meth_cv) && CvXSUB(meth_cv)) {
-
- /* If we are calling an XSUB we jump directly to its C code and
- * bypass perl_call_sv(), pp_entersub() etc. This is fast.
- * This code is based on a small section of pp_entersub().
- */
- (void)(*CvXSUB(meth_cv))(aTHXo_ meth_cv); /* Call the C code directly */
-
- if (gimme == G_SCALAR) { /* Enforce sanity in scalar context */
- if (ax != PL_stack_sp - PL_stack_base ) { /* outitems != 1 */
- ST(0) =
- (ax > PL_stack_sp - PL_stack_base)
- ? &PL_sv_undef /* outitems == 0 */
- : *PL_stack_sp; /* outitems > 1 */
- PL_stack_sp = PL_stack_base + ax;
- }
- outitems = 1;
- }
- else {
- outitems = PL_stack_sp - (PL_stack_base + ax - 1);
- }
-
- }
- else {
- /* sv_dump(imp_msv); */
- outitems = call_sv((SV*)meth_cv,
- (is_DESTROY ? gimme | G_EVAL | G_KEEPERR : gimme) );
- }
-
- XSprePUSH; /* reset SP to base of stack frame */
-
-#ifdef DBI_save_hv_fetch_ent
- if (meth_type == methtype_FETCH)
- PL_hv_fetch_ent_mh = save_mh; /* see start of block */
-#endif
- }
-
- post_dispatch:
-
- if (is_DESTROY && DBI_IS_LAST_HANDLE(h)) { /* if destroying _this_ handle */
- SV *lhp = DBIc_PARENT_H(imp_xxh);
- if (lhp && SvROK(lhp)) {
- DBI_SET_LAST_HANDLE(lhp);
- }
- else {
- DBI_UNSET_LAST_HANDLE;
- }
- }
-
- if (keep_error) {
- /* if we didn't clear err before the call, check to see if a new error
- * or warning has been recorded. If so, turn off keep_error so it gets acted on
- */
- if (DBIc_ErrCount(imp_xxh) > ErrCount || err_hash(aTHX_ imp_xxh) != keep_error) {
- keep_error = 0;
- }
- }
-
- err_sv = DBIc_ERR(imp_xxh);
-
- if (trace_level >= (is_nested_call ? 3 : 1)) {
- PerlIO *logfp = DBILOGFP;
- const int is_fetch = (meth_type == methtype_fetch_star && DBIc_TYPE(imp_xxh)==DBIt_ST);
- const IV row_count = (is_fetch) ? DBIc_ROW_COUNT((imp_sth_t*)imp_xxh) : 0;
- if (is_fetch && row_count>=2 && trace_level<=4 && SvOK(ST(0))) {
- /* skip the 'middle' rows to reduce output */
- goto skip_meth_return_trace;
- }
- if (SvOK(err_sv)) {
- PerlIO_printf(logfp, " %s %s %s %s (err#%ld)\n", (keep_error) ? " " : "!!",
- SvTRUE(err_sv) ? "ERROR:" : strlen(SvPV_nolen(err_sv)) ? "warn:" : "info:",
- neatsvpv(err_sv,0), neatsvpv(DBIc_ERRSTR(imp_xxh),0), (long)DBIc_ErrCount(imp_xxh));
- }
- PerlIO_printf(logfp,"%c%c <%c %s",
- (call_depth > 1) ? '0'+call_depth-1 : (PL_dirty?'!':' '),
- (DBIc_is(imp_xxh, DBIcf_TaintIn|DBIcf_TaintOut)) ? 'T' : ' ',
- (qsv) ? '>' : '-',
- meth_name);
- if (trace_level==1 && (items>=2||is_DESTROY)) { /* make level 1 more useful */
- /* we only have the first two parameters available here */
- if (is_DESTROY) /* show handle as first arg to DESTROY */
- /* want to show outer handle so trace makes sense */
- /* but outer handle has been destroyed so we fake it */
- PerlIO_printf(logfp,"(%s=HASH(0x%p)", HvNAME(SvSTASH(SvRV(orig_h))), (void*)DBIc_MY_H(imp_xxh));
- else
- PerlIO_printf(logfp,"(%s", neatsvpv(st1,0));
- if (items >= 3)
- PerlIO_printf(logfp,", %s", neatsvpv(st2,0));
- PerlIO_printf(logfp,"%s)", (items > 3) ? ", ..." : "");
- }
-
- if (gimme & G_ARRAY)
- PerlIO_printf(logfp,"= (");
- else PerlIO_printf(logfp,"=");
- for(i=0; i < outitems; ++i) {
- SV *s = ST(i);
- if ( SvROK(s) && SvTYPE(SvRV(s))==SVt_PVAV) {
- AV *av = (AV*)SvRV(s);
- int avi;
- int avi_last = SvIV(DBIS->neatsvpvlen) / 10;
- if (avi_last < 39)
- avi_last = 39;
- PerlIO_printf(logfp, " [");
- for (avi=0; avi <= AvFILL(av); ++avi) {
- PerlIO_printf(logfp, " %s", neatsvpv(AvARRAY(av)[avi],0));
- if (avi >= avi_last && AvFILL(av) - avi > 1) {
- PerlIO_printf(logfp, " ... %ld others skipped", AvFILL(av) - avi);
- break;
- }
- }
- PerlIO_printf(logfp, " ]");
- }
- else {
- PerlIO_printf(logfp, " %s", neatsvpv(s,0));
- if ( SvROK(s) && SvTYPE(SvRV(s))==SVt_PVHV && !SvOBJECT(SvRV(s)) )
- PerlIO_printf(logfp, "%ldkeys", (long)HvKEYS(SvRV(s)));
- }
- }
- if (gimme & G_ARRAY) {
- PerlIO_printf(logfp," ) [%d items]", outitems);
- }
- if (is_fetch && row_count) {
- PerlIO_printf(logfp," row%"IVdf, row_count);
- }
- if (qsv) /* flag as quick and peek at the first arg (still on the stack) */
- PerlIO_printf(logfp," (%s from cache)", neatsvpv(st1,0));
- else if (!imp_msv)
- PerlIO_printf(logfp," (not implemented)");
- /* XXX add flag to show pid here? */
- /* add file and line number information */
- PerlIO_puts(logfp, log_where(0, 0, " at ", "\n", 1, (trace_level >= 3), (trace_level >= 4)));
- skip_meth_return_trace:
- PerlIO_flush(logfp);
- }
-
- if (ima_flags & IMA_END_WORK) { /* commit() or rollback() */
- /* XXX does not consider if the method call actually worked or not */
- DBIc_off(imp_xxh, DBIcf_Executed);
-
- if (DBIc_has(imp_xxh, DBIcf_BegunWork)) {
- DBIc_off(imp_xxh, DBIcf_BegunWork);
- if (!DBIc_has(imp_xxh, DBIcf_AutoCommit)) {
- /* We only get here if the driver hasn't implemented their own code */
- /* for begin_work, or has but hasn't correctly turned AutoCommit */
- /* back on in their commit or rollback code. So we have to do it. */
- /* This is bad because it'll probably trigger a spurious commit() */
- /* and may mess up the error handling below for the commit/rollback */
- PUSHMARK(SP);
- XPUSHs(h);
- XPUSHs(sv_2mortal(newSVpv("AutoCommit",0)));
- XPUSHs(&PL_sv_yes);
- PUTBACK;
- call_method("STORE", G_VOID);
- MSPAGAIN;
- }
- }
- }
-
- if (PL_tainting
- && DBIc_is(imp_xxh, DBIcf_TaintOut) /* taint checks requested */
- /* XXX this would taint *everything* being returned from *any* */
- /* method that doesn't have IMA_NO_TAINT_OUT set. */
- /* DISABLED: just tainting fetched data in get_fbav seems ok */
- && 0/* XXX disabled*/ /* !(ima_flags & IMA_NO_TAINT_OUT) */
- ) {
- dTHR;
- TAINT; /* affects sv_setsv()'s within same perl statement */
- for(i=0; i < outitems; ++i) {
- I32 avi;
- char *p;
- SV *s;
- SV *agg = ST(i);
- if ( !SvROK(agg) )
- continue;
- agg = SvRV(agg);
-#define DBI_OUT_TAINTABLE(s) (!SvREADONLY(s) && !SvTAINTED(s))
- switch (SvTYPE(agg)) {
- case SVt_PVAV:
- for(avi=0; avi <= AvFILL((AV*)agg); ++avi) {
- s = AvARRAY((AV*)agg)[avi];
- if (DBI_OUT_TAINTABLE(s))
- SvTAINTED_on(s);
- }
- break;
- case SVt_PVHV:
- hv_iterinit((HV*)agg);
- while( (s = hv_iternextsv((HV*)agg, &p, &avi)) ) {
- if (DBI_OUT_TAINTABLE(s))
- SvTAINTED_on(s);
- }
- break;
- default:
- if (DBIc_WARN(imp_xxh)) {
- PerlIO_printf(DBILOGFP,"Don't know how to taint contents of returned %s (type %d)\n",
- neatsvpv(agg,0), (int)SvTYPE(agg));
- }
- }
- }
- }
-
- /* if method returned a new handle, and that handle has an error on it
- * then copy the error up into the parent handle
- */
- if (ima_flags & IMA_IS_FACTORY && SvROK(ST(0))) {
- SV *h_new = ST(0);
- D_impdata(imp_xxh_new, imp_xxh_t, h_new);
- if (SvOK(DBIc_ERR(imp_xxh_new))) {
- set_err_sv(h, imp_xxh, DBIc_ERR(imp_xxh_new), DBIc_ERRSTR(imp_xxh_new), DBIc_STATE(imp_xxh_new), &PL_sv_no);
- }
- }
-
- if ( !keep_error /* is a new err/warn/info */
- && !is_nested_call /* skip nested (internal) calls */
- && (
- /* is an error and has RaiseError|PrintError|HandleError set */
- (SvTRUE(err_sv) && DBIc_has(imp_xxh, DBIcf_RaiseError|DBIcf_PrintError|DBIcf_HandleError))
- /* is a warn (not info) and has PrintWarn set */
- || ( SvOK(err_sv) && strlen(SvPV_nolen(err_sv)) && DBIc_has(imp_xxh, DBIcf_PrintWarn))
- )
- ) {
- SV *msg;
- SV **statement_svp = NULL;
- const int is_warning = (!SvTRUE(err_sv) && strlen(SvPV_nolen(err_sv))==1);
- const char *err_meth_name = meth_name;
- char intro[200];
-
- if (meth_type == methtype_set_err) {
- SV **sem_svp = hv_fetch((HV*)SvRV(h), "dbi_set_err_method", 18, GV_ADDWARN);
- if (SvOK(*sem_svp))
- err_meth_name = SvPV_nolen(*sem_svp);
- }
-
- /* XXX change to vsprintf into sv directly */
- sprintf(intro,"%s %s %s: ", HvNAME(DBIc_IMP_STASH(imp_xxh)), err_meth_name,
- SvTRUE(err_sv) ? "failed" : is_warning ? "warning" : "information");
- msg = sv_2mortal(newSVpv(intro,0));
- if (SvOK(DBIc_ERRSTR(imp_xxh)))
- sv_catsv(msg, DBIc_ERRSTR(imp_xxh));
- else
- sv_catpvf(msg, "(err=%s, errstr=undef, state=%s)",
- neatsvpv(DBIc_ERR(imp_xxh),0), neatsvpv(DBIc_STATE(imp_xxh),0) );
-
- if ( DBIc_has(imp_xxh, DBIcf_ShowErrorStatement)
- && !is_unrelated_to_Statement
- && (DBIc_TYPE(imp_xxh) == DBIt_ST || ima_flags & IMA_SHOW_ERR_STMT)
- && (statement_svp = hv_fetch((HV*)SvRV(h), "Statement", 9, 0))
- && statement_svp && SvOK(*statement_svp)
- ) {
- SV **svp = 0;
- sv_catpv(msg, " [for Statement \"");
- sv_catsv(msg, *statement_svp);
-
- /* fetch from tied outer handle to trigger FETCH magic */
- /* could add DBIcf_ShowErrorParams (default to on?) */
- if (!(ima_flags & IMA_HIDE_ERR_PARAMVALUES)) {
- svp = hv_fetch((HV*)DBIc_MY_H(imp_xxh),"ParamValues",11,FALSE);
- if (svp && SvMAGICAL(*svp))
- mg_get(*svp); /* XXX may recurse, may croak. could use eval */
- }
- if (svp && SvRV(*svp) && SvTYPE(SvRV(*svp)) == SVt_PVHV && HvKEYS(SvRV(*svp))>0 ) {
- SV *param_values_sv = sv_2mortal(_join_hash_sorted((HV*)SvRV(*svp), "=",1, ", ",2, 1, -1));
- sv_catpv(msg, "\" with ParamValues: ");
- sv_catsv(msg, param_values_sv);
- sv_catpvn(msg, "]", 1);
- }
- else {
- sv_catpv(msg, "\"]");
- }
- }
-
- if (0) {
- COP *cop = dbi_caller_cop();
- if (cop && (CopLINE(cop) != CopLINE(PL_curcop) || CopFILEGV(cop) != CopFILEGV(PL_curcop))) {
- dbi_caller_string(msg, cop, " called via ", 1, 0);
- }
- }
-
- hook_svp = NULL;
- if ( SvTRUE(err_sv)
- && DBIc_has(imp_xxh, DBIcf_HandleError)
- && (hook_svp = hv_fetch((HV*)SvRV(h),"HandleError",11,0))
- && hook_svp && SvOK(*hook_svp)
- ) {
- dSP;
- PerlIO *logfp = DBILOGFP;
- IV items;
- SV *status;
- SV *result; /* point to result SV that's pointed to by the stack */
- if (outitems) {
- result = *(sp-outitems+1);
- if (SvREADONLY(result)) {
- *(sp-outitems+1) = result = sv_2mortal(newSVsv(result));
- }
- }
- else {
- result = sv_newmortal();
- }
- if (trace_level)
- PerlIO_printf(logfp," -> HandleError on %s via %s%s%s%s\n",
- neatsvpv(h,0), neatsvpv(*hook_svp,0),
- (!outitems ? "" : " ("),
- (!outitems ? "" : neatsvpv(result ,0)),
- (!outitems ? "" : ")")
- );
- PUSHMARK(SP);
- XPUSHs(msg);
- XPUSHs(sv_2mortal(newRV_inc((SV*)DBIc_MY_H(imp_xxh))));
- XPUSHs( result );
- PUTBACK;
- items = call_sv(*hook_svp, G_SCALAR);
- MSPAGAIN;
- status = (items) ? POPs : &PL_sv_undef;
- PUTBACK;
- if (trace_level)
- PerlIO_printf(logfp," <- HandleError= %s%s%s%s\n",
- neatsvpv(status,0),
- (!outitems ? "" : " ("),
- (!outitems ? "" : neatsvpv(result,0)),
- (!outitems ? "" : ")")
- );
- if (!SvTRUE(status)) /* handler says it didn't handle it, so... */
- hook_svp = 0; /* pretend we didn't have a handler... */
- }
-
- if (profile_t1) { /* see also dbi_profile() call a few lines below */
- SV *statement_sv = (is_unrelated_to_Statement) ? &PL_sv_no : &PL_sv_undef;
- dbi_profile(h, imp_xxh, statement_sv, imp_msv ? imp_msv : (SV*)cv,
- profile_t1, dbi_time());
- }
- if (is_warning) {
- if (DBIc_has(imp_xxh, DBIcf_PrintWarn))
- warn_sv(msg);
- }
- else if (!hook_svp && SvTRUE(err_sv)) {
- if (DBIc_has(imp_xxh, DBIcf_PrintError))
- warn_sv(msg);
- if (DBIc_has(imp_xxh, DBIcf_RaiseError))
- croak_sv(msg);
- }
- }
- else if (profile_t1) { /* see also dbi_profile() call a few lines above */
- SV *statement_sv = (is_unrelated_to_Statement) ? &PL_sv_no : &PL_sv_undef;
- dbi_profile(h, imp_xxh, statement_sv, imp_msv ? imp_msv : (SV*)cv,
- profile_t1, dbi_time());
- }
- XSRETURN(outitems);
-}
-
-
-
-/* -------------------------------------------------------------------- */
-
-/* comment and placeholder styles to accept and return */
-
-#define DBIpp_cm_cs 0x000001 /* C style */
-#define DBIpp_cm_hs 0x000002 /* # */
-#define DBIpp_cm_dd 0x000004 /* -- */
-#define DBIpp_cm_br 0x000008 /* {} */
-#define DBIpp_cm_dw 0x000010 /* '-- ' dash dash whitespace */
-#define DBIpp_cm_XX 0x00001F /* any of the above */
-
-#define DBIpp_ph_qm 0x000100 /* ? */
-#define DBIpp_ph_cn 0x000200 /* :1 */
-#define DBIpp_ph_cs 0x000400 /* :name */
-#define DBIpp_ph_sp 0x000800 /* %s (as return only, not accept) */
-#define DBIpp_ph_XX 0x000F00 /* any of the above */
-
-#define DBIpp_st_qq 0x010000 /* '' char escape */
-#define DBIpp_st_bs 0x020000 /* \ char escape */
-#define DBIpp_st_XX 0x030000 /* any of the above */
-
-#define DBIpp_L_BRACE '{'
-#define DBIpp_R_BRACE '}'
-#define PS_accept(flag) DBIbf_has(ps_accept,(flag))
-#define PS_return(flag) DBIbf_has(ps_return,(flag))
-
-SV *
-preparse(SV *dbh, const char *statement, IV ps_return, IV ps_accept, void *foo)
-{
- dTHX;
- D_imp_xxh(dbh);
-/*
- The idea here is that ps_accept defines which constructs to
- recognize (accept) as valid in the source string (other
- constructs are ignored), and ps_return defines which
- constructs are valid to return in the result string.
-
- If a construct that is valid in the input is also valid in the
- output then it's simply copied. If it's not valid in the output
- then it's editied into one of the valid forms (ideally the most
- 'standard' and/or information preserving one).
-
- For example, if ps_accept includes '--' style comments but
- ps_return doesn't, but ps_return does include '#' style
- comments then any '--' style comments would be rewritten as '#'
- style comments.
-
- Similarly for placeholders. DBD::Oracle, for example, would say
- '?', ':1' and ':name' are all acceptable input, but only
- ':name' should be returned.
-
- (There's a tricky issue with the '--' comment style because it can
- clash with valid syntax, i.e., "... set foo=foo--1 ..." so it
- would be *bad* to misinterpret that as the start of a comment.
- Perhaps we need a DBIpp_cm_dw (for dash-dash-whitespace) style
- to allow for that.)
-
- Also, we'll only support DBIpp_cm_br as an input style. And
- even then, only with reluctance. We may (need to) drop it when
- we add support for odbc escape sequences.
-*/
- int idx = 1;
-
- char in_quote = '\0';
- char in_comment = '\0';
- char rt_comment = '\0';
- char *dest, *start;
- const char *src;
- const char *style = "", *laststyle = NULL;
- SV *new_stmt_sv;
-
- (void)foo;
-
- if (!(ps_return | DBIpp_ph_XX)) { /* no return ph type specified */
- ps_return |= ps_accept | DBIpp_ph_XX; /* so copy from ps_accept */
- }
-
- /* XXX this allocation strategy won't work when we get to more advanced stuff */
- new_stmt_sv = newSV(strlen(statement) * 3);
- sv_setpv(new_stmt_sv,"");
- src = statement;
- dest = SvPVX(new_stmt_sv);
-
- while( *src )
- {
- if (*src == '%' && PS_return(DBIpp_ph_sp))
- *dest++ = '%';
-
- if (in_comment)
- {
- if ( (in_comment == '-' && (*src == '\n' || *(src+1) == '\0'))
- || (in_comment == '#' && (*src == '\n' || *(src+1) == '\0'))
- || (in_comment == DBIpp_L_BRACE && *src == DBIpp_R_BRACE) /* XXX nesting? */
- || (in_comment == '/' && *src == '*' && *(src+1) == '/')
- ) {
- switch (rt_comment) {
- case '/': *dest++ = '*'; *dest++ = '/'; break;
- case '-': *dest++ = '\n'; break;
- case '#': *dest++ = '\n'; break;
- case DBIpp_L_BRACE: *dest++ = DBIpp_R_BRACE; break;
- case '\0': /* ensure deleting a comment doesn't join two tokens */
- if (in_comment=='/' || in_comment==DBIpp_L_BRACE)
- *dest++ = ' '; /* ('-' and '#' styles use the newline) */
- break;
- }
- if (in_comment == '/')
- src++;
- src += (*src != '\n' || *(dest-1)=='\n') ? 1 : 0;
- in_comment = '\0';
- rt_comment = '\0';
- }
- else
- if (rt_comment)
- *dest++ = *src++;
- else
- src++; /* delete (don't copy) the comment */
- continue;
- }
-
- if (in_quote)
- {
- if (*src == in_quote) {
- in_quote = 0;
- }
- *dest++ = *src++;
- continue;
- }
-
- /* Look for comments */
- if (*src == '-' && *(src+1) == '-' &&
- (PS_accept(DBIpp_cm_dd) || (*(src+2) == ' ' && PS_accept(DBIpp_cm_dw)))
- )
- {
- in_comment = *src;
- src += 2; /* skip past 2nd char of double char delimiters */
- if (PS_return(DBIpp_cm_dd) || PS_return(DBIpp_cm_dw)) {
- *dest++ = rt_comment = '-';
- *dest++ = '-';
- if (PS_return(DBIpp_cm_dw) && *src!=' ')
- *dest++ = ' '; /* insert needed white space */
- }
- else if (PS_return(DBIpp_cm_cs)) {
- *dest++ = rt_comment = '/';
- *dest++ = '*';
- }
- else if (PS_return(DBIpp_cm_hs)) {
- *dest++ = rt_comment = '#';
- }
- else if (PS_return(DBIpp_cm_br)) {
- *dest++ = rt_comment = DBIpp_L_BRACE;
- }
- continue;
- }
- else if (*src == '/' && *(src+1) == '*' && PS_accept(DBIpp_cm_cs))
- {
- in_comment = *src;
- src += 2; /* skip past 2nd char of double char delimiters */
- if (PS_return(DBIpp_cm_cs)) {
- *dest++ = rt_comment = '/';
- *dest++ = '*';
- }
- else if (PS_return(DBIpp_cm_dd) || PS_return(DBIpp_cm_dw)) {
- *dest++ = rt_comment = '-';
- *dest++ = '-';
- if (PS_return(DBIpp_cm_dw)) *dest++ = ' ';
- }
- else if (PS_return(DBIpp_cm_hs)) {
- *dest++ = rt_comment = '#';
- }
- else if (PS_return(DBIpp_cm_br)) {
- *dest++ = rt_comment = DBIpp_L_BRACE;
- }
- continue;
- }
- else if (*src == '#' && PS_accept(DBIpp_cm_hs))
- {
- in_comment = *src;
- src++;
- if (PS_return(DBIpp_cm_hs)) {
- *dest++ = rt_comment = '#';
- }
- else if (PS_return(DBIpp_cm_dd) || PS_return(DBIpp_cm_dw)) {
- *dest++ = rt_comment = '-';
- *dest++ = '-';
- if (PS_return(DBIpp_cm_dw)) *dest++ = ' ';
- }
- else if (PS_return(DBIpp_cm_cs)) {
- *dest++ = rt_comment = '/';
- *dest++ = '*';
- }
- else if (PS_return(DBIpp_cm_br)) {
- *dest++ = rt_comment = DBIpp_L_BRACE;
- }
- continue;
- }
- else if (*src == DBIpp_L_BRACE && PS_accept(DBIpp_cm_br))
- {
- in_comment = *src;
- src++;
- if (PS_return(DBIpp_cm_br)) {
- *dest++ = rt_comment = DBIpp_L_BRACE;
- }
- else if (PS_return(DBIpp_cm_dd) || PS_return(DBIpp_cm_dw)) {
- *dest++ = rt_comment = '-';
- *dest++ = '-';
- if (PS_return(DBIpp_cm_dw)) *dest++ = ' ';
- }
- else if (PS_return(DBIpp_cm_cs)) {
- *dest++ = rt_comment = '/';
- *dest++ = '*';
- }
- else if (PS_return(DBIpp_cm_hs)) {
- *dest++ = rt_comment = '#';
- }
- continue;
- }
-
- if ( !(*src==':' && (PS_accept(DBIpp_ph_cn) || PS_accept(DBIpp_ph_cs)))
- && !(*src=='?' && PS_accept(DBIpp_ph_qm))
- ){
- if (*src == '\'' || *src == '"')
- in_quote = *src;
- *dest++ = *src++;
- continue;
- }
-
- /* only here for : or ? outside of a comment or literal */
-
- start = dest; /* save name inc colon */
- *dest++ = *src++; /* copy and move past first char */
-
- if (*start == '?') /* X/Open Standard */
- {
- style = "?";
-
- if (PS_return(DBIpp_ph_qm))
- ;
- else if (PS_return(DBIpp_ph_cn)) { /* '?' -> ':p1' (etc) */
- sprintf(start,":p%d", idx++);
- dest = start+strlen(start);
- }
- else if (PS_return(DBIpp_ph_sp)) { /* '?' -> '%s' */
- *start = '%';
- *dest++ = 's';
- }
- }
- else if (isDIGIT(*src)) { /* :1 */
- const int pln = atoi(src);
- style = ":1";
-
- if (PS_return(DBIpp_ph_cn)) { /* ':1'->':p1' */
- idx = pln;
- *dest++ = 'p';
- while(isDIGIT(*src))
- *dest++ = *src++;
- }
- else if (PS_return(DBIpp_ph_qm) /* ':1' -> '?' */
- || PS_return(DBIpp_ph_sp) /* ':1' -> '%s' */
- ) {
- PS_return(DBIpp_ph_qm) ? sprintf(start,"?") : sprintf(start,"%%s");
- dest = start + strlen(start);
- if (pln != idx) {
- char buf[99];
- sprintf(buf, "preparse found placeholder :%d out of sequence, expected :%d", pln, idx);
- set_err_char(dbh, imp_xxh, "1", 1, buf, 0, "preparse");
- return &PL_sv_undef;
- }
- while(isDIGIT(*src)) src++;
- idx++;
- }
- }
- else if (isALNUM(*src)) /* :name */
- {
- style = ":name";
-
- if (PS_return(DBIpp_ph_cs)) {
- ;
- }
- else if (PS_return(DBIpp_ph_qm) /* ':name' -> '?' */
- || PS_return(DBIpp_ph_sp) /* ':name' -> '%s' */
- ) {
- PS_return(DBIpp_ph_qm) ? sprintf(start,"?") : sprintf(start,"%%s");
- dest = start + strlen(start);
- while (isALNUM(*src)) /* consume name, includes '_' */
- src++;
- }
- }
- /* perhaps ':=' PL/SQL construct */
- else { continue; }
-
- *dest = '\0'; /* handy for debugging */
-
- if (laststyle && style != laststyle) {
- char buf[99];
- sprintf(buf, "preparse found mixed placeholder styles (%s / %s)", style, laststyle);
- set_err_char(dbh, imp_xxh, "1", 1, buf, 0, "preparse");
- return &PL_sv_undef;
- }
- laststyle = style;
- }
- *dest = '\0';
-
- /* warn about probable parsing errors, but continue anyway (returning processed string) */
- switch (in_quote)
- {
- case '\'':
- set_err_char(dbh, imp_xxh, "1", 1, "preparse found unterminated single-quoted string", 0, "preparse");
- break;
- case '\"':
- set_err_char(dbh, imp_xxh, "1", 1, "preparse found unterminated double-quoted string", 0, "preparse");
- break;
- }
- switch (in_comment)
- {
- case DBIpp_L_BRACE:
- set_err_char(dbh, imp_xxh, "1", 1, "preparse found unterminated bracketed {...} comment", 0, "preparse");
- break;
- case '/':
- set_err_char(dbh, imp_xxh, "1", 1, "preparse found unterminated bracketed C-style comment", 0, "preparse");
- break;
- }
-
- SvCUR_set(new_stmt_sv, strlen(SvPVX(new_stmt_sv)));
- *SvEND(new_stmt_sv) = '\0';
- return new_stmt_sv;
-}
-
-
-/* -------------------------------------------------------------------- */
-/* The DBI Perl interface (via XS) starts here. Currently these are */
-/* all internal support functions. Note install_method and see DBI.pm */
-
-#line 4483 "DBI.c"
-#ifndef PERL_UNUSED_VAR
-# define PERL_UNUSED_VAR(var) if (0) var = var
-#endif
-
-#ifndef dVAR
-# define dVAR dNOOP
-#endif
-
-
-/* This stuff is not part of the API! You have been warned. */
-#ifndef PERL_VERSION_DECIMAL
-# define PERL_VERSION_DECIMAL(r,v,s) (r*1000000 + v*1000 + s)
-#endif
-#ifndef PERL_DECIMAL_VERSION
-# define PERL_DECIMAL_VERSION \
- PERL_VERSION_DECIMAL(PERL_REVISION,PERL_VERSION,PERL_SUBVERSION)
-#endif
-#ifndef PERL_VERSION_GE
-# define PERL_VERSION_GE(r,v,s) \
- (PERL_DECIMAL_VERSION >= PERL_VERSION_DECIMAL(r,v,s))
-#endif
-#ifndef PERL_VERSION_LE
-# define PERL_VERSION_LE(r,v,s) \
- (PERL_DECIMAL_VERSION <= PERL_VERSION_DECIMAL(r,v,s))
-#endif
-
-/* XS_INTERNAL is the explicit static-linkage variant of the default
- * XS macro.
- *
- * XS_EXTERNAL is the same as XS_INTERNAL except it does not include
- * "STATIC", ie. it exports XSUB symbols. You probably don't want that
- * for anything but the BOOT XSUB.
- *
- * See XSUB.h in core!
- */
-
-
-/* TODO: This might be compatible further back than 5.10.0. */
-#if PERL_VERSION_GE(5, 10, 0) && PERL_VERSION_LE(5, 15, 1)
-# undef XS_EXTERNAL
-# undef XS_INTERNAL
-# if defined(__CYGWIN__) && defined(USE_DYNAMIC_LOADING)
-# define XS_EXTERNAL(name) __declspec(dllexport) XSPROTO(name)
-# define XS_INTERNAL(name) STATIC XSPROTO(name)
-# endif
-# if defined(__SYMBIAN32__)
-# define XS_EXTERNAL(name) EXPORT_C XSPROTO(name)
-# define XS_INTERNAL(name) EXPORT_C STATIC XSPROTO(name)
-# endif
-# ifndef XS_EXTERNAL
-# if defined(HASATTRIBUTE_UNUSED) && !defined(__cplusplus)
-# define XS_EXTERNAL(name) void name(pTHX_ CV* cv __attribute__unused__)
-# define XS_INTERNAL(name) STATIC void name(pTHX_ CV* cv __attribute__unused__)
-# else
-# ifdef __cplusplus
-# define XS_EXTERNAL(name) extern "C" XSPROTO(name)
-# define XS_INTERNAL(name) static XSPROTO(name)
-# else
-# define XS_EXTERNAL(name) XSPROTO(name)
-# define XS_INTERNAL(name) STATIC XSPROTO(name)
-# endif
-# endif
-# endif
-#endif
-
-/* perl >= 5.10.0 && perl <= 5.15.1 */
-
-
-/* The XS_EXTERNAL macro is used for functions that must not be static
- * like the boot XSUB of a module. If perl didn't have an XS_EXTERNAL
- * macro defined, the best we can do is assume XS is the same.
- * Dito for XS_INTERNAL.
- */
-#ifndef XS_EXTERNAL
-# define XS_EXTERNAL(name) XS(name)
-#endif
-#ifndef XS_INTERNAL
-# define XS_INTERNAL(name) XS(name)
-#endif
-
-/* Now, finally, after all this mess, we want an ExtUtils::ParseXS
- * internal macro that we're free to redefine for varying linkage due
- * to the EXPORT_XSUB_SYMBOLS XS keyword. This is internal, use
- * XS_EXTERNAL(name) or XS_INTERNAL(name) in your code if you need to!
- */
-
-#undef XS_EUPXS
-#if defined(PERL_EUPXS_ALWAYS_EXPORT)
-# define XS_EUPXS(name) XS_EXTERNAL(name)
-#else
- /* default to internal */
-# define XS_EUPXS(name) XS_INTERNAL(name)
-#endif
-
-#ifndef PERL_ARGS_ASSERT_CROAK_XS_USAGE
-#define PERL_ARGS_ASSERT_CROAK_XS_USAGE assert(cv); assert(params)
-
-/* prototype to pass -Wmissing-prototypes */
-STATIC void
-S_croak_xs_usage(const CV *const cv, const char *const params);
-
-STATIC void
-S_croak_xs_usage(const CV *const cv, const char *const params)
-{
- const GV *const gv = CvGV(cv);
-
- PERL_ARGS_ASSERT_CROAK_XS_USAGE;
-
- if (gv) {
- const char *const gvname = GvNAME(gv);
- const HV *const stash = GvSTASH(gv);
- const char *const hvname = stash ? HvNAME(stash) : NULL;
-
- if (hvname)
- Perl_croak_nocontext("Usage: %s::%s(%s)", hvname, gvname, params);
- else
- Perl_croak_nocontext("Usage: %s(%s)", gvname, params);
- } else {
- /* Pants. I don't think that it should be possible to get here. */
- Perl_croak_nocontext("Usage: CODE(0x%"UVxf")(%s)", PTR2UV(cv), params);
- }
-}
-#undef PERL_ARGS_ASSERT_CROAK_XS_USAGE
-
-#define croak_xs_usage S_croak_xs_usage
-
-#endif
-
-/* NOTE: the prototype of newXSproto() is different in versions of perls,
- * so we define a portable version of newXSproto()
- */
-#ifdef newXS_flags
-#define newXSproto_portable(name, c_impl, file, proto) newXS_flags(name, c_impl, file, proto, 0)
-#else
-#define newXSproto_portable(name, c_impl, file, proto) (PL_Sv=(SV*)newXS(name, c_impl, file), sv_setpv(PL_Sv, proto), (CV*)PL_Sv)
-#endif /* !defined(newXS_flags) */
-
-#if PERL_VERSION_LE(5, 21, 5)
-# define newXS_deffile(a,b) Perl_newXS(aTHX_ a,b,file)
-#else
-# define newXS_deffile(a,b) Perl_newXS_deffile(aTHX_ a,b)
-#endif
-
-#line 4627 "DBI.c"
-
-XS_EUPXS(XS_DBI_constant); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBI_constant)
-{
- dVAR; dXSARGS;
- dXSI32;
- if (items != 0)
- croak_xs_usage(cv, "");
- {
- I32 RETVAL;
- dXSTARG;
-#line 4581 "DBI.xs"
- RETVAL = ix;
-#line 4641 "DBI.c"
- XSprePUSH; PUSHi((IV)RETVAL);
- }
- XSRETURN(1);
-}
-
-
-XS_EUPXS(XS_DBI__clone_dbis); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBI__clone_dbis)
-{
- dVAR; dXSARGS;
- if (items != 0)
- croak_xs_usage(cv, "");
- {
-#line 4589 "DBI.xs"
- dMY_CXT;
- dbistate_t * parent_dbis = DBIS;
-
- (void)cv;
- {
- MY_CXT_CLONE;
- }
- dbi_bootinit(parent_dbis);
-#line 4664 "DBI.c"
- }
- XSRETURN_EMPTY;
-}
-
-
-XS_EUPXS(XS_DBI__new_handle); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBI__new_handle)
-{
- dVAR; dXSARGS;
- if (items != 5)
- croak_xs_usage(cv, "class, parent, attr_ref, imp_datasv, imp_class");
- PERL_UNUSED_VAR(ax); /* -Wall */
- SP -= items;
- {
- SV * class = ST(0)
-;
- SV * parent = ST(1)
-;
- SV * attr_ref = ST(2)
-;
- SV * imp_datasv = ST(3)
-;
- SV * imp_class = ST(4)
-;
-#line 4607 "DBI.xs"
- dMY_CXT;
- HV *outer;
- SV *outer_ref;
- HV *class_stash = gv_stashsv(class, GV_ADDWARN);
-
- if (DBIS_TRACE_LEVEL >= 5) {
- PerlIO_printf(DBILOGFP, " New %s (for %s, parent=%s, id=%s)\n",
- neatsvpv(class,0), SvPV_nolen(imp_class), neatsvpv(parent,0), neatsvpv(imp_datasv,0));
- PERL_UNUSED_VAR(cv);
- }
-
- (void)hv_store((HV*)SvRV(attr_ref), "ImplementorClass", 16, SvREFCNT_inc(imp_class), 0);
-
- /* make attr into inner handle by blessing it into class */
- sv_bless(attr_ref, class_stash);
- /* tie new outer hash to inner handle */
- outer = newHV(); /* create new hash to be outer handle */
- outer_ref = newRV_noinc((SV*)outer);
- /* make outer hash into a handle by blessing it into class */
- sv_bless(outer_ref, class_stash);
- /* tie outer handle to inner handle */
- sv_magic((SV*)outer, attr_ref, PERL_MAGIC_tied, Nullch, 0);
-
- dbih_setup_handle(aTHX_ outer_ref, SvPV_nolen(imp_class), parent, SvOK(imp_datasv) ? imp_datasv : Nullsv);
-
- /* return outer handle, plus inner handle if not in scalar context */
- sv_2mortal(outer_ref);
- EXTEND(SP, 2);
- PUSHs(outer_ref);
- if (GIMME != G_SCALAR) {
- PUSHs(attr_ref);
- }
-#line 4722 "DBI.c"
- PUTBACK;
- return;
- }
-}
-
-
-XS_EUPXS(XS_DBI__setup_handle); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBI__setup_handle)
-{
- dVAR; dXSARGS;
- if (items != 4)
- croak_xs_usage(cv, "sv, imp_class, parent, imp_datasv");
- {
- SV * sv = ST(0)
-;
- char * imp_class = (char *)SvPV_nolen(ST(1))
-;
- SV * parent = ST(2)
-;
- SV * imp_datasv = ST(3)
-;
-#line 4648 "DBI.xs"
- (void)cv;
- dbih_setup_handle(aTHX_ sv, imp_class, parent, SvOK(imp_datasv) ? imp_datasv : Nullsv);
- ST(0) = &PL_sv_undef;
-#line 4748 "DBI.c"
- }
- XSRETURN(1);
-}
-
-
-XS_EUPXS(XS_DBI__get_imp_data); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBI__get_imp_data)
-{
- dVAR; dXSARGS;
- if (items != 1)
- croak_xs_usage(cv, "sv");
- {
- SV * sv = ST(0)
-;
-#line 4657 "DBI.xs"
- D_imp_xxh(sv);
- (void)cv;
- ST(0) = sv_mortalcopy(DBIc_IMP_DATA(imp_xxh)); /* okay if NULL */
-#line 4767 "DBI.c"
- }
- XSRETURN(1);
-}
-
-
-XS_EUPXS(XS_DBI__handles); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBI__handles)
-{
- dVAR; dXSARGS;
- if (items != 1)
- croak_xs_usage(cv, "sv");
- PERL_UNUSED_VAR(ax); /* -Wall */
- SP -= items;
- {
- SV * sv = ST(0)
-;
-#line 4666 "DBI.xs"
- /* return the outer and inner handle for any given handle */
- D_imp_xxh(sv);
- SV *ih = sv_mortalcopy( dbih_inner(aTHX_ sv, "_handles") );
- SV *oh = sv_2mortal(newRV_inc((SV*)DBIc_MY_H(imp_xxh))); /* XXX dangerous */
- (void)cv;
- EXTEND(SP, 2);
- PUSHs(oh); /* returns outer handle then inner */
- if (GIMME != G_SCALAR) {
- PUSHs(ih);
- }
-#line 4795 "DBI.c"
- PUTBACK;
- return;
- }
-}
-
-
-XS_EUPXS(XS_DBI_neat); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBI_neat)
-{
- dVAR; dXSARGS;
- if (items < 1 || items > 2)
- croak_xs_usage(cv, "sv, maxlen=0");
- {
- SV * sv = ST(0)
-;
- U32 maxlen;
-
- if (items < 2)
- maxlen = 0;
- else {
- maxlen = (unsigned long)SvUV(ST(1))
-;
- }
-#line 4683 "DBI.xs"
- ST(0) = sv_2mortal(newSVpv(neatsvpv(sv, maxlen), 0));
- (void)cv;
-#line 4822 "DBI.c"
- }
- XSRETURN(1);
-}
-
-
-XS_EUPXS(XS_DBI_hash); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBI_hash)
-{
- dVAR; dXSARGS;
- if (items < 1 || items > 2)
- croak_xs_usage(cv, "key, type=0");
- {
- const char * key = (const char *)SvPV_nolen(ST(0))
-;
- long type;
- I32 RETVAL;
- dXSTARG;
-
- if (items < 2)
- type = 0;
- else {
- type = (long)SvIV(ST(1))
-;
- }
-#line 4692 "DBI.xs"
- (void)cv;
- RETVAL = dbi_hash(key, type);
-#line 4850 "DBI.c"
- XSprePUSH; PUSHi((IV)RETVAL);
- }
- XSRETURN(1);
-}
-
-
-XS_EUPXS(XS_DBI_looks_like_number); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBI_looks_like_number)
-{
- dVAR; dXSARGS;
- PERL_UNUSED_VAR(cv); /* -W */
- PERL_UNUSED_VAR(ax); /* -Wall */
- SP -= items;
- {
-#line 4700 "DBI.xs"
- int i;
- EXTEND(SP, items);
- (void)cv;
- for(i=0; i < items ; ++i) {
- SV *sv = ST(i);
- if (!SvOK(sv) || (SvPOK(sv) && SvCUR(sv)==0))
- PUSHs(&PL_sv_undef);
- else if ( looks_like_number(sv) )
- PUSHs(&PL_sv_yes);
- else
- PUSHs(&PL_sv_no);
- }
-#line 4878 "DBI.c"
- PUTBACK;
- return;
- }
-}
-
-
-XS_EUPXS(XS_DBI__install_method); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBI__install_method)
-{
- dVAR; dXSARGS;
- if (items < 3 || items > 4)
- croak_xs_usage(cv, "dbi_class, meth_name, file, attribs=Nullsv");
- {
- const char * dbi_class = (const char *)SvPV_nolen(ST(0))
-;
- char * meth_name = (char *)SvPV_nolen(ST(1))
-;
- char * file = (char *)SvPV_nolen(ST(2))
-;
- SV * attribs;
-
- if (items < 4)
- attribs = Nullsv;
- else {
- attribs = ST(3)
-;
- }
-#line 4721 "DBI.xs"
- {
- dMY_CXT;
- /* install another method name/interface for the DBI dispatcher */
- SV *trace_msg = (DBIS_TRACE_LEVEL >= 10) ? sv_2mortal(newSVpv("",0)) : Nullsv;
- CV *cv;
- SV **svp;
- dbi_ima_t *ima;
- MAGIC *mg;
- (void)dbi_class;
-
- if (strnNE(meth_name, "DBI::", 5)) /* XXX m/^DBI::\w+::\w+$/ */
- croak("install_method %s: invalid class", meth_name);
-
- if (trace_msg)
- sv_catpvf(trace_msg, "install_method %-21s", meth_name);
-
- Newxz(ima, 1, dbi_ima_t);
-
- if (attribs && SvOK(attribs)) {
- /* convert and store method attributes in a fast access form */
- if (SvTYPE(SvRV(attribs)) != SVt_PVHV)
- croak("install_method %s: bad attribs", meth_name);
-
- DBD_ATTRIB_GET_IV(attribs, "O",1, svp, ima->flags);
- DBD_ATTRIB_GET_UV(attribs, "T",1, svp, ima->method_trace);
- DBD_ATTRIB_GET_IV(attribs, "H",1, svp, ima->hidearg);
-
- if (trace_msg) {
- if (ima->flags) sv_catpvf(trace_msg, ", flags 0x%04x", (unsigned)ima->flags);
- if (ima->method_trace)sv_catpvf(trace_msg, ", T 0x%08lx", (unsigned long)ima->method_trace);
- if (ima->hidearg) sv_catpvf(trace_msg, ", H %u", (unsigned)ima->hidearg);
- }
- if ( (svp=DBD_ATTRIB_GET_SVP(attribs, "U",1)) != NULL) {
- AV *av = (AV*)SvRV(*svp);
- ima->minargs = (U8)SvIV(*av_fetch(av, 0, 1));
- ima->maxargs = (U8)SvIV(*av_fetch(av, 1, 1));
- svp = av_fetch(av, 2, 0);
- ima->usage_msg = (svp) ? savepv_using_sv(SvPV_nolen(*svp)) : "";
- ima->flags |= IMA_HAS_USAGE;
- if (trace_msg && DBIS_TRACE_LEVEL >= 11)
- sv_catpvf(trace_msg, ",\n usage: min %d, max %d, '%s'",
- ima->minargs, ima->maxargs, ima->usage_msg);
- }
- }
- if (trace_msg)
- PerlIO_printf(DBILOGFP,"%s\n", SvPV_nolen(trace_msg));
- file = savepv(file);
- cv = newXS(meth_name, XS_DBI_dispatch, file);
- SvPVX((SV *)cv) = file;
- SvLEN((SV *)cv) = 1;
- CvXSUBANY(cv).any_ptr = ima;
- ima->meth_type = get_meth_type(GvNAME(CvGV(cv)));
-
- /* Attach magic to handle duping and freeing of the dbi_ima_t struct.
- * Due to the poor interface of the mg dup function, sneak a pointer
- * to the original CV in the mg_ptr field (we get called with a
- * pointer to the mg, but not the SV) */
- mg = sv_magicext((SV*)cv, NULL, DBI_MAGIC, &dbi_ima_vtbl,
- (char *)cv, 0);
-#ifdef BROKEN_DUP_ANY_PTR
- ima->my_perl = my_perl; /* who owns this struct */
-#else
- mg->mg_flags |= MGf_DUP;
-#endif
- ST(0) = &PL_sv_yes;
- }
-#line 4973 "DBI.c"
- }
- XSRETURN(1);
-}
-
-
-XS_EUPXS(XS_DBI_trace); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBI_trace)
-{
- dVAR; dXSARGS;
- dXSI32;
- if (items < 1 || items > 3)
- croak_xs_usage(cv, "class, level_sv=&PL_sv_undef, file=Nullsv");
- {
- SV * class = ST(0)
-;
- SV * level_sv;
- SV * file;
- int RETVAL;
- dXSTARG;
-
- if (items < 2)
- level_sv = &PL_sv_undef;
- else {
- level_sv = ST(1)
-;
- }
-
- if (items < 3)
- file = Nullsv;
- else {
- file = ST(2)
-;
- }
-#line 4797 "DBI.xs"
- {
- dMY_CXT;
- IV level;
- if (!DBIS) {
- PERL_UNUSED_VAR(ix);
- croak("DBI not initialised");
- }
- /* Return old/current value. No change if new value not given. */
- RETVAL = (DBIS) ? DBIS->debug : 0;
- level = parse_trace_flags(class, level_sv, RETVAL);
- if (level) /* call before or after altering DBI trace level */
- set_trace_file(file);
- if (level != RETVAL) {
- if ((level & DBIc_TRACE_LEVEL_MASK) > 0) {
- PerlIO_printf(DBILOGFP," DBI %s%s default trace level set to 0x%lx/%ld (pid %d pi %p) at %s\n",
- XS_VERSION, dbi_build_opt,
- (long)(level & DBIc_TRACE_FLAGS_MASK),
- (long)(level & DBIc_TRACE_LEVEL_MASK),
- (int)PerlProc_getpid(),
-#ifdef MULTIPLICITY
- (void *)my_perl,
-#else
- (void*)NULL,
-#endif
- log_where(Nullsv, 0, "", "", 1, 1, 0)
- );
- if (!PL_dowarn)
- PerlIO_printf(DBILOGFP," Note: perl is running without the recommended perl -w option\n");
- PerlIO_flush(DBILOGFP);
- }
- DBIS->debug = level;
- sv_setiv(get_sv("DBI::dbi_debug",0x5), level);
- }
- if (!level) /* call before or after altering DBI trace level */
- set_trace_file(file);
- }
-#line 5044 "DBI.c"
- XSprePUSH; PUSHi((IV)RETVAL);
- }
- XSRETURN(1);
-}
-
-
-XS_EUPXS(XS_DBI_dump_handle); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBI_dump_handle)
-{
- dVAR; dXSARGS;
- if (items < 1 || items > 3)
- croak_xs_usage(cv, "sv, msg=\"DBI::dump_handle\", level=0");
- {
- SV * sv = ST(0)
-;
- const char * msg;
- int level;
-
- if (items < 2)
- msg = "DBI::dump_handle";
- else {
- msg = (const char *)SvPV_nolen(ST(1))
-;
- }
-
- if (items < 3)
- level = 0;
- else {
- level = (int)SvIV(ST(2))
-;
- }
-#line 4844 "DBI.xs"
- (void)cv;
- dbih_dumphandle(aTHX_ sv, msg, level);
-#line 5079 "DBI.c"
- }
- XSRETURN_EMPTY;
-}
-
-
-XS_EUPXS(XS_DBI__svdump); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBI__svdump)
-{
- dVAR; dXSARGS;
- if (items != 1)
- croak_xs_usage(cv, "sv");
- {
- SV * sv = ST(0)
-;
-#line 4853 "DBI.xs"
- {
- dMY_CXT;
- (void)cv;
- PerlIO_printf(DBILOGFP, "DBI::_svdump(%s)", neatsvpv(sv,0));
-#ifdef DEBUGGING
- sv_dump(sv);
-#endif
- }
-#line 5103 "DBI.c"
- }
- XSRETURN_EMPTY;
-}
-
-
-XS_EUPXS(XS_DBI_dbi_time); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBI_dbi_time)
-{
- dVAR; dXSARGS;
- if (items != 0)
- croak_xs_usage(cv, "");
- {
- NV RETVAL;
- dXSTARG;
-
- RETVAL = dbi_time();
- XSprePUSH; PUSHn((NV)RETVAL);
- }
- XSRETURN(1);
-}
-
-
-XS_EUPXS(XS_DBI_dbi_profile); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBI_dbi_profile)
-{
- dVAR; dXSARGS;
- if (items != 5)
- croak_xs_usage(cv, "h, statement, method, t1, t2");
- {
- SV * h = ST(0)
-;
- SV * statement = ST(1)
-;
- SV * method = ST(2)
-;
- NV t1 = (NV)SvNV(ST(3))
-;
- NV t2 = (NV)SvNV(ST(4))
-;
-#line 4875 "DBI.xs"
- SV *leaf = &PL_sv_undef;
- PERL_UNUSED_VAR(cv);
- if (SvROK(method))
- method = SvRV(method);
- if (dbih_inner(aTHX_ h, NULL)) { /* is a DBI handle */
- D_imp_xxh(h);
- leaf = dbi_profile(h, imp_xxh, statement, method, t1, t2);
- }
- else if (SvROK(h) && SvTYPE(SvRV(h)) == SVt_PVHV) {
- /* iterate over values %$h */
- HV *hv = (HV*)SvRV(h);
- SV *tmp;
- char *key;
- I32 keylen = 0;
- hv_iterinit(hv);
- while ( (tmp = hv_iternextsv(hv, &key, &keylen)) != NULL ) {
- if (SvOK(tmp)) {
- D_imp_xxh(tmp);
- leaf = dbi_profile(tmp, imp_xxh, statement, method, t1, t2);
- }
- };
- }
- else {
- croak("dbi_profile(%s,...) invalid handle argument", neatsvpv(h,0));
- }
- if (GIMME_V == G_VOID)
- ST(0) = &PL_sv_undef; /* skip sv_mortalcopy if not needed */
- else
- ST(0) = sv_mortalcopy(leaf);
-#line 5173 "DBI.c"
- }
- XSRETURN(1);
-}
-
-
-XS_EUPXS(XS_DBI_dbi_profile_merge_nodes); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBI_dbi_profile_merge_nodes)
-{
- dVAR; dXSARGS;
- dXSI32;
- if (items < 1)
- croak_xs_usage(cv, "dest, ...");
- {
- SV * dest = ST(0)
-;
- SV * RETVAL;
-#line 4913 "DBI.xs"
- {
- if (!SvROK(dest) || SvTYPE(SvRV(dest)) != SVt_PVAV)
- croak("dbi_profile_merge_nodes(%s,...) destination is not an array reference", neatsvpv(dest,0));
- if (items <= 1) {
- PERL_UNUSED_VAR(cv);
- PERL_UNUSED_VAR(ix);
- RETVAL = 0;
- }
- else {
- /* items==2 for dest + 1 arg, ST(0) is dest, ST(1) is first arg */
- while (--items >= 1) {
- SV *thingy = ST(items);
- dbi_profile_merge_nodes(dest, thingy);
- }
- RETVAL = newSVsv(*av_fetch((AV*)SvRV(dest), DBIprof_TOTAL_TIME, 1));
- }
- }
-#line 5208 "DBI.c"
- RETVAL = sv_2mortal(RETVAL);
- ST(0) = RETVAL;
- }
- XSRETURN(1);
-}
-
-
-XS_EUPXS(XS_DBI__concat_hash_sorted); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBI__concat_hash_sorted)
-{
- dVAR; dXSARGS;
- if (items != 5)
- croak_xs_usage(cv, "hash_sv, kv_sep_sv, pair_sep_sv, use_neat_sv, num_sort_sv");
- {
- SV * hash_sv = ST(0)
-;
- SV * kv_sep_sv = ST(1)
-;
- SV * pair_sep_sv = ST(2)
-;
- SV * use_neat_sv = ST(3)
-;
- SV * num_sort_sv = ST(4)
-;
-#line 4942 "DBI.xs"
- char *kv_sep, *pair_sep;
- STRLEN kv_sep_len, pair_sep_len;
-#line 5236 "DBI.c"
- SV * RETVAL;
-#line 4945 "DBI.xs"
- if (!SvOK(hash_sv))
- XSRETURN_UNDEF;
- if (!SvROK(hash_sv) || SvTYPE(SvRV(hash_sv))!=SVt_PVHV)
- croak("hash is not a hash reference");
-
- kv_sep = SvPV(kv_sep_sv, kv_sep_len);
- pair_sep = SvPV(pair_sep_sv, pair_sep_len);
-
- RETVAL = _join_hash_sorted( (HV*)SvRV(hash_sv),
- kv_sep, kv_sep_len,
- pair_sep, pair_sep_len,
- /* use_neat should be undef, 0 or 1, may allow sprintf format strings later */
- (SvOK(use_neat_sv)) ? SvIV(use_neat_sv) : 0,
- (SvOK(num_sort_sv)) ? SvIV(num_sort_sv) : -1
- );
-#line 5254 "DBI.c"
- RETVAL = sv_2mortal(RETVAL);
- ST(0) = RETVAL;
- }
- XSRETURN(1);
-}
-
-
-XS_EUPXS(XS_DBI_sql_type_cast); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBI_sql_type_cast)
-{
- dVAR; dXSARGS;
- if (items < 2 || items > 3)
- croak_xs_usage(cv, "sv, sql_type, flags=0");
- {
- SV * sv = ST(0)
-;
- int sql_type = (int)SvIV(ST(1))
-;
- U32 flags;
- int RETVAL;
- dXSTARG;
-
- if (items < 3)
- flags = 0;
- else {
- flags = (unsigned long)SvUV(ST(2))
-;
- }
-#line 4970 "DBI.xs"
- RETVAL = sql_type_cast_svpv(aTHX_ sv, sql_type, flags, 0);
-#line 5285 "DBI.c"
- XSprePUSH; PUSHi((IV)RETVAL);
- }
- XSRETURN(1);
-}
-
-
-XS_EUPXS(XS_DBI__var_FETCH); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBI__var_FETCH)
-{
- dVAR; dXSARGS;
- if (items != 1)
- croak_xs_usage(cv, "sv");
- {
- SV * sv = ST(0)
-;
-#line 4982 "DBI.xs"
- dMY_CXT;
- /* Note that we do not come through the dispatcher to get here. */
- char *meth = SvPV_nolen(SvRV(sv)); /* what should this tie do ? */
- char type = *meth++; /* is this a $ or & style */
- imp_xxh_t *imp_xxh = (DBI_LAST_HANDLE_OK) ? DBIh_COM(DBI_LAST_HANDLE) : NULL;
- int trace_level = (imp_xxh ? DBIc_TRACE_LEVEL(imp_xxh) : DBIS_TRACE_LEVEL);
- NV profile_t1 = 0.0;
-
- if (imp_xxh && DBIc_has(imp_xxh,DBIcf_Profile))
- profile_t1 = dbi_time();
-
- if (trace_level >= 2) {
- PerlIO_printf(DBILOGFP," -> $DBI::%s (%c) FETCH from lasth=%s\n", meth, type,
- (imp_xxh) ? neatsvpv(DBI_LAST_HANDLE,0): "none");
- }
-
- if (type == '!') { /* special case for $DBI::lasth */
- /* Currently we can only return the INNER handle. */
- /* This handle should only be used for true/false tests */
- ST(0) = (imp_xxh) ? sv_2mortal(newRV_inc(DBI_LAST_HANDLE)) : &PL_sv_undef;
- }
- else if ( !imp_xxh ) {
- if (trace_level)
- warn("Can't read $DBI::%s, last handle unknown or destroyed", meth);
- ST(0) = &PL_sv_undef;
- }
- else if (type == '*') { /* special case for $DBI::err, see also err method */
- SV *errsv = DBIc_ERR(imp_xxh);
- ST(0) = sv_mortalcopy(errsv);
- }
- else if (type == '"') { /* special case for $DBI::state */
- SV *state = DBIc_STATE(imp_xxh);
- ST(0) = DBIc_STATE_adjust(imp_xxh, state);
- }
- else if (type == '$') { /* lookup scalar variable in implementors stash */
- const char *vname = mkvname(aTHX_ DBIc_IMP_STASH(imp_xxh), meth, 0);
- SV *vsv = get_sv(vname, 1);
- ST(0) = sv_mortalcopy(vsv);
- }
- else {
- /* default to method call via stash of implementor of DBI_LAST_HANDLE */
- GV *imp_gv;
- HV *imp_stash = DBIc_IMP_STASH(imp_xxh);
-#ifdef DBI_save_hv_fetch_ent
- HE save_mh = PL_hv_fetch_ent_mh; /* XXX nested tied FETCH bug17575 workaround */
-#endif
- profile_t1 = 0.0; /* profile this via dispatch only (else we'll double count) */
- if (trace_level >= 3)
- PerlIO_printf(DBILOGFP," >> %s::%s\n", HvNAME(imp_stash), meth);
- ST(0) = sv_2mortal(newRV_inc(DBI_LAST_HANDLE));
- if ((imp_gv = gv_fetchmethod(imp_stash,meth)) == NULL) {
- croak("Can't locate $DBI::%s object method \"%s\" via package \"%s\"",
- meth, meth, HvNAME(imp_stash));
- }
- PUSHMARK(mark); /* reset mark (implies one arg as we were called with one arg?) */
- call_sv((SV*)GvCV(imp_gv), GIMME);
- SPAGAIN;
-#ifdef DBI_save_hv_fetch_ent
- PL_hv_fetch_ent_mh = save_mh;
-#endif
- }
- if (trace_level)
- PerlIO_printf(DBILOGFP," <- $DBI::%s= %s\n", meth, neatsvpv(ST(0),0));
- if (profile_t1) {
- SV *h = sv_2mortal(newRV_inc(DBI_LAST_HANDLE));
- dbi_profile(h, imp_xxh, &PL_sv_undef, (SV*)cv, profile_t1, dbi_time());
- }
-#line 5369 "DBI.c"
- }
- XSRETURN(1);
-}
-
-
-XS_EUPXS(XS_DBD_____dr_dbixs_revision); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD_____dr_dbixs_revision)
-{
- dVAR; dXSARGS;
- if (items != 1)
- croak_xs_usage(cv, "h");
- {
- SV * h = ST(0)
-;
-#line 5057 "DBI.xs"
- PERL_UNUSED_VAR(h);
- ST(0) = sv_2mortal(newSViv(DBIXS_REVISION));
-#line 5387 "DBI.c"
- }
- XSRETURN(1);
-}
-
-
-XS_EUPXS(XS_DBD_____db_connected); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD_____db_connected)
-{
- dVAR; dXSARGS;
- PERL_UNUSED_VAR(cv); /* -W */
- {
-#line 5066 "DBI.xs"
- /* defined here just to avoid AUTOLOAD */
- (void)cv;
- (void)items;
- ST(0) = &PL_sv_undef;
-#line 5404 "DBI.c"
- }
- XSRETURN(1);
-}
-
-
-XS_EUPXS(XS_DBD_____db_preparse); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD_____db_preparse)
-{
- dVAR; dXSARGS;
- if (items < 4 || items > 5)
- croak_xs_usage(cv, "dbh, statement, ps_accept, ps_return, foo=Nullch");
- {
- SV * dbh = ST(0)
-;
- char * statement = (char *)SvPV_nolen(ST(1))
-;
- IV ps_accept = (IV)SvIV(ST(2))
-;
- IV ps_return = (IV)SvIV(ST(3))
-;
- void * foo;
- SV * RETVAL;
-
- if (items < 5)
- foo = Nullch;
- else {
- foo = INT2PTR(void *,SvIV(ST(4)))
-;
- }
-
- RETVAL = preparse(dbh, statement, ps_accept, ps_return, foo);
- RETVAL = sv_2mortal(RETVAL);
- ST(0) = RETVAL;
- }
- XSRETURN(1);
-}
-
-
-XS_EUPXS(XS_DBD_____db_take_imp_data); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD_____db_take_imp_data)
-{
- dVAR; dXSARGS;
- if (items != 1)
- croak_xs_usage(cv, "h");
- {
- SV * h = ST(0)
-;
-#line 5085 "DBI.xs"
- /* take_imp_data currently in DBD::_::db not DBD::_::common, so for dbh's only */
- D_imp_xxh(h);
- MAGIC *mg;
- SV *imp_xxh_sv;
- SV **tmp_svp;
-#line 5458 "DBI.c"
-#line 5091 "DBI.xs"
- PERL_UNUSED_VAR(cv);
- /*
- * Remove and return the imp_xxh_t structure that's attached to the inner
- * hash of the handle. Effectively this removes the 'brain' of the handle
- * leaving it as an empty shell - brain dead. All method calls on it fail.
- *
- * The imp_xxh_t structure that's removed and returned is a plain scalar
- * (containing binary data). It can be passed to a new DBI->connect call
- * in order to have the new $dbh use the same 'connection' as the original
- * handle. In this way a multi-threaded connection pool can be implemented.
- *
- * If the drivers imp_xxh_t structure contains SV*'s, or other interpreter
- * specific items, they should be freed by the drivers own take_imp_data()
- * method before it then calls SUPER::take_imp_data() to finalize removal
- * of the imp_xxh_t structure.
- *
- * The driver needs to view the take_imp_data method as being nearly the
- * same as disconnect+DESTROY only not actually calling the database API to
- * disconnect. All that needs to remain valid in the imp_xxh_t structure
- * is the underlying database API connection data. Everything else should
- * in a 'clean' state such that if the drivers own DESTROY method was
- * called it would be able to properly handle the contents of the
- * structure. This is important in case a new handle created using this
- * imp_data, possibly in a new thread, might end up being DESTROY'd before
- * the driver has had a chance to 're-setup' the data. See dbih_setup_handle()
- *
- * All the above relates to the 'typical use case' for a compiled driver.
- * For a pure-perl driver using a socket pair, for example, the drivers
- * take_imp_data method might just return a string containing the fileno()
- * values of the sockets (without calling this SUPER::take_imp_data() code).
- * The key point is that the take_imp_data() method returns an opaque buffer
- * containing whatever the driver would need to reuse the same underlying
- * 'connection to the database' in a new handle.
- *
- * In all cases, care should be taken that driver attributes (such as
- * AutoCommit) match the state of the underlying connection.
- */
-
- if (!DBIc_ACTIVE(imp_xxh)) {/* sanity check, may be relaxed later */
- set_err_char(h, imp_xxh, "1", 1, "Can't take_imp_data from handle that's not Active", 0, "take_imp_data");
- XSRETURN(0);
- }
-
- /* Ideally there should be no child statement handles existing when
- * take_imp_data is called because when those statement handles are
- * destroyed they may need to interact with the 'zombie' parent dbh.
- * So we do our best to neautralize them (finish & rebless)
- */
- if ((tmp_svp = hv_fetch((HV*)SvRV(h), "ChildHandles", 12, FALSE)) && SvROK(*tmp_svp)) {
- AV *av = (AV*)SvRV(*tmp_svp);
- HV *zombie_stash = gv_stashpv("DBI::zombie", GV_ADDWARN);
- I32 kidslots;
- for (kidslots = AvFILL(av); kidslots >= 0; --kidslots) {
- SV **hp = av_fetch(av, kidslots, FALSE);
- if (hp && SvROK(*hp) && SvMAGICAL(SvRV(*hp))) {
- PUSHMARK(sp);
- XPUSHs(*hp);
- PUTBACK;
- call_method("finish", G_VOID);
- SPAGAIN;
- PUTBACK;
- sv_unmagic(SvRV(*hp), 'P'); /* untie */
- sv_bless(*hp, zombie_stash); /* neutralise */
- }
- }
- }
- /* The above measures may not be sufficient if weakrefs aren't available
- * or something has a reference to the inner-handle of an sth.
- * We'll require no Active kids, but just warn about others.
- */
- if (DBIc_ACTIVE_KIDS(imp_xxh)) {
- set_err_char(h, imp_xxh, "1", 1, "Can't take_imp_data from handle while it still has Active kids", 0, "take_imp_data");
- XSRETURN(0);
- }
- if (DBIc_KIDS(imp_xxh))
- warn("take_imp_data from handle while it still has kids");
-
- /* it may be better here to return a copy and poison the original
- * rather than detatching and returning the original
- */
-
- /* --- perform the surgery */
- dbih_getcom2(aTHX_ h, &mg); /* get the MAGIC so we can change it */
- imp_xxh_sv = mg->mg_obj; /* take local copy of the imp_data pointer */
- mg->mg_obj = Nullsv; /* sever the link from handle to imp_xxh */
- mg->mg_ptr = NULL; /* and sever the shortcut too */
- if (DBIc_TRACE_LEVEL(imp_xxh) >= 9)
- sv_dump(imp_xxh_sv);
- /* --- housekeeping */
- DBIc_ACTIVE_off(imp_xxh); /* silence warning from dbih_clearcom */
- DBIc_IMPSET_off(imp_xxh); /* silence warning from dbih_clearcom */
- dbih_clearcom(imp_xxh); /* free SVs like DBD::_mem::common::DESTROY */
- SvOBJECT_off(imp_xxh_sv); /* no longer needs DESTROY via dbih_clearcom */
- /* restore flags to mark fact imp data holds active connection */
- /* (don't use magical DBIc_ACTIVE_on here) */
- DBIc_FLAGS(imp_xxh) |= DBIcf_IMPSET | DBIcf_ACTIVE;
- /* --- tidy up the raw PV for life as a more normal string */
- SvPOK_on(imp_xxh_sv); /* SvCUR & SvEND were set at creation */
- /* --- return the actual imp_xxh_sv on the stack */
- ST(0) = imp_xxh_sv;
-#line 5560 "DBI.c"
- }
- XSRETURN(1);
-}
-
-
-XS_EUPXS(XS_DBD_____st__get_fbav); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD_____st__get_fbav)
-{
- dVAR; dXSARGS;
- if (items != 1)
- croak_xs_usage(cv, "sth");
- {
- SV * sth = ST(0)
-;
-#line 5200 "DBI.xs"
- D_imp_sth(sth);
- AV *av = dbih_get_fbav(imp_sth);
- (void)cv;
- ST(0) = sv_2mortal(newRV_inc((SV*)av));
-#line 5580 "DBI.c"
- }
- XSRETURN(1);
-}
-
-
-XS_EUPXS(XS_DBD_____st__set_fbav); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD_____st__set_fbav)
-{
- dVAR; dXSARGS;
- if (items != 2)
- croak_xs_usage(cv, "sth, src_rv");
- {
- SV * sth = ST(0)
-;
- SV * src_rv = ST(1)
-;
-#line 5210 "DBI.xs"
- D_imp_sth(sth);
- int i;
- AV *src_av;
- AV *dst_av = dbih_get_fbav(imp_sth);
- int dst_fields = AvFILL(dst_av)+1;
- int src_fields;
- (void)cv;
-
- if (!SvROK(src_rv) || SvTYPE(SvRV(src_rv)) != SVt_PVAV)
- croak("_set_fbav(%s): not an array ref", neatsvpv(src_rv,0));
- src_av = (AV*)SvRV(src_rv);
- src_fields = AvFILL(src_av)+1;
- if (src_fields != dst_fields) {
- warn("_set_fbav(%s): array has %d elements, the statement handle row buffer has %d (and NUM_OF_FIELDS is %d)",
- neatsvpv(src_rv,0), src_fields, dst_fields, DBIc_NUM_FIELDS(imp_sth));
- SvREADONLY_off(dst_av);
- if (src_fields < dst_fields) {
- /* shrink the array - sadly this looses column bindings for the lost columns */
- av_fill(dst_av, src_fields-1);
- dst_fields = src_fields;
- }
- else {
- av_fill(dst_av, src_fields-1);
- /* av_fill pads with immutable undefs which we need to change */
- for(i=dst_fields-1; i < src_fields; ++i) {
- sv_setsv(AvARRAY(dst_av)[i], newSV(0));
- }
- }
- SvREADONLY_on(dst_av);
- }
- for(i=0; i < dst_fields; ++i) { /* copy over the row */
- /* If we're given the values, then taint them if required */
- if (DBIc_is(imp_sth, DBIcf_TaintOut))
- SvTAINT(AvARRAY(src_av)[i]);
- sv_setsv(AvARRAY(dst_av)[i], AvARRAY(src_av)[i]);
- }
- ST(0) = sv_2mortal(newRV_inc((SV*)dst_av));
-#line 5635 "DBI.c"
- }
- XSRETURN(1);
-}
-
-
-XS_EUPXS(XS_DBD_____st_bind_col); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD_____st_bind_col)
-{
- dVAR; dXSARGS;
- if (items < 3 || items > 4)
- croak_xs_usage(cv, "sth, col, ref, attribs=Nullsv");
- {
- SV * sth = ST(0)
-;
- SV * col = ST(1)
-;
- SV * ref = ST(2)
-;
- SV * attribs;
-
- if (items < 4)
- attribs = Nullsv;
- else {
- attribs = ST(3)
-;
- }
-#line 5256 "DBI.xs"
- DBD_ATTRIBS_CHECK("bind_col", sth, attribs);
- ST(0) = boolSV(dbih_sth_bind_col(sth, col, ref, attribs));
- (void)cv;
-#line 5666 "DBI.c"
- }
- XSRETURN(1);
-}
-
-
-XS_EUPXS(XS_DBD_____st_fetchrow_array); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD_____st_fetchrow_array)
-{
- dVAR; dXSARGS;
- dXSI32;
- if (items != 1)
- croak_xs_usage(cv, "sth");
- PERL_UNUSED_VAR(ax); /* -Wall */
- SP -= items;
- {
- SV * sth = ST(0)
-;
-#line 5267 "DBI.xs"
- SV *retsv;
- if (CvDEPTH(cv) == 99) {
- PERL_UNUSED_VAR(ix);
- croak("Deep recursion, probably fetchrow-fetch-fetchrow loop");
- }
- PUSHMARK(sp);
- XPUSHs(sth);
- PUTBACK;
- if (call_method("fetch", G_SCALAR) != 1)
- croak("panic: DBI fetch"); /* should never happen */
- SPAGAIN;
- retsv = POPs;
- PUTBACK;
- if (SvROK(retsv) && SvTYPE(SvRV(retsv)) == SVt_PVAV) {
- D_imp_sth(sth);
- int num_fields, i;
- AV *bound_av;
- AV *av = (AV*)SvRV(retsv);
- num_fields = AvFILL(av)+1;
- EXTEND(sp, num_fields+1);
-
- /* We now check for bind_col() having been called but fetch */
- /* not returning the fields_svav array. Probably because the */
- /* driver is implemented in perl. XXX This logic may change later. */
- bound_av = DBIc_FIELDS_AV(imp_sth); /* bind_col() called ? */
- if (bound_av && av != bound_av) {
- /* let dbih_get_fbav know what's going on */
- bound_av = dbih_get_fbav(imp_sth);
- if (DBIc_TRACE_LEVEL(imp_sth) >= 3) {
- PerlIO_printf(DBIc_LOGPIO(imp_sth),
- "fetchrow: updating fbav 0x%lx from 0x%lx\n",
- (long)bound_av, (long)av);
- }
- for(i=0; i < num_fields; ++i) { /* copy over the row */
- sv_setsv(AvARRAY(bound_av)[i], AvARRAY(av)[i]);
- }
- }
- for(i=0; i < num_fields; ++i) {
- PUSHs(AvARRAY(av)[i]);
- }
- }
-#line 5726 "DBI.c"
- PUTBACK;
- return;
- }
-}
-
-
-XS_EUPXS(XS_DBD_____st_fetchrow_hashref); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD_____st_fetchrow_hashref)
-{
- dVAR; dXSARGS;
- if (items < 1 || items > 2)
- croak_xs_usage(cv, "sth, keyattrib=Nullch");
- {
- SV * sth = ST(0)
-;
- const char * keyattrib;
-#line 5315 "DBI.xs"
- SV *rowavr;
- SV *ka_rv;
- D_imp_sth(sth);
-#line 5747 "DBI.c"
- SV * RETVAL;
-
- if (items < 2)
- keyattrib = Nullch;
- else {
- keyattrib = (const char *)SvPV_nolen(ST(1))
-;
- }
-#line 5319 "DBI.xs"
- (void)cv;
- PUSHMARK(sp);
- XPUSHs(sth);
- PUTBACK;
- if (!keyattrib || !*keyattrib) {
- SV *kn = DBIc_FetchHashKeyName(imp_sth);
- if (kn && SvOK(kn))
- keyattrib = SvPVX(kn);
- else
- keyattrib = "NAME";
- }
- ka_rv = *hv_fetch((HV*)DBIc_MY_H(imp_sth), keyattrib,strlen(keyattrib), TRUE);
- /* we copy to invoke FETCH magic, and we do that before fetch() so if tainting */
- /* then the taint triggered by the fetch won't then apply to the fetched name */
- ka_rv = newSVsv(ka_rv);
- if (call_method("fetch", G_SCALAR) != 1)
- croak("panic: DBI fetch"); /* should never happen */
- SPAGAIN;
- rowavr = POPs;
- PUTBACK;
- /* have we got an array ref in rowavr */
- if (SvROK(rowavr) && SvTYPE(SvRV(rowavr)) == SVt_PVAV) {
- int i;
- AV *rowav = (AV*)SvRV(rowavr);
- const int num_fields = AvFILL(rowav)+1;
- HV *hv;
- AV *ka_av;
- if (!(SvROK(ka_rv) && SvTYPE(SvRV(ka_rv))==SVt_PVAV)) {
- sv_setiv(DBIc_ERR(imp_sth), 1);
- sv_setpvf(DBIc_ERRSTR(imp_sth),
- "Can't use attribute '%s' because it doesn't contain a reference to an array (%s)",
- keyattrib, neatsvpv(ka_rv,0));
- XSRETURN_UNDEF;
- }
- ka_av = (AV*)SvRV(ka_rv);
- hv = newHV();
- for (i=0; i < num_fields; ++i) { /* honor the original order as sent by the database */
- SV **field_name_svp = av_fetch(ka_av, i, 1);
- (void)hv_store_ent(hv, *field_name_svp, newSVsv((SV*)(AvARRAY(rowav)[i])), 0);
- }
- RETVAL = newRV_inc((SV*)hv);
- SvREFCNT_dec(hv); /* since newRV incremented it */
- }
- else {
- RETVAL = &PL_sv_undef;
-#if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION <= 4))
- RETVAL = newSV(0); /* mutable undef for 5.004_04 */
-#endif
- }
- SvREFCNT_dec(ka_rv); /* since we created it */
-#line 5807 "DBI.c"
- RETVAL = sv_2mortal(RETVAL);
- ST(0) = RETVAL;
- }
- XSRETURN(1);
-}
-
-
-XS_EUPXS(XS_DBD_____st_fetch); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD_____st_fetch)
-{
- dVAR; dXSARGS;
- dXSI32;
- if (items != 1)
- croak_xs_usage(cv, "sth");
- {
- SV * sth = ST(0)
-;
-#line 5379 "DBI.xs"
- int num_fields;
- if (CvDEPTH(cv) == 99) {
- PERL_UNUSED_VAR(ix);
- croak("Deep recursion. Probably fetch-fetchrow-fetch loop.");
- }
- PUSHMARK(sp);
- XPUSHs(sth);
- PUTBACK;
- num_fields = call_method("fetchrow", G_ARRAY); /* XXX change the name later */
- SPAGAIN;
- if (num_fields == 0) {
- ST(0) = &PL_sv_undef;
- } else {
- D_imp_sth(sth);
- AV *av = dbih_get_fbav(imp_sth);
- if (num_fields != AvFILL(av)+1)
- croak("fetchrow returned %d fields, expected %d",
- num_fields, (int)AvFILL(av)+1);
- SPAGAIN;
- while(--num_fields >= 0)
- sv_setsv(AvARRAY(av)[num_fields], POPs);
- PUTBACK;
- ST(0) = sv_2mortal(newRV_inc((SV*)av));
- }
-#line 5850 "DBI.c"
- }
- XSRETURN(1);
-}
-
-
-XS_EUPXS(XS_DBD_____st_rows); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD_____st_rows)
-{
- dVAR; dXSARGS;
- if (items != 1)
- croak_xs_usage(cv, "sth");
- {
- SV * sth = ST(0)
-;
-#line 5409 "DBI.xs"
- D_imp_sth(sth);
- const IV rows = DBIc_ROW_COUNT(imp_sth);
- ST(0) = sv_2mortal(newSViv(rows));
- (void)cv;
-#line 5870 "DBI.c"
- }
- XSRETURN(1);
-}
-
-
-XS_EUPXS(XS_DBD_____st_finish); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD_____st_finish)
-{
- dVAR; dXSARGS;
- if (items != 1)
- croak_xs_usage(cv, "sth");
- {
- SV * sth = ST(0)
-;
-#line 5419 "DBI.xs"
- D_imp_sth(sth);
- DBIc_ACTIVE_off(imp_sth);
- ST(0) = &PL_sv_yes;
- (void)cv;
-#line 5890 "DBI.c"
- }
- XSRETURN(1);
-}
-
-
-XS_EUPXS(XS_DBD_____st_DESTROY); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD_____st_DESTROY)
-{
- dVAR; dXSARGS;
- if (items != 1)
- croak_xs_usage(cv, "sth");
- PERL_UNUSED_VAR(ax); /* -Wall */
- SP -= items;
- {
- SV * sth = ST(0)
-;
-#line 5429 "DBI.xs"
- /* keep in sync with DESTROY in Driver.xst */
- D_imp_sth(sth);
- ST(0) = &PL_sv_yes;
- /* we don't test IMPSET here because this code applies to pure-perl drivers */
- if (DBIc_IADESTROY(imp_sth)) { /* want's ineffective destroy */
- DBIc_ACTIVE_off(imp_sth);
- if (DBIc_TRACE_LEVEL(imp_sth))
- PerlIO_printf(DBIc_LOGPIO(imp_sth), " DESTROY %s skipped due to InactiveDestroy\n", SvPV_nolen(sth));
- }
- if (DBIc_ACTIVE(imp_sth)) {
- D_imp_dbh_from_sth;
- if (!PL_dirty && DBIc_ACTIVE(imp_dbh)) {
- dSP;
- PUSHMARK(sp);
- XPUSHs(sth);
- PUTBACK;
- call_method("finish", G_SCALAR);
- SPAGAIN;
- PUTBACK;
- }
- else {
- DBIc_ACTIVE_off(imp_sth);
- }
- }
-#line 5932 "DBI.c"
- PUTBACK;
- return;
- }
-}
-
-
-XS_EUPXS(XS_DBI__st_TIEHASH); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBI__st_TIEHASH)
-{
- dVAR; dXSARGS;
- if (items != 2)
- croak_xs_usage(cv, "class, inner_ref");
- {
- SV * class = ST(0)
-;
- SV * inner_ref = ST(1)
-;
-#line 5462 "DBI.xs"
- HV *stash = gv_stashsv(class, GV_ADDWARN); /* a new hash is supplied to us, we just need to bless and apply tie magic */
- sv_bless(inner_ref, stash);
- ST(0) = inner_ref;
-#line 5954 "DBI.c"
- }
- XSRETURN(1);
-}
-
-
-XS_EUPXS(XS_DBD_____common_DESTROY); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD_____common_DESTROY)
-{
- dVAR; dXSARGS;
- if (items != 1)
- croak_xs_usage(cv, "h");
- {
- SV * h = ST(0)
-;
-#line 5473 "DBI.xs"
- /* DESTROY defined here just to avoid AUTOLOAD */
- (void)cv;
- (void)h;
- ST(0) = &PL_sv_undef;
-#line 5974 "DBI.c"
- }
- XSRETURN(1);
-}
-
-
-XS_EUPXS(XS_DBD_____common_STORE); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD_____common_STORE)
-{
- dVAR; dXSARGS;
- if (items != 3)
- croak_xs_usage(cv, "h, keysv, valuesv");
- {
- SV * h = ST(0)
-;
- SV * keysv = ST(1)
-;
- SV * valuesv = ST(2)
-;
-#line 5485 "DBI.xs"
- ST(0) = &PL_sv_yes;
- if (!dbih_set_attr_k(h, keysv, 0, valuesv))
- ST(0) = &PL_sv_no;
- (void)cv;
-#line 5998 "DBI.c"
- }
- XSRETURN(1);
-}
-
-
-XS_EUPXS(XS_DBD_____common_FETCH); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD_____common_FETCH)
-{
- dVAR; dXSARGS;
- if (items != 2)
- croak_xs_usage(cv, "h, keysv");
- {
- SV * h = ST(0)
-;
- SV * keysv = ST(1)
-;
-#line 5496 "DBI.xs"
- ST(0) = dbih_get_attr_k(h, keysv, 0);
- (void)cv;
-#line 6018 "DBI.c"
- }
- XSRETURN(1);
-}
-
-
-XS_EUPXS(XS_DBD_____common_DELETE); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD_____common_DELETE)
-{
- dVAR; dXSARGS;
- if (items != 2)
- croak_xs_usage(cv, "h, keysv");
- {
- SV * h = ST(0)
-;
- SV * keysv = ST(1)
-;
-#line 5504 "DBI.xs"
- /* only private_* keys can be deleted, for others DELETE acts like FETCH */
- /* because the DBI internals rely on certain handle attributes existing */
- if (strnEQ(SvPV_nolen(keysv),"private_",8))
- ST(0) = hv_delete_ent((HV*)SvRV(h), keysv, 0, 0);
- else
- ST(0) = dbih_get_attr_k(h, keysv, 0);
- (void)cv;
-#line 6043 "DBI.c"
- }
- XSRETURN(1);
-}
-
-
-XS_EUPXS(XS_DBD_____common_private_data); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD_____common_private_data)
-{
- dVAR; dXSARGS;
- if (items != 1)
- croak_xs_usage(cv, "h");
- {
- SV * h = ST(0)
-;
-#line 5517 "DBI.xs"
- D_imp_xxh(h);
- (void)cv;
- ST(0) = sv_mortalcopy(DBIc_IMP_DATA(imp_xxh));
-#line 6062 "DBI.c"
- }
- XSRETURN(1);
-}
-
-
-XS_EUPXS(XS_DBD_____common_err); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD_____common_err)
-{
- dVAR; dXSARGS;
- if (items != 1)
- croak_xs_usage(cv, "h");
- {
- SV * h = ST(0)
-;
-#line 5526 "DBI.xs"
- D_imp_xxh(h);
- SV *errsv = DBIc_ERR(imp_xxh);
- (void)cv;
- ST(0) = sv_mortalcopy(errsv);
-#line 6082 "DBI.c"
- }
- XSRETURN(1);
-}
-
-
-XS_EUPXS(XS_DBD_____common_state); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD_____common_state)
-{
- dVAR; dXSARGS;
- if (items != 1)
- croak_xs_usage(cv, "h");
- {
- SV * h = ST(0)
-;
-#line 5535 "DBI.xs"
- D_imp_xxh(h);
- SV *state = DBIc_STATE(imp_xxh);
- (void)cv;
- ST(0) = DBIc_STATE_adjust(imp_xxh, state);
-#line 6102 "DBI.c"
- }
- XSRETURN(1);
-}
-
-
-XS_EUPXS(XS_DBD_____common_errstr); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD_____common_errstr)
-{
- dVAR; dXSARGS;
- if (items != 1)
- croak_xs_usage(cv, "h");
- {
- SV * h = ST(0)
-;
-#line 5544 "DBI.xs"
- D_imp_xxh(h);
- SV *errstr = DBIc_ERRSTR(imp_xxh);
- SV *err;
- /* If there's no errstr but there is an err then use err */
- (void)cv;
- if (!SvTRUE(errstr) && (err=DBIc_ERR(imp_xxh)) && SvTRUE(err))
- errstr = err;
- ST(0) = sv_mortalcopy(errstr);
-#line 6126 "DBI.c"
- }
- XSRETURN(1);
-}
-
-
-XS_EUPXS(XS_DBD_____common_set_err); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD_____common_set_err)
-{
- dVAR; dXSARGS;
- if (items < 2 || items > 6)
- croak_xs_usage(cv, "h, err, errstr=&PL_sv_no, state=&PL_sv_undef, method=&PL_sv_undef, result=Nullsv");
- PERL_UNUSED_VAR(ax); /* -Wall */
- SP -= items;
- {
- SV * h = ST(0)
-;
- SV * err = ST(1)
-;
- SV * errstr;
- SV * state;
- SV * method;
- SV * result;
-
- if (items < 3)
- errstr = &PL_sv_no;
- else {
- errstr = ST(2)
-;
- }
-
- if (items < 4)
- state = &PL_sv_undef;
- else {
- state = ST(3)
-;
- }
-
- if (items < 5)
- method = &PL_sv_undef;
- else {
- method = ST(4)
-;
- }
-
- if (items < 6)
- result = Nullsv;
- else {
- result = ST(5)
-;
- }
-#line 5563 "DBI.xs"
- {
- D_imp_xxh(h);
- SV **sem_svp;
- (void)cv;
-
- if (DBIc_has(imp_xxh, DBIcf_HandleSetErr) && SvREADONLY(method))
- method = sv_mortalcopy(method); /* HandleSetErr may want to change it */
-
- if (!set_err_sv(h, imp_xxh, err, errstr, state, method)) {
- /* set_err was canceled by HandleSetErr, */
- /* don't set "dbi_set_err_method", return an empty list */
- }
- else {
- /* store provided method name so handler code can find it */
- sem_svp = hv_fetch((HV*)SvRV(h), "dbi_set_err_method", 18, 1);
- if (SvOK(method)) {
- sv_setpv(*sem_svp, SvPV_nolen(method));
- }
- else
- (void)SvOK_off(*sem_svp);
- EXTEND(SP, 1);
- PUSHs( result ? result : &PL_sv_undef );
- }
- /* We don't check RaiseError and call die here because that must be */
- /* done by returning through dispatch and letting the DBI handle it */
- }
-#line 6204 "DBI.c"
- PUTBACK;
- return;
- }
-}
-
-
-XS_EUPXS(XS_DBD_____common_trace); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD_____common_trace)
-{
- dVAR; dXSARGS;
- dXSI32;
- if (items < 1 || items > 3)
- croak_xs_usage(cv, "h, level=&PL_sv_undef, file=Nullsv");
- {
- SV * h = ST(0)
-;
- SV * level;
- SV * file;
- int RETVAL;
- dXSTARG;
-
- if (items < 2)
- level = &PL_sv_undef;
- else {
- level = ST(1)
-;
- }
-
- if (items < 3)
- file = Nullsv;
- else {
- file = ST(2)
-;
- }
-#line 5599 "DBI.xs"
- RETVAL = set_trace(h, level, file);
- (void)cv; /* Unused variables */
- (void)ix;
-#line 6243 "DBI.c"
- XSprePUSH; PUSHi((IV)RETVAL);
- }
- XSRETURN(1);
-}
-
-
-XS_EUPXS(XS_DBD_____common_trace_msg); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD_____common_trace_msg)
-{
- dVAR; dXSARGS;
- if (items < 2 || items > 3)
- croak_xs_usage(cv, "sv, msg, this_trace=1");
- {
- SV * sv = ST(0)
-;
- const char * msg = (const char *)SvPV_nolen(ST(1))
-;
- int this_trace;
-#line 5612 "DBI.xs"
- int current_trace;
- PerlIO *pio;
-#line 6265 "DBI.c"
-
- if (items < 3)
- this_trace = 1;
- else {
- this_trace = (int)SvIV(ST(2))
-;
- }
-#line 5615 "DBI.xs"
- {
- dMY_CXT;
- (void)cv;
- if (SvROK(sv)) {
- D_imp_xxh(sv);
- current_trace = DBIc_TRACE_LEVEL(imp_xxh);
- pio = DBIc_LOGPIO(imp_xxh);
- }
- else { /* called as a static method */
- current_trace = DBIS_TRACE_FLAGS;
- pio = DBILOGFP;
- }
- if (DBIc_TRACE_MATCHES(this_trace, current_trace)) {
- PerlIO_puts(pio, msg);
- ST(0) = &PL_sv_yes;
- }
- else {
- ST(0) = &PL_sv_no;
- }
- }
-#line 6294 "DBI.c"
- }
- XSRETURN(1);
-}
-
-
-XS_EUPXS(XS_DBD_____common_rows); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD_____common_rows)
-{
- dVAR; dXSARGS;
- if (items != 1)
- croak_xs_usage(cv, "h");
- {
- SV * h = ST(0)
-;
-#line 5641 "DBI.xs"
- /* fallback esp for $DBI::rows after $drh was last used */
- ST(0) = sv_2mortal(newSViv(-1));
- (void)h;
- (void)cv;
-#line 6314 "DBI.c"
- }
- XSRETURN(1);
-}
-
-
-XS_EUPXS(XS_DBD_____common_swap_inner_handle); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD_____common_swap_inner_handle)
-{
- dVAR; dXSARGS;
- if (items < 2 || items > 3)
- croak_xs_usage(cv, "rh1, rh2, allow_reparent=0");
- {
- SV * rh1 = ST(0)
-;
- SV * rh2 = ST(1)
-;
- IV allow_reparent;
-
- if (items < 3)
- allow_reparent = 0;
- else {
- allow_reparent = (IV)SvIV(ST(2))
-;
- }
-#line 5653 "DBI.xs"
- {
- D_impdata(imp_xxh1, imp_xxh_t, rh1);
- D_impdata(imp_xxh2, imp_xxh_t, rh2);
- SV *h1i = dbih_inner(aTHX_ rh1, "swap_inner_handle");
- SV *h2i = dbih_inner(aTHX_ rh2, "swap_inner_handle");
- SV *h1 = (rh1 == h1i) ? (SV*)DBIc_MY_H(imp_xxh1) : SvRV(rh1);
- SV *h2 = (rh2 == h2i) ? (SV*)DBIc_MY_H(imp_xxh2) : SvRV(rh2);
- (void)cv;
-
- if (DBIc_TYPE(imp_xxh1) != DBIc_TYPE(imp_xxh2)) {
- char buf[99];
- sprintf(buf, "Can't swap_inner_handle between %sh and %sh",
- dbih_htype_name(DBIc_TYPE(imp_xxh1)), dbih_htype_name(DBIc_TYPE(imp_xxh2)));
- DBIh_SET_ERR_CHAR(rh1, imp_xxh1, "1", 1, buf, Nullch, Nullch);
- XSRETURN_NO;
- }
- if (!allow_reparent && DBIc_PARENT_COM(imp_xxh1) != DBIc_PARENT_COM(imp_xxh2)) {
- DBIh_SET_ERR_CHAR(rh1, imp_xxh1, "1", 1,
- "Can't swap_inner_handle with handle from different parent",
- Nullch, Nullch);
- XSRETURN_NO;
- }
-
- (void)SvREFCNT_inc(h1i);
- (void)SvREFCNT_inc(h2i);
-
- sv_unmagic(h1, 'P'); /* untie(%$h1) */
- sv_unmagic(h2, 'P'); /* untie(%$h2) */
-
- sv_magic(h1, h2i, 'P', Nullch, 0); /* tie %$h1, $h2i */
- DBIc_MY_H(imp_xxh2) = (HV*)h1;
-
- sv_magic(h2, h1i, 'P', Nullch, 0); /* tie %$h2, $h1i */
- DBIc_MY_H(imp_xxh1) = (HV*)h2;
-
- SvREFCNT_dec(h1i);
- SvREFCNT_dec(h2i);
-
- ST(0) = &PL_sv_yes;
- }
-#line 6380 "DBI.c"
- }
- XSRETURN(1);
-}
-
-
-XS_EUPXS(XS_DBD___mem__common_DESTROY); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD___mem__common_DESTROY)
-{
- dVAR; dXSARGS;
- if (items != 1)
- croak_xs_usage(cv, "imp_xxh_rv");
- {
- SV * imp_xxh_rv = ST(0)
-;
-#line 5701 "DBI.xs"
- /* ignore 'cast increases required alignment' warning */
- imp_xxh_t *imp_xxh = (imp_xxh_t*)SvPVX(SvRV(imp_xxh_rv));
- DBIc_DBISTATE(imp_xxh)->clearcom(imp_xxh);
- (void)cv;
-#line 6400 "DBI.c"
- }
- XSRETURN_EMPTY;
-}
-
-#ifdef __cplusplus
-extern "C"
-#endif
-XS_EXTERNAL(boot_DBI); /* prototype to pass -Wmissing-prototypes */
-XS_EXTERNAL(boot_DBI)
-{
-#if PERL_VERSION_LE(5, 21, 5)
- dVAR; dXSARGS;
-#else
- dVAR; dXSBOOTARGSXSAPIVERCHK;
-#endif
-#if (PERL_REVISION == 5 && PERL_VERSION < 9)
- char* file = __FILE__;
-#else
- const char* file = __FILE__;
-#endif
-
- PERL_UNUSED_VAR(file);
-
- PERL_UNUSED_VAR(cv); /* -W */
- PERL_UNUSED_VAR(items); /* -W */
-#if PERL_VERSION_LE(5, 21, 5)
- XS_VERSION_BOOTCHECK;
-# ifdef XS_APIVERSION_BOOTCHECK
- XS_APIVERSION_BOOTCHECK;
-# endif
-#endif
-
- cv = newXSproto_portable("DBI::DBIf_TRACE_CON", XS_DBI_constant, file, "");
- XSANY.any_i32 = DBIf_TRACE_CON;
- cv = newXSproto_portable("DBI::DBIf_TRACE_DBD", XS_DBI_constant, file, "");
- XSANY.any_i32 = DBIf_TRACE_DBD;
- cv = newXSproto_portable("DBI::DBIf_TRACE_ENC", XS_DBI_constant, file, "");
- XSANY.any_i32 = DBIf_TRACE_ENC;
- cv = newXSproto_portable("DBI::DBIf_TRACE_SQL", XS_DBI_constant, file, "");
- XSANY.any_i32 = DBIf_TRACE_SQL;
- cv = newXSproto_portable("DBI::DBIf_TRACE_TXN", XS_DBI_constant, file, "");
- XSANY.any_i32 = DBIf_TRACE_TXN;
- cv = newXSproto_portable("DBI::DBIpp_cm_XX", XS_DBI_constant, file, "");
- XSANY.any_i32 = DBIpp_cm_XX;
- cv = newXSproto_portable("DBI::DBIpp_cm_br", XS_DBI_constant, file, "");
- XSANY.any_i32 = DBIpp_cm_br;
- cv = newXSproto_portable("DBI::DBIpp_cm_cs", XS_DBI_constant, file, "");
- XSANY.any_i32 = DBIpp_cm_cs;
- cv = newXSproto_portable("DBI::DBIpp_cm_dd", XS_DBI_constant, file, "");
- XSANY.any_i32 = DBIpp_cm_dd;
- cv = newXSproto_portable("DBI::DBIpp_cm_dw", XS_DBI_constant, file, "");
- XSANY.any_i32 = DBIpp_cm_dw;
- cv = newXSproto_portable("DBI::DBIpp_cm_hs", XS_DBI_constant, file, "");
- XSANY.any_i32 = DBIpp_cm_hs;
- cv = newXSproto_portable("DBI::DBIpp_ph_XX", XS_DBI_constant, file, "");
- XSANY.any_i32 = DBIpp_ph_XX;
- cv = newXSproto_portable("DBI::DBIpp_ph_cn", XS_DBI_constant, file, "");
- XSANY.any_i32 = DBIpp_ph_cn;
- cv = newXSproto_portable("DBI::DBIpp_ph_cs", XS_DBI_constant, file, "");
- XSANY.any_i32 = DBIpp_ph_cs;
- cv = newXSproto_portable("DBI::DBIpp_ph_qm", XS_DBI_constant, file, "");
- XSANY.any_i32 = DBIpp_ph_qm;
- cv = newXSproto_portable("DBI::DBIpp_ph_sp", XS_DBI_constant, file, "");
- XSANY.any_i32 = DBIpp_ph_sp;
- cv = newXSproto_portable("DBI::DBIpp_st_XX", XS_DBI_constant, file, "");
- XSANY.any_i32 = DBIpp_st_XX;
- cv = newXSproto_portable("DBI::DBIpp_st_bs", XS_DBI_constant, file, "");
- XSANY.any_i32 = DBIpp_st_bs;
- cv = newXSproto_portable("DBI::DBIpp_st_qq", XS_DBI_constant, file, "");
- XSANY.any_i32 = DBIpp_st_qq;
- cv = newXSproto_portable("DBI::DBIstcf_DISCARD_STRING", XS_DBI_constant, file, "");
- XSANY.any_i32 = DBIstcf_DISCARD_STRING;
- cv = newXSproto_portable("DBI::DBIstcf_STRICT", XS_DBI_constant, file, "");
- XSANY.any_i32 = DBIstcf_STRICT;
- cv = newXSproto_portable("DBI::SQL_ALL_TYPES", XS_DBI_constant, file, "");
- XSANY.any_i32 = SQL_ALL_TYPES;
- cv = newXSproto_portable("DBI::SQL_ARRAY", XS_DBI_constant, file, "");
- XSANY.any_i32 = SQL_ARRAY;
- cv = newXSproto_portable("DBI::SQL_ARRAY_LOCATOR", XS_DBI_constant, file, "");
- XSANY.any_i32 = SQL_ARRAY_LOCATOR;
- cv = newXSproto_portable("DBI::SQL_BIGINT", XS_DBI_constant, file, "");
- XSANY.any_i32 = SQL_BIGINT;
- cv = newXSproto_portable("DBI::SQL_BINARY", XS_DBI_constant, file, "");
- XSANY.any_i32 = SQL_BINARY;
- cv = newXSproto_portable("DBI::SQL_BIT", XS_DBI_constant, file, "");
- XSANY.any_i32 = SQL_BIT;
- cv = newXSproto_portable("DBI::SQL_BLOB", XS_DBI_constant, file, "");
- XSANY.any_i32 = SQL_BLOB;
- cv = newXSproto_portable("DBI::SQL_BLOB_LOCATOR", XS_DBI_constant, file, "");
- XSANY.any_i32 = SQL_BLOB_LOCATOR;
- cv = newXSproto_portable("DBI::SQL_BOOLEAN", XS_DBI_constant, file, "");
- XSANY.any_i32 = SQL_BOOLEAN;
- cv = newXSproto_portable("DBI::SQL_CHAR", XS_DBI_constant, file, "");
- XSANY.any_i32 = SQL_CHAR;
- cv = newXSproto_portable("DBI::SQL_CLOB", XS_DBI_constant, file, "");
- XSANY.any_i32 = SQL_CLOB;
- cv = newXSproto_portable("DBI::SQL_CLOB_LOCATOR", XS_DBI_constant, file, "");
- XSANY.any_i32 = SQL_CLOB_LOCATOR;
- cv = newXSproto_portable("DBI::SQL_CURSOR_DYNAMIC", XS_DBI_constant, file, "");
- XSANY.any_i32 = SQL_CURSOR_DYNAMIC;
- cv = newXSproto_portable("DBI::SQL_CURSOR_FORWARD_ONLY", XS_DBI_constant, file, "");
- XSANY.any_i32 = SQL_CURSOR_FORWARD_ONLY;
- cv = newXSproto_portable("DBI::SQL_CURSOR_KEYSET_DRIVEN", XS_DBI_constant, file, "");
- XSANY.any_i32 = SQL_CURSOR_KEYSET_DRIVEN;
- cv = newXSproto_portable("DBI::SQL_CURSOR_STATIC", XS_DBI_constant, file, "");
- XSANY.any_i32 = SQL_CURSOR_STATIC;
- cv = newXSproto_portable("DBI::SQL_CURSOR_TYPE_DEFAULT", XS_DBI_constant, file, "");
- XSANY.any_i32 = SQL_CURSOR_TYPE_DEFAULT;
- cv = newXSproto_portable("DBI::SQL_DATE", XS_DBI_constant, file, "");
- XSANY.any_i32 = SQL_DATE;
- cv = newXSproto_portable("DBI::SQL_DATETIME", XS_DBI_constant, file, "");
- XSANY.any_i32 = SQL_DATETIME;
- cv = newXSproto_portable("DBI::SQL_DECIMAL", XS_DBI_constant, file, "");
- XSANY.any_i32 = SQL_DECIMAL;
- cv = newXSproto_portable("DBI::SQL_DOUBLE", XS_DBI_constant, file, "");
- XSANY.any_i32 = SQL_DOUBLE;
- cv = newXSproto_portable("DBI::SQL_FLOAT", XS_DBI_constant, file, "");
- XSANY.any_i32 = SQL_FLOAT;
- cv = newXSproto_portable("DBI::SQL_GUID", XS_DBI_constant, file, "");
- XSANY.any_i32 = SQL_GUID;
- cv = newXSproto_portable("DBI::SQL_INTEGER", XS_DBI_constant, file, "");
- XSANY.any_i32 = SQL_INTEGER;
- cv = newXSproto_portable("DBI::SQL_INTERVAL", XS_DBI_constant, file, "");
- XSANY.any_i32 = SQL_INTERVAL;
- cv = newXSproto_portable("DBI::SQL_INTERVAL_DAY", XS_DBI_constant, file, "");
- XSANY.any_i32 = SQL_INTERVAL_DAY;
- cv = newXSproto_portable("DBI::SQL_INTERVAL_DAY_TO_HOUR", XS_DBI_constant, file, "");
- XSANY.any_i32 = SQL_INTERVAL_DAY_TO_HOUR;
- cv = newXSproto_portable("DBI::SQL_INTERVAL_DAY_TO_MINUTE", XS_DBI_constant, file, "");
- XSANY.any_i32 = SQL_INTERVAL_DAY_TO_MINUTE;
- cv = newXSproto_portable("DBI::SQL_INTERVAL_DAY_TO_SECOND", XS_DBI_constant, file, "");
- XSANY.any_i32 = SQL_INTERVAL_DAY_TO_SECOND;
- cv = newXSproto_portable("DBI::SQL_INTERVAL_HOUR", XS_DBI_constant, file, "");
- XSANY.any_i32 = SQL_INTERVAL_HOUR;
- cv = newXSproto_portable("DBI::SQL_INTERVAL_HOUR_TO_MINUTE", XS_DBI_constant, file, "");
- XSANY.any_i32 = SQL_INTERVAL_HOUR_TO_MINUTE;
- cv = newXSproto_portable("DBI::SQL_INTERVAL_HOUR_TO_SECOND", XS_DBI_constant, file, "");
- XSANY.any_i32 = SQL_INTERVAL_HOUR_TO_SECOND;
- cv = newXSproto_portable("DBI::SQL_INTERVAL_MINUTE", XS_DBI_constant, file, "");
- XSANY.any_i32 = SQL_INTERVAL_MINUTE;
- cv = newXSproto_portable("DBI::SQL_INTERVAL_MINUTE_TO_SECOND", XS_DBI_constant, file, "");
- XSANY.any_i32 = SQL_INTERVAL_MINUTE_TO_SECOND;
- cv = newXSproto_portable("DBI::SQL_INTERVAL_MONTH", XS_DBI_constant, file, "");
- XSANY.any_i32 = SQL_INTERVAL_MONTH;
- cv = newXSproto_portable("DBI::SQL_INTERVAL_SECOND", XS_DBI_constant, file, "");
- XSANY.any_i32 = SQL_INTERVAL_SECOND;
- cv = newXSproto_portable("DBI::SQL_INTERVAL_YEAR", XS_DBI_constant, file, "");
- XSANY.any_i32 = SQL_INTERVAL_YEAR;
- cv = newXSproto_portable("DBI::SQL_INTERVAL_YEAR_TO_MONTH", XS_DBI_constant, file, "");
- XSANY.any_i32 = SQL_INTERVAL_YEAR_TO_MONTH;
- cv = newXSproto_portable("DBI::SQL_LONGVARBINARY", XS_DBI_constant, file, "");
- XSANY.any_i32 = SQL_LONGVARBINARY;
- cv = newXSproto_portable("DBI::SQL_LONGVARCHAR", XS_DBI_constant, file, "");
- XSANY.any_i32 = SQL_LONGVARCHAR;
- cv = newXSproto_portable("DBI::SQL_MULTISET", XS_DBI_constant, file, "");
- XSANY.any_i32 = SQL_MULTISET;
- cv = newXSproto_portable("DBI::SQL_MULTISET_LOCATOR", XS_DBI_constant, file, "");
- XSANY.any_i32 = SQL_MULTISET_LOCATOR;
- cv = newXSproto_portable("DBI::SQL_NUMERIC", XS_DBI_constant, file, "");
- XSANY.any_i32 = SQL_NUMERIC;
- cv = newXSproto_portable("DBI::SQL_REAL", XS_DBI_constant, file, "");
- XSANY.any_i32 = SQL_REAL;
- cv = newXSproto_portable("DBI::SQL_REF", XS_DBI_constant, file, "");
- XSANY.any_i32 = SQL_REF;
- cv = newXSproto_portable("DBI::SQL_ROW", XS_DBI_constant, file, "");
- XSANY.any_i32 = SQL_ROW;
- cv = newXSproto_portable("DBI::SQL_SMALLINT", XS_DBI_constant, file, "");
- XSANY.any_i32 = SQL_SMALLINT;
- cv = newXSproto_portable("DBI::SQL_TIME", XS_DBI_constant, file, "");
- XSANY.any_i32 = SQL_TIME;
- cv = newXSproto_portable("DBI::SQL_TIMESTAMP", XS_DBI_constant, file, "");
- XSANY.any_i32 = SQL_TIMESTAMP;
- cv = newXSproto_portable("DBI::SQL_TINYINT", XS_DBI_constant, file, "");
- XSANY.any_i32 = SQL_TINYINT;
- cv = newXSproto_portable("DBI::SQL_TYPE_DATE", XS_DBI_constant, file, "");
- XSANY.any_i32 = SQL_TYPE_DATE;
- cv = newXSproto_portable("DBI::SQL_TYPE_TIME", XS_DBI_constant, file, "");
- XSANY.any_i32 = SQL_TYPE_TIME;
- cv = newXSproto_portable("DBI::SQL_TYPE_TIMESTAMP", XS_DBI_constant, file, "");
- XSANY.any_i32 = SQL_TYPE_TIMESTAMP;
- cv = newXSproto_portable("DBI::SQL_TYPE_TIMESTAMP_WITH_TIMEZONE", XS_DBI_constant, file, "");
- XSANY.any_i32 = SQL_TYPE_TIMESTAMP_WITH_TIMEZONE;
- cv = newXSproto_portable("DBI::SQL_TYPE_TIME_WITH_TIMEZONE", XS_DBI_constant, file, "");
- XSANY.any_i32 = SQL_TYPE_TIME_WITH_TIMEZONE;
- cv = newXSproto_portable("DBI::SQL_UDT", XS_DBI_constant, file, "");
- XSANY.any_i32 = SQL_UDT;
- cv = newXSproto_portable("DBI::SQL_UDT_LOCATOR", XS_DBI_constant, file, "");
- XSANY.any_i32 = SQL_UDT_LOCATOR;
- cv = newXSproto_portable("DBI::SQL_UNKNOWN_TYPE", XS_DBI_constant, file, "");
- XSANY.any_i32 = SQL_UNKNOWN_TYPE;
- cv = newXSproto_portable("DBI::SQL_VARBINARY", XS_DBI_constant, file, "");
- XSANY.any_i32 = SQL_VARBINARY;
- cv = newXSproto_portable("DBI::SQL_VARCHAR", XS_DBI_constant, file, "");
- XSANY.any_i32 = SQL_VARCHAR;
- cv = newXSproto_portable("DBI::SQL_WCHAR", XS_DBI_constant, file, "");
- XSANY.any_i32 = SQL_WCHAR;
- cv = newXSproto_portable("DBI::SQL_WLONGVARCHAR", XS_DBI_constant, file, "");
- XSANY.any_i32 = SQL_WLONGVARCHAR;
- cv = newXSproto_portable("DBI::SQL_WVARCHAR", XS_DBI_constant, file, "");
- XSANY.any_i32 = SQL_WVARCHAR;
- cv = newXSproto_portable("DBI::constant", XS_DBI_constant, file, "");
- XSANY.any_i32 = 0;
- newXS_deffile("DBI::_clone_dbis", XS_DBI__clone_dbis);
- newXS_deffile("DBI::_new_handle", XS_DBI__new_handle);
- newXS_deffile("DBI::_setup_handle", XS_DBI__setup_handle);
- newXS_deffile("DBI::_get_imp_data", XS_DBI__get_imp_data);
- newXS_deffile("DBI::_handles", XS_DBI__handles);
- newXS_deffile("DBI::neat", XS_DBI_neat);
- newXS_deffile("DBI::hash", XS_DBI_hash);
- newXS_deffile("DBI::looks_like_number", XS_DBI_looks_like_number);
- newXS_deffile("DBI::_install_method", XS_DBI__install_method);
- cv = newXS_deffile("DBI::_debug_dispatch", XS_DBI_trace);
- XSANY.any_i32 = 1;
- cv = newXS_deffile("DBI::trace", XS_DBI_trace);
- XSANY.any_i32 = 0;
- newXS_deffile("DBI::dump_handle", XS_DBI_dump_handle);
- newXS_deffile("DBI::_svdump", XS_DBI__svdump);
- newXS_deffile("DBI::dbi_time", XS_DBI_dbi_time);
- newXS_deffile("DBI::dbi_profile", XS_DBI_dbi_profile);
- cv = newXS_deffile("DBI::dbi_profile_merge", XS_DBI_dbi_profile_merge_nodes);
- XSANY.any_i32 = 1;
- cv = newXS_deffile("DBI::dbi_profile_merge_nodes", XS_DBI_dbi_profile_merge_nodes);
- XSANY.any_i32 = 0;
- newXS_deffile("DBI::_concat_hash_sorted", XS_DBI__concat_hash_sorted);
- newXS_deffile("DBI::sql_type_cast", XS_DBI_sql_type_cast);
- newXS_deffile("DBI::var::FETCH", XS_DBI__var_FETCH);
- newXS_deffile("DBD::_::dr::dbixs_revision", XS_DBD_____dr_dbixs_revision);
- newXS_deffile("DBD::_::db::connected", XS_DBD_____db_connected);
- newXS_deffile("DBD::_::db::preparse", XS_DBD_____db_preparse);
- newXS_deffile("DBD::_::db::take_imp_data", XS_DBD_____db_take_imp_data);
- newXS_deffile("DBD::_::st::_get_fbav", XS_DBD_____st__get_fbav);
- newXS_deffile("DBD::_::st::_set_fbav", XS_DBD_____st__set_fbav);
- newXS_deffile("DBD::_::st::bind_col", XS_DBD_____st_bind_col);
- cv = newXS_deffile("DBD::_::st::fetchrow", XS_DBD_____st_fetchrow_array);
- XSANY.any_i32 = 1;
- cv = newXS_deffile("DBD::_::st::fetchrow_array", XS_DBD_____st_fetchrow_array);
- XSANY.any_i32 = 0;
- newXS_deffile("DBD::_::st::fetchrow_hashref", XS_DBD_____st_fetchrow_hashref);
- cv = newXS_deffile("DBD::_::st::fetch", XS_DBD_____st_fetch);
- XSANY.any_i32 = 0;
- cv = newXS_deffile("DBD::_::st::fetchrow_arrayref", XS_DBD_____st_fetch);
- XSANY.any_i32 = 1;
- newXS_deffile("DBD::_::st::rows", XS_DBD_____st_rows);
- newXS_deffile("DBD::_::st::finish", XS_DBD_____st_finish);
- newXS_deffile("DBD::_::st::DESTROY", XS_DBD_____st_DESTROY);
- newXS_deffile("DBI::st::TIEHASH", XS_DBI__st_TIEHASH);
- newXS_deffile("DBD::_::common::DESTROY", XS_DBD_____common_DESTROY);
- newXS_deffile("DBD::_::common::STORE", XS_DBD_____common_STORE);
- newXS_deffile("DBD::_::common::FETCH", XS_DBD_____common_FETCH);
- newXS_deffile("DBD::_::common::DELETE", XS_DBD_____common_DELETE);
- newXS_deffile("DBD::_::common::private_data", XS_DBD_____common_private_data);
- newXS_deffile("DBD::_::common::err", XS_DBD_____common_err);
- newXS_deffile("DBD::_::common::state", XS_DBD_____common_state);
- newXS_deffile("DBD::_::common::errstr", XS_DBD_____common_errstr);
- newXS_deffile("DBD::_::common::set_err", XS_DBD_____common_set_err);
- cv = newXS_deffile("DBD::_::common::debug", XS_DBD_____common_trace);
- XSANY.any_i32 = 1;
- cv = newXS_deffile("DBD::_::common::trace", XS_DBD_____common_trace);
- XSANY.any_i32 = 0;
- newXS_deffile("DBD::_::common::trace_msg", XS_DBD_____common_trace_msg);
- newXS_deffile("DBD::_::common::rows", XS_DBD_____common_rows);
- newXS_deffile("DBD::_::common::swap_inner_handle", XS_DBD_____common_swap_inner_handle);
- newXS_deffile("DBD::_mem::common::DESTROY", XS_DBD___mem__common_DESTROY);
-
- /* Initialisation Section */
-
-#line 4480 "DBI.xs"
- {
- MY_CXT_INIT;
- PERL_UNUSED_VAR(MY_CXT);
- }
- PERL_UNUSED_VAR(cv);
- PERL_UNUSED_VAR(items);
- dbi_bootinit(NULL);
- /* make this sub into a fake XS so it can bee seen by DBD::* modules;
- * never actually call it as an XS sub, or it will crash and burn! */
- (void) newXS("DBI::_dbi_state_lval", (XSUBADDR_t)_dbi_state_lval, __FILE__);
-
-#line 6679 "DBI.c"
-
- /* End of Initialisation Section */
-
-#if PERL_VERSION_LE(5, 21, 5)
-# if PERL_VERSION_GE(5, 9, 0)
- if (PL_unitcheckav)
- call_list(PL_scopestack_ix, PL_unitcheckav);
-# endif
- XSRETURN_YES;
-#else
- Perl_xs_boot_epilog(aTHX_ ax);
-#endif
-}
-
+++ /dev/null
-# $Id$
-# vim: ts=8:sw=4:et
-#
-# Copyright (c) 1994-2012 Tim Bunce Ireland
-#
-# See COPYRIGHT section in pod text below for usage and distribution rights.
-#
-
-package DBI;
-
-require 5.008_001;
-
-BEGIN {
-our $XS_VERSION = our $VERSION = "1.641"; # ==> ALSO update the version in the pod text below!
-$VERSION = eval $VERSION;
-}
-
-=head1 NAME
-
-DBI - Database independent interface for Perl
-
-=head1 SYNOPSIS
-
- use DBI;
-
- @driver_names = DBI->available_drivers;
- %drivers = DBI->installed_drivers;
- @data_sources = DBI->data_sources($driver_name, \%attr);
-
- $dbh = DBI->connect($data_source, $username, $auth, \%attr);
-
- $rv = $dbh->do($statement);
- $rv = $dbh->do($statement, \%attr);
- $rv = $dbh->do($statement, \%attr, @bind_values);
-
- $ary_ref = $dbh->selectall_arrayref($statement);
- $hash_ref = $dbh->selectall_hashref($statement, $key_field);
-
- $ary_ref = $dbh->selectcol_arrayref($statement);
- $ary_ref = $dbh->selectcol_arrayref($statement, \%attr);
-
- @row_ary = $dbh->selectrow_array($statement);
- $ary_ref = $dbh->selectrow_arrayref($statement);
- $hash_ref = $dbh->selectrow_hashref($statement);
-
- $sth = $dbh->prepare($statement);
- $sth = $dbh->prepare_cached($statement);
-
- $rc = $sth->bind_param($p_num, $bind_value);
- $rc = $sth->bind_param($p_num, $bind_value, $bind_type);
- $rc = $sth->bind_param($p_num, $bind_value, \%attr);
-
- $rv = $sth->execute;
- $rv = $sth->execute(@bind_values);
- $rv = $sth->execute_array(\%attr, ...);
-
- $rc = $sth->bind_col($col_num, \$col_variable);
- $rc = $sth->bind_columns(@list_of_refs_to_vars_to_bind);
-
- @row_ary = $sth->fetchrow_array;
- $ary_ref = $sth->fetchrow_arrayref;
- $hash_ref = $sth->fetchrow_hashref;
-
- $ary_ref = $sth->fetchall_arrayref;
- $ary_ref = $sth->fetchall_arrayref( $slice, $max_rows );
-
- $hash_ref = $sth->fetchall_hashref( $key_field );
-
- $rv = $sth->rows;
-
- $rc = $dbh->begin_work;
- $rc = $dbh->commit;
- $rc = $dbh->rollback;
-
- $quoted_string = $dbh->quote($string);
-
- $rc = $h->err;
- $str = $h->errstr;
- $rv = $h->state;
-
- $rc = $dbh->disconnect;
-
-I<The synopsis above only lists the major methods and parameters.>
-
-
-=head2 GETTING HELP
-
-=head3 General
-
-Before asking any questions, reread this document, consult the
-archives and read the DBI FAQ. The archives are listed
-at the end of this document and on the DBI home page L<http://dbi.perl.org/support/>
-
-You might also like to read the Advanced DBI Tutorial at
-L<http://www.slideshare.net/Tim.Bunce/dbi-advanced-tutorial-2007>
-
-To help you make the best use of the dbi-users mailing list,
-and any other lists or forums you may use, I recommend that you read
-"Getting Answers" by Mike Ash: L<http://mikeash.com/getting_answers.html>.
-
-=head3 Mailing Lists
-
-If you have questions about DBI, or DBD driver modules, you can get
-help from the I<dbi-users@perl.org> mailing list. This is the best way to get
-help. You don't have to subscribe to the list in order to post, though I'd
-recommend it. You can get help on subscribing and using the list by emailing
-I<dbi-users-help@perl.org>.
-
-Please note that Tim Bunce does not maintain the mailing lists or the
-web pages (generous volunteers do that). So please don't send mail
-directly to him; he just doesn't have the time to answer questions
-personally. The I<dbi-users> mailing list has lots of experienced
-people who should be able to help you if you need it. If you do email
-Tim he is very likely to just forward it to the mailing list.
-
-=head3 IRC
-
-DBI IRC Channel: #dbi on irc.perl.org (L<irc://irc.perl.org/#dbi>)
-
-=for html <a href="http://chat.mibbit.com/#dbi@irc.perl.org">(click for instant chatroom login)</a>
-
-=head3 Online
-
-StackOverflow has a DBI tag L<http://stackoverflow.com/questions/tagged/dbi>
-with over 800 questions.
-
-The DBI home page at L<http://dbi.perl.org/> and the DBI FAQ
-at L<http://faq.dbi-support.com/> may be worth a visit.
-They include links to other resources, but I<are rather out-dated>.
-
-=head3 Reporting a Bug
-
-If you think you've found a bug then please read
-"How to Report Bugs Effectively" by Simon Tatham:
-L<http://www.chiark.greenend.org.uk/~sgtatham/bugs.html>.
-
-If you think you've found a memory leak then read L</Memory Leaks>.
-
-Your problem is most likely related to the specific DBD driver module you're
-using. If that's the case then click on the 'Bugs' link on the L<http://metacpan.org>
-page for your driver. Only submit a bug report against the DBI itself if you're
-sure that your issue isn't related to the driver you're using.
-
-=head2 NOTES
-
-This is the DBI specification that corresponds to DBI version 1.641
-(see L<DBI::Changes> for details).
-
-The DBI is evolving at a steady pace, so it's good to check that
-you have the latest copy.
-
-The significant user-visible changes in each release are documented
-in the L<DBI::Changes> module so you can read them by executing
-C<perldoc DBI::Changes>.
-
-Some DBI changes require changes in the drivers, but the drivers
-can take some time to catch up. Newer versions of the DBI have
-added features that may not yet be supported by the drivers you
-use. Talk to the authors of your drivers if you need a new feature
-that is not yet supported.
-
-Features added after DBI 1.21 (February 2002) are marked in the
-text with the version number of the DBI release they first appeared in.
-
-Extensions to the DBI API often use the C<DBIx::*> namespace.
-See L</Naming Conventions and Name Space>. DBI extension modules
-can be found at L<https://metacpan.org/search?q=DBIx>. And all modules
-related to the DBI can be found at L<https://metacpan.org/search?q=DBI>.
-
-=cut
-
-# The POD text continues at the end of the file.
-
-use Scalar::Util ();
-use Carp();
-use DynaLoader ();
-use Exporter ();
-
-BEGIN {
-@ISA = qw(Exporter DynaLoader);
-
-# Make some utility functions available if asked for
-@EXPORT = (); # we export nothing by default
-@EXPORT_OK = qw(%DBI %DBI_methods hash); # also populated by export_ok_tags:
-%EXPORT_TAGS = (
- sql_types => [ qw(
- SQL_GUID
- SQL_WLONGVARCHAR
- SQL_WVARCHAR
- SQL_WCHAR
- SQL_BIGINT
- SQL_BIT
- SQL_TINYINT
- SQL_LONGVARBINARY
- SQL_VARBINARY
- SQL_BINARY
- SQL_LONGVARCHAR
- SQL_UNKNOWN_TYPE
- SQL_ALL_TYPES
- SQL_CHAR
- SQL_NUMERIC
- SQL_DECIMAL
- SQL_INTEGER
- SQL_SMALLINT
- SQL_FLOAT
- SQL_REAL
- SQL_DOUBLE
- SQL_DATETIME
- SQL_DATE
- SQL_INTERVAL
- SQL_TIME
- SQL_TIMESTAMP
- SQL_VARCHAR
- SQL_BOOLEAN
- SQL_UDT
- SQL_UDT_LOCATOR
- SQL_ROW
- SQL_REF
- SQL_BLOB
- SQL_BLOB_LOCATOR
- SQL_CLOB
- SQL_CLOB_LOCATOR
- SQL_ARRAY
- SQL_ARRAY_LOCATOR
- SQL_MULTISET
- SQL_MULTISET_LOCATOR
- SQL_TYPE_DATE
- SQL_TYPE_TIME
- SQL_TYPE_TIMESTAMP
- SQL_TYPE_TIME_WITH_TIMEZONE
- SQL_TYPE_TIMESTAMP_WITH_TIMEZONE
- SQL_INTERVAL_YEAR
- SQL_INTERVAL_MONTH
- SQL_INTERVAL_DAY
- SQL_INTERVAL_HOUR
- SQL_INTERVAL_MINUTE
- SQL_INTERVAL_SECOND
- SQL_INTERVAL_YEAR_TO_MONTH
- SQL_INTERVAL_DAY_TO_HOUR
- SQL_INTERVAL_DAY_TO_MINUTE
- SQL_INTERVAL_DAY_TO_SECOND
- SQL_INTERVAL_HOUR_TO_MINUTE
- SQL_INTERVAL_HOUR_TO_SECOND
- SQL_INTERVAL_MINUTE_TO_SECOND
- ) ],
- sql_cursor_types => [ qw(
- SQL_CURSOR_FORWARD_ONLY
- SQL_CURSOR_KEYSET_DRIVEN
- SQL_CURSOR_DYNAMIC
- SQL_CURSOR_STATIC
- SQL_CURSOR_TYPE_DEFAULT
- ) ], # for ODBC cursor types
- utils => [ qw(
- neat neat_list $neat_maxlen dump_results looks_like_number
- data_string_diff data_string_desc data_diff sql_type_cast
- DBIstcf_DISCARD_STRING
- DBIstcf_STRICT
- ) ],
- profile => [ qw(
- dbi_profile dbi_profile_merge dbi_profile_merge_nodes dbi_time
- ) ], # notionally "in" DBI::Profile and normally imported from there
-);
-
-$DBI::dbi_debug = 0; # mixture of bit fields and int sub-fields
-$DBI::neat_maxlen = 1000;
-$DBI::stderr = 2_000_000_000; # a very round number below 2**31
-
-# If you get an error here like "Can't find loadable object ..."
-# then you haven't installed the DBI correctly. Read the README
-# then install it again.
-if ( $ENV{DBI_PUREPERL} ) {
- eval { bootstrap DBI $XS_VERSION } if $ENV{DBI_PUREPERL} == 1;
- require DBI::PurePerl if $@ or $ENV{DBI_PUREPERL} >= 2;
- $DBI::PurePerl ||= 0; # just to silence "only used once" warnings
-}
-else {
- bootstrap DBI $XS_VERSION;
-}
-
-$EXPORT_TAGS{preparse_flags} = [ grep { /^DBIpp_\w\w_/ } keys %{__PACKAGE__."::"} ];
-
-Exporter::export_ok_tags(keys %EXPORT_TAGS);
-
-}
-
-# Alias some handle methods to also be DBI class methods
-for (qw(trace_msg set_err parse_trace_flag parse_trace_flags)) {
- no strict;
- *$_ = \&{"DBD::_::common::$_"};
-}
-
-use strict;
-
-DBI->trace(split /=/, $ENV{DBI_TRACE}, 2) if $ENV{DBI_TRACE};
-
-$DBI::connect_via ||= "connect";
-
-# check if user wants a persistent database connection ( Apache + mod_perl )
-if ($INC{'Apache/DBI.pm'} && $ENV{MOD_PERL}) {
- $DBI::connect_via = "Apache::DBI::connect";
- DBI->trace_msg("DBI connect via $DBI::connect_via in $INC{'Apache/DBI.pm'}\n");
-}
-
-%DBI::installed_drh = (); # maps driver names to installed driver handles
-sub installed_drivers { %DBI::installed_drh }
-%DBI::installed_methods = (); # XXX undocumented, may change
-sub installed_methods { %DBI::installed_methods }
-
-# Setup special DBI dynamic variables. See DBI::var::FETCH for details.
-# These are dynamically associated with the last handle used.
-tie $DBI::err, 'DBI::var', '*err'; # special case: referenced via IHA list
-tie $DBI::state, 'DBI::var', '"state'; # special case: referenced via IHA list
-tie $DBI::lasth, 'DBI::var', '!lasth'; # special case: return boolean
-tie $DBI::errstr, 'DBI::var', '&errstr'; # call &errstr in last used pkg
-tie $DBI::rows, 'DBI::var', '&rows'; # call &rows in last used pkg
-sub DBI::var::TIESCALAR{ my $var = $_[1]; bless \$var, 'DBI::var'; }
-sub DBI::var::STORE { Carp::croak("Can't modify \$DBI::${$_[0]} special variable") }
-
-# --- Driver Specific Prefix Registry ---
-
-my $dbd_prefix_registry = {
- ad_ => { class => 'DBD::AnyData', },
- ad2_ => { class => 'DBD::AnyData2', },
- ado_ => { class => 'DBD::ADO', },
- amzn_ => { class => 'DBD::Amazon', },
- best_ => { class => 'DBD::BestWins', },
- csv_ => { class => 'DBD::CSV', },
- cubrid_ => { class => 'DBD::cubrid', },
- db2_ => { class => 'DBD::DB2', },
- dbi_ => { class => 'DBI', },
- dbm_ => { class => 'DBD::DBM', },
- df_ => { class => 'DBD::DF', },
- examplep_ => { class => 'DBD::ExampleP', },
- f_ => { class => 'DBD::File', },
- file_ => { class => 'DBD::TextFile', },
- go_ => { class => 'DBD::Gofer', },
- ib_ => { class => 'DBD::InterBase', },
- ing_ => { class => 'DBD::Ingres', },
- ix_ => { class => 'DBD::Informix', },
- jdbc_ => { class => 'DBD::JDBC', },
- mariadb_ => { class => 'DBD::MariaDB', },
- mem_ => { class => 'DBD::Mem', },
- mo_ => { class => 'DBD::MO', },
- monetdb_ => { class => 'DBD::monetdb', },
- msql_ => { class => 'DBD::mSQL', },
- mvsftp_ => { class => 'DBD::MVS_FTPSQL', },
- mysql_ => { class => 'DBD::mysql', },
- multi_ => { class => 'DBD::Multi' },
- mx_ => { class => 'DBD::Multiplex', },
- neo_ => { class => 'DBD::Neo4p', },
- nullp_ => { class => 'DBD::NullP', },
- odbc_ => { class => 'DBD::ODBC', },
- ora_ => { class => 'DBD::Oracle', },
- pg_ => { class => 'DBD::Pg', },
- pgpp_ => { class => 'DBD::PgPP', },
- plb_ => { class => 'DBD::Plibdata', },
- po_ => { class => 'DBD::PO', },
- proxy_ => { class => 'DBD::Proxy', },
- ram_ => { class => 'DBD::RAM', },
- rdb_ => { class => 'DBD::RDB', },
- sapdb_ => { class => 'DBD::SAP_DB', },
- snmp_ => { class => 'DBD::SNMP', },
- solid_ => { class => 'DBD::Solid', },
- spatialite_ => { class => 'DBD::Spatialite', },
- sponge_ => { class => 'DBD::Sponge', },
- sql_ => { class => 'DBI::DBD::SqlEngine', },
- sqlite_ => { class => 'DBD::SQLite', },
- syb_ => { class => 'DBD::Sybase', },
- sys_ => { class => 'DBD::Sys', },
- tdat_ => { class => 'DBD::Teradata', },
- tmpl_ => { class => 'DBD::Template', },
- tmplss_ => { class => 'DBD::TemplateSS', },
- tree_ => { class => 'DBD::TreeData', },
- tuber_ => { class => 'DBD::Tuber', },
- uni_ => { class => 'DBD::Unify', },
- vt_ => { class => 'DBD::Vt', },
- wmi_ => { class => 'DBD::WMI', },
- x_ => { }, # for private use
- xbase_ => { class => 'DBD::XBase', },
- xmlsimple_ => { class => 'DBD::XMLSimple', },
- xl_ => { class => 'DBD::Excel', },
- yaswi_ => { class => 'DBD::Yaswi', },
-};
-
-my %dbd_class_registry = map { $dbd_prefix_registry->{$_}->{class} => { prefix => $_ } }
- grep { exists $dbd_prefix_registry->{$_}->{class} }
- keys %{$dbd_prefix_registry};
-
-sub dump_dbd_registry {
- require Data::Dumper;
- local $Data::Dumper::Sortkeys=1;
- local $Data::Dumper::Indent=1;
- print Data::Dumper->Dump([$dbd_prefix_registry], [qw($dbd_prefix_registry)]);
-}
-
-# --- Dynamically create the DBI Standard Interface
-
-my $keeperr = { O=>0x0004 };
-
-%DBI::DBI_methods = ( # Define the DBI interface methods per class:
-
- common => { # Interface methods common to all DBI handle classes
- 'DESTROY' => { O=>0x004|0x10000 },
- 'CLEAR' => $keeperr,
- 'EXISTS' => $keeperr,
- 'FETCH' => { O=>0x0404 },
- 'FETCH_many' => { O=>0x0404 },
- 'FIRSTKEY' => $keeperr,
- 'NEXTKEY' => $keeperr,
- 'STORE' => { O=>0x0418 | 0x4 },
- 'DELETE' => { O=>0x0404 },
- can => { O=>0x0100 }, # special case, see dispatch
- debug => { U =>[1,2,'[$debug_level]'], O=>0x0004 }, # old name for trace
- dump_handle => { U =>[1,3,'[$message [, $level]]'], O=>0x0004 },
- err => $keeperr,
- errstr => $keeperr,
- state => $keeperr,
- func => { O=>0x0006 },
- parse_trace_flag => { U =>[2,2,'$name'], O=>0x0404, T=>8 },
- parse_trace_flags => { U =>[2,2,'$flags'], O=>0x0404, T=>8 },
- private_data => { U =>[1,1], O=>0x0004 },
- set_err => { U =>[3,6,'$err, $errmsg [, $state, $method, $rv]'], O=>0x0010 },
- trace => { U =>[1,3,'[$trace_level, [$filename]]'], O=>0x0004 },
- trace_msg => { U =>[2,3,'$message_text [, $min_level ]' ], O=>0x0004, T=>8 },
- swap_inner_handle => { U =>[2,3,'$h [, $allow_reparent ]'] },
- private_attribute_info => { },
- visit_child_handles => { U => [2,3,'$coderef [, $info ]'], O=>0x0404, T=>4 },
- },
- dr => { # Database Driver Interface
- 'connect' => { U =>[1,5,'[$db [,$user [,$passwd [,\%attr]]]]'], H=>3, O=>0x8000, T=>0x200 },
- 'connect_cached'=>{U=>[1,5,'[$db [,$user [,$passwd [,\%attr]]]]'], H=>3, O=>0x8000, T=>0x200 },
- 'disconnect_all'=>{ U =>[1,1], O=>0x0800, T=>0x200 },
- data_sources => { U =>[1,2,'[\%attr]' ], O=>0x0800, T=>0x200 },
- default_user => { U =>[3,4,'$user, $pass [, \%attr]' ], T=>0x200 },
- dbixs_revision => $keeperr,
- },
- db => { # Database Session Class Interface
- data_sources => { U =>[1,2,'[\%attr]' ], O=>0x0200 },
- take_imp_data => { U =>[1,1], O=>0x10000 },
- clone => { U =>[1,2,'[\%attr]'], T=>0x200 },
- connected => { U =>[1,0], O => 0x0004, T=>0x200, H=>3 },
- begin_work => { U =>[1,2,'[ \%attr ]'], O=>0x0400, T=>0x1000 },
- commit => { U =>[1,1], O=>0x0480|0x0800, T=>0x1000 },
- rollback => { U =>[1,1], O=>0x0480|0x0800, T=>0x1000 },
- 'do' => { U =>[2,0,'$statement [, \%attr [, @bind_params ] ]'], O=>0x3200 },
- last_insert_id => { U =>[5,6,'$catalog, $schema, $table_name, $field_name [, \%attr ]'], O=>0x2800 },
- preparse => { }, # XXX
- prepare => { U =>[2,3,'$statement [, \%attr]'], O=>0xA200 },
- prepare_cached => { U =>[2,4,'$statement [, \%attr [, $if_active ] ]'], O=>0xA200 },
- selectrow_array => { U =>[2,0,'$statement [, \%attr [, @bind_params ] ]'], O=>0x2000 },
- selectrow_arrayref=>{U =>[2,0,'$statement [, \%attr [, @bind_params ] ]'], O=>0x2000 },
- selectrow_hashref=>{ U =>[2,0,'$statement [, \%attr [, @bind_params ] ]'], O=>0x2000 },
- selectall_arrayref=>{U =>[2,0,'$statement [, \%attr [, @bind_params ] ]'], O=>0x2000 },
- selectall_array =>{U =>[2,0,'$statement [, \%attr [, @bind_params ] ]'], O=>0x2000 },
- selectall_hashref=>{ U =>[3,0,'$statement, $keyfield [, \%attr [, @bind_params ] ]'], O=>0x2000 },
- selectcol_arrayref=>{U =>[2,0,'$statement [, \%attr [, @bind_params ] ]'], O=>0x2000 },
- ping => { U =>[1,1], O=>0x0404 },
- disconnect => { U =>[1,1], O=>0x0400|0x0800|0x10000, T=>0x200 },
- quote => { U =>[2,3, '$string [, $data_type ]' ], O=>0x0430, T=>2 },
- quote_identifier=> { U =>[2,6, '$name [, ...] [, \%attr ]' ], O=>0x0430, T=>2 },
- rows => $keeperr,
-
- tables => { U =>[1,6,'$catalog, $schema, $table, $type [, \%attr ]' ], O=>0x2200 },
- table_info => { U =>[1,6,'$catalog, $schema, $table, $type [, \%attr ]' ], O=>0x2200|0x8800 },
- column_info => { U =>[5,6,'$catalog, $schema, $table, $column [, \%attr ]'],O=>0x2200|0x8800 },
- primary_key_info=> { U =>[4,5,'$catalog, $schema, $table [, \%attr ]' ], O=>0x2200|0x8800 },
- primary_key => { U =>[4,5,'$catalog, $schema, $table [, \%attr ]' ], O=>0x2200 },
- foreign_key_info=> { U =>[7,8,'$pk_catalog, $pk_schema, $pk_table, $fk_catalog, $fk_schema, $fk_table [, \%attr ]' ], O=>0x2200|0x8800 },
- statistics_info => { U =>[6,7,'$catalog, $schema, $table, $unique_only, $quick, [, \%attr ]' ], O=>0x2200|0x8800 },
- type_info_all => { U =>[1,1], O=>0x2200|0x0800 },
- type_info => { U =>[1,2,'$data_type'], O=>0x2200 },
- get_info => { U =>[2,2,'$info_type'], O=>0x2200|0x0800 },
- },
- st => { # Statement Class Interface
- bind_col => { U =>[3,4,'$column, \\$var [, \%attr]'] },
- bind_columns => { U =>[2,0,'\\$var1 [, \\$var2, ...]'] },
- bind_param => { U =>[3,4,'$parameter, $var [, \%attr]'] },
- bind_param_inout=> { U =>[4,5,'$parameter, \\$var, $maxlen, [, \%attr]'] },
- execute => { U =>[1,0,'[@args]'], O=>0x1040 },
-
- bind_param_array => { U =>[3,4,'$parameter, $var [, \%attr]'] },
- bind_param_inout_array => { U =>[4,5,'$parameter, \\@var, $maxlen, [, \%attr]'] },
- execute_array => { U =>[2,0,'\\%attribs [, @args]'], O=>0x1040|0x4000 },
- execute_for_fetch => { U =>[2,3,'$fetch_sub [, $tuple_status]'], O=>0x1040|0x4000 },
-
- fetch => undef, # alias for fetchrow_arrayref
- fetchrow_arrayref => undef,
- fetchrow_hashref => undef,
- fetchrow_array => undef,
- fetchrow => undef, # old alias for fetchrow_array
-
- fetchall_arrayref => { U =>[1,3, '[ $slice [, $max_rows]]'] },
- fetchall_hashref => { U =>[2,2,'$key_field'] },
-
- blob_read => { U =>[4,5,'$field, $offset, $len [, \\$buf [, $bufoffset]]'] },
- blob_copy_to_file => { U =>[3,3,'$field, $filename_or_handleref'] },
- dump_results => { U =>[1,5,'$maxfieldlen, $linesep, $fieldsep, $filehandle'] },
- more_results => { U =>[1,1] },
- finish => { U =>[1,1] },
- cancel => { U =>[1,1], O=>0x0800 },
- rows => $keeperr,
-
- _get_fbav => undef,
- _set_fbav => { T=>6 },
- },
-);
-
-while ( my ($class, $meths) = each %DBI::DBI_methods ) {
- my $ima_trace = 0+($ENV{DBI_IMA_TRACE}||0);
- while ( my ($method, $info) = each %$meths ) {
- my $fullmeth = "DBI::${class}::$method";
- if (($DBI::dbi_debug & 0xF) == 15) { # quick hack to list DBI methods
- # and optionally filter by IMA flags
- my $O = $info->{O}||0;
- printf "0x%04x %-20s\n", $O, $fullmeth
- unless $ima_trace && !($O & $ima_trace);
- }
- DBI->_install_method($fullmeth, 'DBI.pm', $info);
- }
-}
-
-{
- package DBI::common;
- @DBI::dr::ISA = ('DBI::common');
- @DBI::db::ISA = ('DBI::common');
- @DBI::st::ISA = ('DBI::common');
-}
-
-# End of init code
-
-END {
- return unless defined &DBI::trace_msg; # return unless bootstrap'd ok
- local ($!,$?);
- DBI->trace_msg(sprintf(" -- DBI::END (\$\@: %s, \$!: %s)\n", $@||'', $!||''), 2);
- # Let drivers know why we are calling disconnect_all:
- $DBI::PERL_ENDING = $DBI::PERL_ENDING = 1; # avoid typo warning
- DBI->disconnect_all() if %DBI::installed_drh;
-}
-
-
-sub CLONE {
- _clone_dbis() unless $DBI::PurePerl; # clone the DBIS structure
- DBI->trace_msg("CLONE DBI for new thread\n");
- while ( my ($driver, $drh) = each %DBI::installed_drh) {
- no strict 'refs';
- next if defined &{"DBD::${driver}::CLONE"};
- warn("$driver has no driver CLONE() function so is unsafe threaded\n");
- }
- %DBI::installed_drh = (); # clear loaded drivers so they have a chance to reinitialize
-}
-
-sub parse_dsn {
- my ($class, $dsn) = @_;
- $dsn =~ s/^(dbi):(\w*?)(?:\((.*?)\))?://i or return;
- my ($scheme, $driver, $attr, $attr_hash) = (lc($1), $2, $3);
- $driver ||= $ENV{DBI_DRIVER} || '';
- $attr_hash = { split /\s*=>?\s*|\s*,\s*/, $attr, -1 } if $attr;
- return ($scheme, $driver, $attr, $attr_hash, $dsn);
-}
-
-sub visit_handles {
- my ($class, $code, $outer_info) = @_;
- $outer_info = {} if not defined $outer_info;
- my %drh = DBI->installed_drivers;
- for my $h (values %drh) {
- my $child_info = $code->($h, $outer_info)
- or next;
- $h->visit_child_handles($code, $child_info);
- }
- return $outer_info;
-}
-
-
-# --- The DBI->connect Front Door methods
-
-sub connect_cached {
- # For library code using connect_cached() with mod_perl
- # we redirect those calls to Apache::DBI::connect() as well
- my ($class, $dsn, $user, $pass, $attr) = @_;
- my $dbi_connect_method = ($DBI::connect_via eq "Apache::DBI::connect")
- ? 'Apache::DBI::connect' : 'connect_cached';
- $attr = {
- $attr ? %$attr : (), # clone, don't modify callers data
- dbi_connect_method => $dbi_connect_method,
- };
- return $class->connect($dsn, $user, $pass, $attr);
-}
-
-sub connect {
- my $class = shift;
- my ($dsn, $user, $pass, $attr, $old_driver) = my @orig_args = @_;
- my $driver;
-
- if ($attr and !ref($attr)) { # switch $old_driver<->$attr if called in old style
- Carp::carp("DBI->connect using 'old-style' syntax is deprecated and will be an error in future versions");
- ($old_driver, $attr) = ($attr, $old_driver);
- }
-
- my $connect_meth = $attr->{dbi_connect_method};
- $connect_meth ||= $DBI::connect_via; # fallback to default
-
- $dsn ||= $ENV{DBI_DSN} || $ENV{DBI_DBNAME} || '' unless $old_driver;
-
- if ($DBI::dbi_debug) {
- local $^W = 0;
- pop @_ if $connect_meth ne 'connect';
- my @args = @_; $args[2] = '****'; # hide password
- DBI->trace_msg(" -> $class->$connect_meth(".join(", ",@args).")\n");
- }
- Carp::croak('Usage: $class->connect([$dsn [,$user [,$passwd [,\%attr]]]])')
- if (ref $old_driver or ($attr and not ref $attr) or
- (ref $pass and not defined Scalar::Util::blessed($pass)));
-
- # extract dbi:driver prefix from $dsn into $1
- $dsn =~ s/^dbi:(\w*?)(?:\((.*?)\))?://i
- or '' =~ /()/; # ensure $1 etc are empty if match fails
- my $driver_attrib_spec = $2 || '';
-
- # Set $driver. Old style driver, if specified, overrides new dsn style.
- $driver = $old_driver || $1 || $ENV{DBI_DRIVER}
- or Carp::croak("Can't connect to data source '$dsn' "
- ."because I can't work out what driver to use "
- ."(it doesn't seem to contain a 'dbi:driver:' prefix "
- ."and the DBI_DRIVER env var is not set)");
-
- my $proxy;
- if ($ENV{DBI_AUTOPROXY} && $driver ne 'Proxy' && $driver ne 'Sponge' && $driver ne 'Switch') {
- my $dbi_autoproxy = $ENV{DBI_AUTOPROXY};
- $proxy = 'Proxy';
- if ($dbi_autoproxy =~ s/^dbi:(\w*?)(?:\((.*?)\))?://i) {
- $proxy = $1;
- $driver_attrib_spec = join ",",
- ($driver_attrib_spec) ? $driver_attrib_spec : (),
- ($2 ) ? $2 : ();
- }
- $dsn = "$dbi_autoproxy;dsn=dbi:$driver:$dsn";
- $driver = $proxy;
- DBI->trace_msg(" DBI_AUTOPROXY: dbi:$driver($driver_attrib_spec):$dsn\n");
- }
- # avoid recursion if proxy calls DBI->connect itself
- local $ENV{DBI_AUTOPROXY} if $ENV{DBI_AUTOPROXY};
-
- my %attributes; # take a copy we can delete from
- if ($old_driver) {
- %attributes = %$attr if $attr;
- }
- else { # new-style connect so new default semantics
- %attributes = (
- PrintError => 1,
- AutoCommit => 1,
- ref $attr ? %$attr : (),
- # attributes in DSN take precedence over \%attr connect parameter
- $driver_attrib_spec ? (split /\s*=>?\s*|\s*,\s*/, $driver_attrib_spec, -1) : (),
- );
- }
- $attr = \%attributes; # now set $attr to refer to our local copy
-
- my $drh = $DBI::installed_drh{$driver} || $class->install_driver($driver)
- or die "panic: $class->install_driver($driver) failed";
-
- # attributes in DSN take precedence over \%attr connect parameter
- $user = $attr->{Username} if defined $attr->{Username};
- $pass = $attr->{Password} if defined $attr->{Password};
- delete $attr->{Password}; # always delete Password as closure stores it securely
- if ( !(defined $user && defined $pass) ) {
- ($user, $pass) = $drh->default_user($user, $pass, $attr);
- }
- $attr->{Username} = $user; # force the Username to be the actual one used
-
- my $connect_closure = sub {
- my ($old_dbh, $override_attr) = @_;
-
- #use Data::Dumper;
- #warn "connect_closure: ".Data::Dumper::Dumper([$attr,\%attributes, $override_attr]);
-
- my $dbh;
- unless ($dbh = $drh->$connect_meth($dsn, $user, $pass, $attr)) {
- $user = '' if !defined $user;
- $dsn = '' if !defined $dsn;
- # $drh->errstr isn't safe here because $dbh->DESTROY may not have
- # been called yet and so the dbh errstr would not have been copied
- # up to the drh errstr. Certainly true for connect_cached!
- my $errstr = $DBI::errstr;
- # Getting '(no error string)' here is a symptom of a ref loop
- $errstr = '(no error string)' if !defined $errstr;
- my $msg = "$class connect('$dsn','$user',...) failed: $errstr";
- DBI->trace_msg(" $msg\n");
- # XXX HandleWarn
- unless ($attr->{HandleError} && $attr->{HandleError}->($msg, $drh, $dbh)) {
- Carp::croak($msg) if $attr->{RaiseError};
- Carp::carp ($msg) if $attr->{PrintError};
- }
- $! = 0; # for the daft people who do DBI->connect(...) || die "$!";
- return $dbh; # normally undef, but HandleError could change it
- }
-
- # merge any attribute overrides but don't change $attr itself (for closure)
- my $apply = { ($override_attr) ? (%$attr, %$override_attr ) : %$attr };
-
- # handle basic RootClass subclassing:
- my $rebless_class = $apply->{RootClass} || ($class ne 'DBI' ? $class : '');
- if ($rebless_class) {
- no strict 'refs';
- if ($apply->{RootClass}) { # explicit attribute (ie not static method call class)
- delete $apply->{RootClass};
- DBI::_load_class($rebless_class, 0);
- }
- unless (@{"$rebless_class\::db::ISA"} && @{"$rebless_class\::st::ISA"}) {
- Carp::carp("DBI subclasses '$rebless_class\::db' and ::st are not setup, RootClass ignored");
- $rebless_class = undef;
- $class = 'DBI';
- }
- else {
- $dbh->{RootClass} = $rebless_class; # $dbh->STORE called via plain DBI::db
- DBI::_set_isa([$rebless_class], 'DBI'); # sets up both '::db' and '::st'
- DBI::_rebless($dbh, $rebless_class); # appends '::db'
- }
- }
-
- if (%$apply) {
-
- if ($apply->{DbTypeSubclass}) {
- my $DbTypeSubclass = delete $apply->{DbTypeSubclass};
- DBI::_rebless_dbtype_subclass($dbh, $rebless_class||$class, $DbTypeSubclass);
- }
- my $a;
- foreach $a (qw(Profile RaiseError PrintError AutoCommit)) { # do these first
- next unless exists $apply->{$a};
- $dbh->{$a} = delete $apply->{$a};
- }
- while ( my ($a, $v) = each %$apply) {
- eval { $dbh->{$a} = $v }; # assign in void context to avoid re-FETCH
- warn $@ if $@;
- }
- }
-
- # confirm to driver (ie if subclassed) that we've connected successfully
- # and finished the attribute setup. pass in the original arguments
- $dbh->connected(@orig_args); #if ref $dbh ne 'DBI::db' or $proxy;
-
- DBI->trace_msg(" <- connect= $dbh\n") if $DBI::dbi_debug & 0xF;
-
- return $dbh;
- };
-
- my $dbh = &$connect_closure(undef, undef);
-
- $dbh->{dbi_connect_closure} = $connect_closure if $dbh;
-
- return $dbh;
-}
-
-
-sub disconnect_all {
- keys %DBI::installed_drh; # reset iterator
- while ( my ($name, $drh) = each %DBI::installed_drh ) {
- $drh->disconnect_all() if ref $drh;
- }
-}
-
-
-sub disconnect { # a regular beginners bug
- Carp::croak("DBI->disconnect is not a DBI method (read the DBI manual)");
-}
-
-
-sub install_driver { # croaks on failure
- my $class = shift;
- my($driver, $attr) = @_;
- my $drh;
-
- $driver ||= $ENV{DBI_DRIVER} || '';
-
- # allow driver to be specified as a 'dbi:driver:' string
- $driver = $1 if $driver =~ s/^DBI:(.*?)://i;
-
- Carp::croak("usage: $class->install_driver(\$driver [, \%attr])")
- unless ($driver and @_<=3);
-
- # already installed
- return $drh if $drh = $DBI::installed_drh{$driver};
-
- $class->trace_msg(" -> $class->install_driver($driver"
- .") for $^O perl=$] pid=$$ ruid=$< euid=$>\n")
- if $DBI::dbi_debug & 0xF;
-
- # --- load the code
- my $driver_class = "DBD::$driver";
- eval qq{package # hide from PAUSE
- DBI::_firesafe; # just in case
- require $driver_class; # load the driver
- };
- if ($@) {
- my $err = $@;
- my $advice = "";
- if ($err =~ /Can't find loadable object/) {
- $advice = "Perhaps DBD::$driver was statically linked into a new perl binary."
- ."\nIn which case you need to use that new perl binary."
- ."\nOr perhaps only the .pm file was installed but not the shared object file."
- }
- elsif ($err =~ /Can't locate.*?DBD\/$driver\.pm in \@INC/) {
- my @drv = $class->available_drivers(1);
- $advice = "Perhaps the DBD::$driver perl module hasn't been fully installed,\n"
- ."or perhaps the capitalisation of '$driver' isn't right.\n"
- ."Available drivers: ".join(", ", @drv).".";
- }
- elsif ($err =~ /Can't load .*? for module DBD::/) {
- $advice = "Perhaps a required shared library or dll isn't installed where expected";
- }
- elsif ($err =~ /Can't locate .*? in \@INC/) {
- $advice = "Perhaps a module that DBD::$driver requires hasn't been fully installed";
- }
- Carp::croak("install_driver($driver) failed: $err$advice\n");
- }
- if ($DBI::dbi_debug & 0xF) {
- no strict 'refs';
- (my $driver_file = $driver_class) =~ s/::/\//g;
- my $dbd_ver = ${"$driver_class\::VERSION"} || "undef";
- $class->trace_msg(" install_driver: $driver_class version $dbd_ver"
- ." loaded from $INC{qq($driver_file.pm)}\n");
- }
-
- # --- do some behind-the-scenes checks and setups on the driver
- $class->setup_driver($driver_class);
-
- # --- run the driver function
- $drh = eval { $driver_class->driver($attr || {}) };
- unless ($drh && ref $drh && !$@) {
- my $advice = "";
- $@ ||= "$driver_class->driver didn't return a handle";
- # catch people on case in-sensitive systems using the wrong case
- $advice = "\nPerhaps the capitalisation of DBD '$driver' isn't right."
- if $@ =~ /locate object method/;
- Carp::croak("$driver_class initialisation failed: $@$advice");
- }
-
- $DBI::installed_drh{$driver} = $drh;
- $class->trace_msg(" <- install_driver= $drh\n") if $DBI::dbi_debug & 0xF;
- $drh;
-}
-
-*driver = \&install_driver; # currently an alias, may change
-
-
-sub setup_driver {
- my ($class, $driver_class) = @_;
- my $h_type;
- foreach $h_type (qw(dr db st)){
- my $h_class = $driver_class."::$h_type";
- no strict 'refs';
- push @{"${h_class}::ISA"}, "DBD::_::$h_type"
- unless UNIVERSAL::isa($h_class, "DBD::_::$h_type");
- # The _mem class stuff is (IIRC) a crufty hack for global destruction
- # timing issues in early versions of perl5 and possibly no longer needed.
- my $mem_class = "DBD::_mem::$h_type";
- push @{"${h_class}_mem::ISA"}, $mem_class
- unless UNIVERSAL::isa("${h_class}_mem", $mem_class)
- or $DBI::PurePerl;
- }
-}
-
-
-sub _rebless {
- my $dbh = shift;
- my ($outer, $inner) = DBI::_handles($dbh);
- my $class = shift(@_).'::db';
- bless $inner => $class;
- bless $outer => $class; # outer last for return
-}
-
-
-sub _set_isa {
- my ($classes, $topclass) = @_;
- my $trace = DBI->trace_msg(" _set_isa([@$classes])\n");
- foreach my $suffix ('::db','::st') {
- my $previous = $topclass || 'DBI'; # trees are rooted here
- foreach my $class (@$classes) {
- my $base_class = $previous.$suffix;
- my $sub_class = $class.$suffix;
- my $sub_class_isa = "${sub_class}::ISA";
- no strict 'refs';
- if (@$sub_class_isa) {
- DBI->trace_msg(" $sub_class_isa skipped (already set to @$sub_class_isa)\n")
- if $trace;
- }
- else {
- @$sub_class_isa = ($base_class) unless @$sub_class_isa;
- DBI->trace_msg(" $sub_class_isa = $base_class\n")
- if $trace;
- }
- $previous = $class;
- }
- }
-}
-
-
-sub _rebless_dbtype_subclass {
- my ($dbh, $rootclass, $DbTypeSubclass) = @_;
- # determine the db type names for class hierarchy
- my @hierarchy = DBI::_dbtype_names($dbh, $DbTypeSubclass);
- # add the rootclass prefix to each ('DBI::' or 'MyDBI::' etc)
- $_ = $rootclass.'::'.$_ foreach (@hierarchy);
- # load the modules from the 'top down'
- DBI::_load_class($_, 1) foreach (reverse @hierarchy);
- # setup class hierarchy if needed, does both '::db' and '::st'
- DBI::_set_isa(\@hierarchy, $rootclass);
- # finally bless the handle into the subclass
- DBI::_rebless($dbh, $hierarchy[0]);
-}
-
-
-sub _dbtype_names { # list dbtypes for hierarchy, ie Informix=>ADO=>ODBC
- my ($dbh, $DbTypeSubclass) = @_;
-
- if ($DbTypeSubclass && $DbTypeSubclass ne '1' && ref $DbTypeSubclass ne 'CODE') {
- # treat $DbTypeSubclass as a comma separated list of names
- my @dbtypes = split /\s*,\s*/, $DbTypeSubclass;
- $dbh->trace_msg(" DbTypeSubclass($DbTypeSubclass)=@dbtypes (explicit)\n");
- return @dbtypes;
- }
-
- # XXX will call $dbh->get_info(17) (=SQL_DBMS_NAME) in future?
-
- my $driver = $dbh->{Driver}->{Name};
- if ( $driver eq 'Proxy' ) {
- # XXX Looking into the internals of DBD::Proxy is questionable!
- ($driver) = $dbh->{proxy_client}->{application} =~ /^DBI:(.+?):/i
- or die "Can't determine driver name from proxy";
- }
-
- my @dbtypes = (ucfirst($driver));
- if ($driver eq 'ODBC' || $driver eq 'ADO') {
- # XXX will move these out and make extensible later:
- my $_dbtype_name_regexp = 'Oracle'; # eg 'Oracle|Foo|Bar'
- my %_dbtype_name_map = (
- 'Microsoft SQL Server' => 'MSSQL',
- 'SQL Server' => 'Sybase',
- 'Adaptive Server Anywhere' => 'ASAny',
- 'ADABAS D' => 'AdabasD',
- );
-
- my $name;
- $name = $dbh->func(17, 'GetInfo') # SQL_DBMS_NAME
- if $driver eq 'ODBC';
- $name = $dbh->{ado_conn}->Properties->Item('DBMS Name')->Value
- if $driver eq 'ADO';
- die "Can't determine driver name! ($DBI::errstr)\n"
- unless $name;
-
- my $dbtype;
- if ($_dbtype_name_map{$name}) {
- $dbtype = $_dbtype_name_map{$name};
- }
- else {
- if ($name =~ /($_dbtype_name_regexp)/) {
- $dbtype = lc($1);
- }
- else { # generic mangling for other names:
- $dbtype = lc($name);
- }
- $dbtype =~ s/\b(\w)/\U$1/g;
- $dbtype =~ s/\W+/_/g;
- }
- # add ODBC 'behind' ADO
- push @dbtypes, 'ODBC' if $driver eq 'ADO';
- # add discovered dbtype in front of ADO/ODBC
- unshift @dbtypes, $dbtype;
- }
- @dbtypes = &$DbTypeSubclass($dbh, \@dbtypes)
- if (ref $DbTypeSubclass eq 'CODE');
- $dbh->trace_msg(" DbTypeSubclass($DbTypeSubclass)=@dbtypes\n");
- return @dbtypes;
-}
-
-sub _load_class {
- my ($load_class, $missing_ok) = @_;
- DBI->trace_msg(" _load_class($load_class, $missing_ok)\n", 2);
- no strict 'refs';
- return 1 if @{"$load_class\::ISA"}; # already loaded/exists
- (my $module = $load_class) =~ s!::!/!g;
- DBI->trace_msg(" _load_class require $module\n", 2);
- eval { require "$module.pm"; };
- return 1 unless $@;
- return 0 if $missing_ok && $@ =~ /^Can't locate \Q$module.pm\E/;
- die $@;
-}
-
-
-sub init_rootclass { # deprecated
- return 1;
-}
-
-
-*internal = \&DBD::Switch::dr::driver;
-
-sub driver_prefix {
- my ($class, $driver) = @_;
- return $dbd_class_registry{$driver}->{prefix} if exists $dbd_class_registry{$driver};
- return;
-}
-
-sub available_drivers {
- my($quiet) = @_;
- my(@drivers, $d, $f);
- local(*DBI::DIR, $@);
- my(%seen_dir, %seen_dbd);
- my $haveFileSpec = eval { require File::Spec };
- foreach $d (@INC){
- chomp($d); # Perl 5 beta 3 bug in #!./perl -Ilib from Test::Harness
- my $dbd_dir =
- ($haveFileSpec ? File::Spec->catdir($d, 'DBD') : "$d/DBD");
- next unless -d $dbd_dir;
- next if $seen_dir{$d};
- $seen_dir{$d} = 1;
- # XXX we have a problem here with case insensitive file systems
- # XXX since we can't tell what case must be used when loading.
- opendir(DBI::DIR, $dbd_dir) || Carp::carp "opendir $dbd_dir: $!\n";
- foreach $f (readdir(DBI::DIR)){
- next unless $f =~ s/\.pm$//;
- next if $f eq 'NullP';
- if ($seen_dbd{$f}){
- Carp::carp "DBD::$f in $d is hidden by DBD::$f in $seen_dbd{$f}\n"
- unless $quiet;
- } else {
- push(@drivers, $f);
- }
- $seen_dbd{$f} = $d;
- }
- closedir(DBI::DIR);
- }
-
- # "return sort @drivers" will not DWIM in scalar context.
- return wantarray ? sort @drivers : @drivers;
-}
-
-sub installed_versions {
- my ($class, $quiet) = @_;
- my %error;
- my %version;
- for my $driver ($class->available_drivers($quiet)) {
- next if $DBI::PurePerl && grep { -d "$_/auto/DBD/$driver" } @INC;
- my $drh = eval {
- local $SIG{__WARN__} = sub {};
- $class->install_driver($driver);
- };
- ($error{"DBD::$driver"}=$@),next if $@;
- no strict 'refs';
- my $vers = ${"DBD::$driver" . '::VERSION'};
- $version{"DBD::$driver"} = $vers || '?';
- }
- if (wantarray) {
- return map { m/^DBD::(\w+)/ ? ($1) : () } sort keys %version;
- }
- $version{"DBI"} = $DBI::VERSION;
- $version{"DBI::PurePerl"} = $DBI::PurePerl::VERSION if $DBI::PurePerl;
- if (!defined wantarray) { # void context
- require Config; # add more detail
- $version{OS} = "$^O\t($Config::Config{osvers})";
- $version{Perl} = "$]\t($Config::Config{archname})";
- $version{$_} = (($error{$_} =~ s/ \(\@INC.*//s),$error{$_})
- for keys %error;
- printf " %-16s: %s\n",$_,$version{$_}
- for reverse sort keys %version;
- }
- return \%version;
-}
-
-
-sub data_sources {
- my ($class, $driver, @other) = @_;
- my $drh = $class->install_driver($driver);
- my @ds = $drh->data_sources(@other);
- return @ds;
-}
-
-
-sub neat_list {
- my ($listref, $maxlen, $sep) = @_;
- $maxlen = 0 unless defined $maxlen; # 0 == use internal default
- $sep = ", " unless defined $sep;
- join($sep, map { neat($_,$maxlen) } @$listref);
-}
-
-
-sub dump_results { # also aliased as a method in DBD::_::st
- my ($sth, $maxlen, $lsep, $fsep, $fh) = @_;
- return 0 unless $sth;
- $maxlen ||= 35;
- $lsep ||= "\n";
- $fh ||= \*STDOUT;
- my $rows = 0;
- my $ref;
- while($ref = $sth->fetch) {
- print $fh $lsep if $rows++ and $lsep;
- my $str = neat_list($ref,$maxlen,$fsep);
- print $fh $str; # done on two lines to avoid 5.003 errors
- }
- print $fh "\n$rows rows".($DBI::err ? " ($DBI::err: $DBI::errstr)" : "")."\n";
- $rows;
-}
-
-
-sub data_diff {
- my ($a, $b, $logical) = @_;
-
- my $diff = data_string_diff($a, $b);
- return "" if $logical and !$diff;
-
- my $a_desc = data_string_desc($a);
- my $b_desc = data_string_desc($b);
- return "" if !$diff and $a_desc eq $b_desc;
-
- $diff ||= "Strings contain the same sequence of characters"
- if length($a);
- $diff .= "\n" if $diff;
- return "a: $a_desc\nb: $b_desc\n$diff";
-}
-
-
-sub data_string_diff {
- # Compares 'logical' characters, not bytes, so a latin1 string and an
- # an equivalent Unicode string will compare as equal even though their
- # byte encodings are different.
- my ($a, $b) = @_;
- unless (defined $a and defined $b) { # one undef
- return ""
- if !defined $a and !defined $b;
- return "String a is undef, string b has ".length($b)." characters"
- if !defined $a;
- return "String b is undef, string a has ".length($a)." characters"
- if !defined $b;
- }
-
- require utf8;
- # hack to cater for perl 5.6
- *utf8::is_utf8 = sub { (DBI::neat(shift)=~/^"/) } unless defined &utf8::is_utf8;
-
- my @a_chars = (utf8::is_utf8($a)) ? unpack("U*", $a) : unpack("C*", $a);
- my @b_chars = (utf8::is_utf8($b)) ? unpack("U*", $b) : unpack("C*", $b);
- my $i = 0;
- while (@a_chars && @b_chars) {
- ++$i, shift(@a_chars), shift(@b_chars), next
- if $a_chars[0] == $b_chars[0];# compare ordinal values
- my @desc = map {
- $_ > 255 ? # if wide character...
- sprintf("\\x{%04X}", $_) : # \x{...}
- chr($_) =~ /[[:cntrl:]]/ ? # else if control character ...
- sprintf("\\x%02X", $_) : # \x..
- chr($_) # else as themselves
- } ($a_chars[0], $b_chars[0]);
- # highlight probable double-encoding?
- foreach my $c ( @desc ) {
- next unless $c =~ m/\\x\{08(..)}/;
- $c .= "='" .chr(hex($1)) ."'"
- }
- return sprintf "Strings differ at index $i: a[$i]=$desc[0], b[$i]=$desc[1]";
- }
- return "String a truncated after $i characters" if @b_chars;
- return "String b truncated after $i characters" if @a_chars;
- return "";
-}
-
-
-sub data_string_desc { # describe a data string
- my ($a) = @_;
- require bytes;
- require utf8;
-
- # hacks to cater for perl 5.6
- *utf8::is_utf8 = sub { (DBI::neat(shift)=~/^"/) } unless defined &utf8::is_utf8;
- *utf8::valid = sub { 1 } unless defined &utf8::valid;
-
- # Give sufficient info to help diagnose at least these kinds of situations:
- # - valid UTF8 byte sequence but UTF8 flag not set
- # (might be ascii so also need to check for hibit to make it worthwhile)
- # - UTF8 flag set but invalid UTF8 byte sequence
- # could do better here, but this'll do for now
- my $utf8 = sprintf "UTF8 %s%s",
- utf8::is_utf8($a) ? "on" : "off",
- utf8::valid($a||'') ? "" : " but INVALID encoding";
- return "$utf8, undef" unless defined $a;
- my $is_ascii = $a =~ m/^[\000-\177]*$/;
- return sprintf "%s, %s, %d characters %d bytes",
- $utf8, $is_ascii ? "ASCII" : "non-ASCII",
- length($a), bytes::length($a);
-}
-
-
-sub connect_test_perf {
- my($class, $dsn,$dbuser,$dbpass, $attr) = @_;
- Carp::croak("connect_test_perf needs hash ref as fourth arg") unless ref $attr;
- # these are non standard attributes just for this special method
- my $loops ||= $attr->{dbi_loops} || 5;
- my $par ||= $attr->{dbi_par} || 1; # parallelism
- my $verb ||= $attr->{dbi_verb} || 1;
- my $meth ||= $attr->{dbi_meth} || 'connect';
- print "$dsn: testing $loops sets of $par connections:\n";
- require "FileHandle.pm"; # don't let toke.c create empty FileHandle package
- local $| = 1;
- my $drh = $class->install_driver($dsn) or Carp::croak("Can't install $dsn driver\n");
- # test the connection and warm up caches etc
- $drh->connect($dsn,$dbuser,$dbpass) or Carp::croak("connect failed: $DBI::errstr");
- my $t1 = dbi_time();
- my $loop;
- for $loop (1..$loops) {
- my @cons;
- print "Connecting... " if $verb;
- for (1..$par) {
- print "$_ ";
- push @cons, ($drh->connect($dsn,$dbuser,$dbpass)
- or Carp::croak("connect failed: $DBI::errstr\n"));
- }
- print "\nDisconnecting...\n" if $verb;
- for (@cons) {
- $_->disconnect or warn "disconnect failed: $DBI::errstr"
- }
- }
- my $t2 = dbi_time();
- my $td = $t2 - $t1;
- printf "$meth %d and disconnect them, %d times: %.4fs / %d = %.4fs\n",
- $par, $loops, $td, $loops*$par, $td/($loops*$par);
- return $td;
-}
-
-
-# Help people doing DBI->errstr, might even document it one day
-# XXX probably best moved to cheaper XS code if this gets documented
-sub err { $DBI::err }
-sub errstr { $DBI::errstr }
-
-
-# --- Private Internal Function for Creating New DBI Handles
-
-# XXX move to PurePerl?
-*DBI::dr::TIEHASH = \&DBI::st::TIEHASH;
-*DBI::db::TIEHASH = \&DBI::st::TIEHASH;
-
-
-# These three special constructors are called by the drivers
-# The way they are called is likely to change.
-
-our $shared_profile;
-
-sub _new_drh { # called by DBD::<drivername>::driver()
- my ($class, $initial_attr, $imp_data) = @_;
- # Provide default storage for State,Err and Errstr.
- # Note that these are shared by all child handles by default! XXX
- # State must be undef to get automatic faking in DBI::var::FETCH
- my ($h_state_store, $h_err_store, $h_errstr_store) = (undef, undef, '');
- my $attr = {
- # these attributes get copied down to child handles by default
- 'State' => \$h_state_store, # Holder for DBI::state
- 'Err' => \$h_err_store, # Holder for DBI::err
- 'Errstr' => \$h_errstr_store, # Holder for DBI::errstr
- 'TraceLevel' => 0,
- FetchHashKeyName=> 'NAME',
- %$initial_attr,
- };
- my ($h, $i) = _new_handle('DBI::dr', '', $attr, $imp_data, $class);
-
- # XXX DBI_PROFILE unless DBI::PurePerl because for some reason
- # it kills the t/zz_*_pp.t tests (they silently exit early)
- if (($ENV{DBI_PROFILE} && !$DBI::PurePerl) || $shared_profile) {
- # The profile object created here when the first driver is loaded
- # is shared by all drivers so we end up with just one set of profile
- # data and thus the 'total time in DBI' is really the true total.
- if (!$shared_profile) { # first time
- $h->{Profile} = $ENV{DBI_PROFILE}; # write string
- $shared_profile = $h->{Profile}; # read and record object
- }
- else {
- $h->{Profile} = $shared_profile;
- }
- }
- return $h unless wantarray;
- ($h, $i);
-}
-
-sub _new_dbh { # called by DBD::<drivername>::dr::connect()
- my ($drh, $attr, $imp_data) = @_;
- my $imp_class = $drh->{ImplementorClass}
- or Carp::croak("DBI _new_dbh: $drh has no ImplementorClass");
- substr($imp_class,-4,4) = '::db';
- my $app_class = ref $drh;
- substr($app_class,-4,4) = '::db';
- $attr->{Err} ||= \my $err;
- $attr->{Errstr} ||= \my $errstr;
- $attr->{State} ||= \my $state;
- _new_handle($app_class, $drh, $attr, $imp_data, $imp_class);
-}
-
-sub _new_sth { # called by DBD::<drivername>::db::prepare)
- my ($dbh, $attr, $imp_data) = @_;
- my $imp_class = $dbh->{ImplementorClass}
- or Carp::croak("DBI _new_sth: $dbh has no ImplementorClass");
- substr($imp_class,-4,4) = '::st';
- my $app_class = ref $dbh;
- substr($app_class,-4,4) = '::st';
- _new_handle($app_class, $dbh, $attr, $imp_data, $imp_class);
-}
-
-
-# end of DBI package
-
-
-
-# --------------------------------------------------------------------
-# === The internal DBI Switch pseudo 'driver' class ===
-
-{ package # hide from PAUSE
- DBD::Switch::dr;
- DBI->setup_driver('DBD::Switch'); # sets up @ISA
-
- $DBD::Switch::dr::imp_data_size = 0;
- $DBD::Switch::dr::imp_data_size = 0; # avoid typo warning
- my $drh;
-
- sub driver {
- return $drh if $drh; # a package global
-
- my $inner;
- ($drh, $inner) = DBI::_new_drh('DBD::Switch::dr', {
- 'Name' => 'Switch',
- 'Version' => $DBI::VERSION,
- 'Attribution' => "DBI $DBI::VERSION by Tim Bunce",
- });
- Carp::croak("DBD::Switch init failed!") unless ($drh && $inner);
- return $drh;
- }
- sub CLONE {
- undef $drh;
- }
-
- sub FETCH {
- my($drh, $key) = @_;
- return DBI->trace if $key eq 'DebugDispatch';
- return undef if $key eq 'DebugLog'; # not worth fetching, sorry
- return $drh->DBD::_::dr::FETCH($key);
- undef;
- }
- sub STORE {
- my($drh, $key, $value) = @_;
- if ($key eq 'DebugDispatch') {
- DBI->trace($value);
- } elsif ($key eq 'DebugLog') {
- DBI->trace(-1, $value);
- } else {
- $drh->DBD::_::dr::STORE($key, $value);
- }
- }
-}
-
-
-# --------------------------------------------------------------------
-# === OPTIONAL MINIMAL BASE CLASSES FOR DBI SUBCLASSES ===
-
-# We only define default methods for harmless functions.
-# We don't, for example, define a DBD::_::st::prepare()
-
-{ package # hide from PAUSE
- DBD::_::common; # ====== Common base class methods ======
- use strict;
-
- # methods common to all handle types:
-
- # generic TIEHASH default methods:
- sub FIRSTKEY { }
- sub NEXTKEY { }
- sub EXISTS { defined($_[0]->FETCH($_[1])) } # XXX undef?
- sub CLEAR { Carp::carp "Can't CLEAR $_[0] (DBI)" }
-
- sub FETCH_many { # XXX should move to C one day
- my $h = shift;
- # scalar is needed to workaround drivers that return an empty list
- # for some attributes
- return map { scalar $h->FETCH($_) } @_;
- }
-
- *dump_handle = \&DBI::dump_handle;
-
- sub install_method {
- # special class method called directly by apps and/or drivers
- # to install new methods into the DBI dispatcher
- # DBD::Foo::db->install_method("foo_mumble", { usage => [...], options => '...' });
- my ($class, $method, $attr) = @_;
- Carp::croak("Class '$class' must begin with DBD:: and end with ::db or ::st")
- unless $class =~ /^DBD::(\w+)::(dr|db|st)$/;
- my ($driver, $subtype) = ($1, $2);
- Carp::croak("invalid method name '$method'")
- unless $method =~ m/^([a-z][a-z0-9]*_)\w+$/;
- my $prefix = $1;
- my $reg_info = $dbd_prefix_registry->{$prefix};
- Carp::carp("method name prefix '$prefix' is not associated with a registered driver") unless $reg_info;
-
- my $full_method = "DBI::${subtype}::$method";
- $DBI::installed_methods{$full_method} = $attr;
-
- my (undef, $filename, $line) = caller;
- # XXX reformat $attr as needed for _install_method
- my %attr = %{$attr||{}}; # copy so we can edit
- DBI->_install_method("DBI::${subtype}::$method", "$filename at line $line", \%attr);
- }
-
- sub parse_trace_flags {
- my ($h, $spec) = @_;
- my $level = 0;
- my $flags = 0;
- my @unknown;
- for my $word (split /\s*[|&,]\s*/, $spec) {
- if (DBI::looks_like_number($word) && $word <= 0xF && $word >= 0) {
- $level = $word;
- } elsif ($word eq 'ALL') {
- $flags = 0x7FFFFFFF; # XXX last bit causes negative headaches
- last;
- } elsif (my $flag = $h->parse_trace_flag($word)) {
- $flags |= $flag;
- }
- else {
- push @unknown, $word;
- }
- }
- if (@unknown && (ref $h ? $h->FETCH('Warn') : 1)) {
- Carp::carp("$h->parse_trace_flags($spec) ignored unknown trace flags: ".
- join(" ", map { DBI::neat($_) } @unknown));
- }
- $flags |= $level;
- return $flags;
- }
-
- sub parse_trace_flag {
- my ($h, $name) = @_;
- # 0xddDDDDrL (driver, DBI, reserved, Level)
- return 0x00000100 if $name eq 'SQL';
- return 0x00000200 if $name eq 'CON';
- return 0x00000400 if $name eq 'ENC';
- return 0x00000800 if $name eq 'DBD';
- return 0x00001000 if $name eq 'TXN';
- return;
- }
-
- sub private_attribute_info {
- return undef;
- }
-
- sub visit_child_handles {
- my ($h, $code, $info) = @_;
- $info = {} if not defined $info;
- for my $ch (@{ $h->{ChildHandles} || []}) {
- next unless $ch;
- my $child_info = $code->($ch, $info)
- or next;
- $ch->visit_child_handles($code, $child_info);
- }
- return $info;
- }
-}
-
-
-{ package # hide from PAUSE
- DBD::_::dr; # ====== DRIVER ======
- @DBD::_::dr::ISA = qw(DBD::_::common);
- use strict;
-
- sub default_user {
- my ($drh, $user, $pass, $attr) = @_;
- $user = $ENV{DBI_USER} unless defined $user;
- $pass = $ENV{DBI_PASS} unless defined $pass;
- return ($user, $pass);
- }
-
- sub connect { # normally overridden, but a handy default
- my ($drh, $dsn, $user, $auth) = @_;
- my ($this) = DBI::_new_dbh($drh, {
- 'Name' => $dsn,
- });
- # XXX debatable as there's no "server side" here
- # (and now many uses would trigger warnings on DESTROY)
- # $this->STORE(Active => 1);
- # so drivers should set it in their own connect
- $this;
- }
-
-
- sub connect_cached {
- my $drh = shift;
- my ($dsn, $user, $auth, $attr) = @_;
-
- my $cache = $drh->{CachedKids} ||= {};
- my $key = do { local $^W;
- join "!\001", $dsn, $user, $auth, DBI::_concat_hash_sorted($attr, "=\001", ",\001", 0, 0)
- };
- my $dbh = $cache->{$key};
- $drh->trace_msg(sprintf(" connect_cached: key '$key', cached dbh $dbh\n", DBI::neat($key), DBI::neat($dbh)))
- if (($DBI::dbi_debug & 0xF) >= 4);
-
- my $cb = $attr->{Callbacks}; # take care not to autovivify
- if ($dbh && $dbh->FETCH('Active') && eval { $dbh->ping }) {
- # If the caller has provided a callback then call it
- if ($cb and $cb = $cb->{"connect_cached.reused"}) {
- local $_ = "connect_cached.reused";
- $cb->($dbh, $dsn, $user, $auth, $attr);
- }
- return $dbh;
- }
-
- # If the caller has provided a callback then call it
- if ($cb and (my $new_cb = $cb->{"connect_cached.new"})) {
- local $_ = "connect_cached.new";
- $new_cb->($dbh, $dsn, $user, $auth, $attr); # $dbh is dead or undef
- }
-
- $dbh = $drh->connect(@_);
- $cache->{$key} = $dbh; # replace prev entry, even if connect failed
- if ($cb and (my $conn_cb = $cb->{"connect_cached.connected"})) {
- local $_ = "connect_cached.connected";
- $conn_cb->($dbh, $dsn, $user, $auth, $attr);
- }
- return $dbh;
- }
-
-}
-
-
-{ package # hide from PAUSE
- DBD::_::db; # ====== DATABASE ======
- @DBD::_::db::ISA = qw(DBD::_::common);
- use strict;
-
- sub clone {
- my ($old_dbh, $attr) = @_;
-
- my $closure = $old_dbh->{dbi_connect_closure}
- or return $old_dbh->set_err($DBI::stderr, "Can't clone handle");
-
- unless ($attr) { # XXX deprecated, caller should always pass a hash ref
- # copy attributes visible in the attribute cache
- keys %$old_dbh; # reset iterator
- while ( my ($k, $v) = each %$old_dbh ) {
- # ignore non-code refs, i.e., caches, handles, Err etc
- next if ref $v && ref $v ne 'CODE'; # HandleError etc
- $attr->{$k} = $v;
- }
- # explicitly set attributes which are unlikely to be in the
- # attribute cache, i.e., boolean's and some others
- $attr->{$_} = $old_dbh->FETCH($_) for (qw(
- AutoCommit ChopBlanks InactiveDestroy AutoInactiveDestroy
- LongTruncOk PrintError PrintWarn Profile RaiseError
- ShowErrorStatement TaintIn TaintOut
- ));
- }
-
- # use Data::Dumper; warn Dumper([$old_dbh, $attr]);
- my $new_dbh = &$closure($old_dbh, $attr);
- unless ($new_dbh) {
- # need to copy err/errstr from driver back into $old_dbh
- my $drh = $old_dbh->{Driver};
- return $old_dbh->set_err($drh->err, $drh->errstr, $drh->state);
- }
- $new_dbh->{dbi_connect_closure} = $closure;
- return $new_dbh;
- }
-
- sub quote_identifier {
- my ($dbh, @id) = @_;
- my $attr = (@id > 3 && ref($id[-1])) ? pop @id : undef;
-
- my $info = $dbh->{dbi_quote_identifier_cache} ||= [
- $dbh->get_info(29) || '"', # SQL_IDENTIFIER_QUOTE_CHAR
- $dbh->get_info(41) || '.', # SQL_CATALOG_NAME_SEPARATOR
- $dbh->get_info(114) || 1, # SQL_CATALOG_LOCATION
- ];
-
- my $quote = $info->[0];
- foreach (@id) { # quote the elements
- next unless defined;
- s/$quote/$quote$quote/g; # escape embedded quotes
- $_ = qq{$quote$_$quote};
- }
-
- # strip out catalog if present for special handling
- my $catalog = (@id >= 3) ? shift @id : undef;
-
- # join the dots, ignoring any null/undef elements (ie schema)
- my $quoted_id = join '.', grep { defined } @id;
-
- if ($catalog) { # add catalog correctly
- if ($quoted_id) {
- $quoted_id = ($info->[2] == 2) # SQL_CL_END
- ? $quoted_id . $info->[1] . $catalog
- : $catalog . $info->[1] . $quoted_id;
- } else {
- $quoted_id = $catalog;
- }
- }
- return $quoted_id;
- }
-
- sub quote {
- my ($dbh, $str, $data_type) = @_;
-
- return "NULL" unless defined $str;
- unless ($data_type) {
- $str =~ s/'/''/g; # ISO SQL2
- return "'$str'";
- }
-
- my $dbi_literal_quote_cache = $dbh->{'dbi_literal_quote_cache'} ||= [ {} , {} ];
- my ($prefixes, $suffixes) = @$dbi_literal_quote_cache;
-
- my $lp = $prefixes->{$data_type};
- my $ls = $suffixes->{$data_type};
-
- if ( ! defined $lp || ! defined $ls ) {
- my $ti = $dbh->type_info($data_type);
- $lp = $prefixes->{$data_type} = $ti ? $ti->{LITERAL_PREFIX} || "" : "'";
- $ls = $suffixes->{$data_type} = $ti ? $ti->{LITERAL_SUFFIX} || "" : "'";
- }
- return $str unless $lp || $ls; # no quoting required
-
- # XXX don't know what the standard says about escaping
- # in the 'general case' (where $lp != "'").
- # So we just do this and hope:
- $str =~ s/$lp/$lp$lp/g
- if $lp && $lp eq $ls && ($lp eq "'" || $lp eq '"');
- return "$lp$str$ls";
- }
-
- sub rows { -1 } # here so $DBI::rows 'works' after using $dbh
-
- sub do {
- my($dbh, $statement, $attr, @params) = @_;
- my $sth = $dbh->prepare($statement, $attr) or return undef;
- $sth->execute(@params) or return undef;
- my $rows = $sth->rows;
- ($rows == 0) ? "0E0" : $rows;
- }
-
- sub _do_selectrow {
- my ($method, $dbh, $stmt, $attr, @bind) = @_;
- my $sth = ((ref $stmt) ? $stmt : $dbh->prepare($stmt, $attr))
- or return undef;
- $sth->execute(@bind)
- or return undef;
- my $row = $sth->$method()
- and $sth->finish;
- return $row;
- }
-
- sub selectrow_hashref { return _do_selectrow('fetchrow_hashref', @_); }
-
- # XXX selectrow_array/ref also have C implementations in Driver.xst
- sub selectrow_arrayref { return _do_selectrow('fetchrow_arrayref', @_); }
- sub selectrow_array {
- my $row = _do_selectrow('fetchrow_arrayref', @_) or return;
- return $row->[0] unless wantarray;
- return @$row;
- }
-
- sub selectall_array {
- return @{ shift->selectall_arrayref(@_) || [] };
- }
-
- # XXX selectall_arrayref also has C implementation in Driver.xst
- # which fallsback to this if a slice is given
- sub selectall_arrayref {
- my ($dbh, $stmt, $attr, @bind) = @_;
- my $sth = (ref $stmt) ? $stmt : $dbh->prepare($stmt, $attr)
- or return;
- $sth->execute(@bind) || return;
- my $slice = $attr->{Slice}; # typically undef, else hash or array ref
- if (!$slice and $slice=$attr->{Columns}) {
- if (ref $slice eq 'ARRAY') { # map col idx to perl array idx
- $slice = [ @{$attr->{Columns}} ]; # take a copy
- for (@$slice) { $_-- }
- }
- }
- my $rows = $sth->fetchall_arrayref($slice, my $MaxRows = $attr->{MaxRows});
- $sth->finish if defined $MaxRows;
- return $rows;
- }
-
- sub selectall_hashref {
- my ($dbh, $stmt, $key_field, $attr, @bind) = @_;
- my $sth = (ref $stmt) ? $stmt : $dbh->prepare($stmt, $attr);
- return unless $sth;
- $sth->execute(@bind) || return;
- return $sth->fetchall_hashref($key_field);
- }
-
- sub selectcol_arrayref {
- my ($dbh, $stmt, $attr, @bind) = @_;
- my $sth = (ref $stmt) ? $stmt : $dbh->prepare($stmt, $attr);
- return unless $sth;
- $sth->execute(@bind) || return;
- my @columns = ($attr->{Columns}) ? @{$attr->{Columns}} : (1);
- my @values = (undef) x @columns;
- my $idx = 0;
- for (@columns) {
- $sth->bind_col($_, \$values[$idx++]) || return;
- }
- my @col;
- if (my $max = $attr->{MaxRows}) {
- push @col, @values while 0 < $max-- && $sth->fetch;
- }
- else {
- push @col, @values while $sth->fetch;
- }
- return \@col;
- }
-
- sub prepare_cached {
- my ($dbh, $statement, $attr, $if_active) = @_;
-
- # Needs support at dbh level to clear cache before complaining about
- # active children. The XS template code does this. Drivers not using
- # the template must handle clearing the cache themselves.
- my $cache = $dbh->{CachedKids} ||= {};
- my $key = do { local $^W;
- join "!\001", $statement, DBI::_concat_hash_sorted($attr, "=\001", ",\001", 0, 0)
- };
- my $sth = $cache->{$key};
-
- if ($sth) {
- return $sth unless $sth->FETCH('Active');
- Carp::carp("prepare_cached($statement) statement handle $sth still Active")
- unless ($if_active ||= 0);
- $sth->finish if $if_active <= 1;
- return $sth if $if_active <= 2;
- }
-
- $sth = $dbh->prepare($statement, $attr);
- $cache->{$key} = $sth if $sth;
-
- return $sth;
- }
-
- sub ping {
- my $dbh = shift;
- # "0 but true" is a special kind of true 0 that is used here so
- # applications can check if the ping was a real ping or not
- ($dbh->FETCH('Active')) ? "0 but true" : 0;
- }
-
- sub begin_work {
- my $dbh = shift;
- return $dbh->set_err($DBI::stderr, "Already in a transaction")
- unless $dbh->FETCH('AutoCommit');
- $dbh->STORE('AutoCommit', 0); # will croak if driver doesn't support it
- $dbh->STORE('BegunWork', 1); # trigger post commit/rollback action
- return 1;
- }
-
- sub primary_key {
- my ($dbh, @args) = @_;
- my $sth = $dbh->primary_key_info(@args) or return;
- my ($row, @col);
- push @col, $row->[3] while ($row = $sth->fetch);
- Carp::croak("primary_key method not called in list context")
- unless wantarray; # leave us some elbow room
- return @col;
- }
-
- sub tables {
- my ($dbh, @args) = @_;
- my $sth = $dbh->table_info(@args[0,1,2,3,4]) or return;
- my $tables = $sth->fetchall_arrayref or return;
- my @tables;
- if (defined($args[3]) && $args[3] eq '%' # special case for tables('','','','%')
- && grep {defined($_) && $_ eq ''} @args[0,1,2]
- ) {
- @tables = map { $_->[3] } @$tables;
- } elsif ($dbh->get_info(29)) { # SQL_IDENTIFIER_QUOTE_CHAR
- @tables = map { $dbh->quote_identifier( @{$_}[0,1,2] ) } @$tables;
- }
- else { # temporary old style hack (yeach)
- @tables = map {
- my $name = $_->[2];
- if ($_->[1]) {
- my $schema = $_->[1];
- # a sad hack (mostly for Informix I recall)
- my $quote = ($schema eq uc($schema)) ? '' : '"';
- $name = "$quote$schema$quote.$name"
- }
- $name;
- } @$tables;
- }
- return @tables;
- }
-
- sub type_info { # this should be sufficient for all drivers
- my ($dbh, $data_type) = @_;
- my $idx_hash;
- my $tia = $dbh->{dbi_type_info_row_cache};
- if ($tia) {
- $idx_hash = $dbh->{dbi_type_info_idx_cache};
- }
- else {
- my $temp = $dbh->type_info_all;
- return unless $temp && @$temp;
- # we cache here because type_info_all may be expensive to call
- # (and we take a copy so the following shift can't corrupt
- # the data that may be returned by future calls to type_info_all)
- $tia = $dbh->{dbi_type_info_row_cache} = [ @$temp ];
- $idx_hash = $dbh->{dbi_type_info_idx_cache} = shift @$tia;
- }
-
- my $dt_idx = $idx_hash->{DATA_TYPE} || $idx_hash->{data_type};
- Carp::croak("type_info_all returned non-standard DATA_TYPE index value ($dt_idx != 1)")
- if $dt_idx && $dt_idx != 1;
-
- # --- simple DATA_TYPE match filter
- my @ti;
- my @data_type_list = (ref $data_type) ? @$data_type : ($data_type);
- foreach $data_type (@data_type_list) {
- if (defined($data_type) && $data_type != DBI::SQL_ALL_TYPES()) {
- push @ti, grep { $_->[$dt_idx] == $data_type } @$tia;
- }
- else { # SQL_ALL_TYPES
- push @ti, @$tia;
- }
- last if @ti; # found at least one match
- }
-
- # --- format results into list of hash refs
- my $idx_fields = keys %$idx_hash;
- my @idx_names = map { uc($_) } keys %$idx_hash;
- my @idx_values = values %$idx_hash;
- Carp::croak "type_info_all result has $idx_fields keys but ".(@{$ti[0]})." fields"
- if @ti && @{$ti[0]} != $idx_fields;
- my @out = map {
- my %h; @h{@idx_names} = @{$_}[ @idx_values ]; \%h;
- } @ti;
- return $out[0] unless wantarray;
- return @out;
- }
-
- sub data_sources {
- my ($dbh, @other) = @_;
- my $drh = $dbh->{Driver}; # XXX proxy issues?
- return $drh->data_sources(@other);
- }
-
-}
-
-
-{ package # hide from PAUSE
- DBD::_::st; # ====== STATEMENT ======
- @DBD::_::st::ISA = qw(DBD::_::common);
- use strict;
-
- sub bind_param { Carp::croak("Can't bind_param, not implement by driver") }
-
-#
-# ********************************************************
-#
-# BEGIN ARRAY BINDING
-#
-# Array binding support for drivers which don't support
-# array binding, but have sufficient interfaces to fake it.
-# NOTE: mixing scalars and arrayrefs requires using bind_param_array
-# for *all* params...unless we modify bind_param for the default
-# case...
-#
-# 2002-Apr-10 D. Arnold
-
- sub bind_param_array {
- my $sth = shift;
- my ($p_id, $value_array, $attr) = @_;
-
- return $sth->set_err($DBI::stderr, "Value for parameter $p_id must be a scalar or an arrayref, not a ".ref($value_array))
- if defined $value_array and ref $value_array and ref $value_array ne 'ARRAY';
-
- return $sth->set_err($DBI::stderr, "Can't use named placeholder '$p_id' for non-driver supported bind_param_array")
- unless DBI::looks_like_number($p_id); # because we rely on execute(@ary) here
-
- return $sth->set_err($DBI::stderr, "Placeholder '$p_id' is out of range")
- if $p_id <= 0; # can't easily/reliably test for too big
-
- # get/create arrayref to hold params
- my $hash_of_arrays = $sth->{ParamArrays} ||= { };
-
- # If the bind has attribs then we rely on the driver conforming to
- # the DBI spec in that a single bind_param() call with those attribs
- # makes them 'sticky' and apply to all later execute(@values) calls.
- # Since we only call bind_param() if we're given attribs then
- # applications using drivers that don't support bind_param can still
- # use bind_param_array() so long as they don't pass any attribs.
-
- $$hash_of_arrays{$p_id} = $value_array;
- return $sth->bind_param($p_id, undef, $attr)
- if $attr;
- 1;
- }
-
- sub bind_param_inout_array {
- my $sth = shift;
- # XXX not supported so we just call bind_param_array instead
- # and then return an error
- my ($p_num, $value_array, $attr) = @_;
- $sth->bind_param_array($p_num, $value_array, $attr);
- return $sth->set_err($DBI::stderr, "bind_param_inout_array not supported");
- }
-
- sub bind_columns {
- my $sth = shift;
- my $fields = $sth->FETCH('NUM_OF_FIELDS') || 0;
- if ($fields <= 0 && !$sth->{Active}) {
- return $sth->set_err($DBI::stderr, "Statement has no result columns to bind"
- ." (perhaps you need to successfully call execute first, or again)");
- }
- # Backwards compatibility for old-style call with attribute hash
- # ref as first arg. Skip arg if undef or a hash ref.
- my $attr;
- $attr = shift if !defined $_[0] or ref($_[0]) eq 'HASH';
-
- my $idx = 0;
- $sth->bind_col(++$idx, shift, $attr) or return
- while (@_ and $idx < $fields);
-
- return $sth->set_err($DBI::stderr, "bind_columns called with ".($idx+@_)." values but $fields are needed")
- if @_ or $idx != $fields;
-
- return 1;
- }
-
- sub execute_array {
- my $sth = shift;
- my ($attr, @array_of_arrays) = @_;
- my $NUM_OF_PARAMS = $sth->FETCH('NUM_OF_PARAMS'); # may be undef at this point
-
- # get tuple status array or hash attribute
- my $tuple_sts = $attr->{ArrayTupleStatus};
- return $sth->set_err($DBI::stderr, "ArrayTupleStatus attribute must be an arrayref")
- if $tuple_sts and ref $tuple_sts ne 'ARRAY';
-
- # bind all supplied arrays
- if (@array_of_arrays) {
- $sth->{ParamArrays} = { }; # clear out old params
- return $sth->set_err($DBI::stderr,
- @array_of_arrays." bind values supplied but $NUM_OF_PARAMS expected")
- if defined ($NUM_OF_PARAMS) && @array_of_arrays != $NUM_OF_PARAMS;
- $sth->bind_param_array($_, $array_of_arrays[$_-1]) or return
- foreach (1..@array_of_arrays);
- }
-
- my $fetch_tuple_sub;
-
- if ($fetch_tuple_sub = $attr->{ArrayTupleFetch}) { # fetch on demand
-
- return $sth->set_err($DBI::stderr,
- "Can't use both ArrayTupleFetch and explicit bind values")
- if @array_of_arrays; # previous bind_param_array calls will simply be ignored
-
- if (UNIVERSAL::isa($fetch_tuple_sub,'DBI::st')) {
- my $fetch_sth = $fetch_tuple_sub;
- return $sth->set_err($DBI::stderr,
- "ArrayTupleFetch sth is not Active, need to execute() it first")
- unless $fetch_sth->{Active};
- # check column count match to give more friendly message
- my $NUM_OF_FIELDS = $fetch_sth->{NUM_OF_FIELDS};
- return $sth->set_err($DBI::stderr,
- "$NUM_OF_FIELDS columns from ArrayTupleFetch sth but $NUM_OF_PARAMS expected")
- if defined($NUM_OF_FIELDS) && defined($NUM_OF_PARAMS)
- && $NUM_OF_FIELDS != $NUM_OF_PARAMS;
- $fetch_tuple_sub = sub { $fetch_sth->fetchrow_arrayref };
- }
- elsif (!UNIVERSAL::isa($fetch_tuple_sub,'CODE')) {
- return $sth->set_err($DBI::stderr, "ArrayTupleFetch '$fetch_tuple_sub' is not a code ref or statement handle");
- }
-
- }
- else {
- my $NUM_OF_PARAMS_given = keys %{ $sth->{ParamArrays} || {} };
- return $sth->set_err($DBI::stderr,
- "$NUM_OF_PARAMS_given bind values supplied but $NUM_OF_PARAMS expected")
- if defined($NUM_OF_PARAMS) && $NUM_OF_PARAMS != $NUM_OF_PARAMS_given;
-
- # get the length of a bound array
- my $maxlen;
- my %hash_of_arrays = %{$sth->{ParamArrays}};
- foreach (keys(%hash_of_arrays)) {
- my $ary = $hash_of_arrays{$_};
- next unless ref $ary eq 'ARRAY';
- $maxlen = @$ary if !$maxlen || @$ary > $maxlen;
- }
- # if there are no arrays then execute scalars once
- $maxlen = 1 unless defined $maxlen;
- my @bind_ids = 1..keys(%hash_of_arrays);
-
- my $tuple_idx = 0;
- $fetch_tuple_sub = sub {
- return if $tuple_idx >= $maxlen;
- my @tuple = map {
- my $a = $hash_of_arrays{$_};
- ref($a) ? $a->[$tuple_idx] : $a
- } @bind_ids;
- ++$tuple_idx;
- return \@tuple;
- };
- }
- # pass thru the callers scalar or list context
- return $sth->execute_for_fetch($fetch_tuple_sub, $tuple_sts);
- }
-
- sub execute_for_fetch {
- my ($sth, $fetch_tuple_sub, $tuple_status) = @_;
- # start with empty status array
- ($tuple_status) ? @$tuple_status = () : $tuple_status = [];
-
- my $rc_total = 0;
- my $err_count;
- while ( my $tuple = &$fetch_tuple_sub() ) {
- if ( my $rc = $sth->execute(@$tuple) ) {
- push @$tuple_status, $rc;
- $rc_total = ($rc >= 0 && $rc_total >= 0) ? $rc_total + $rc : -1;
- }
- else {
- $err_count++;
- push @$tuple_status, [ $sth->err, $sth->errstr, $sth->state ];
- # XXX drivers implementing execute_for_fetch could opt to "last;" here
- # if they know the error code means no further executes will work.
- }
- }
- my $tuples = @$tuple_status;
- return $sth->set_err($DBI::stderr, "executing $tuples generated $err_count errors")
- if $err_count;
- $tuples ||= "0E0";
- return $tuples unless wantarray;
- return ($tuples, $rc_total);
- }
-
-
- sub fetchall_arrayref { # ALSO IN Driver.xst
- my ($sth, $slice, $max_rows) = @_;
-
- # when batch fetching with $max_rows were very likely to try to
- # fetch the 'next batch' after the previous batch returned
- # <=$max_rows. So don't treat that as an error.
- return undef if $max_rows and not $sth->FETCH('Active');
-
- my $mode = ref($slice) || 'ARRAY';
- my @rows;
-
- if ($mode eq 'ARRAY') {
- my $row;
- # we copy the array here because fetch (currently) always
- # returns the same array ref. XXX
- if ($slice && @$slice) {
- $max_rows = -1 unless defined $max_rows;
- push @rows, [ @{$row}[ @$slice] ]
- while($max_rows-- and $row = $sth->fetch);
- }
- elsif (defined $max_rows) {
- push @rows, [ @$row ]
- while($max_rows-- and $row = $sth->fetch);
- }
- else {
- push @rows, [ @$row ] while($row = $sth->fetch);
- }
- return \@rows
- }
-
- my %row;
- if ($mode eq 'REF' && ref($$slice) eq 'HASH') { # \{ $idx => $name }
- keys %$$slice; # reset the iterator
- while ( my ($idx, $name) = each %$$slice ) {
- $sth->bind_col($idx+1, \$row{$name});
- }
- }
- elsif ($mode eq 'HASH') {
- if (keys %$slice) { # resets the iterator
- my $name2idx = $sth->FETCH('NAME_lc_hash');
- while ( my ($name, $unused) = each %$slice ) {
- my $idx = $name2idx->{lc $name};
- return $sth->set_err($DBI::stderr, "Invalid column name '$name' for slice")
- if not defined $idx;
- $sth->bind_col($idx+1, \$row{$name});
- }
- }
- else {
- my @column_names = @{ $sth->FETCH($sth->FETCH('FetchHashKeyName')) };
- return [] if !@column_names;
-
- $sth->bind_columns( \( @row{@column_names} ) );
- }
- }
- else {
- return $sth->set_err($DBI::stderr, "fetchall_arrayref($mode) invalid");
- }
-
- if (not defined $max_rows) {
- push @rows, { %row } while ($sth->fetch); # full speed ahead!
- }
- else {
- push @rows, { %row } while ($max_rows-- and $sth->fetch);
- }
-
- return \@rows;
- }
-
- sub fetchall_hashref {
- my ($sth, $key_field) = @_;
-
- my $hash_key_name = $sth->{FetchHashKeyName} || 'NAME';
- my $names_hash = $sth->FETCH("${hash_key_name}_hash");
- my @key_fields = (ref $key_field) ? @$key_field : ($key_field);
- my @key_indexes;
- my $num_of_fields = $sth->FETCH('NUM_OF_FIELDS');
- foreach (@key_fields) {
- my $index = $names_hash->{$_}; # perl index not column
- $index = $_ - 1 if !defined $index && DBI::looks_like_number($_) && $_>=1 && $_ <= $num_of_fields;
- return $sth->set_err($DBI::stderr, "Field '$_' does not exist (not one of @{[keys %$names_hash]})")
- unless defined $index;
- push @key_indexes, $index;
- }
- my $rows = {};
- my $NAME = $sth->FETCH($hash_key_name);
- my @row = (undef) x $num_of_fields;
- $sth->bind_columns(\(@row));
- while ($sth->fetch) {
- my $ref = $rows;
- $ref = $ref->{$row[$_]} ||= {} for @key_indexes;
- @{$ref}{@$NAME} = @row;
- }
- return $rows;
- }
-
- *dump_results = \&DBI::dump_results;
-
- sub blob_copy_to_file { # returns length or undef on error
- my($self, $field, $filename_or_handleref, $blocksize) = @_;
- my $fh = $filename_or_handleref;
- my($len, $buf) = (0, "");
- $blocksize ||= 512; # not too ambitious
- local(*FH);
- unless(ref $fh) {
- open(FH, ">$fh") || return undef;
- $fh = \*FH;
- }
- while(defined($self->blob_read($field, $len, $blocksize, \$buf))) {
- print $fh $buf;
- $len += length $buf;
- }
- close(FH);
- $len;
- }
-
- sub more_results {
- shift->{syb_more_results}; # handy grandfathering
- }
-
-}
-
-unless ($DBI::PurePerl) { # See install_driver
- { @DBD::_mem::dr::ISA = qw(DBD::_mem::common); }
- { @DBD::_mem::db::ISA = qw(DBD::_mem::common); }
- { @DBD::_mem::st::ISA = qw(DBD::_mem::common); }
- # DBD::_mem::common::DESTROY is implemented in DBI.xs
-}
-
-1;
-__END__
-
-=head1 DESCRIPTION
-
-The DBI is a database access module for the Perl programming language. It defines
-a set of methods, variables, and conventions that provide a consistent
-database interface, independent of the actual database being used.
-
-It is important to remember that the DBI is just an interface.
-The DBI is a layer
-of "glue" between an application and one or more database I<driver>
-modules. It is the driver modules which do most of the real work. The DBI
-provides a standard interface and framework for the drivers to operate
-within.
-
-This document often uses terms like I<references>, I<objects>,
-I<methods>. If you're not familiar with those terms then it would
-be a good idea to read at least the following perl manuals first:
-L<perlreftut>, L<perldsc>, L<perllol>, and L<perlboot>.
-
-
-=head2 Architecture of a DBI Application
-
- |<- Scope of DBI ->|
- .-. .--------------. .-------------.
- .-------. | |---| XYZ Driver |---| XYZ Engine |
- | Perl | | | `--------------' `-------------'
- | script| |A| |D| .--------------. .-------------.
- | using |--|P|--|B|---|Oracle Driver |---|Oracle Engine|
- | DBI | |I| |I| `--------------' `-------------'
- | API | | |...
- |methods| | |... Other drivers
- `-------' | |...
- `-'
-
-The API, or Application Programming Interface, defines the
-call interface and variables for Perl scripts to use. The API
-is implemented by the Perl DBI extension.
-
-The DBI "dispatches" the method calls to the appropriate driver for
-actual execution. The DBI is also responsible for the dynamic loading
-of drivers, error checking and handling, providing default
-implementations for methods, and many other non-database specific duties.
-
-Each driver
-contains implementations of the DBI methods using the
-private interface functions of the corresponding database engine. Only authors
-of sophisticated/multi-database applications or generic library
-functions need be concerned with drivers.
-
-=head2 Notation and Conventions
-
-The following conventions are used in this document:
-
- $dbh Database handle object
- $sth Statement handle object
- $drh Driver handle object (rarely seen or used in applications)
- $h Any of the handle types above ($dbh, $sth, or $drh)
- $rc General Return Code (boolean: true=ok, false=error)
- $rv General Return Value (typically an integer)
- @ary List of values returned from the database, typically a row of data
- $rows Number of rows processed (if available, else -1)
- $fh A filehandle
- undef NULL values are represented by undefined values in Perl
- \%attr Reference to a hash of attribute values passed to methods
-
-Note that Perl will automatically destroy database and statement handle objects
-if all references to them are deleted.
-
-
-=head2 Outline Usage
-
-To use DBI,
-first you need to load the DBI module:
-
- use DBI;
- use strict;
-
-(The C<use strict;> isn't required but is strongly recommended.)
-
-Then you need to L</connect> to your data source and get a I<handle> for that
-connection:
-
- $dbh = DBI->connect($dsn, $user, $password,
- { RaiseError => 1, AutoCommit => 0 });
-
-Since connecting can be expensive, you generally just connect at the
-start of your program and disconnect at the end.
-
-Explicitly defining the required C<AutoCommit> behaviour is strongly
-recommended and may become mandatory in a later version. This
-determines whether changes are automatically committed to the
-database when executed, or need to be explicitly committed later.
-
-The DBI allows an application to "prepare" statements for later
-execution. A prepared statement is identified by a statement handle
-held in a Perl variable.
-We'll call the Perl variable C<$sth> in our examples.
-
-The typical method call sequence for a C<SELECT> statement is:
-
- prepare,
- execute, fetch, fetch, ...
- execute, fetch, fetch, ...
- execute, fetch, fetch, ...
-
-for example:
-
- $sth = $dbh->prepare("SELECT foo, bar FROM table WHERE baz=?");
-
- $sth->execute( $baz );
-
- while ( @row = $sth->fetchrow_array ) {
- print "@row\n";
- }
-
-The typical method call sequence for a I<non>-C<SELECT> statement is:
-
- prepare,
- execute,
- execute,
- execute.
-
-for example:
-
- $sth = $dbh->prepare("INSERT INTO table(foo,bar,baz) VALUES (?,?,?)");
-
- while(<CSV>) {
- chomp;
- my ($foo,$bar,$baz) = split /,/;
- $sth->execute( $foo, $bar, $baz );
- }
-
-The C<do()> method can be used for non repeated I<non>-C<SELECT> statement
-(or with drivers that don't support placeholders):
-
- $rows_affected = $dbh->do("UPDATE your_table SET foo = foo + 1");
-
-To commit your changes to the database (when L</AutoCommit> is off):
-
- $dbh->commit; # or call $dbh->rollback; to undo changes
-
-Finally, when you have finished working with the data source, you should
-L</disconnect> from it:
-
- $dbh->disconnect;
-
-
-=head2 General Interface Rules & Caveats
-
-The DBI does not have a concept of a "current session". Every session
-has a handle object (i.e., a C<$dbh>) returned from the C<connect> method.
-That handle object is used to invoke database related methods.
-
-Most data is returned to the Perl script as strings. (Null values are
-returned as C<undef>.) This allows arbitrary precision numeric data to be
-handled without loss of accuracy. Beware that Perl may not preserve
-the same accuracy when the string is used as a number.
-
-Dates and times are returned as character strings in the current
-default format of the corresponding database engine. Time zone effects
-are database/driver dependent.
-
-Perl supports binary data in Perl strings, and the DBI will pass binary
-data to and from the driver without change. It is up to the driver
-implementors to decide how they wish to handle such binary data.
-
-Perl supports two kinds of strings: Unicode (utf8 internally) and non-Unicode
-(defaults to iso-8859-1 if forced to assume an encoding). Drivers should
-accept both kinds of strings and, if required, convert them to the character
-set of the database being used. Similarly, when fetching from the database
-character data that isn't iso-8859-1 the driver should convert it into utf8.
-
-Multiple SQL statements may not be combined in a single statement
-handle (C<$sth>), although some databases and drivers do support this
-(notably Sybase and SQL Server).
-
-Non-sequential record reads are not supported in this version of the DBI.
-In other words, records can only be fetched in the order that the
-database returned them, and once fetched they are forgotten.
-
-Positioned updates and deletes are not directly supported by the DBI.
-See the description of the C<CursorName> attribute for an alternative.
-
-Individual driver implementors are free to provide any private
-functions and/or handle attributes that they feel are useful.
-Private driver functions can be invoked using the DBI C<func()> method.
-Private driver attributes are accessed just like standard attributes.
-
-Many methods have an optional C<\%attr> parameter which can be used to
-pass information to the driver implementing the method. Except where
-specifically documented, the C<\%attr> parameter can only be used to pass
-driver specific hints. In general, you can ignore C<\%attr> parameters
-or pass it as C<undef>.
-
-
-=head2 Naming Conventions and Name Space
-
-The DBI package and all packages below it (C<DBI::*>) are reserved for
-use by the DBI. Extensions and related modules use the C<DBIx::>
-namespace (see L<http://www.perl.com/CPAN/modules/by-module/DBIx/>).
-Package names beginning with C<DBD::> are reserved for use
-by DBI database drivers. All environment variables used by the DBI
-or by individual DBDs begin with "C<DBI_>" or "C<DBD_>".
-
-The letter case used for attribute names is significant and plays an
-important part in the portability of DBI scripts. The case of the
-attribute name is used to signify who defined the meaning of that name
-and its values.
-
- Case of name Has a meaning defined by
- ------------ ------------------------
- UPPER_CASE Standards, e.g., X/Open, ISO SQL92 etc (portable)
- MixedCase DBI API (portable), underscores are not used.
- lower_case Driver or database engine specific (non-portable)
-
-It is of the utmost importance that Driver developers only use
-lowercase attribute names when defining private attributes. Private
-attribute names must be prefixed with the driver name or suitable
-abbreviation (e.g., "C<ora_>" for Oracle, "C<ing_>" for Ingres, etc).
-
-
-=head2 SQL - A Query Language
-
-Most DBI drivers require applications to use a dialect of SQL
-(Structured Query Language) to interact with the database engine.
-The L</"Standards Reference Information"> section provides links
-to useful information about SQL.
-
-The DBI itself does not mandate or require any particular language to
-be used; it is language independent. In ODBC terms, the DBI is in
-"pass-thru" mode, although individual drivers might not be. The only requirement
-is that queries and other statements must be expressed as a single
-string of characters passed as the first argument to the L</prepare> or
-L</do> methods.
-
-For an interesting diversion on the I<real> history of RDBMS and SQL,
-from the people who made it happen, see:
-
- http://www.mcjones.org/System_R/SQL_Reunion_95/sqlr95.html
-
-Follow the "Full Contents" then "Intergalactic dataspeak" links for the
-SQL history.
-
-=head2 Placeholders and Bind Values
-
-Some drivers support placeholders and bind values.
-I<Placeholders>, also called parameter markers, are used to indicate
-values in a database statement that will be supplied later,
-before the prepared statement is executed. For example, an application
-might use the following to insert a row of data into the SALES table:
-
- INSERT INTO sales (product_code, qty, price) VALUES (?, ?, ?)
-
-or the following, to select the description for a product:
-
- SELECT description FROM products WHERE product_code = ?
-
-The C<?> characters are the placeholders. The association of actual
-values with placeholders is known as I<binding>, and the values are
-referred to as I<bind values>.
-Note that the C<?> is not enclosed in quotation marks, even when the
-placeholder represents a string.
-
-Some drivers also allow placeholders like C<:>I<name> and C<:>I<N> (e.g.,
-C<:1>, C<:2>, and so on) in addition to C<?>, but their use is not portable.
-
-If the C<:>I<N> form of placeholder is supported by the driver you're using,
-then you should be able to use either L</bind_param> or L</execute> to bind
-values. Check your driver documentation.
-
-Some drivers allow you to prevent the recognition of a placeholder by placing a
-single backslash character (C<\>) immediately before it. The driver will remove
-the backslash character and ignore the placeholder, passing it unchanged to the
-backend. If the driver supports this then L</get_info>(9000) will return true.
-
-With most drivers, placeholders can't be used for any element of a
-statement that would prevent the database server from validating the
-statement and creating a query execution plan for it. For example:
-
- "SELECT name, age FROM ?" # wrong (will probably fail)
- "SELECT name, ? FROM people" # wrong (but may not 'fail')
-
-Also, placeholders can only represent single scalar values.
-For example, the following
-statement won't work as expected for more than one value:
-
- "SELECT name, age FROM people WHERE name IN (?)" # wrong
- "SELECT name, age FROM people WHERE name IN (?,?)" # two names
-
-When using placeholders with the SQL C<LIKE> qualifier, you must
-remember that the placeholder substitutes for the whole string.
-So you should use "C<... LIKE ? ...>" and include any wildcard
-characters in the value that you bind to the placeholder.
-
-B<NULL Values>
-
-Undefined values, or C<undef>, are used to indicate NULL values.
-You can insert and update columns with a NULL value as you would a
-non-NULL value. These examples insert and update the column
-C<age> with a NULL value:
-
- $sth = $dbh->prepare(qq{
- INSERT INTO people (fullname, age) VALUES (?, ?)
- });
- $sth->execute("Joe Bloggs", undef);
-
- $sth = $dbh->prepare(qq{
- UPDATE people SET age = ? WHERE fullname = ?
- });
- $sth->execute(undef, "Joe Bloggs");
-
-However, care must be taken when trying to use NULL values in a
-C<WHERE> clause. Consider:
-
- SELECT fullname FROM people WHERE age = ?
-
-Binding an C<undef> (NULL) to the placeholder will I<not> select rows
-which have a NULL C<age>! At least for database engines that
-conform to the SQL standard. Refer to the SQL manual for your database
-engine or any SQL book for the reasons for this. To explicitly select
-NULLs you have to say "C<WHERE age IS NULL>".
-
-A common issue is to have a code fragment handle a value that could be
-either C<defined> or C<undef> (non-NULL or NULL) at runtime.
-A simple technique is to prepare the appropriate statement as needed,
-and substitute the placeholder for non-NULL cases:
-
- $sql_clause = defined $age? "age = ?" : "age IS NULL";
- $sth = $dbh->prepare(qq{
- SELECT fullname FROM people WHERE $sql_clause
- });
- $sth->execute(defined $age ? $age : ());
-
-The following technique illustrates qualifying a C<WHERE> clause with
-several columns, whose associated values (C<defined> or C<undef>) are
-in a hash %h:
-
- for my $col ("age", "phone", "email") {
- if (defined $h{$col}) {
- push @sql_qual, "$col = ?";
- push @sql_bind, $h{$col};
- }
- else {
- push @sql_qual, "$col IS NULL";
- }
- }
- $sql_clause = join(" AND ", @sql_qual);
- $sth = $dbh->prepare(qq{
- SELECT fullname FROM people WHERE $sql_clause
- });
- $sth->execute(@sql_bind);
-
-The techniques above call prepare for the SQL statement with each call to
-execute. Because calls to prepare() can be expensive, performance
-can suffer when an application iterates many times over statements
-like the above.
-
-A better solution is a single C<WHERE> clause that supports both
-NULL and non-NULL comparisons. Its SQL statement would need to be
-prepared only once for all cases, thus improving performance.
-Several examples of C<WHERE> clauses that support this are presented
-below. But each example lacks portability, robustness, or simplicity.
-Whether an example is supported on your database engine depends on
-what SQL extensions it provides, and where it supports the C<?>
-placeholder in a statement.
-
- 0) age = ?
- 1) NVL(age, xx) = NVL(?, xx)
- 2) ISNULL(age, xx) = ISNULL(?, xx)
- 3) DECODE(age, ?, 1, 0) = 1
- 4) age = ? OR (age IS NULL AND ? IS NULL)
- 5) age = ? OR (age IS NULL AND SP_ISNULL(?) = 1)
- 6) age = ? OR (age IS NULL AND ? = 1)
-
-Statements formed with the above C<WHERE> clauses require execute
-statements as follows. The arguments are required, whether their
-values are C<defined> or C<undef>.
-
- 0,1,2,3) $sth->execute($age);
- 4,5) $sth->execute($age, $age);
- 6) $sth->execute($age, defined($age) ? 0 : 1);
-
-Example 0 should not work (as mentioned earlier), but may work on
-a few database engines anyway (e.g. Sybase). Example 0 is part
-of examples 4, 5, and 6, so if example 0 works, these other
-examples may work, even if the engine does not properly support
-the right hand side of the C<OR> expression.
-
-Examples 1 and 2 are not robust: they require that you provide a
-valid column value xx (e.g. '~') which is not present in any row.
-That means you must have some notion of what data won't be stored
-in the column, and expect clients to adhere to that.
-
-Example 5 requires that you provide a stored procedure (SP_ISNULL
-in this example) that acts as a function: it checks whether a value
-is null, and returns 1 if it is, or 0 if not.
-
-Example 6, the least simple, is probably the most portable, i.e., it
-should work with most, if not all, database engines.
-
-Here is a table that indicates which examples above are known to
-work on various database engines:
-
- -----Examples------
- 0 1 2 3 4 5 6
- - - - - - - -
- Oracle 9 N Y N Y Y ? Y
- Informix IDS 9 N N N Y N Y Y
- MS SQL N N Y N Y ? Y
- Sybase Y N N N N N Y
- AnyData,DBM,CSV Y N N N Y Y* Y
- SQLite 3.3 N N N N Y N N
- MSAccess N N N N Y N Y
-
-* Works only because Example 0 works.
-
-DBI provides a sample perl script that will test the examples above
-on your database engine and tell you which ones work. It is located
-in the F<ex/> subdirectory of the DBI source distribution, or here:
-L<https://github.com/perl5-dbi/dbi/blob/master/ex/perl_dbi_nulls_test.pl>
-Please use the script to help us fill-in and maintain this table.
-
-B<Performance>
-
-Without using placeholders, the insert statement shown previously would have to
-contain the literal values to be inserted and would have to be
-re-prepared and re-executed for each row. With placeholders, the insert
-statement only needs to be prepared once. The bind values for each row
-can be given to the C<execute> method each time it's called. By avoiding
-the need to re-prepare the statement for each row, the application
-typically runs many times faster. Here's an example:
-
- my $sth = $dbh->prepare(q{
- INSERT INTO sales (product_code, qty, price) VALUES (?, ?, ?)
- }) or die $dbh->errstr;
- while (<>) {
- chomp;
- my ($product_code, $qty, $price) = split /,/;
- $sth->execute($product_code, $qty, $price) or die $dbh->errstr;
- }
- $dbh->commit or die $dbh->errstr;
-
-See L</execute> and L</bind_param> for more details.
-
-The C<q{...}> style quoting used in this example avoids clashing with
-quotes that may be used in the SQL statement. Use the double-quote like
-C<qq{...}> operator if you want to interpolate variables into the string.
-See L<perlop/"Quote and Quote-like Operators"> for more details.
-
-See also the L</bind_columns> method, which is used to associate Perl
-variables with the output columns of a C<SELECT> statement.
-
-=head1 THE DBI PACKAGE AND CLASS
-
-In this section, we cover the DBI class methods, utility functions,
-and the dynamic attributes associated with generic DBI handles.
-
-=head2 DBI Constants
-
-Constants representing the values of the SQL standard types can be
-imported individually by name, or all together by importing the
-special C<:sql_types> tag.
-
-The names and values of all the defined SQL standard types can be
-produced like this:
-
- foreach (@{ $DBI::EXPORT_TAGS{sql_types} }) {
- printf "%s=%d\n", $_, &{"DBI::$_"};
- }
-
-These constants are defined by SQL/CLI, ODBC or both.
-C<SQL_BIGINT> has conflicting codes in SQL/CLI and ODBC,
-DBI uses the ODBC one.
-
-See the L</type_info>, L</type_info_all>, and L</bind_param> methods
-for possible uses.
-
-Note that just because the DBI defines a named constant for a given
-data type doesn't mean that drivers will support that data type.
-
-
-=head2 DBI Class Methods
-
-The following methods are provided by the DBI class:
-
-=head3 C<parse_dsn>
-
- ($scheme, $driver, $attr_string, $attr_hash, $driver_dsn) = DBI->parse_dsn($dsn)
- or die "Can't parse DBI DSN '$dsn'";
-
-Breaks apart a DBI Data Source Name (DSN) and returns the individual
-parts. If $dsn doesn't contain a valid DSN then parse_dsn() returns
-an empty list.
-
-$scheme is the first part of the DSN and is currently always 'dbi'.
-$driver is the driver name, possibly defaulted to $ENV{DBI_DRIVER},
-and may be undefined. $attr_string is the contents of the optional attribute
-string, which may be undefined. If $attr_string is not empty then $attr_hash
-is a reference to a hash containing the parsed attribute names and values.
-$driver_dsn is the last part of the DBI DSN string. For example:
-
- ($scheme, $driver, $attr_string, $attr_hash, $driver_dsn)
- = DBI->parse_dsn("dbi:MyDriver(RaiseError=>1):db=test;port=42");
- $scheme = 'dbi';
- $driver = 'MyDriver';
- $attr_string = 'RaiseError=>1';
- $attr_hash = { 'RaiseError' => '1' };
- $driver_dsn = 'db=test;port=42';
-
-The parse_dsn() method was added in DBI 1.43.
-
-=head3 C<connect>
-
- $dbh = DBI->connect($data_source, $username, $password)
- or die $DBI::errstr;
- $dbh = DBI->connect($data_source, $username, $password, \%attr)
- or die $DBI::errstr;
-
-Establishes a database connection, or session, to the requested C<$data_source>.
-Returns a database handle object if the connection succeeds. Use
-C<$dbh-E<gt>disconnect> to terminate the connection.
-
-If the connect fails (see below), it returns C<undef> and sets both C<$DBI::err>
-and C<$DBI::errstr>. (It does I<not> explicitly set C<$!>.) You should generally
-test the return status of C<connect> and C<print $DBI::errstr> if it has failed.
-
-Multiple simultaneous connections to multiple databases through multiple
-drivers can be made via the DBI. Simply make one C<connect> call for each
-database and keep a copy of each returned database handle.
-
-The C<$data_source> value must begin with "C<dbi:>I<driver_name>C<:>".
-The I<driver_name> specifies the driver that will be used to make the
-connection. (Letter case is significant.)
-
-As a convenience, if the C<$data_source> parameter is undefined or empty,
-the DBI will substitute the value of the environment variable C<DBI_DSN>.
-If just the I<driver_name> part is empty (i.e., the C<$data_source>
-prefix is "C<dbi::>"), the environment variable C<DBI_DRIVER> is
-used. If neither variable is set, then C<connect> dies.
-
-Examples of C<$data_source> values are:
-
- dbi:DriverName:database_name
- dbi:DriverName:database_name@hostname:port
- dbi:DriverName:database=database_name;host=hostname;port=port
-
-There is I<no standard> for the text following the driver name. Each
-driver is free to use whatever syntax it wants. The only requirement the
-DBI makes is that all the information is supplied in a single string.
-You must consult the documentation for the drivers you are using for a
-description of the syntax they require.
-
-It is recommended that drivers support the ODBC style, shown in the
-last example above. It is also recommended that they support the
-three common names 'C<host>', 'C<port>', and 'C<database>' (plus 'C<db>'
-as an alias for C<database>). This simplifies automatic construction
-of basic DSNs: C<"dbi:$driver:database=$db;host=$host;port=$port">.
-Drivers should aim to 'do something reasonable' when given a DSN
-in this form, but if any part is meaningless for that driver (such
-as 'port' for Informix) it should generate an error if that part
-is not empty.
-
-If the environment variable C<DBI_AUTOPROXY> is defined (and the
-driver in C<$data_source> is not "C<Proxy>") then the connect request
-will automatically be changed to:
-
- $ENV{DBI_AUTOPROXY};dsn=$data_source
-
-C<DBI_AUTOPROXY> is typically set as "C<dbi:Proxy:hostname=...;port=...>".
-If $ENV{DBI_AUTOPROXY} doesn't begin with 'C<dbi:>' then "dbi:Proxy:"
-will be prepended to it first. See the DBD::Proxy documentation
-for more details.
-
-If C<$username> or C<$password> are undefined (rather than just empty),
-then the DBI will substitute the values of the C<DBI_USER> and C<DBI_PASS>
-environment variables, respectively. The DBI will warn if the
-environment variables are not defined. However, the everyday use
-of these environment variables is not recommended for security
-reasons. The mechanism is primarily intended to simplify testing.
-See below for alternative way to specify the username and password.
-
-C<DBI-E<gt>connect> automatically installs the driver if it has not been
-installed yet. Driver installation either returns a valid driver
-handle, or it I<dies> with an error message that includes the string
-"C<install_driver>" and the underlying problem. So C<DBI-E<gt>connect>
-will die
-on a driver installation failure and will only return C<undef> on a
-connect failure, in which case C<$DBI::errstr> will hold the error message.
-Use C<eval> if you need to catch the "C<install_driver>" error.
-
-The C<$data_source> argument (with the "C<dbi:...:>" prefix removed) and the
-C<$username> and C<$password> arguments are then passed to the driver for
-processing. The DBI does not define any interpretation for the
-contents of these fields. The driver is free to interpret the
-C<$data_source>, C<$username>, and C<$password> fields in any way, and supply
-whatever defaults are appropriate for the engine being accessed.
-(Oracle, for example, uses the ORACLE_SID and TWO_TASK environment
-variables if no C<$data_source> is specified.)
-
-The C<AutoCommit> and C<PrintError> attributes for each connection
-default to "on". (See L</AutoCommit> and L</PrintError> for more information.)
-However, it is strongly recommended that you explicitly define C<AutoCommit>
-rather than rely on the default. The C<PrintWarn> attribute defaults to true.
-
-The C<\%attr> parameter can be used to alter the default settings of
-C<PrintError>, C<RaiseError>, C<AutoCommit>, and other attributes. For example:
-
- $dbh = DBI->connect($data_source, $user, $pass, {
- PrintError => 0,
- AutoCommit => 0
- });
-
-The username and password can also be specified using the attributes
-C<Username> and C<Password>, in which case they take precedence
-over the C<$username> and C<$password> parameters.
-
-You can also define connection attribute values within the C<$data_source>
-parameter. For example:
-
- dbi:DriverName(PrintWarn=>0,PrintError=>0,Taint=>1):...
-
-Individual attributes values specified in this way take precedence over
-any conflicting values specified via the C<\%attr> parameter to C<connect>.
-
-The C<dbi_connect_method> attribute can be used to specify which driver
-method should be called to establish the connection. The only useful
-values are 'connect', 'connect_cached', or some specialized case like
-'Apache::DBI::connect' (which is automatically the default when running
-within Apache).
-
-Where possible, each session (C<$dbh>) is independent from the transactions
-in other sessions. This is useful when you need to hold cursors open
-across transactions--for example, if you use one session for your long lifespan
-cursors (typically read-only) and another for your short update
-transactions.
-
-For compatibility with old DBI scripts, the driver can be specified by
-passing its name as the fourth argument to C<connect> (instead of C<\%attr>):
-
- $dbh = DBI->connect($data_source, $user, $pass, $driver);
-
-In this "old-style" form of C<connect>, the C<$data_source> should not start
-with "C<dbi:driver_name:>". (If it does, the embedded driver_name
-will be ignored). Also note that in this older form of C<connect>,
-the C<$dbh-E<gt>{AutoCommit}> attribute is I<undefined>, the
-C<$dbh-E<gt>{PrintError}> attribute is off, and the old C<DBI_DBNAME>
-environment variable is
-checked if C<DBI_DSN> is not defined. Beware that this "old-style"
-C<connect> will soon be withdrawn in a future version of DBI.
-
-=head3 C<connect_cached>
-
- $dbh = DBI->connect_cached($data_source, $username, $password)
- or die $DBI::errstr;
- $dbh = DBI->connect_cached($data_source, $username, $password, \%attr)
- or die $DBI::errstr;
-
-C<connect_cached> is like L</connect>, except that the database handle
-returned is also
-stored in a hash associated with the given parameters. If another call
-is made to C<connect_cached> with the same parameter values, then the
-corresponding cached C<$dbh> will be returned if it is still valid.
-The cached database handle is replaced with a new connection if it
-has been disconnected or if the C<ping> method fails.
-
-Note that the behaviour of this method differs in several respects from the
-behaviour of persistent connections implemented by Apache::DBI.
-However, if Apache::DBI is loaded then C<connect_cached> will use it.
-
-Caching connections can be useful in some applications, but it can
-also cause problems, such as too many connections, and so should
-be used with care. In particular, avoid changing the attributes of
-a database handle created via connect_cached() because it will affect
-other code that may be using the same handle. When connect_cached()
-returns a handle the attributes will be reset to their initial values.
-This can cause problems, especially with the C<AutoCommit> attribute.
-
-Also, to ensure that the attributes passed are always the same, avoid passing
-references inline. For example, the C<Callbacks> attribute is specified as a
-hash reference. Be sure to declare it external to the call to
-connect_cached(), such that the hash reference is not re-created on every
-call. A package-level lexical works well:
-
- package MyDBH;
- my $cb = {
- 'connect_cached.reused' => sub { delete $_[4]->{AutoCommit} },
- };
-
- sub dbh {
- DBI->connect_cached( $dsn, $username, $auth, { Callbacks => $cb });
- }
-
-Where multiple separate parts of a program are using connect_cached()
-to connect to the same database with the same (initial) attributes
-it is a good idea to add a private attribute to the connect_cached()
-call to effectively limit the scope of the caching. For example:
-
- DBI->connect_cached(..., { private_foo_cachekey => "Bar", ... });
-
-Handles returned from that connect_cached() call will only be returned
-by other connect_cached() call elsewhere in the code if those other
-calls also pass in the same attribute values, including the private one.
-(I've used C<private_foo_cachekey> here as an example, you can use
-any attribute name with a C<private_> prefix.)
-
-Taking that one step further, you can limit a particular connect_cached()
-call to return handles unique to that one place in the code by setting the
-private attribute to a unique value for that place:
-
- DBI->connect_cached(..., { private_foo_cachekey => __FILE__.__LINE__, ... });
-
-By using a private attribute you still get connection caching for
-the individual calls to connect_cached() but, by making separate
-database connections for separate parts of the code, the database
-handles are isolated from any attribute changes made to other handles.
-
-The cache can be accessed (and cleared) via the L</CachedKids> attribute:
-
- my $CachedKids_hashref = $dbh->{Driver}->{CachedKids};
- %$CachedKids_hashref = () if $CachedKids_hashref;
-
-
-=head3 C<available_drivers>
-
- @ary = DBI->available_drivers;
- @ary = DBI->available_drivers($quiet);
-
-Returns a list of all available drivers by searching for C<DBD::*> modules
-through the directories in C<@INC>. By default, a warning is given if
-some drivers are hidden by others of the same name in earlier
-directories. Passing a true value for C<$quiet> will inhibit the warning.
-
-=head3 C<installed_drivers>
-
- %drivers = DBI->installed_drivers();
-
-Returns a list of driver name and driver handle pairs for all drivers
-'installed' (loaded) into the current process. The driver name does not
-include the 'DBD::' prefix.
-
-To get a list of all drivers available in your perl installation you can use
-L</available_drivers>.
-
-Added in DBI 1.49.
-
-=head3 C<installed_versions>
-
- DBI->installed_versions;
- @ary = DBI->installed_versions;
- $hash = DBI->installed_versions;
-
-Calls available_drivers() and attempts to load each of them in turn
-using install_driver(). For each load that succeeds the driver
-name and version number are added to a hash. When running under
-L<DBI::PurePerl> drivers which appear not be pure-perl are ignored.
-
-When called in array context the list of successfully loaded drivers
-is returned (without the 'DBD::' prefix).
-
-When called in scalar context an extra entry for the C<DBI> is added (and
-C<DBI::PurePerl> if appropriate) and a reference to the hash is returned.
-
-When called in a void context the installed_versions() method will
-print out a formatted list of the hash contents, one per line, along with some
-other information about the DBI version and OS.
-
-Due to the potentially high memory cost and unknown risks of loading
-in an unknown number of drivers that just happen to be installed
-on the system, this method is not recommended for general use.
-Use available_drivers() instead.
-
-The installed_versions() method is primarily intended as a quick
-way to see from the command line what's installed. For example:
-
- perl -MDBI -e 'DBI->installed_versions'
-
-The installed_versions() method was added in DBI 1.38.
-
-=head3 C<data_sources>
-
- @ary = DBI->data_sources($driver);
- @ary = DBI->data_sources($driver, \%attr);
-
-Returns a list of data sources (databases) available via the named
-driver. If C<$driver> is empty or C<undef>, then the value of the
-C<DBI_DRIVER> environment variable is used.
-
-The driver will be loaded if it hasn't been already. Note that if the
-driver loading fails then data_sources() I<dies> with an error message
-that includes the string "C<install_driver>" and the underlying problem.
-
-Data sources are returned in a form suitable for passing to the
-L</connect> method (that is, they will include the "C<dbi:$driver:>" prefix).
-
-Note that many drivers have no way of knowing what data sources might
-be available for it. These drivers return an empty or incomplete list
-or may require driver-specific attributes.
-
-There is also a data_sources() method defined for database handles.
-
-
-=head3 C<trace>
-
- DBI->trace($trace_setting)
- DBI->trace($trace_setting, $trace_filename)
- DBI->trace($trace_setting, $trace_filehandle)
- $trace_setting = DBI->trace;
-
-The C<DBI-E<gt>trace> method sets the I<global default> trace
-settings and returns the I<previous> trace settings. It can also
-be used to change where the trace output is sent.
-
-There's a similar method, C<$h-E<gt>trace>, which sets the trace
-settings for the specific handle it's called on.
-
-See the L</TRACING> section for full details about the DBI's powerful
-tracing facilities.
-
-
-=head3 C<visit_handles>
-
- DBI->visit_handles( $coderef );
- DBI->visit_handles( $coderef, $info );
-
-Where $coderef is a reference to a subroutine and $info is an arbitrary value
-which, if undefined, defaults to a reference to an empty hash. Returns $info.
-
-For each installed driver handle, if any, $coderef is invoked as:
-
- $coderef->($driver_handle, $info);
-
-If the execution of $coderef returns a true value then L</visit_child_handles>
-is called on that child handle and passed the returned value as $info.
-
-For example:
-
- my $info = $dbh->{Driver}->visit_child_handles(sub {
- my ($h, $info) = @_;
- ++$info->{ $h->{Type} }; # count types of handles (dr/db/st)
- return $info; # visit kids
- });
-
-See also L</visit_child_handles>.
-
-=head2 DBI Utility Functions
-
-In addition to the DBI methods listed in the previous section,
-the DBI package also provides several utility functions.
-
-These can be imported into your code by listing them in
-the C<use> statement. For example:
-
- use DBI qw(neat data_diff);
-
-Alternatively, all these utility functions (except hash) can be
-imported using the C<:utils> import tag. For example:
-
- use DBI qw(:utils);
-
-=head3 C<data_string_desc>
-
- $description = data_string_desc($string);
-
-Returns an informal description of the string. For example:
-
- UTF8 off, ASCII, 42 characters 42 bytes
- UTF8 off, non-ASCII, 42 characters 42 bytes
- UTF8 on, non-ASCII, 4 characters 6 bytes
- UTF8 on but INVALID encoding, non-ASCII, 4 characters 6 bytes
- UTF8 off, undef
-
-The initial C<UTF8> on/off refers to Perl's internal SvUTF8 flag.
-If $string has the SvUTF8 flag set but the sequence of bytes it
-contains are not a valid UTF-8 encoding then data_string_desc()
-will report C<UTF8 on but INVALID encoding>.
-
-The C<ASCII> vs C<non-ASCII> portion shows C<ASCII> if I<all> the
-characters in the string are ASCII (have code points <= 127).
-
-The data_string_desc() function was added in DBI 1.46.
-
-=head3 C<data_string_diff>
-
- $diff = data_string_diff($a, $b);
-
-Returns an informal description of the first character difference
-between the strings. If both $a and $b contain the same sequence
-of characters then data_string_diff() returns an empty string.
-For example:
-
- Params a & b Result
- ------------ ------
- 'aaa', 'aaa' ''
- 'aaa', 'abc' 'Strings differ at index 2: a[2]=a, b[2]=b'
- 'aaa', undef 'String b is undef, string a has 3 characters'
- 'aaa', 'aa' 'String b truncated after 2 characters'
-
-Unicode characters are reported in C<\x{XXXX}> format. Unicode
-code points in the range U+0800 to U+08FF are unassigned and most
-likely to occur due to double-encoding. Characters in this range
-are reported as C<\x{08XX}='C'> where C<C> is the corresponding
-latin-1 character.
-
-The data_string_diff() function only considers logical I<characters>
-and not the underlying encoding. See L</data_diff> for an alternative.
-
-The data_string_diff() function was added in DBI 1.46.
-
-=head3 C<data_diff>
-
- $diff = data_diff($a, $b);
- $diff = data_diff($a, $b, $logical);
-
-Returns an informal description of the difference between two strings.
-It calls L</data_string_desc> and L</data_string_diff>
-and returns the combined results as a multi-line string.
-
-For example, C<data_diff("abc", "ab\x{263a}")> will return:
-
- a: UTF8 off, ASCII, 3 characters 3 bytes
- b: UTF8 on, non-ASCII, 3 characters 5 bytes
- Strings differ at index 2: a[2]=c, b[2]=\x{263A}
-
-If $a and $b are identical in both the characters they contain I<and>
-their physical encoding then data_diff() returns an empty string.
-If $logical is true then physical encoding differences are ignored
-(but are still reported if there is a difference in the characters).
-
-The data_diff() function was added in DBI 1.46.
-
-=head3 C<neat>
-
- $str = neat($value);
- $str = neat($value, $maxlen);
-
-Return a string containing a neat (and tidy) representation of the
-supplied value.
-
-Strings will be quoted, although internal quotes will I<not> be escaped.
-Values known to be numeric will be unquoted. Undefined (NULL) values
-will be shown as C<undef> (without quotes).
-
-If the string is flagged internally as utf8 then double quotes will
-be used, otherwise single quotes are used and unprintable characters
-will be replaced by dot (.).
-
-For result strings longer than C<$maxlen> the result string will be
-truncated to C<$maxlen-4> and "C<...'>" will be appended. If C<$maxlen> is 0
-or C<undef>, it defaults to C<$DBI::neat_maxlen> which, in turn, defaults to 400.
-
-This function is designed to format values for human consumption.
-It is used internally by the DBI for L</trace> output. It should
-typically I<not> be used for formatting values for database use.
-(See also L</quote>.)
-
-=head3 C<neat_list>
-
- $str = neat_list(\@listref, $maxlen, $field_sep);
-
-Calls C<neat> on each element of the list and returns a string
-containing the results joined with C<$field_sep>. C<$field_sep> defaults
-to C<", ">.
-
-=head3 C<looks_like_number>
-
- @bool = looks_like_number(@array);
-
-Returns true for each element that looks like a number.
-Returns false for each element that does not look like a number.
-Returns C<undef> for each element that is undefined or empty.
-
-=head3 C<hash>
-
- $hash_value = DBI::hash($buffer, $type);
-
-Return a 32-bit integer 'hash' value corresponding to the contents of $buffer.
-The $type parameter selects which kind of hash algorithm should be used.
-
-For the technically curious, type 0 (which is the default if $type
-isn't specified) is based on the Perl 5.1 hash except that the value
-is forced to be negative (for obscure historical reasons).
-Type 1 is the better "Fowler / Noll / Vo" (FNV) hash. See
-L<http://www.isthe.com/chongo/tech/comp/fnv/> for more information.
-Both types are implemented in C and are very fast.
-
-This function doesn't have much to do with databases, except that
-it can sometimes be handy to store such values in a database.
-It also doesn't have much to do with perl hashes, like %foo.
-
-=head3 C<sql_type_cast>
-
- $sts = DBI::sql_type_cast($sv, $sql_type, $flags);
-
-sql_type_cast attempts to cast C<$sv> to the SQL type (see L<DBI
-Constants>) specified in C<$sql_type>. At present only the SQL types
-C<SQL_INTEGER>, C<SQL_DOUBLE> and C<SQL_NUMERIC> are supported.
-
-For C<SQL_INTEGER> the effect is similar to using the value in an expression
-that requires an integer. It gives the perl scalar an 'integer aspect'.
-(Technically the value gains an IV, or possibly a UV or NV if the value is too
-large for an IV.)
-
-For C<SQL_DOUBLE> the effect is similar to using the value in an expression
-that requires a general numeric value. It gives the perl scalar a 'numeric
-aspect'. (Technically the value gains an NV.)
-
-C<SQL_NUMERIC> is similar to C<SQL_INTEGER> or C<SQL_DOUBLE> but more
-general and more cautious. It will look at the string first and if it
-looks like an integer (that will fit in an IV or UV) it will act like
-C<SQL_INTEGER>, if it looks like a floating point value it will act
-like C<SQL_DOUBLE>, if it looks like neither then it will do nothing -
-and thereby avoid the warnings that would be generated by
-C<SQL_INTEGER> and C<SQL_DOUBLE> when given non-numeric data.
-
-C<$flags> may be:
-
-=over 4
-
-=item C<DBIstcf_DISCARD_STRING>
-
-If this flag is specified then when the driver successfully casts the
-bound perl scalar to a non-string type then the string portion of the
-scalar will be discarded.
-
-=item C<DBIstcf_STRICT>
-
-If C<$sv> cannot be cast to the requested C<$sql_type> then by default
-it is left untouched and no error is generated. If you specify
-C<DBIstcf_STRICT> and the cast fails, this will generate an error.
-
-=back
-
-The returned C<$sts> value is:
-
- -2 sql_type is not handled
- -1 sv is undef so unchanged
- 0 sv could not be cast cleanly and DBIstcf_STRICT was used
- 1 sv could not be cast and DBIstcf_STRICT was not used
- 2 sv was cast successfully
-
-This method is exported by the :utils tag and was introduced in DBI
-1.611.
-
-=head2 DBI Dynamic Attributes
-
-Dynamic attributes are always associated with the I<last handle used>
-(that handle is represented by C<$h> in the descriptions below).
-
-Where an attribute is equivalent to a method call, then refer to
-the method call for all related documentation.
-
-Warning: these attributes are provided as a convenience but they
-do have limitations. Specifically, they have a short lifespan:
-because they are associated with
-the last handle used, they should only be used I<immediately> after
-calling the method that "sets" them.
-If in any doubt, use the corresponding method call.
-
-=head3 C<$DBI::err>
-
-Equivalent to C<$h-E<gt>err>.
-
-=head3 C<$DBI::errstr>
-
-Equivalent to C<$h-E<gt>errstr>.
-
-=head3 C<$DBI::state>
-
-Equivalent to C<$h-E<gt>state>.
-
-=head3 C<$DBI::rows>
-
-Equivalent to C<$h-E<gt>rows>. Please refer to the documentation
-for the L</rows> method.
-
-=head3 C<$DBI::lasth>
-
-Returns the DBI object handle used for the most recent DBI method call.
-If the last DBI method call was a DESTROY then $DBI::lasth will return
-the handle of the parent of the destroyed handle, if there is one.
-
-
-=head1 METHODS COMMON TO ALL HANDLES
-
-The following methods can be used by all types of DBI handles.
-
-=head3 C<err>
-
- $rv = $h->err;
-
-Returns the I<native> database engine error code from the last driver
-method called. The code is typically an integer but you should not
-assume that.
-
-The DBI resets $h->err to undef before almost all DBI method calls, so the
-value only has a short lifespan. Also, for most drivers, the statement
-handles share the same error variable as the parent database handle,
-so calling a method on one handle may reset the error on the
-related handles.
-
-(Methods which don't reset err before being called include err() and errstr(),
-obviously, state(), rows(), func(), trace(), trace_msg(), ping(), and the
-tied hash attribute FETCH() and STORE() methods.)
-
-If you need to test for specific error conditions I<and> have your program be
-portable to different database engines, then you'll need to determine what the
-corresponding error codes are for all those engines and test for all of them.
-
-The DBI uses the value of $DBI::stderr as the C<err> value for internal errors.
-Drivers should also do likewise. The default value for $DBI::stderr is 2000000000.
-
-A driver may return C<0> from err() to indicate a warning condition
-after a method call. Similarly, a driver may return an empty string
-to indicate a 'success with information' condition. In both these
-cases the value is false but not undef. The errstr() and state()
-methods may be used to retrieve extra information in these cases.
-
-See L</set_err> for more information.
-
-=head3 C<errstr>
-
- $str = $h->errstr;
-
-Returns the native database engine error message from the last DBI
-method called. This has the same lifespan issues as the L</err> method
-described above.
-
-The returned string may contain multiple messages separated by
-newline characters.
-
-The errstr() method should not be used to test for errors, use err()
-for that, because drivers may return 'success with information' or
-warning messages via errstr() for methods that have not 'failed'.
-
-See L</set_err> for more information.
-
-=head3 C<state>
-
- $str = $h->state;
-
-Returns a state code in the standard SQLSTATE five character format.
-Note that the specific success code C<00000> is translated to any empty string
-(false). If the driver does not support SQLSTATE (and most don't),
-then state() will return C<S1000> (General Error) for all errors.
-
-The driver is free to return any value via C<state>, e.g., warning
-codes, even if it has not declared an error by returning a true value
-via the L</err> method described above.
-
-The state() method should not be used to test for errors, use err()
-for that, because drivers may return a 'success with information' or
-warning state code via state() for methods that have not 'failed'.
-
-=head3 C<set_err>
-
- $rv = $h->set_err($err, $errstr);
- $rv = $h->set_err($err, $errstr, $state);
- $rv = $h->set_err($err, $errstr, $state, $method);
- $rv = $h->set_err($err, $errstr, $state, $method, $rv);
-
-Set the C<err>, C<errstr>, and C<state> values for the handle.
-This method is typically only used by DBI drivers and DBI subclasses.
-
-If the L</HandleSetErr> attribute holds a reference to a subroutine
-it is called first. The subroutine can alter the $err, $errstr, $state,
-and $method values. See L</HandleSetErr> for full details.
-If the subroutine returns a true value then the handle C<err>,
-C<errstr>, and C<state> values are not altered and set_err() returns
-an empty list (it normally returns $rv which defaults to undef, see below).
-
-Setting C<err> to a I<true> value indicates an error and will trigger
-the normal DBI error handling mechanisms, such as C<RaiseError> and
-C<HandleError>, if they are enabled, when execution returns from
-the DBI back to the application.
-
-Setting C<err> to C<""> indicates an 'information' state, and setting
-it to C<"0"> indicates a 'warning' state. Setting C<err> to C<undef>
-also sets C<errstr> to undef, and C<state> to C<"">, irrespective
-of the values of the $errstr and $state parameters.
-
-The $method parameter provides an alternate method name for the
-C<RaiseError>/C<PrintError>/C<PrintWarn> error string instead of
-the fairly unhelpful 'C<set_err>'.
-
-The C<set_err> method normally returns undef. The $rv parameter
-provides an alternate return value.
-
-Some special rules apply if the C<err> or C<errstr>
-values for the handle are I<already> set...
-
-If C<errstr> is true then: "C< [err was %s now %s]>" is appended if $err is
-true and C<err> is already true and the new err value differs from the original
-one. Similarly "C< [state was %s now %s]>" is appended if $state is true and C<state> is
-already true and the new state value differs from the original one. Finally
-"C<\n>" and the new $errstr are appended if $errstr differs from the existing
-errstr value. Obviously the C<%s>'s above are replaced by the corresponding values.
-
-The handle C<err> value is set to $err if: $err is true; or handle
-C<err> value is undef; or $err is defined and the length is greater
-than the handle C<err> length. The effect is that an 'information'
-state only overrides undef; a 'warning' overrides undef or 'information',
-and an 'error' state overrides anything.
-
-The handle C<state> value is set to $state if $state is true and
-the handle C<err> value was set (by the rules above).
-
-Support for warning and information states was added in DBI 1.41.
-
-=head3 C<trace>
-
- $h->trace($trace_settings);
- $h->trace($trace_settings, $trace_filename);
- $trace_settings = $h->trace;
-
-The trace() method is used to alter the trace settings for a handle
-(and any future children of that handle). It can also be used to
-change where the trace output is sent.
-
-There's a similar method, C<DBI-E<gt>trace>, which sets the global
-default trace settings.
-
-See the L</TRACING> section for full details about the DBI's powerful
-tracing facilities.
-
-=head3 C<trace_msg>
-
- $h->trace_msg($message_text);
- $h->trace_msg($message_text, $min_level);
-
-Writes C<$message_text> to the trace file if the trace level is
-greater than or equal to $min_level (which defaults to 1).
-Can also be called as C<DBI-E<gt>trace_msg($msg)>.
-
-See L</TRACING> for more details.
-
-=head3 C<func>
-
- $h->func(@func_arguments, $func_name) or die ...;
-
-The C<func> method can be used to call private non-standard and
-non-portable methods implemented by the driver. Note that the function
-name is given as the I<last> argument.
-
-It's also important to note that the func() method does not clear
-a previous error ($DBI::err etc.) and it does not trigger automatic
-error detection (RaiseError etc.) so you must check the return
-status and/or $h->err to detect errors.
-
-(This method is not directly related to calling stored procedures.
-Calling stored procedures is currently not defined by the DBI.
-Some drivers, such as DBD::Oracle, support it in non-portable ways.
-See driver documentation for more details.)
-
-See also install_method() in L<DBI::DBD> for how you can avoid needing to
-use func() and gain direct access to driver-private methods.
-
-=head3 C<can>
-
- $is_implemented = $h->can($method_name);
-
-Returns true if $method_name is implemented by the driver or a
-default method is provided by the DBI's driver base class.
-It returns false where a driver hasn't implemented a method and the
-default method is provided by the DBI's driver base class is just an empty stub.
-
-=head3 C<parse_trace_flags>
-
- $trace_settings_integer = $h->parse_trace_flags($trace_settings);
-
-Parses a string containing trace settings and returns the corresponding
-integer value used internally by the DBI and drivers.
-
-The $trace_settings argument is a string containing a trace level
-between 0 and 15 and/or trace flag names separated by vertical bar
-("C<|>") or comma ("C<,>") characters. For example: C<"SQL|3|foo">.
-
-It uses the parse_trace_flag() method, described below, to process
-the individual trace flag names.
-
-The parse_trace_flags() method was added in DBI 1.42.
-
-=head3 C<parse_trace_flag>
-
- $bit_flag = $h->parse_trace_flag($trace_flag_name);
-
-Returns the bit flag corresponding to the trace flag name in
-$trace_flag_name. Drivers are expected to override this method and
-check if $trace_flag_name is a driver specific trace flags and, if
-not, then call the DBI's default parse_trace_flag().
-
-The parse_trace_flag() method was added in DBI 1.42.
-
-=head3 C<private_attribute_info>
-
- $hash_ref = $h->private_attribute_info();
-
-Returns a reference to a hash whose keys are the names of driver-private
-handle attributes available for the kind of handle (driver, database, statement)
-that the method was called on.
-
-For example, the return value when called with a DBD::Sybase $dbh could look like this:
-
- {
- syb_dynamic_supported => undef,
- syb_oc_version => undef,
- syb_server_version => undef,
- syb_server_version_string => undef,
- }
-
-and when called with a DBD::Sybase $sth they could look like this:
-
- {
- syb_types => undef,
- syb_proc_status => undef,
- syb_result_type => undef,
- }
-
-The values should be undef. Meanings may be assigned to particular values in future.
-
-=head3 C<swap_inner_handle>
-
- $rc = $h1->swap_inner_handle( $h2 );
- $rc = $h1->swap_inner_handle( $h2, $allow_reparent );
-
-Brain transplants for handles. You don't need to know about this
-unless you want to become a handle surgeon.
-
-A DBI handle is a reference to a tied hash. A tied hash has an
-I<inner> hash that actually holds the contents. The swap_inner_handle()
-method swaps the inner hashes between two handles. The $h1 and $h2
-handles still point to the same tied hashes, but what those hashes
-are tied to has been swapped. In effect $h1 I<becomes> $h2 and
-vice-versa. This is powerful stuff, expect problems. Use with care.
-
-As a small safety measure, the two handles, $h1 and $h2, have to
-share the same parent unless $allow_reparent is true.
-
-The swap_inner_handle() method was added in DBI 1.44.
-
-Here's a quick kind of 'diagram' as a worked example to help think about what's
-happening:
-
- Original state:
- dbh1o -> dbh1i
- sthAo -> sthAi(dbh1i)
- dbh2o -> dbh2i
-
- swap_inner_handle dbh1o with dbh2o:
- dbh2o -> dbh1i
- sthAo -> sthAi(dbh1i)
- dbh1o -> dbh2i
-
- create new sth from dbh1o:
- dbh2o -> dbh1i
- sthAo -> sthAi(dbh1i)
- dbh1o -> dbh2i
- sthBo -> sthBi(dbh2i)
-
- swap_inner_handle sthAo with sthBo:
- dbh2o -> dbh1i
- sthBo -> sthAi(dbh1i)
- dbh1o -> dbh2i
- sthAo -> sthBi(dbh2i)
-
-=head3 C<visit_child_handles>
-
- $h->visit_child_handles( $coderef );
- $h->visit_child_handles( $coderef, $info );
-
-Where $coderef is a reference to a subroutine and $info is an arbitrary value
-which, if undefined, defaults to a reference to an empty hash. Returns $info.
-
-For each child handle of $h, if any, $coderef is invoked as:
-
- $coderef->($child_handle, $info);
-
-If the execution of $coderef returns a true value then C<visit_child_handles>
-is called on that child handle and passed the returned value as $info.
-
-For example:
-
- # count database connections with names (DSN) matching a pattern
- my $connections = 0;
- $dbh->{Driver}->visit_child_handles(sub {
- my ($h, $info) = @_;
- ++$connections if $h->{Name} =~ /foo/;
- return 0; # don't visit kids
- })
-
-See also L</visit_handles>.
-
-=head1 ATTRIBUTES COMMON TO ALL HANDLES
-
-These attributes are common to all types of DBI handles.
-
-Some attributes are inherited by child handles. That is, the value
-of an inherited attribute in a newly created statement handle is the
-same as the value in the parent database handle. Changes to attributes
-in the new statement handle do not affect the parent database handle
-and changes to the database handle do not affect existing statement
-handles, only future ones.
-
-Attempting to set or get the value of an unknown attribute generates a warning,
-except for private driver specific attributes (which all have names
-starting with a lowercase letter).
-
-Example:
-
- $h->{AttributeName} = ...; # set/write
- ... = $h->{AttributeName}; # get/read
-
-=head3 C<Warn>
-
-Type: boolean, inherited
-
-The C<Warn> attribute enables useful warnings for certain bad
-practices. It is enabled by default and should only be disabled in
-rare circumstances. Since warnings are generated using the Perl
-C<warn> function, they can be intercepted using the Perl C<$SIG{__WARN__}>
-hook.
-
-The C<Warn> attribute is not related to the C<PrintWarn> attribute.
-
-=head3 C<Active>
-
-Type: boolean, read-only
-
-The C<Active> attribute is true if the handle object is "active". This is rarely used in
-applications. The exact meaning of active is somewhat vague at the
-moment. For a database handle it typically means that the handle is
-connected to a database (C<$dbh-E<gt>disconnect> sets C<Active> off). For
-a statement handle it typically means that the handle is a C<SELECT>
-that may have more data to fetch. (Fetching all the data or calling C<$sth-E<gt>finish>
-sets C<Active> off.)
-
-=head3 C<Executed>
-
-Type: boolean
-
-The C<Executed> attribute is true if the handle object has been "executed".
-Currently only the $dbh do() method and the $sth execute(), execute_array(),
-and execute_for_fetch() methods set the C<Executed> attribute.
-
-When it's set on a handle it is also set on the parent handle at the
-same time. So calling execute() on a $sth also sets the C<Executed>
-attribute on the parent $dbh.
-
-The C<Executed> attribute for a database handle is cleared by the commit() and
-rollback() methods (even if they fail). The C<Executed> attribute of a
-statement handle is not cleared by the DBI under any circumstances and so acts
-as a permanent record of whether the statement handle was ever used.
-
-The C<Executed> attribute was added in DBI 1.41.
-
-=head3 C<Kids>
-
-Type: integer, read-only
-
-For a driver handle, C<Kids> is the number of currently existing database
-handles that were created from that driver handle. For a database
-handle, C<Kids> is the number of currently existing statement handles that
-were created from that database handle.
-For a statement handle, the value is zero.
-
-=head3 C<ActiveKids>
-
-Type: integer, read-only
-
-Like C<Kids>, but only counting those that are C<Active> (as above).
-
-=head3 C<CachedKids>
-
-Type: hash ref
-
-For a database handle, C<CachedKids> returns a reference to the cache (hash) of
-statement handles created by the L</prepare_cached> method. For a
-driver handle, returns a reference to the cache (hash) of
-database handles created by the L</connect_cached> method.
-
-=head3 C<Type>
-
-Type: scalar, read-only
-
-The C<Type> attribute identifies the type of a DBI handle. Returns
-"dr" for driver handles, "db" for database handles and "st" for
-statement handles.
-
-=head3 C<ChildHandles>
-
-Type: array ref
-
-The ChildHandles attribute contains a reference to an array of all the
-handles created by this handle which are still accessible. The
-contents of the array are weak-refs and will become undef when the
-handle goes out of scope. (They're cleared out occasionally.)
-
-C<ChildHandles> returns undef if your perl version does not support weak
-references (check the L<Scalar::Util|Scalar::Util> module). The referenced
-array returned should be treated as read-only.
-
-For example, to enumerate all driver handles, database handles and
-statement handles:
-
- sub show_child_handles {
- my ($h, $level) = @_;
- printf "%sh %s %s\n", $h->{Type}, "\t" x $level, $h;
- show_child_handles($_, $level + 1)
- for (grep { defined } @{$h->{ChildHandles}});
- }
-
- my %drivers = DBI->installed_drivers();
- show_child_handles($_, 0) for (values %drivers);
-
-=head3 C<CompatMode>
-
-Type: boolean, inherited
-
-The C<CompatMode> attribute is used by emulation layers (such as
-Oraperl) to enable compatible behaviour in the underlying driver
-(e.g., DBD::Oracle) for this handle. Not normally set by application code.
-
-It also has the effect of disabling the 'quick FETCH' of attribute
-values from the handles attribute cache. So all attribute values
-are handled by the drivers own FETCH method. This makes them slightly
-slower but is useful for special-purpose drivers like DBD::Multiplex.
-
-=head3 C<InactiveDestroy>
-
-Type: boolean
-
-The default value, false, means a handle will be fully destroyed
-as normal when the last reference to it is removed, just as you'd expect.
-
-If set true then the handle will be treated by the DESTROY as if it was no
-longer Active, and so the I<database engine> related effects of DESTROYing a
-handle will be skipped. Think of the name as meaning 'treat the handle as
-not-Active in the DESTROY method'.
-
-For a database handle, this attribute does not disable an I<explicit>
-call to the disconnect method, only the implicit call from DESTROY
-that happens if the handle is still marked as C<Active>.
-
-This attribute is specifically designed for use in Unix applications
-that "fork" child processes. For some drivers, when the child process exits
-the destruction of inherited handles cause the corresponding handles in the
-parent process to cease working.
-
-Either the parent or the child process, but not both, should set
-C<InactiveDestroy> true on all their shared handles. Alternatively, and
-preferably, the L</AutoInactiveDestroy> can be set in the parent on connect.
-
-To help tracing applications using fork the process id is shown in
-the trace log whenever a DBI or handle trace() method is called.
-The process id also shown for I<every> method call if the DBI trace
-level (not handle trace level) is set high enough to show the trace
-from the DBI's method dispatcher, e.g. >= 9.
-
-=head3 C<AutoInactiveDestroy>
-
-Type: boolean, inherited
-
-The L</InactiveDestroy> attribute, described above, needs to be explicitly set
-in the child process after a fork(), on every active database and statement handle.
-This is a problem if the code that performs the fork() is not under your
-control, perhaps in a third-party module. Use C<AutoInactiveDestroy> to get
-around this situation.
-
-If set true, the DESTROY method will check the process id of the handle and, if
-different from the current process id, it will set the I<InactiveDestroy> attribute.
-It is strongly recommended that C<AutoInactiveDestroy> is enabled on all new code
-(it's only not enabled by default to avoid backwards compatibility problems).
-
-This is the example it's designed to deal with:
-
- my $dbh = DBI->connect(...);
- some_code_that_forks(); # Perhaps without your knowledge
- # Child process dies, destroying the inherited dbh
- $dbh->do(...); # Breaks because parent $dbh is now broken
-
-The C<AutoInactiveDestroy> attribute was added in DBI 1.614.
-
-=head3 C<PrintWarn>
-
-Type: boolean, inherited
-
-The C<PrintWarn> attribute controls the printing of warnings recorded
-by the driver. When set to a true value (the default) the DBI will check method
-calls to see if a warning condition has been set. If so, the DBI
-will effectively do a C<warn("$class $method warning: $DBI::errstr")>
-where C<$class> is the driver class and C<$method> is the name of
-the method which failed. E.g.,
-
- DBD::Oracle::db execute warning: ... warning text here ...
-
-If desired, the warnings can be caught and processed using a C<$SIG{__WARN__}>
-handler or modules like CGI::Carp and CGI::ErrorWrap.
-
-See also L</set_err> for how warnings are recorded and L</HandleSetErr>
-for how to influence it.
-
-Fetching the full details of warnings can require an extra round-trip
-to the database server for some drivers. In which case the driver
-may opt to only fetch the full details of warnings if the C<PrintWarn>
-attribute is true. If C<PrintWarn> is false then these drivers should
-still indicate the fact that there were warnings by setting the
-warning string to, for example: "3 warnings".
-
-=head3 C<PrintError>
-
-Type: boolean, inherited
-
-The C<PrintError> attribute can be used to force errors to generate warnings (using
-C<warn>) in addition to returning error codes in the normal way. When set
-"on", any method which results in an error occurring will cause the DBI to
-effectively do a C<warn("$class $method failed: $DBI::errstr")> where C<$class>
-is the driver class and C<$method> is the name of the method which failed. E.g.,
-
- DBD::Oracle::db prepare failed: ... error text here ...
-
-By default, C<DBI-E<gt>connect> sets C<PrintError> "on".
-
-If desired, the warnings can be caught and processed using a C<$SIG{__WARN__}>
-handler or modules like CGI::Carp and CGI::ErrorWrap.
-
-=head3 C<RaiseError>
-
-Type: boolean, inherited
-
-The C<RaiseError> attribute can be used to force errors to raise exceptions rather
-than simply return error codes in the normal way. It is "off" by default.
-When set "on", any method which results in an error will cause
-the DBI to effectively do a C<die("$class $method failed: $DBI::errstr")>,
-where C<$class> is the driver class and C<$method> is the name of the method
-that failed. E.g.,
-
- DBD::Oracle::db prepare failed: ... error text here ...
-
-If you turn C<RaiseError> on then you'd normally turn C<PrintError> off.
-If C<PrintError> is also on, then the C<PrintError> is done first (naturally).
-
-Typically C<RaiseError> is used in conjunction with C<eval>,
-or a module like L<Try::Tiny> or L<TryCatch>,
-to catch the exception that's been thrown and handle it.
-For example:
-
- use Try::Tiny;
-
- try {
- ...
- $sth->execute();
- ...
- } catch {
- # $sth->err and $DBI::err will be true if error was from DBI
- warn $_; # print the error (which Try::Tiny puts into $_)
- ... # do whatever you need to deal with the error
- };
-
-In the catch block the $DBI::lasth variable can be useful for
-diagnosis and reporting if you can't be sure which handle triggered
-the error. For example, $DBI::lasth->{Type} and $DBI::lasth->{Statement}.
-
-See also L</Transactions>.
-
-If you want to temporarily turn C<RaiseError> off (inside a library function
-that is likely to fail, for example), the recommended way is like this:
-
- {
- local $h->{RaiseError}; # localize and turn off for this block
- ...
- }
-
-The original value will automatically and reliably be restored by Perl,
-regardless of how the block is exited.
-The same logic applies to other attributes, including C<PrintError>.
-
-=head3 C<HandleError>
-
-Type: code ref, inherited
-
-The C<HandleError> attribute can be used to provide your own alternative behaviour
-in case of errors. If set to a reference to a subroutine then that
-subroutine is called when an error is detected (at the same point that
-C<RaiseError> and C<PrintError> are handled).
-
-The subroutine is called with three parameters: the error message
-string that C<RaiseError> and C<PrintError> would use,
-the DBI handle being used, and the first value being returned by
-the method that failed (typically undef).
-
-If the subroutine returns a false value then the C<RaiseError>
-and/or C<PrintError> attributes are checked and acted upon as normal.
-
-For example, to C<die> with a full stack trace for any error:
-
- use Carp;
- $h->{HandleError} = sub { confess(shift) };
-
-Or to turn errors into exceptions:
-
- use Exception; # or your own favourite exception module
- $h->{HandleError} = sub { Exception->new('DBI')->raise($_[0]) };
-
-It is possible to 'stack' multiple HandleError handlers by using
-closures:
-
- sub your_subroutine {
- my $previous_handler = $h->{HandleError};
- $h->{HandleError} = sub {
- return 1 if $previous_handler and &$previous_handler(@_);
- ... your code here ...
- };
- }
-
-Using a C<my> inside a subroutine to store the previous C<HandleError>
-value is important. See L<perlsub> and L<perlref> for more information
-about I<closures>.
-
-It is possible for C<HandleError> to alter the error message that
-will be used by C<RaiseError> and C<PrintError> if it returns false.
-It can do that by altering the value of $_[0]. This example appends
-a stack trace to all errors and, unlike the previous example using
-Carp::confess, this will work C<PrintError> as well as C<RaiseError>:
-
- $h->{HandleError} = sub { $_[0]=Carp::longmess($_[0]); 0; };
-
-It is also possible for C<HandleError> to hide an error, to a limited
-degree, by using L</set_err> to reset $DBI::err and $DBI::errstr,
-and altering the return value of the failed method. For example:
-
- $h->{HandleError} = sub {
- return 0 unless $_[0] =~ /^\S+ fetchrow_arrayref failed:/;
- return 0 unless $_[1]->err == 1234; # the error to 'hide'
- $h->set_err(undef,undef); # turn off the error
- $_[2] = [ ... ]; # supply alternative return value
- return 1;
- };
-
-This only works for methods which return a single value and is hard
-to make reliable (avoiding infinite loops, for example) and so isn't
-recommended for general use! If you find a I<good> use for it then
-please let me know.
-
-=head3 C<HandleSetErr>
-
-Type: code ref, inherited
-
-The C<HandleSetErr> attribute can be used to intercept
-the setting of handle C<err>, C<errstr>, and C<state> values.
-If set to a reference to a subroutine then that subroutine is called
-whenever set_err() is called, typically by the driver or a subclass.
-
-The subroutine is called with five arguments, the first five that
-were passed to set_err(): the handle, the C<err>, C<errstr>, and
-C<state> values being set, and the method name. These can be altered
-by changing the values in the @_ array. The return value affects
-set_err() behaviour, see L</set_err> for details.
-
-It is possible to 'stack' multiple HandleSetErr handlers by using
-closures. See L</HandleError> for an example.
-
-The C<HandleSetErr> and C<HandleError> subroutines differ in subtle
-but significant ways. HandleError is only invoked at the point where
-the DBI is about to return to the application with C<err> set true.
-It's not invoked by the failure of a method that's been called by
-another DBI method. HandleSetErr, on the other hand, is called
-whenever set_err() is called with a defined C<err> value, even if false.
-So it's not just for errors, despite the name, but also warn and info states.
-The set_err() method, and thus HandleSetErr, may be called multiple
-times within a method and is usually invoked from deep within driver code.
-
-In theory a driver can use the return value from HandleSetErr via
-set_err() to decide whether to continue or not. If set_err() returns
-an empty list, indicating that the HandleSetErr code has 'handled'
-the 'error', the driver could then continue instead of failing (if
-that's a reasonable thing to do). This isn't excepted to be
-common and any such cases should be clearly marked in the driver
-documentation and discussed on the dbi-dev mailing list.
-
-The C<HandleSetErr> attribute was added in DBI 1.41.
-
-=head3 C<ErrCount>
-
-Type: unsigned integer
-
-The C<ErrCount> attribute is incremented whenever the set_err()
-method records an error. It isn't incremented by warnings or
-information states. It is not reset by the DBI at any time.
-
-The C<ErrCount> attribute was added in DBI 1.41. Older drivers may
-not have been updated to use set_err() to record errors and so this
-attribute may not be incremented when using them.
-
-
-=head3 C<ShowErrorStatement>
-
-Type: boolean, inherited
-
-The C<ShowErrorStatement> attribute can be used to cause the relevant
-Statement text to be appended to the error messages generated by
-the C<RaiseError>, C<PrintError>, and C<PrintWarn> attributes.
-Only applies to errors on statement handles
-plus the prepare(), do(), and the various C<select*()> database handle methods.
-(The exact format of the appended text is subject to change.)
-
-If C<$h-E<gt>{ParamValues}> returns a hash reference of parameter
-(placeholder) values then those are formatted and appended to the
-end of the Statement text in the error message.
-
-=head3 C<TraceLevel>
-
-Type: integer, inherited
-
-The C<TraceLevel> attribute can be used as an alternative to the
-L</trace> method to set the DBI trace level and trace flags for a
-specific handle. See L</TRACING> for more details.
-
-The C<TraceLevel> attribute is especially useful combined with
-C<local> to alter the trace settings for just a single block of code.
-
-=head3 C<FetchHashKeyName>
-
-Type: string, inherited
-
-The C<FetchHashKeyName> attribute is used to specify whether the fetchrow_hashref()
-method should perform case conversion on the field names used for
-the hash keys. For historical reasons it defaults to 'C<NAME>' but
-it is recommended to set it to 'C<NAME_lc>' (convert to lower case)
-or 'C<NAME_uc>' (convert to upper case) according to your preference.
-It can only be set for driver and database handles. For statement
-handles the value is frozen when prepare() is called.
-
-
-=head3 C<ChopBlanks>
-
-Type: boolean, inherited
-
-The C<ChopBlanks> attribute can be used to control the trimming of trailing space
-characters from fixed width character (CHAR) fields. No other field
-types are affected, even where field values have trailing spaces.
-
-The default is false (although it is possible that the default may change).
-Applications that need specific behaviour should set the attribute as
-needed.
-
-Drivers are not required to support this attribute, but any driver which
-does not support it must arrange to return C<undef> as the attribute value.
-
-
-=head3 C<LongReadLen>
-
-Type: unsigned integer, inherited
-
-The C<LongReadLen> attribute may be used to control the maximum
-length of 'long' type fields (LONG, BLOB, CLOB, MEMO, etc.) which the driver will
-read from the database automatically when it fetches each row of data.
-
-The C<LongReadLen> attribute only relates to fetching and reading
-long values; it is not involved in inserting or updating them.
-
-A value of 0 means not to automatically fetch any long data.
-Drivers may return undef or an empty string for long fields when
-C<LongReadLen> is 0.
-
-The default is typically 0 (zero) or 80 bytes but may vary between drivers.
-Applications fetching long fields should set this value to slightly
-larger than the longest long field value to be fetched.
-
-Some databases return some long types encoded as pairs of hex digits.
-For these types, C<LongReadLen> relates to the underlying data
-length and not the doubled-up length of the encoded string.
-
-Changing the value of C<LongReadLen> for a statement handle after it
-has been C<prepare>'d will typically have no effect, so it's common to
-set C<LongReadLen> on the C<$dbh> before calling C<prepare>.
-
-For most drivers the value used here has a direct effect on the
-memory used by the statement handle while it's active, so don't be
-too generous. If you can't be sure what value to use you could
-execute an extra select statement to determine the longest value.
-For example:
-
- $dbh->{LongReadLen} = $dbh->selectrow_array(qq{
- SELECT MAX(OCTET_LENGTH(long_column_name))
- FROM table WHERE ...
- });
- $sth = $dbh->prepare(qq{
- SELECT long_column_name, ... FROM table WHERE ...
- });
-
-You may need to take extra care if the table can be modified between
-the first select and the second being executed. You may also need to
-use a different function if OCTET_LENGTH() does not work for long
-types in your database. For example, for Sybase use DATALENGTH() and
-for Oracle use LENGTHB().
-
-See also L</LongTruncOk> for information on truncation of long types.
-
-=head3 C<LongTruncOk>
-
-Type: boolean, inherited
-
-The C<LongTruncOk> attribute may be used to control the effect of
-fetching a long field value which has been truncated (typically
-because it's longer than the value of the C<LongReadLen> attribute).
-
-By default, C<LongTruncOk> is false and so fetching a long value that
-needs to be truncated will cause the fetch to fail.
-(Applications should always be sure to
-check for errors after a fetch loop in case an error, such as a divide
-by zero or long field truncation, caused the fetch to terminate
-prematurely.)
-
-If a fetch fails due to a long field truncation when C<LongTruncOk> is
-false, many drivers will allow you to continue fetching further rows.
-
-See also L</LongReadLen>.
-
-=head3 C<TaintIn>
-
-Type: boolean, inherited
-
-If the C<TaintIn> attribute is set to a true value I<and> Perl is running in
-taint mode (e.g., started with the C<-T> option), then all the arguments
-to most DBI method calls are checked for being tainted. I<This may change.>
-
-The attribute defaults to off, even if Perl is in taint mode.
-See L<perlsec> for more about taint mode. If Perl is not
-running in taint mode, this attribute has no effect.
-
-When fetching data that you trust you can turn off the TaintIn attribute,
-for that statement handle, for the duration of the fetch loop.
-
-The C<TaintIn> attribute was added in DBI 1.31.
-
-=head3 C<TaintOut>
-
-Type: boolean, inherited
-
-If the C<TaintOut> attribute is set to a true value I<and> Perl is running in
-taint mode (e.g., started with the C<-T> option), then most data fetched
-from the database is considered tainted. I<This may change.>
-
-The attribute defaults to off, even if Perl is in taint mode.
-See L<perlsec> for more about taint mode. If Perl is not
-running in taint mode, this attribute has no effect.
-
-When fetching data that you trust you can turn off the TaintOut attribute,
-for that statement handle, for the duration of the fetch loop.
-
-Currently only fetched data is tainted. It is possible that the results
-of other DBI method calls, and the value of fetched attributes, may
-also be tainted in future versions. That change may well break your
-applications unless you take great care now. If you use DBI Taint mode,
-please report your experience and any suggestions for changes.
-
-The C<TaintOut> attribute was added in DBI 1.31.
-
-=head3 C<Taint>
-
-Type: boolean, inherited
-
-The C<Taint> attribute is a shortcut for L</TaintIn> and L</TaintOut> (it is also present
-for backwards compatibility).
-
-Setting this attribute sets both L</TaintIn> and L</TaintOut>, and retrieving
-it returns a true value if and only if L</TaintIn> and L</TaintOut> are
-both set to true values.
-
-=head3 C<Profile>
-
-Type: inherited
-
-The C<Profile> attribute enables the collection and reporting of
-method call timing statistics. See the L<DBI::Profile> module
-documentation for I<much> more detail.
-
-The C<Profile> attribute was added in DBI 1.24.
-
-=head3 C<ReadOnly>
-
-Type: boolean, inherited
-
-An application can set the C<ReadOnly> attribute of a handle to a true value to
-indicate that it will not be attempting to make any changes using that handle
-or any children of it.
-
-Note that the exact definition of 'read only' is rather fuzzy.
-For more details see the documentation for the driver you're using.
-
-If the driver can make the handle truly read-only then it should
-(unless doing so would have unpleasant side effect, like changing the
-consistency level from per-statement to per-session).
-Otherwise the attribute is simply advisory.
-
-A driver can set the C<ReadOnly> attribute itself to indicate that the data it
-is connected to cannot be changed for some reason.
-
-If the driver cannot ensure the C<ReadOnly> attribute is adhered to it
-will record a warning. In this case reading the C<ReadOnly> attribute
-back after it is set true will return true even if the underlying
-driver cannot ensure this (so any application knows the application
-declared itself ReadOnly).
-
-Library modules and proxy drivers can use the attribute to influence
-their behavior. For example, the DBD::Gofer driver considers the
-C<ReadOnly> attribute when making a decision about whether to retry an
-operation that failed.
-
-The attribute should be set to 1 or 0 (or undef). Other values are reserved.
-
-=head3 C<Callbacks>
-
-Type: hash ref
-
-The DBI callback mechanism lets you intercept, and optionally replace, any
-method call on a DBI handle. At the extreme, it lets you become a puppet
-master, deceiving the application in any way you want.
-
-The C<Callbacks> attribute is a hash reference where the keys are DBI method
-names and the values are code references. For each key naming a method, the
-DBI will execute the associated code reference before executing the method.
-
-The arguments to the code reference will be the same as to the method,
-including the invocant (a database handle or statement handle). For example,
-say that to callback to some code on a call to C<prepare()>:
-
- $dbh->{Callbacks} = {
- prepare => sub {
- my ($dbh, $query, $attrs) = @_;
- print "Preparing q{$query}\n"
- },
- };
-
-The callback would then be executed when you called the C<prepare()> method:
-
- $dbh->prepare('SELECT 1');
-
-And the output of course would be:
-
- Preparing q{SELECT 1}
-
-Because callbacks are executed I<before> the methods
-they're associated with, you can modify the arguments before they're passed on
-to the method call. For example, to make sure that all calls to C<prepare()>
-are immediately prepared by L<DBD::Pg>, add a callback that makes sure that
-the C<pg_prepare_now> attribute is always set:
-
- my $dbh = DBI->connect($dsn, $username, $auth, {
- Callbacks => {
- prepare => sub {
- $_[2] ||= {};
- $_[2]->{pg_prepare_now} = 1;
- return; # must return nothing
- },
- }
- });
-
-Note that we are editing the contents of C<@_> directly. In this case we've
-created the attributes hash if it's not passed to the C<prepare> call.
-
-You can also prevent the associated method from ever executing. While a
-callback executes, C<$_> holds the method name. (This allows multiple callbacks
-to share the same code reference and still know what method was called.)
-To prevent the method from
-executing, simply C<undef $_>. For example, if you wanted to disable calls to
-C<ping()>, you could do this:
-
- $dbh->{Callbacks} = {
- ping => sub {
- # tell dispatch to not call the method:
- undef $_;
- # return this value instead:
- return "42 bells";
- }
- };
-
-As with other attributes, Callbacks can be specified on a handle or via the
-attributes to C<connect()>. Callbacks can also be applied to a statement
-methods on a statement handle. For example:
-
- $sth->{Callbacks} = {
- execute => sub {
- print "Executing ", shift->{Statement}, "\n";
- }
- };
-
-The C<Callbacks> attribute of a database handle isn't copied to any statement
-handles it creates. So setting callbacks for a statement handle requires you to
-set the C<Callbacks> attribute on the statement handle yourself, as in the
-example above, or use the special C<ChildCallbacks> key described below.
-
-B<Special Keys in Callbacks Attribute>
-
-In addition to DBI handle method names, the C<Callbacks> hash reference
-supports four additional keys.
-
-The first is the C<ChildCallbacks> key. When a statement handle is created from
-a database handle the C<ChildCallbacks> key of the database handle's
-C<Callbacks> attribute, if any, becomes the new C<Callbacks> attribute of the
-statement handle.
-This allows you to define callbacks for all statement handles created from a
-database handle. For example, if you wanted to count how many times C<execute>
-was called in your application, you could write:
-
- my $exec_count = 0;
- my $dbh = DBI->connect( $dsn, $username, $auth, {
- Callbacks => {
- ChildCallbacks => {
- execute => sub { $exec_count++; return; }
- }
- }
- });
-
- END {
- print "The execute method was called $exec_count times\n";
- }
-
-The other three special keys are C<connect_cached.new>,
-C<connect_cached.connected>, and C<connect_cached.reused>. These keys define
-callbacks that are called when C<connect_cached()> is called, but allow
-different behaviors depending on whether a new handle is created or a handle
-is returned. The callback is invoked with these arguments:
-C<$dbh, $dsn, $user, $auth, $attr>.
-
-For example, some applications uses C<connect_cached()> to connect with
-C<AutoCommit> enabled and then disable C<AutoCommit> temporarily for
-transactions. If C<connect_cached()> is called during a transaction, perhaps in
-a utility method, then it might select the same cached handle and then force
-C<AutoCommit> on, forcing a commit of the transaction. See the L</connect_cached>
-documentation for one way to deal with that. Here we'll describe an alternative
-approach using a callback.
-
-Because the C<connect_cached.new> and C<connect_cached.reused> callbacks are
-invoked before C<connect_cached()> has applied the connect attributes, you can
-use them to edit the attributes that will be applied. To prevent a cached
-handle from having its transactions committed before it's returned, you can
-eliminate the C<AutoCommit> attribute in a C<connect_cached.reused> callback,
-like so:
-
- my $cb = {
- 'connect_cached.reused' => sub { delete $_[4]->{AutoCommit} },
- };
-
- sub dbh {
- my $self = shift;
- DBI->connect_cached( $dsn, $username, $auth, {
- PrintError => 0,
- RaiseError => 1,
- AutoCommit => 1,
- Callbacks => $cb,
- });
- }
-
-The upshot is that new database handles are created with C<AutoCommit>
-enabled, while cached database handles are left in whatever transaction state
-they happened to be in when retrieved from the cache.
-
-Note that we've also used a lexical for the callbacks hash reference. This is
-because C<connect_cached()> returns a new database handle if any of the
-attributes passed to is have changed. If we used an inline hash reference,
-C<connect_cached()> would return a new database handle every time. Which would
-rather defeat the purpose.
-
-A more common application for callbacks is setting connection state only when
-a new connection is made (by connect() or connect_cached()). Adding a callback
-to the connected method (when using C<connect>) or via
-C<connect_cached.connected> (when useing connect_cached()>) makes this easy.
-The connected() method is a no-op by default (unless you subclass the DBI and
-change it). The DBI calls it to indicate that a new connection has been made
-and the connection attributes have all been set. You can give it a bit of
-added functionality by applying a callback to it. For example, to make sure
-that MySQL understands your application's ANSI-compliant SQL, set it up like
-so:
-
- my $dbh = DBI->connect($dsn, $username, $auth, {
- Callbacks => {
- connected => sub {
- shift->do(q{
- SET SESSION sql_mode='ansi,strict_trans_tables,no_auto_value_on_zero';
- });
- return;
- },
- }
- });
-
-If you're using C<connect_cached()>, use the C<connect_cached.connected>
-callback, instead. This is because C<connected()> is called for both new and
-reused database handles, but you want to execute a callback only the when a
-new database handle is returned. For example, to set the time zone on
-connection to a PostgreSQL database, try this:
-
- my $cb = {
- 'connect_cached.connected' => sub {
- shift->do('SET timezone = UTC');
- }
- };
-
- sub dbh {
- my $self = shift;
- DBI->connect_cached( $dsn, $username, $auth, { Callbacks => $cb });
- }
-
-One significant limitation with callbacks is that there can only be one per
-method per handle. This means it's easy for one use of callbacks to interfere
-with, or typically simply overwrite, another use of callbacks. For this reason
-modules using callbacks should document the fact clearly so application authors
-can tell if use of callbacks by the module will clash with use of callbacks by
-the application.
-
-You might be able to work around this issue by taking a copy of the original
-callback and calling it within your own. For example:
-
- my $prev_cb = $h->{Callbacks}{method_name};
- $h->{Callbacks}{method_name} = sub {
- if ($prev_cb) {
- my @result = $prev_cb->(@_);
- return @result if not $_; # $prev_cb vetoed call
- }
- ... your callback logic here ...
- };
-
-=head3 C<private_your_module_name_*>
-
-The DBI provides a way to store extra information in a DBI handle as
-"private" attributes. The DBI will allow you to store and retrieve any
-attribute which has a name starting with "C<private_>".
-
-It is I<strongly> recommended that you use just I<one> private
-attribute (e.g., use a hash ref) I<and> give it a long and unambiguous
-name that includes the module or application name that the attribute
-relates to (e.g., "C<private_YourFullModuleName_thingy>").
-
-Because of the way the Perl tie mechanism works you cannot reliably
-use the C<||=> operator directly to initialise the attribute, like this:
-
- my $foo = $dbh->{private_yourmodname_foo} ||= { ... }; # WRONG
-
-you should use a two step approach like this:
-
- my $foo = $dbh->{private_yourmodname_foo};
- $foo ||= $dbh->{private_yourmodname_foo} = { ... };
-
-This attribute is primarily of interest to people sub-classing DBI,
-or for applications to piggy-back extra information onto DBI handles.
-
-=head1 DBI DATABASE HANDLE OBJECTS
-
-This section covers the methods and attributes associated with
-database handles.
-
-=head2 Database Handle Methods
-
-The following methods are specified for DBI database handles:
-
-=head3 C<clone>
-
- $new_dbh = $dbh->clone(\%attr);
-
-The C<clone> method duplicates the $dbh connection by connecting
-with the same parameters ($dsn, $user, $password) as originally used.
-
-The attributes for the cloned connect are the same as those used
-for the I<original> connect, with any other attributes in C<\%attr>
-merged over them. Effectively the same as doing:
-
- %attributes_used = ( %original_attributes, %attr );
-
-If \%attr is not given then it defaults to a hash containing all
-the attributes in the attribute cache of $dbh excluding any non-code
-references, plus the main boolean attributes (RaiseError, PrintError,
-AutoCommit, etc.). I<This behaviour is unreliable and so use of clone without
-an argument is deprecated and may cause a warning in a future release.>
-
-The clone method can be used even if the database handle is disconnected.
-
-The C<clone> method was added in DBI 1.33.
-
-=head3 C<data_sources>
-
- @ary = $dbh->data_sources();
- @ary = $dbh->data_sources(\%attr);
-
-Returns a list of data sources (databases) available via the $dbh
-driver's data_sources() method, plus any extra data sources that
-the driver can discover via the connected $dbh. Typically the extra
-data sources are other databases managed by the same server process
-that the $dbh is connected to.
-
-Data sources are returned in a form suitable for passing to the
-L</connect> method (that is, they will include the "C<dbi:$driver:>" prefix).
-
-The data_sources() method, for a $dbh, was added in DBI 1.38.
-
-=head3 C<do>
-
- $rows = $dbh->do($statement) or die $dbh->errstr;
- $rows = $dbh->do($statement, \%attr) or die $dbh->errstr;
- $rows = $dbh->do($statement, \%attr, @bind_values) or die ...
-
-Prepare and execute a single statement. Returns the number of rows
-affected or C<undef> on error. A return value of C<-1> means the
-number of rows is not known, not applicable, or not available.
-
-This method is typically most useful for I<non>-C<SELECT> statements that
-either cannot be prepared in advance (due to a limitation of the
-driver) or do not need to be executed repeatedly. It should not
-be used for C<SELECT> statements because it does not return a statement
-handle (so you can't fetch any data).
-
-The default C<do> method is logically similar to:
-
- sub do {
- my($dbh, $statement, $attr, @bind_values) = @_;
- my $sth = $dbh->prepare($statement, $attr) or return undef;
- $sth->execute(@bind_values) or return undef;
- my $rows = $sth->rows;
- ($rows == 0) ? "0E0" : $rows; # always return true if no error
- }
-
-For example:
-
- my $rows_deleted = $dbh->do(q{
- DELETE FROM table
- WHERE status = ?
- }, undef, 'DONE') or die $dbh->errstr;
-
-Using placeholders and C<@bind_values> with the C<do> method can be
-useful because it avoids the need to correctly quote any variables
-in the C<$statement>. But if you'll be executing the statement many
-times then it's more efficient to C<prepare> it once and call
-C<execute> many times instead.
-
-The C<q{...}> style quoting used in this example avoids clashing with
-quotes that may be used in the SQL statement. Use the double-quote-like
-C<qq{...}> operator if you want to interpolate variables into the string.
-See L<perlop/"Quote and Quote-like Operators"> for more details.
-
-Note drivers are free to avoid the overhead of creating an DBI
-statement handle for do(), especially if there are no parameters. In
-this case error handlers, if invoked during do(), will be passed the
-database handle.
-
-=head3 C<last_insert_id>
-
- $rv = $dbh->last_insert_id($catalog, $schema, $table, $field);
- $rv = $dbh->last_insert_id($catalog, $schema, $table, $field, \%attr);
-
-Returns a value 'identifying' the row just inserted, if possible.
-Typically this would be a value assigned by the database server
-to a column with an I<auto_increment> or I<serial> type.
-Returns undef if the driver does not support the method or can't
-determine the value.
-
-The $catalog, $schema, $table, and $field parameters may be required
-for some drivers (see below). If you don't know the parameter values
-and your driver does not need them, then use C<undef> for each.
-
-There are several caveats to be aware of with this method if you want
-to use it for portable applications:
-
-B<*> For some drivers the value may only available immediately after
-the insert statement has executed (e.g., mysql, Informix).
-
-B<*> For some drivers the $catalog, $schema, $table, and $field parameters
-are required, for others they are ignored (e.g., mysql).
-
-B<*> Drivers may return an indeterminate value if no insert has
-been performed yet.
-
-B<*> For some drivers the value may only be available if placeholders
-have I<not> been used (e.g., Sybase, MS SQL). In this case the value
-returned would be from the last non-placeholder insert statement.
-
-B<*> Some drivers may need driver-specific hints about how to get
-the value. For example, being told the name of the database 'sequence'
-object that holds the value. Any such hints are passed as driver-specific
-attributes in the \%attr parameter.
-
-B<*> If the underlying database offers nothing better, then some
-drivers may attempt to implement this method by executing
-"C<select max($field) from $table>". Drivers using any approach
-like this should issue a warning if C<AutoCommit> is true because
-it is generally unsafe - another process may have modified the table
-between your insert and the select. For situations where you know
-it is safe, such as when you have locked the table, you can silence
-the warning by passing C<Warn> => 0 in \%attr.
-
-B<*> If no insert has been performed yet, or the last insert failed,
-then the value is implementation defined.
-
-Given all the caveats above, it's clear that this method must be
-used with care.
-
-The C<last_insert_id> method was added in DBI 1.38.
-
-=head3 C<selectrow_array>
-
- @row_ary = $dbh->selectrow_array($statement);
- @row_ary = $dbh->selectrow_array($statement, \%attr);
- @row_ary = $dbh->selectrow_array($statement, \%attr, @bind_values);
-
-This utility method combines L</prepare>, L</execute> and
-L</fetchrow_array> into a single call. If called in a list context, it
-returns the first row of data from the statement. The C<$statement>
-parameter can be a previously prepared statement handle, in which case
-the C<prepare> is skipped.
-
-If any method fails, and L</RaiseError> is not set, C<selectrow_array>
-will return an empty list.
-
-If called in a scalar context for a statement handle that has more
-than one column, it is undefined whether the driver will return
-the value of the first column or the last. So don't do that.
-Also, in a scalar context, an C<undef> is returned if there are no
-more rows or if an error occurred. That C<undef> can't be distinguished
-from an C<undef> returned because the first field value was NULL.
-For these reasons you should exercise some caution if you use
-C<selectrow_array> in a scalar context, or just don't do that.
-
-
-=head3 C<selectrow_arrayref>
-
- $ary_ref = $dbh->selectrow_arrayref($statement);
- $ary_ref = $dbh->selectrow_arrayref($statement, \%attr);
- $ary_ref = $dbh->selectrow_arrayref($statement, \%attr, @bind_values);
-
-This utility method combines L</prepare>, L</execute> and
-L</fetchrow_arrayref> into a single call. It returns the first row of
-data from the statement. The C<$statement> parameter can be a previously
-prepared statement handle, in which case the C<prepare> is skipped.
-
-If any method fails, and L</RaiseError> is not set, C<selectrow_arrayref>
-will return undef.
-
-
-=head3 C<selectrow_hashref>
-
- $hash_ref = $dbh->selectrow_hashref($statement);
- $hash_ref = $dbh->selectrow_hashref($statement, \%attr);
- $hash_ref = $dbh->selectrow_hashref($statement, \%attr, @bind_values);
-
-This utility method combines L</prepare>, L</execute> and
-L</fetchrow_hashref> into a single call. It returns the first row of
-data from the statement. The C<$statement> parameter can be a previously
-prepared statement handle, in which case the C<prepare> is skipped.
-
-If any method fails, and L</RaiseError> is not set, C<selectrow_hashref>
-will return undef.
-
-
-=head3 C<selectall_arrayref>
-
- $ary_ref = $dbh->selectall_arrayref($statement);
- $ary_ref = $dbh->selectall_arrayref($statement, \%attr);
- $ary_ref = $dbh->selectall_arrayref($statement, \%attr, @bind_values);
-
-This utility method combines L</prepare>, L</execute> and
-L</fetchall_arrayref> into a single call. It returns a reference to an
-array containing a reference to an array (or hash, see below) for each row of
-data fetched.
-
-The C<$statement> parameter can be a previously prepared statement handle,
-in which case the C<prepare> is skipped. This is recommended if the
-statement is going to be executed many times.
-
-If L</RaiseError> is not set and any method except C<fetchall_arrayref>
-fails then C<selectall_arrayref> will return C<undef>; if
-C<fetchall_arrayref> fails then it will return with whatever data
-has been fetched thus far. You should check C<$dbh-E<gt>err>
-afterwards (or use the C<RaiseError> attribute) to discover if the data is
-complete or was truncated due to an error.
-
-The L</fetchall_arrayref> method called by C<selectall_arrayref>
-supports a $max_rows parameter. You can specify a value for $max_rows
-by including a 'C<MaxRows>' attribute in \%attr. In which case finish()
-is called for you after fetchall_arrayref() returns.
-
-The L</fetchall_arrayref> method called by C<selectall_arrayref>
-also supports a $slice parameter. You can specify a value for $slice by
-including a 'C<Slice>' or 'C<Columns>' attribute in \%attr. The only
-difference between the two is that if C<Slice> is not defined and
-C<Columns> is an array ref, then the array is assumed to contain column
-index values (which count from 1), rather than perl array index values.
-In which case the array is copied and each value decremented before
-passing to C</fetchall_arrayref>.
-
-You may often want to fetch an array of rows where each row is stored as a
-hash. That can be done simply using:
-
- my $emps = $dbh->selectall_arrayref(
- "SELECT ename FROM emp ORDER BY ename",
- { Slice => {} }
- );
- foreach my $emp ( @$emps ) {
- print "Employee: $emp->{ename}\n";
- }
-
-Or, to fetch into an array instead of an array ref:
-
- @result = @{ $dbh->selectall_arrayref($sql, { Slice => {} }) };
-
-See L</fetchall_arrayref> method for more details.
-
-=head3 C<selectall_array>
-
- @ary = $dbh->selectall_array($statement);
- @ary = $dbh->selectall_array($statement, \%attr);
- @ary = $dbh->selectall_array($statement, \%attr, @bind_values);
-
-This is a convenience wrapper around L<selectall_arrayref> that returns
-the rows directly as a list, rather than a reference to an array of rows.
-
-Note that if L</RaiseError> is not set then you can't tell the difference
-between returning no rows and an error. Using RaiseError is best practice.
-
-=head3 C<selectall_hashref>
-
- $hash_ref = $dbh->selectall_hashref($statement, $key_field);
- $hash_ref = $dbh->selectall_hashref($statement, $key_field, \%attr);
- $hash_ref = $dbh->selectall_hashref($statement, $key_field, \%attr, @bind_values);
-
-This utility method combines L</prepare>, L</execute> and
-L</fetchall_hashref> into a single call. It returns a reference to a
-hash containing one entry, at most, for each row, as returned by fetchall_hashref().
-
-The C<$statement> parameter can be a previously prepared statement handle,
-in which case the C<prepare> is skipped. This is recommended if the
-statement is going to be executed many times.
-
-The C<$key_field> parameter defines which column, or columns, are used as keys
-in the returned hash. It can either be the name of a single field, or a
-reference to an array containing multiple field names. Using multiple names
-yields a tree of nested hashes.
-
-If a row has the same key as an earlier row then it replaces the earlier row.
-
-If any method except C<fetchrow_hashref> fails, and L</RaiseError> is not set,
-C<selectall_hashref> will return C<undef>. If C<fetchrow_hashref> fails and
-L</RaiseError> is not set, then it will return with whatever data it
-has fetched thus far. $DBI::err should be checked to catch that.
-
-See fetchall_hashref() for more details.
-
-=head3 C<selectcol_arrayref>
-
- $ary_ref = $dbh->selectcol_arrayref($statement);
- $ary_ref = $dbh->selectcol_arrayref($statement, \%attr);
- $ary_ref = $dbh->selectcol_arrayref($statement, \%attr, @bind_values);
-
-This utility method combines L</prepare>, L</execute>, and fetching one
-column from all the rows, into a single call. It returns a reference to
-an array containing the values of the first column from each row.
-
-The C<$statement> parameter can be a previously prepared statement handle,
-in which case the C<prepare> is skipped. This is recommended if the
-statement is going to be executed many times.
-
-If any method except C<fetch> fails, and L</RaiseError> is not set,
-C<selectcol_arrayref> will return C<undef>. If C<fetch> fails and
-L</RaiseError> is not set, then it will return with whatever data it
-has fetched thus far. $DBI::err should be checked to catch that.
-
-The C<selectcol_arrayref> method defaults to pushing a single column
-value (the first) from each row into the result array. However, it can
-also push another column, or even multiple columns per row, into the
-result array. This behaviour can be specified via a 'C<Columns>'
-attribute which must be a ref to an array containing the column number
-or numbers to use. For example:
-
- # get array of id and name pairs:
- my $ary_ref = $dbh->selectcol_arrayref("select id, name from table", { Columns=>[1,2] });
- my %hash = @$ary_ref; # build hash from key-value pairs so $hash{$id} => name
-
-You can specify a maximum number of rows to fetch by including a
-'C<MaxRows>' attribute in \%attr.
-
-=head3 C<prepare>
-
- $sth = $dbh->prepare($statement) or die $dbh->errstr;
- $sth = $dbh->prepare($statement, \%attr) or die $dbh->errstr;
-
-Prepares a statement for later execution by the database
-engine and returns a reference to a statement handle object.
-
-The returned statement handle can be used to get attributes of the
-statement and invoke the L</execute> method. See L</Statement Handle Methods>.
-
-Drivers for engines without the concept of preparing a
-statement will typically just store the statement in the returned
-handle and process it when C<$sth-E<gt>execute> is called. Such drivers are
-unlikely to give much useful information about the
-statement, such as C<$sth-E<gt>{NUM_OF_FIELDS}>, until after C<$sth-E<gt>execute>
-has been called. Portable applications should take this into account.
-
-In general, DBI drivers do not parse the contents of the statement
-(other than simply counting any L<Placeholders|/Placeholders and Bind Values>).
-The statement is
-passed directly to the database engine, sometimes known as pass-thru
-mode. This has advantages and disadvantages. On the plus side, you can
-access all the functionality of the engine being used. On the downside,
-you're limited if you're using a simple engine, and you need to take extra care if
-writing applications intended to be portable between engines.
-
-Portable applications should not assume that a new statement can be
-prepared and/or executed while still fetching results from a previous
-statement.
-
-Some command-line SQL tools use statement terminators, like a semicolon,
-to indicate the end of a statement. Such terminators should not normally
-be used with the DBI.
-
-
-=head3 C<prepare_cached>
-
- $sth = $dbh->prepare_cached($statement)
- $sth = $dbh->prepare_cached($statement, \%attr)
- $sth = $dbh->prepare_cached($statement, \%attr, $if_active)
-
-Like L</prepare> except that the statement handle returned will be
-stored in a hash associated with the C<$dbh>. If another call is made to
-C<prepare_cached> with the same C<$statement> and C<%attr> parameter values,
-then the corresponding cached C<$sth> will be returned without contacting the
-database server. Be sure to understand the cautions and caveats noted below.
-
-The C<$if_active> parameter lets you adjust the behaviour if an
-already cached statement handle is still Active. There are several
-alternatives:
-
-=over 4
-
-=item B<0>: A warning will be generated, and finish() will be called on
-the statement handle before it is returned. This is the default
-behaviour if $if_active is not passed.
-
-=item B<1>: finish() will be called on the statement handle, but the
-warning is suppressed.
-
-=item B<2>: Disables any checking.
-
-=item B<3>: The existing active statement handle will be removed from the
-cache and a new statement handle prepared and cached in its place.
-This is the safest option because it doesn't affect the state of the
-old handle, it just removes it from the cache. [Added in DBI 1.40]
-
-=back
-
-Here are some examples of C<prepare_cached>:
-
- sub insert_hash {
- my ($table, $field_values) = @_;
- # sort to keep field order, and thus sql, stable for prepare_cached
- my @fields = sort keys %$field_values;
- my @values = @{$field_values}{@fields};
- my $sql = sprintf "insert into %s (%s) values (%s)",
- $table, join(",", @fields), join(",", ("?")x@fields);
- my $sth = $dbh->prepare_cached($sql);
- return $sth->execute(@values);
- }
-
- sub search_hash {
- my ($table, $field_values) = @_;
- # sort to keep field order, and thus sql, stable for prepare_cached
- my @fields = sort keys %$field_values;
- my @values = @{$field_values}{@fields};
- my $qualifier = "";
- $qualifier = "where ".join(" and ", map { "$_=?" } @fields) if @fields;
- $sth = $dbh->prepare_cached("SELECT * FROM $table $qualifier");
- return $dbh->selectall_arrayref($sth, {}, @values);
- }
-
-I<Caveat emptor:> This caching can be useful in some applications,
-but it can also cause problems and should be used with care. Here
-is a contrived case where caching would cause a significant problem:
-
- my $sth = $dbh->prepare_cached('SELECT * FROM foo WHERE bar=?');
- $sth->execute(...);
- while (my $data = $sth->fetchrow_hashref) {
-
- # later, in some other code called within the loop...
- my $sth2 = $dbh->prepare_cached('SELECT * FROM foo WHERE bar=?');
- $sth2->execute(...);
- while (my $data2 = $sth2->fetchrow_arrayref) {
- do_stuff(...);
- }
- }
-
-In this example, since both handles are preparing the exact same statement,
-C<$sth2> will not be its own statement handle, but a duplicate of C<$sth>
-returned from the cache. The results will certainly not be what you expect.
-Typically the inner fetch loop will work normally, fetching all
-the records and terminating when there are no more, but now that $sth
-is the same as $sth2 the outer fetch loop will also terminate.
-
-You'll know if you run into this problem because prepare_cached()
-will generate a warning by default (when $if_active is false).
-
-The cache used by prepare_cached() is keyed by both the statement
-and any attributes so you can also avoid this issue by doing something
-like:
-
- $sth = $dbh->prepare_cached("...", { dbi_dummy => __FILE__.__LINE__ });
-
-which will ensure that prepare_cached only returns statements cached
-by that line of code in that source file.
-
-Also, to ensure the attributes passed are always the same, avoid passing
-references inline. For example, the Slice attribute is specified as a
-reference. Be sure to declare it external to the call to prepare_cached(), such
-that a new hash reference is not created on every call. See L</connect_cached>
-for more details and examples.
-
-If you'd like the cache to managed intelligently, you can tie the
-hashref returned by C<CachedKids> to an appropriate caching module,
-such as L<Tie::Cache::LRU>:
-
- my $cache;
- tie %$cache, 'Tie::Cache::LRU', 500;
- $dbh->{CachedKids} = $cache;
-
-=head3 C<commit>
-
- $rc = $dbh->commit or die $dbh->errstr;
-
-Commit (make permanent) the most recent series of database changes
-if the database supports transactions and AutoCommit is off.
-
-If C<AutoCommit> is on, then calling
-C<commit> will issue a "commit ineffective with AutoCommit" warning.
-
-See also L</Transactions> in the L</FURTHER INFORMATION> section below.
-
-=head3 C<rollback>
-
- $rc = $dbh->rollback or die $dbh->errstr;
-
-Rollback (undo) the most recent series of uncommitted database
-changes if the database supports transactions and AutoCommit is off.
-
-If C<AutoCommit> is on, then calling
-C<rollback> will issue a "rollback ineffective with AutoCommit" warning.
-
-See also L</Transactions> in the L</FURTHER INFORMATION> section below.
-
-=head3 C<begin_work>
-
- $rc = $dbh->begin_work or die $dbh->errstr;
-
-Enable transactions (by turning C<AutoCommit> off) until the next call
-to C<commit> or C<rollback>. After the next C<commit> or C<rollback>,
-C<AutoCommit> will automatically be turned on again.
-
-If C<AutoCommit> is already off when C<begin_work> is called then
-it does nothing except return an error. If the driver does not support
-transactions then when C<begin_work> attempts to set C<AutoCommit> off
-the driver will trigger a fatal error.
-
-See also L</Transactions> in the L</FURTHER INFORMATION> section below.
-
-
-=head3 C<disconnect>
-
- $rc = $dbh->disconnect or warn $dbh->errstr;
-
-Disconnects the database from the database handle. C<disconnect> is typically only used
-before exiting the program. The handle is of little use after disconnecting.
-
-The transaction behaviour of the C<disconnect> method is, sadly,
-undefined. Some database systems (such as Oracle and Ingres) will
-automatically commit any outstanding changes, but others (such as
-Informix) will rollback any outstanding changes. Applications not
-using C<AutoCommit> should explicitly call C<commit> or C<rollback> before
-calling C<disconnect>.
-
-The database is automatically disconnected by the C<DESTROY> method if
-still connected when there are no longer any references to the handle.
-The C<DESTROY> method for each driver should implicitly call C<rollback> to
-undo any uncommitted changes. This is vital behaviour to ensure that
-incomplete transactions don't get committed simply because Perl calls
-C<DESTROY> on every object before exiting. Also, do not rely on the order
-of object destruction during "global destruction", as it is undefined.
-
-Generally, if you want your changes to be committed or rolled back when
-you disconnect, then you should explicitly call L</commit> or L</rollback>
-before disconnecting.
-
-If you disconnect from a database while you still have active
-statement handles (e.g., SELECT statement handles that may have
-more data to fetch), you will get a warning. The warning may indicate
-that a fetch loop terminated early, perhaps due to an uncaught error.
-To avoid the warning call the C<finish> method on the active handles.
-
-
-=head3 C<ping>
-
- $rc = $dbh->ping;
-
-Attempts to determine, in a reasonably efficient way, if the database
-server is still running and the connection to it is still working.
-Individual drivers should implement this function in the most suitable
-manner for their database engine.
-
-The current I<default> implementation always returns true without
-actually doing anything. Actually, it returns "C<0 but true>" which is
-true but zero. That way you can tell if the return value is genuine or
-just the default. Drivers should override this method with one that
-does the right thing for their type of database.
-
-Few applications would have direct use for this method. See the specialized
-Apache::DBI module for one example usage.
-
-
-=head3 C<get_info>
-
- $value = $dbh->get_info( $info_type );
-
-Returns information about the implementation, i.e. driver and data
-source capabilities, restrictions etc. It returns C<undef> for
-unknown or unimplemented information types. For example:
-
- $database_version = $dbh->get_info( 18 ); # SQL_DBMS_VER
- $max_select_tables = $dbh->get_info( 106 ); # SQL_MAXIMUM_TABLES_IN_SELECT
-
-See L</"Standards Reference Information"> for more detailed information
-about the information types and their meanings and possible return values.
-
-The L<DBI::Const::GetInfoType> module exports a %GetInfoType hash that
-can be used to map info type names to numbers. For example:
-
- $database_version = $dbh->get_info( $GetInfoType{SQL_DBMS_VER} );
-
-The names are a merging of the ANSI and ODBC standards (which differ
-in some cases). See L<DBI::Const::GetInfoType> for more details.
-
-Because some DBI methods make use of get_info(), drivers are strongly
-encouraged to support I<at least> the following very minimal set
-of information types to ensure the DBI itself works properly:
-
- Type Name Example A Example B
- ---- -------------------------- ------------ ----------------
- 17 SQL_DBMS_NAME 'ACCESS' 'Oracle'
- 18 SQL_DBMS_VER '03.50.0000' '08.01.0721 ...'
- 29 SQL_IDENTIFIER_QUOTE_CHAR '`' '"'
- 41 SQL_CATALOG_NAME_SEPARATOR '.' '@'
- 114 SQL_CATALOG_LOCATION 1 2
-
-Values from 9000 to 9999 for get_info are officially reserved for use by Perl DBI.
-Values in that range which have been assigned a meaning are defined here:
-
-C<9000>: true if a backslash character (C<\>) before placeholder-like text
-(e.g. C<?>, C<:foo>) will prevent it being treated as a placeholder by the driver.
-The backslash will be removed before the text is passed to the backend.
-
-=head3 C<table_info>
-
- $sth = $dbh->table_info( $catalog, $schema, $table, $type );
- $sth = $dbh->table_info( $catalog, $schema, $table, $type, \%attr );
-
- # then $sth->fetchall_arrayref or $sth->fetchall_hashref etc
-
-Returns an active statement handle that can be used to fetch
-information about tables and views that exist in the database.
-
-The arguments $catalog, $schema and $table may accept search patterns
-according to the database/driver, for example: $table = '%FOO%';
-Remember that the underscore character ('C<_>') is a search pattern
-that means match any character, so 'FOO_%' is the same as 'FOO%'
-and 'FOO_BAR%' will match names like 'FOO1BAR'.
-
-The value of $type is a comma-separated list of one or more types of
-tables to be returned in the result set. Each value may optionally be
-quoted, e.g.:
-
- $type = "TABLE";
- $type = "'TABLE','VIEW'";
-
-In addition the following special cases may also be supported by some drivers:
-
-=over 4
-
-=item *
-If the value of $catalog is '%' and $schema and $table name
-are empty strings, the result set contains a list of catalog names.
-For example:
-
- $sth = $dbh->table_info('%', '', '');
-
-=item *
-If the value of $schema is '%' and $catalog and $table are empty
-strings, the result set contains a list of schema names.
-
-=item *
-If the value of $type is '%' and $catalog, $schema, and $table are all
-empty strings, the result set contains a list of table types.
-
-=back
-
-If your driver doesn't support one or more of the selection filter
-parameters then you may get back more than you asked for and can
-do the filtering yourself.
-
-This method can be expensive, and can return a large amount of data.
-(For example, small Oracle installation returns over 2000 rows.)
-So it's a good idea to use the filters to limit the data as much as possible.
-
-The statement handle returned has at least the following fields in the
-order show below. Other fields, after these, may also be present.
-
-B<TABLE_CAT>: Table catalog identifier. This field is NULL (C<undef>) if not
-applicable to the data source, which is usually the case. This field
-is empty if not applicable to the table.
-
-B<TABLE_SCHEM>: The name of the schema containing the TABLE_NAME value.
-This field is NULL (C<undef>) if not applicable to data source, and
-empty if not applicable to the table.
-
-B<TABLE_NAME>: Name of the table (or view, synonym, etc).
-
-B<TABLE_TYPE>: One of the following: "TABLE", "VIEW", "SYSTEM TABLE",
-"GLOBAL TEMPORARY", "LOCAL TEMPORARY", "ALIAS", "SYNONYM" or a type
-identifier that is specific to the data
-source.
-
-B<REMARKS>: A description of the table. May be NULL (C<undef>).
-
-Note that C<table_info> might not return records for all tables.
-Applications can use any valid table regardless of whether it's
-returned by C<table_info>.
-
-See also L</tables>, L</"Catalog Methods"> and
-L</"Standards Reference Information">.
-
-=head3 C<column_info>
-
- $sth = $dbh->column_info( $catalog, $schema, $table, $column );
-
- # then $sth->fetchall_arrayref or $sth->fetchall_hashref etc
-
-Returns an active statement handle that can be used to fetch
-information about columns in specified tables.
-
-The arguments $schema, $table and $column may accept search patterns
-according to the database/driver, for example: $table = '%FOO%';
-
-Note: The support for the selection criteria is driver specific. If the
-driver doesn't support one or more of them then you may get back more
-than you asked for and can do the filtering yourself.
-
-Note: If your driver does not support column_info an undef is
-returned. This is distinct from asking for something which does not
-exist in a driver which supports column_info as a valid statement
-handle to an empty result-set will be returned in this case.
-
-If the arguments don't match any tables then you'll still get a statement
-handle, it'll just return no rows.
-
-The statement handle returned has at least the following fields in the
-order shown below. Other fields, after these, may also be present.
-
-B<TABLE_CAT>: The catalog identifier.
-This field is NULL (C<undef>) if not applicable to the data source,
-which is often the case. This field is empty if not applicable to the
-table.
-
-B<TABLE_SCHEM>: The schema identifier.
-This field is NULL (C<undef>) if not applicable to the data source,
-and empty if not applicable to the table.
-
-B<TABLE_NAME>: The table identifier.
-Note: A driver may provide column metadata not only for base tables, but
-also for derived objects like SYNONYMS etc.
-
-B<COLUMN_NAME>: The column identifier.
-
-B<DATA_TYPE>: The concise data type code.
-
-B<TYPE_NAME>: A data source dependent data type name.
-
-B<COLUMN_SIZE>: The column size.
-This is the maximum length in characters for character data types,
-the number of digits or bits for numeric data types or the length
-in the representation of temporal types.
-See the relevant specifications for detailed information.
-
-B<BUFFER_LENGTH>: The length in bytes of transferred data.
-
-B<DECIMAL_DIGITS>: The total number of significant digits to the right of
-the decimal point.
-
-B<NUM_PREC_RADIX>: The radix for numeric precision.
-The value is 10 or 2 for numeric data types and NULL (C<undef>) if not
-applicable.
-
-B<NULLABLE>: Indicates if a column can accept NULLs.
-The following values are defined:
-
- SQL_NO_NULLS 0
- SQL_NULLABLE 1
- SQL_NULLABLE_UNKNOWN 2
-
-B<REMARKS>: A description of the column.
-
-B<COLUMN_DEF>: The default value of the column, in a format that can be used
-directly in an SQL statement.
-
-Note that this may be an expression and not simply the text used for the
-default value in the original CREATE TABLE statement. For example, given:
-
- col1 char(30) default current_user -- a 'function'
- col2 char(30) default 'string' -- a string literal
-
-where "current_user" is the name of a function, the corresponding C<COLUMN_DEF>
-values would be:
-
- Database col1 col2
- -------- ---- ----
- Oracle: current_user 'string'
- Postgres: "current_user"() 'string'::text
- MS SQL: (user_name()) ('string')
-
-B<SQL_DATA_TYPE>: The SQL data type.
-
-B<SQL_DATETIME_SUB>: The subtype code for datetime and interval data types.
-
-B<CHAR_OCTET_LENGTH>: The maximum length in bytes of a character or binary
-data type column.
-
-B<ORDINAL_POSITION>: The column sequence number (starting with 1).
-
-B<IS_NULLABLE>: Indicates if the column can accept NULLs.
-Possible values are: 'NO', 'YES' and ''.
-
-SQL/CLI defines the following additional columns:
-
- CHAR_SET_CAT
- CHAR_SET_SCHEM
- CHAR_SET_NAME
- COLLATION_CAT
- COLLATION_SCHEM
- COLLATION_NAME
- UDT_CAT
- UDT_SCHEM
- UDT_NAME
- DOMAIN_CAT
- DOMAIN_SCHEM
- DOMAIN_NAME
- SCOPE_CAT
- SCOPE_SCHEM
- SCOPE_NAME
- MAX_CARDINALITY
- DTD_IDENTIFIER
- IS_SELF_REF
-
-Drivers capable of supplying any of those values should do so in
-the corresponding column and supply undef values for the others.
-
-Drivers wishing to provide extra database/driver specific information
-should do so in extra columns beyond all those listed above, and
-use lowercase field names with the driver-specific prefix (i.e.,
-'ora_...'). Applications accessing such fields should do so by name
-and not by column number.
-
-The result set is ordered by TABLE_CAT, TABLE_SCHEM, TABLE_NAME
-and ORDINAL_POSITION.
-
-Note: There is some overlap with statement handle attributes (in perl) and
-SQLDescribeCol (in ODBC). However, SQLColumns provides more metadata.
-
-See also L</"Catalog Methods"> and L</"Standards Reference Information">.
-
-=head3 C<primary_key_info>
-
- $sth = $dbh->primary_key_info( $catalog, $schema, $table );
-
- # then $sth->fetchall_arrayref or $sth->fetchall_hashref etc
-
-Returns an active statement handle that can be used to fetch information
-about columns that make up the primary key for a table.
-The arguments don't accept search patterns (unlike table_info()).
-
-The statement handle will return one row per column, ordered by
-TABLE_CAT, TABLE_SCHEM, TABLE_NAME, and KEY_SEQ.
-If there is no primary key then the statement handle will fetch no rows.
-
-Note: The support for the selection criteria, such as $catalog, is
-driver specific. If the driver doesn't support catalogs and/or
-schemas, it may ignore these criteria.
-
-The statement handle returned has at least the following fields in the
-order shown below. Other fields, after these, may also be present.
-
-B<TABLE_CAT>: The catalog identifier.
-This field is NULL (C<undef>) if not applicable to the data source,
-which is often the case. This field is empty if not applicable to the
-table.
-
-B<TABLE_SCHEM>: The schema identifier.
-This field is NULL (C<undef>) if not applicable to the data source,
-and empty if not applicable to the table.
-
-B<TABLE_NAME>: The table identifier.
-
-B<COLUMN_NAME>: The column identifier.
-
-B<KEY_SEQ>: The column sequence number (starting with 1).
-Note: This field is named B<ORDINAL_POSITION> in SQL/CLI.
-
-B<PK_NAME>: The primary key constraint identifier.
-This field is NULL (C<undef>) if not applicable to the data source.
-
-See also L</"Catalog Methods"> and L</"Standards Reference Information">.
-
-=head3 C<primary_key>
-
- @key_column_names = $dbh->primary_key( $catalog, $schema, $table );
-
-Simple interface to the primary_key_info() method. Returns a list of
-the column names that comprise the primary key of the specified table.
-The list is in primary key column sequence order.
-If there is no primary key then an empty list is returned.
-
-=head3 C<foreign_key_info>
-
- $sth = $dbh->foreign_key_info( $pk_catalog, $pk_schema, $pk_table
- , $fk_catalog, $fk_schema, $fk_table );
-
- $sth = $dbh->foreign_key_info( $pk_catalog, $pk_schema, $pk_table
- , $fk_catalog, $fk_schema, $fk_table
- , \%attr );
-
- # then $sth->fetchall_arrayref or $sth->fetchall_hashref etc
-
-Returns an active statement handle that can be used to fetch information
-about foreign keys in and/or referencing the specified table(s).
-The arguments don't accept search patterns (unlike table_info()).
-
-C<$pk_catalog>, C<$pk_schema>, C<$pk_table>
-identify the primary (unique) key table (B<PKT>).
-
-C<$fk_catalog>, C<$fk_schema>, C<$fk_table>
-identify the foreign key table (B<FKT>).
-
-If both B<PKT> and B<FKT> are given, the function returns the foreign key, if
-any, in table B<FKT> that refers to the primary (unique) key of table B<PKT>.
-(Note: In SQL/CLI, the result is implementation-defined.)
-
-If only B<PKT> is given, then the result set contains the primary key
-of that table and all foreign keys that refer to it.
-
-If only B<FKT> is given, then the result set contains all foreign keys
-in that table and the primary keys to which they refer.
-(Note: In SQL/CLI, the result includes unique keys too.)
-
-For example:
-
- $sth = $dbh->foreign_key_info( undef, $user, 'master');
- $sth = $dbh->foreign_key_info( undef, undef, undef , undef, $user, 'detail');
- $sth = $dbh->foreign_key_info( undef, $user, 'master', undef, $user, 'detail');
-
- # then $sth->fetchall_arrayref or $sth->fetchall_hashref etc
-
-Note: The support for the selection criteria, such as C<$catalog>, is
-driver specific. If the driver doesn't support catalogs and/or
-schemas, it may ignore these criteria.
-
-The statement handle returned has the following fields in the order shown below.
-Because ODBC never includes unique keys, they define different columns in the
-result set than SQL/CLI. SQL/CLI column names are shown in parentheses.
-
-B<PKTABLE_CAT ( UK_TABLE_CAT )>:
-The primary (unique) key table catalog identifier.
-This field is NULL (C<undef>) if not applicable to the data source,
-which is often the case. This field is empty if not applicable to the
-table.
-
-B<PKTABLE_SCHEM ( UK_TABLE_SCHEM )>:
-The primary (unique) key table schema identifier.
-This field is NULL (C<undef>) if not applicable to the data source,
-and empty if not applicable to the table.
-
-B<PKTABLE_NAME ( UK_TABLE_NAME )>:
-The primary (unique) key table identifier.
-
-B<PKCOLUMN_NAME (UK_COLUMN_NAME )>:
-The primary (unique) key column identifier.
-
-B<FKTABLE_CAT ( FK_TABLE_CAT )>:
-The foreign key table catalog identifier.
-This field is NULL (C<undef>) if not applicable to the data source,
-which is often the case. This field is empty if not applicable to the
-table.
-
-B<FKTABLE_SCHEM ( FK_TABLE_SCHEM )>:
-The foreign key table schema identifier.
-This field is NULL (C<undef>) if not applicable to the data source,
-and empty if not applicable to the table.
-
-B<FKTABLE_NAME ( FK_TABLE_NAME )>:
-The foreign key table identifier.
-
-B<FKCOLUMN_NAME ( FK_COLUMN_NAME )>:
-The foreign key column identifier.
-
-B<KEY_SEQ ( ORDINAL_POSITION )>:
-The column sequence number (starting with 1).
-
-B<UPDATE_RULE ( UPDATE_RULE )>:
-The referential action for the UPDATE rule.
-The following codes are defined:
-
- CASCADE 0
- RESTRICT 1
- SET NULL 2
- NO ACTION 3
- SET DEFAULT 4
-
-B<DELETE_RULE ( DELETE_RULE )>:
-The referential action for the DELETE rule.
-The codes are the same as for UPDATE_RULE.
-
-B<FK_NAME ( FK_NAME )>:
-The foreign key name.
-
-B<PK_NAME ( UK_NAME )>:
-The primary (unique) key name.
-
-B<DEFERRABILITY ( DEFERABILITY )>:
-The deferrability of the foreign key constraint.
-The following codes are defined:
-
- INITIALLY DEFERRED 5
- INITIALLY IMMEDIATE 6
- NOT DEFERRABLE 7
-
-B< ( UNIQUE_OR_PRIMARY )>:
-This column is necessary if a driver includes all candidate (i.e. primary and
-alternate) keys in the result set (as specified by SQL/CLI).
-The value of this column is UNIQUE if the foreign key references an alternate
-key and PRIMARY if the foreign key references a primary key, or it
-may be undefined if the driver doesn't have access to the information.
-
-See also L</"Catalog Methods"> and L</"Standards Reference Information">.
-
-=head3 C<statistics_info>
-
-B<Warning:> This method is experimental and may change.
-
- $sth = $dbh->statistics_info( $catalog, $schema, $table, $unique_only, $quick );
-
- # then $sth->fetchall_arrayref or $sth->fetchall_hashref etc
-
-Returns an active statement handle that can be used to fetch statistical
-information about a table and its indexes.
-
-The arguments don't accept search patterns (unlike L</table_info>).
-
-If the boolean argument $unique_only is true, only UNIQUE indexes will be
-returned in the result set, otherwise all indexes will be returned.
-
-If the boolean argument $quick is set, the actual statistical information
-columns (CARDINALITY and PAGES) will only be returned if they are readily
-available from the server, and might not be current. Some databases may
-return stale statistics or no statistics at all with this flag set.
-
-The statement handle will return at most one row per column name per index,
-plus at most one row for the entire table itself, ordered by NON_UNIQUE, TYPE,
-INDEX_QUALIFIER, INDEX_NAME, and ORDINAL_POSITION.
-
-Note: The support for the selection criteria, such as $catalog, is
-driver specific. If the driver doesn't support catalogs and/or
-schemas, it may ignore these criteria.
-
-The statement handle returned has at least the following fields in the
-order shown below. Other fields, after these, may also be present.
-
-B<TABLE_CAT>: The catalog identifier.
-This field is NULL (C<undef>) if not applicable to the data source,
-which is often the case. This field is empty if not applicable to the
-table.
-
-B<TABLE_SCHEM>: The schema identifier.
-This field is NULL (C<undef>) if not applicable to the data source,
-and empty if not applicable to the table.
-
-B<TABLE_NAME>: The table identifier.
-
-B<NON_UNIQUE>: Unique index indicator.
-Returns 0 for unique indexes, 1 for non-unique indexes
-
-B<INDEX_QUALIFIER>: Index qualifier identifier.
-The identifier that is used to qualify the index name when doing a
-C<DROP INDEX>; NULL (C<undef>) is returned if an index qualifier is not
-supported by the data source.
-If a non-NULL (defined) value is returned in this column, it must be used
-to qualify the index name on a C<DROP INDEX> statement; otherwise,
-the TABLE_SCHEM should be used to qualify the index name.
-
-B<INDEX_NAME>: The index identifier.
-
-B<TYPE>: The type of information being returned. Can be any of the
-following values: 'table', 'btree', 'clustered', 'content', 'hashed',
-or 'other'.
-
-In the case that this field is 'table', all fields
-other than TABLE_CAT, TABLE_SCHEM, TABLE_NAME, TYPE,
-CARDINALITY, and PAGES will be NULL (C<undef>).
-
-B<ORDINAL_POSITION>: Column sequence number (starting with 1).
-
-B<COLUMN_NAME>: The column identifier.
-
-B<ASC_OR_DESC>: Column sort sequence.
-C<A> for Ascending, C<D> for Descending, or NULL (C<undef>) if
-not supported for this index.
-
-B<CARDINALITY>: Cardinality of the table or index.
-For indexes, this is the number of unique values in the index.
-For tables, this is the number of rows in the table.
-If not supported, the value will be NULL (C<undef>).
-
-B<PAGES>: Number of storage pages used by this table or index.
-If not supported, the value will be NULL (C<undef>).
-
-B<FILTER_CONDITION>: The index filter condition as a string.
-If the index is not a filtered index, or it cannot be determined
-whether the index is a filtered index, this value is NULL (C<undef>).
-If the index is a filtered index, but the filter condition
-cannot be determined, this value is the empty string C<''>.
-Otherwise it will be the literal filter condition as a string,
-such as C<SALARY <= 4500>.
-
-See also L</"Catalog Methods"> and L</"Standards Reference Information">.
-
-=head3 C<tables>
-
- @names = $dbh->tables( $catalog, $schema, $table, $type );
- @names = $dbh->tables; # deprecated
-
-Simple interface to table_info(). Returns a list of matching
-table names, possibly including a catalog/schema prefix.
-
-See L</table_info> for a description of the parameters.
-
-If C<$dbh-E<gt>get_info(29)> returns true (29 is SQL_IDENTIFIER_QUOTE_CHAR)
-then the table names are constructed and quoted by L</quote_identifier>
-to ensure they are usable even if they contain whitespace or reserved
-words etc. This means that the table names returned will include
-quote characters.
-
-=head3 C<type_info_all>
-
- $type_info_all = $dbh->type_info_all;
-
-Returns a reference to an array which holds information about each data
-type variant supported by the database and driver. The array and its
-contents should be treated as read-only.
-
-The first item is a reference to an 'index' hash of C<Name =>E<gt> C<Index> pairs.
-The items following that are references to arrays, one per supported data
-type variant. The leading index hash defines the names and order of the
-fields within the arrays that follow it.
-For example:
-
- $type_info_all = [
- { TYPE_NAME => 0,
- DATA_TYPE => 1,
- COLUMN_SIZE => 2, # was PRECISION originally
- LITERAL_PREFIX => 3,
- LITERAL_SUFFIX => 4,
- CREATE_PARAMS => 5,
- NULLABLE => 6,
- CASE_SENSITIVE => 7,
- SEARCHABLE => 8,
- UNSIGNED_ATTRIBUTE=> 9,
- FIXED_PREC_SCALE => 10, # was MONEY originally
- AUTO_UNIQUE_VALUE => 11, # was AUTO_INCREMENT originally
- LOCAL_TYPE_NAME => 12,
- MINIMUM_SCALE => 13,
- MAXIMUM_SCALE => 14,
- SQL_DATA_TYPE => 15,
- SQL_DATETIME_SUB => 16,
- NUM_PREC_RADIX => 17,
- INTERVAL_PRECISION=> 18,
- },
- [ 'VARCHAR', SQL_VARCHAR,
- undef, "'","'", undef,0, 1,1,0,0,0,undef,1,255, undef
- ],
- [ 'INTEGER', SQL_INTEGER,
- undef, "", "", undef,0, 0,1,0,0,0,undef,0, 0, 10
- ],
- ];
-
-More than one row may have the same value in the C<DATA_TYPE>
-field if there are different ways to spell the type name and/or there
-are variants of the type with different attributes (e.g., with and
-without C<AUTO_UNIQUE_VALUE> set, with and without C<UNSIGNED_ATTRIBUTE>, etc).
-
-The rows are ordered by C<DATA_TYPE> first and then by how closely each
-type maps to the corresponding ODBC SQL data type, closest first.
-
-The meaning of the fields is described in the documentation for
-the L</type_info> method.
-
-An 'index' hash is provided so you don't need to rely on index
-values defined above. However, using DBD::ODBC with some old ODBC
-drivers may return older names, shown as comments in the example above.
-Another issue with the index hash is that the lettercase of the
-keys is not defined. It is usually uppercase, as show here, but
-drivers may return names with any lettercase.
-
-Drivers are also free to return extra driver-specific columns of
-information - though it's recommended that they start at column
-index 50 to leave room for expansion of the DBI/ODBC specification.
-
-The type_info_all() method is not normally used directly.
-The L</type_info> method provides a more usable and useful interface
-to the data.
-
-=head3 C<type_info>
-
- @type_info = $dbh->type_info($data_type);
-
-Returns a list of hash references holding information about one or more
-variants of $data_type. The list is ordered by C<DATA_TYPE> first and
-then by how closely each type maps to the corresponding ODBC SQL data
-type, closest first. If called in a scalar context then only the first
-(best) element is returned.
-
-If $data_type is undefined or C<SQL_ALL_TYPES>, then the list will
-contain hashes for all data type variants supported by the database and driver.
-
-If $data_type is an array reference then C<type_info> returns the
-information for the I<first> type in the array that has any matches.
-
-The keys of the hash follow the same letter case conventions as the
-rest of the DBI (see L</Naming Conventions and Name Space>). The
-following uppercase items should always exist, though may be undef:
-
-=over 4
-
-=item TYPE_NAME (string)
-
-Data type name for use in CREATE TABLE statements etc.
-
-=item DATA_TYPE (integer)
-
-SQL data type number.
-
-=item COLUMN_SIZE (integer)
-
-For numeric types, this is either the total number of digits (if the
-NUM_PREC_RADIX value is 10) or the total number of bits allowed in the
-column (if NUM_PREC_RADIX is 2).
-
-For string types, this is the maximum size of the string in characters.
-
-For date and interval types, this is the maximum number of characters
-needed to display the value.
-
-=item LITERAL_PREFIX (string)
-
-Characters used to prefix a literal. A typical prefix is "C<'>" for characters,
-or possibly "C<0x>" for binary values passed as hexadecimal. NULL (C<undef>) is
-returned for data types for which this is not applicable.
-
-
-=item LITERAL_SUFFIX (string)
-
-Characters used to suffix a literal. Typically "C<'>" for characters.
-NULL (C<undef>) is returned for data types where this is not applicable.
-
-=item CREATE_PARAMS (string)
-
-Parameter names for data type definition. For example, C<CREATE_PARAMS> for a
-C<DECIMAL> would be "C<precision,scale>" if the DECIMAL type should be
-declared as C<DECIMAL(>I<precision,scale>C<)> where I<precision> and I<scale>
-are integer values. For a C<VARCHAR> it would be "C<max length>".
-NULL (C<undef>) is returned for data types for which this is not applicable.
-
-=item NULLABLE (integer)
-
-Indicates whether the data type accepts a NULL value:
-C<0> or an empty string = no, C<1> = yes, C<2> = unknown.
-
-=item CASE_SENSITIVE (boolean)
-
-Indicates whether the data type is case sensitive in collations and
-comparisons.
-
-=item SEARCHABLE (integer)
-
-Indicates how the data type can be used in a WHERE clause, as
-follows:
-
- 0 - Cannot be used in a WHERE clause
- 1 - Only with a LIKE predicate
- 2 - All comparison operators except LIKE
- 3 - Can be used in a WHERE clause with any comparison operator
-
-=item UNSIGNED_ATTRIBUTE (boolean)
-
-Indicates whether the data type is unsigned. NULL (C<undef>) is returned
-for data types for which this is not applicable.
-
-=item FIXED_PREC_SCALE (boolean)
-
-Indicates whether the data type always has the same precision and scale
-(such as a money type). NULL (C<undef>) is returned for data types
-for which
-this is not applicable.
-
-=item AUTO_UNIQUE_VALUE (boolean)
-
-Indicates whether a column of this data type is automatically set to a
-unique value whenever a new row is inserted. NULL (C<undef>) is returned
-for data types for which this is not applicable.
-
-=item LOCAL_TYPE_NAME (string)
-
-Localized version of the C<TYPE_NAME> for use in dialog with users.
-NULL (C<undef>) is returned if a localized name is not available (in which
-case C<TYPE_NAME> should be used).
-
-=item MINIMUM_SCALE (integer)
-
-The minimum scale of the data type. If a data type has a fixed scale,
-then C<MAXIMUM_SCALE> holds the same value. NULL (C<undef>) is returned for
-data types for which this is not applicable.
-
-=item MAXIMUM_SCALE (integer)
-
-The maximum scale of the data type. If a data type has a fixed scale,
-then C<MINIMUM_SCALE> holds the same value. NULL (C<undef>) is returned for
-data types for which this is not applicable.
-
-=item SQL_DATA_TYPE (integer)
-
-This column is the same as the C<DATA_TYPE> column, except for interval
-and datetime data types. For interval and datetime data types, the
-C<SQL_DATA_TYPE> field will return C<SQL_INTERVAL> or C<SQL_DATETIME>, and the
-C<SQL_DATETIME_SUB> field below will return the subcode for the specific
-interval or datetime data type. If this field is NULL, then the driver
-does not support or report on interval or datetime subtypes.
-
-=item SQL_DATETIME_SUB (integer)
-
-For interval or datetime data types, where the C<SQL_DATA_TYPE>
-field above is C<SQL_INTERVAL> or C<SQL_DATETIME>, this field will
-hold the I<subcode> for the specific interval or datetime data type.
-Otherwise it will be NULL (C<undef>).
-
-Although not mentioned explicitly in the standards, it seems there
-is a simple relationship between these values:
-
- DATA_TYPE == (10 * SQL_DATA_TYPE) + SQL_DATETIME_SUB
-
-=item NUM_PREC_RADIX (integer)
-
-The radix value of the data type. For approximate numeric types,
-C<NUM_PREC_RADIX>
-contains the value 2 and C<COLUMN_SIZE> holds the number of bits. For
-exact numeric types, C<NUM_PREC_RADIX> contains the value 10 and C<COLUMN_SIZE> holds
-the number of decimal digits. NULL (C<undef>) is returned either for data types
-for which this is not applicable or if the driver cannot report this information.
-
-=item INTERVAL_PRECISION (integer)
-
-The interval leading precision for interval types. NULL is returned
-either for data types for which this is not applicable or if the driver
-cannot report this information.
-
-=back
-
-For example, to find the type name for the fields in a select statement
-you can do:
-
- @names = map { scalar $dbh->type_info($_)->{TYPE_NAME} } @{ $sth->{TYPE} }
-
-Since DBI and ODBC drivers vary in how they map their types into the
-ISO standard types you may need to search for more than one type.
-Here's an example looking for a usable type to store a date:
-
- $my_date_type = $dbh->type_info( [ SQL_DATE, SQL_TIMESTAMP ] );
-
-Similarly, to more reliably find a type to store small integers, you could
-use a list starting with C<SQL_SMALLINT>, C<SQL_INTEGER>, C<SQL_DECIMAL>, etc.
-
-See also L</"Standards Reference Information">.
-
-
-=head3 C<quote>
-
- $sql = $dbh->quote($value);
- $sql = $dbh->quote($value, $data_type);
-
-Quote a string literal for use as a literal value in an SQL statement,
-by escaping any special characters (such as quotation marks)
-contained within the string and adding the required type of outer
-quotation marks.
-
- $sql = sprintf "SELECT foo FROM bar WHERE baz = %s",
- $dbh->quote("Don't");
-
-For most database types, at least those that conform to SQL standards, quote
-would return C<'Don''t'> (including the outer quotation marks). For others it
-may return something like C<'Don\'t'>
-
-An undefined C<$value> value will be returned as the string C<NULL> (without
-single quotation marks) to match how NULLs are represented in SQL.
-
-If C<$data_type> is supplied, it is used to try to determine the required
-quoting behaviour by using the information returned by L</type_info>.
-As a special case, the standard numeric types are optimized to return
-C<$value> without calling C<type_info>.
-
-Quote will probably I<not> be able to deal with all possible input
-(such as binary data or data containing newlines), and is not related in
-any way with escaping or quoting shell meta-characters.
-
-It is valid for the quote() method to return an SQL expression that
-evaluates to the desired string. For example:
-
- $quoted = $dbh->quote("one\ntwo\0three")
-
-may return something like:
-
- CONCAT('one', CHAR(12), 'two', CHAR(0), 'three')
-
-The quote() method should I<not> be used with L</"Placeholders and
-Bind Values">.
-
-=head3 C<quote_identifier>
-
- $sql = $dbh->quote_identifier( $name );
- $sql = $dbh->quote_identifier( $catalog, $schema, $table, \%attr );
-
-Quote an identifier (table name etc.) for use in an SQL statement,
-by escaping any special characters (such as double quotation marks)
-it contains and adding the required type of outer quotation marks.
-
-Undefined names are ignored and the remainder are quoted and then
-joined together, typically with a dot (C<.>) character. For example:
-
- $id = $dbh->quote_identifier( undef, 'Her schema', 'My table' );
-
-would, for most database types, return C<"Her schema"."My table">
-(including all the double quotation marks).
-
-If three names are supplied then the first is assumed to be a
-catalog name and special rules may be applied based on what L</get_info>
-returns for SQL_CATALOG_NAME_SEPARATOR (41) and SQL_CATALOG_LOCATION (114).
-For example, for Oracle:
-
- $id = $dbh->quote_identifier( 'link', 'schema', 'table' );
-
-would return C<"schema"."table"@"link">.
-
-=head3 C<take_imp_data>
-
- $imp_data = $dbh->take_imp_data;
-
-Leaves the $dbh in an almost dead, zombie-like, state and returns
-a binary string of raw implementation data from the driver which
-describes the current database connection. Effectively it detaches
-the underlying database API connection data from the DBI handle.
-After calling take_imp_data(), all other methods except C<DESTROY>
-will generate a warning and return undef.
-
-Why would you want to do this? You don't, forget I even mentioned it.
-Unless, that is, you're implementing something advanced like a
-multi-threaded connection pool. See L<DBI::Pool>.
-
-The returned $imp_data can be passed as a C<dbi_imp_data> attribute
-to a later connect() call, even in a separate thread in the same
-process, where the driver can use it to 'adopt' the existing
-connection that the implementation data was taken from.
-
-Some things to keep in mind...
-
-B<*> the $imp_data holds the only reference to the underlying
-database API connection data. That connection is still 'live' and
-won't be cleaned up properly unless the $imp_data is used to create
-a new $dbh which is then allowed to disconnect() normally.
-
-B<*> using the same $imp_data to create more than one other new
-$dbh at a time may well lead to unpleasant problems. Don't do that.
-
-Any child statement handles are effectively destroyed when take_imp_data() is
-called.
-
-The C<take_imp_data> method was added in DBI 1.36 but wasn't useful till 1.49.
-
-
-=head2 Database Handle Attributes
-
-This section describes attributes specific to database handles.
-
-Changes to these database handle attributes do not affect any other
-existing or future database handles.
-
-Attempting to set or get the value of an unknown attribute generates a warning,
-except for private driver-specific attributes (which all have names
-starting with a lowercase letter).
-
-Example:
-
- $h->{AutoCommit} = ...; # set/write
- ... = $h->{AutoCommit}; # get/read
-
-=head3 C<AutoCommit>
-
-Type: boolean
-
-If true, then database changes cannot be rolled-back (undone). If false,
-then database changes automatically occur within a "transaction", which
-must either be committed or rolled back using the C<commit> or C<rollback>
-methods.
-
-Drivers should always default to C<AutoCommit> mode (an unfortunate
-choice largely forced on the DBI by ODBC and JDBC conventions.)
-
-Attempting to set C<AutoCommit> to an unsupported value is a fatal error.
-This is an important feature of the DBI. Applications that need
-full transaction behaviour can set C<$dbh-E<gt>{AutoCommit} = 0> (or
-set C<AutoCommit> to 0 via L</connect>)
-without having to check that the value was assigned successfully.
-
-For the purposes of this description, we can divide databases into three
-categories:
-
- Databases which don't support transactions at all.
- Databases in which a transaction is always active.
- Databases in which a transaction must be explicitly started (C<'BEGIN WORK'>).
-
-B<* Databases which don't support transactions at all>
-
-For these databases, attempting to turn C<AutoCommit> off is a fatal error.
-C<commit> and C<rollback> both issue warnings about being ineffective while
-C<AutoCommit> is in effect.
-
-B<* Databases in which a transaction is always active>
-
-These are typically mainstream commercial relational databases with
-"ANSI standard" transaction behaviour.
-If C<AutoCommit> is off, then changes to the database won't have any
-lasting effect unless L</commit> is called (but see also
-L</disconnect>). If L</rollback> is called then any changes since the
-last commit are undone.
-
-If C<AutoCommit> is on, then the effect is the same as if the DBI
-called C<commit> automatically after every successful database
-operation. So calling C<commit> or C<rollback> explicitly while
-C<AutoCommit> is on would be ineffective because the changes would
-have already been committed.
-
-Changing C<AutoCommit> from off to on will trigger a L</commit>.
-
-For databases which don't support a specific auto-commit mode, the
-driver has to commit each statement automatically using an explicit
-C<COMMIT> after it completes successfully (and roll it back using an
-explicit C<ROLLBACK> if it fails). The error information reported to the
-application will correspond to the statement which was executed, unless
-it succeeded and the commit or rollback failed.
-
-B<* Databases in which a transaction must be explicitly started>
-
-For these databases, the intention is to have them act like databases in
-which a transaction is always active (as described above).
-
-To do this, the driver will automatically begin an explicit transaction
-when C<AutoCommit> is turned off, or after a L</commit> or
-L</rollback> (or when the application issues the next database
-operation after one of those events).
-
-In this way, the application does not have to treat these databases
-as a special case.
-
-See L</commit>, L</disconnect> and L</Transactions> for other important
-notes about transactions.
-
-
-=head3 C<Driver>
-
-Type: handle
-
-Holds the handle of the parent driver. The only recommended use for this
-is to find the name of the driver using:
-
- $dbh->{Driver}->{Name}
-
-
-=head3 C<Name>
-
-Type: string
-
-Holds the "name" of the database. Usually (and recommended to be) the
-same as the "C<dbi:DriverName:...>" string used to connect to the database,
-but with the leading "C<dbi:DriverName:>" removed.
-
-
-=head3 C<Statement>
-
-Type: string, read-only
-
-Returns the statement string passed to the most recent L</prepare> or
-L</do> method called in this database handle, even if that method
-failed. This is especially useful where C<RaiseError> is enabled and
-the exception handler checks $@ and sees that a 'prepare' method call
-failed.
-
-
-=head3 C<RowCacheSize>
-
-Type: integer
-
-A hint to the driver indicating the size of the local row cache that the
-application would like the driver to use for future C<SELECT> statements.
-If a row cache is not implemented, then setting C<RowCacheSize> is ignored
-and getting the value returns C<undef>.
-
-Some C<RowCacheSize> values have special meaning, as follows:
-
- 0 - Automatically determine a reasonable cache size for each C<SELECT>
- 1 - Disable the local row cache
- >1 - Cache this many rows
- <0 - Cache as many rows that will fit into this much memory for each C<SELECT>.
-
-Note that large cache sizes may require a very large amount of memory
-(I<cached rows * maximum size of row>). Also, a large cache will cause
-a longer delay not only for the first fetch, but also whenever the
-cache needs refilling.
-
-See also the L</RowsInCache> statement handle attribute.
-
-=head3 C<Username>
-
-Type: string
-
-Returns the username used to connect to the database.
-
-
-=head1 DBI STATEMENT HANDLE OBJECTS
-
-This section lists the methods and attributes associated with DBI
-statement handles.
-
-=head2 Statement Handle Methods
-
-The DBI defines the following methods for use on DBI statement handles:
-
-=head3 C<bind_param>
-
- $sth->bind_param($p_num, $bind_value)
- $sth->bind_param($p_num, $bind_value, \%attr)
- $sth->bind_param($p_num, $bind_value, $bind_type)
-
-The C<bind_param> method takes a copy of $bind_value and associates it
-(binds it) with a placeholder, identified by $p_num, embedded in
-the prepared statement. Placeholders are indicated with question
-mark character (C<?>). For example:
-
- $dbh->{RaiseError} = 1; # save having to check each method call
- $sth = $dbh->prepare("SELECT name, age FROM people WHERE name LIKE ?");
- $sth->bind_param(1, "John%"); # placeholders are numbered from 1
- $sth->execute;
- DBI::dump_results($sth);
-
-See L</Placeholders and Bind Values> for more information.
-
-
-B<Data Types for Placeholders>
-
-The C<\%attr> parameter can be used to hint at the data type the
-placeholder should have. This is rarely needed. Typically, the driver is only
-interested in knowing if the placeholder should be bound as a number or a string.
-
- $sth->bind_param(1, $value, { TYPE => SQL_INTEGER });
-
-As a short-cut for the common case, the data type can be passed
-directly, in place of the C<\%attr> hash reference. This example is
-equivalent to the one above:
-
- $sth->bind_param(1, $value, SQL_INTEGER);
-
-The C<TYPE> value indicates the standard (non-driver-specific) type for
-this parameter. To specify the driver-specific type, the driver may
-support a driver-specific attribute, such as C<{ ora_type =E<gt> 97 }>.
-
-The SQL_INTEGER and other related constants can be imported using
-
- use DBI qw(:sql_types);
-
-See L</"DBI Constants"> for more information.
-
-The data type is 'sticky' in that bind values passed to execute() are bound
-with the data type specified by earlier bind_param() calls, if any.
-Portable applications should not rely on being able to change the data type
-after the first C<bind_param> call.
-
-Perl only has string and number scalar data types. All database types
-that aren't numbers are bound as strings and must be in a format the
-database will understand except where the bind_param() TYPE attribute
-specifies a type that implies a particular format. For example, given:
-
- $sth->bind_param(1, $value, SQL_DATETIME);
-
-the driver should expect $value to be in the ODBC standard SQL_DATETIME
-format, which is 'YYYY-MM-DD HH:MM:SS'. Similarly for SQL_DATE, SQL_TIME etc.
-
-As an alternative to specifying the data type in the C<bind_param> call,
-you can let the driver pass the value as the default type (C<VARCHAR>).
-You can then use an SQL function to convert the type within the statement.
-For example:
-
- INSERT INTO price(code, price) VALUES (?, CONVERT(MONEY,?))
-
-The C<CONVERT> function used here is just an example. The actual function
-and syntax will vary between different databases and is non-portable.
-
-See also L</Placeholders and Bind Values> for more information.
-
-
-=head3 C<bind_param_inout>
-
- $rc = $sth->bind_param_inout($p_num, \$bind_value, $max_len) or die $sth->errstr;
- $rv = $sth->bind_param_inout($p_num, \$bind_value, $max_len, \%attr) or ...
- $rv = $sth->bind_param_inout($p_num, \$bind_value, $max_len, $bind_type) or ...
-
-This method acts like L</bind_param>, but also enables values to be
-updated by the statement. The statement is typically
-a call to a stored procedure. The C<$bind_value> must be passed as a
-reference to the actual value to be used.
-
-Note that unlike L</bind_param>, the C<$bind_value> variable is not
-copied when C<bind_param_inout> is called. Instead, the value in the
-variable is read at the time L</execute> is called.
-
-The additional C<$max_len> parameter specifies the minimum amount of
-memory to allocate to C<$bind_value> for the new value. If the value
-returned from the database is too
-big to fit, then the execution should fail. If unsure what value to use,
-pick a generous length, i.e., a length larger than the longest value that would ever be
-returned. The only cost of using a larger value than needed is wasted memory.
-
-Undefined values or C<undef> are used to indicate null values.
-See also L</Placeholders and Bind Values> for more information.
-
-
-=head3 C<bind_param_array>
-
- $rc = $sth->bind_param_array($p_num, $array_ref_or_value)
- $rc = $sth->bind_param_array($p_num, $array_ref_or_value, \%attr)
- $rc = $sth->bind_param_array($p_num, $array_ref_or_value, $bind_type)
-
-The C<bind_param_array> method is used to bind an array of values
-to a placeholder embedded in the prepared statement which is to be executed
-with L</execute_array>. For example:
-
- $dbh->{RaiseError} = 1; # save having to check each method call
- $sth = $dbh->prepare("INSERT INTO staff (first_name, last_name, dept) VALUES(?, ?, ?)");
- $sth->bind_param_array(1, [ 'John', 'Mary', 'Tim' ]);
- $sth->bind_param_array(2, [ 'Booth', 'Todd', 'Robinson' ]);
- $sth->bind_param_array(3, "SALES"); # scalar will be reused for each row
- $sth->execute_array( { ArrayTupleStatus => \my @tuple_status } );
-
-The C<%attr> ($bind_type) argument is the same as defined for L</bind_param>.
-Refer to L</bind_param> for general details on using placeholders.
-
-(Note that bind_param_array() can I<not> be used to expand a
-placeholder into a list of values for a statement like "SELECT foo
-WHERE bar IN (?)". A placeholder can only ever represent one value
-per execution.)
-
-Scalar values, including C<undef>, may also be bound by
-C<bind_param_array>. In which case the same value will be used for each
-L</execute> call. Driver-specific implementations may behave
-differently, e.g., when binding to a stored procedure call, some
-databases may permit mixing scalars and arrays as arguments.
-
-The default implementation provided by DBI (for drivers that have
-not implemented array binding) is to iteratively call L</execute> for
-each parameter tuple provided in the bound arrays. Drivers may
-provide more optimized implementations using whatever bulk operation
-support the database API provides. The default driver behaviour should
-match the default DBI behaviour, but always consult your driver
-documentation as there may be driver specific issues to consider.
-
-Note that the default implementation currently only supports non-data
-returning statements (INSERT, UPDATE, but not SELECT). Also,
-C<bind_param_array> and L</bind_param> cannot be mixed in the same
-statement execution, and C<bind_param_array> must be used with
-L</execute_array>; using C<bind_param_array> will have no effect
-for L</execute>.
-
-The C<bind_param_array> method was added in DBI 1.22.
-
-=head3 C<execute>
-
- $rv = $sth->execute or die $sth->errstr;
- $rv = $sth->execute(@bind_values) or die $sth->errstr;
-
-Perform whatever processing is necessary to execute the prepared
-statement. An C<undef> is returned if an error occurs. A successful
-C<execute> always returns true regardless of the number of rows affected,
-even if it's zero (see below). It is always important to check the
-return status of C<execute> (and most other DBI methods) for errors
-if you're not using L</RaiseError>.
-
-For a I<non>-C<SELECT> statement, C<execute> returns the number of rows
-affected, if known. If no rows were affected, then C<execute> returns
-"C<0E0>", which Perl will treat as 0 but will regard as true. Note that it
-is I<not> an error for no rows to be affected by a statement. If the
-number of rows affected is not known, then C<execute> returns -1.
-
-For C<SELECT> statements, execute simply "starts" the query within the
-database engine. Use one of the fetch methods to retrieve the data after
-calling C<execute>. The C<execute> method does I<not> return the number of
-rows that will be returned by the query (because most databases can't
-tell in advance), it simply returns a true value.
-
-You can tell if the statement was a C<SELECT> statement by checking if
-C<$sth-E<gt>{NUM_OF_FIELDS}> is greater than zero after calling C<execute>.
-
-If any arguments are given, then C<execute> will effectively call
-L</bind_param> for each value before executing the statement. Values
-bound in this way are usually treated as C<SQL_VARCHAR> types unless
-the driver can determine the correct type (which is rare), or unless
-C<bind_param> (or C<bind_param_inout>) has already been used to
-specify the type.
-
-Note that passing C<execute> an empty array is the same as passing no arguments
-at all, which will execute the statement with previously bound values.
-That's probably not what you want.
-
-If execute() is called on a statement handle that's still active
-($sth->{Active} is true) then it should effectively call finish()
-to tidy up the previous execution results before starting this new
-execution.
-
-=head3 C<execute_array>
-
- $tuples = $sth->execute_array(\%attr) or die $sth->errstr;
- $tuples = $sth->execute_array(\%attr, @bind_values) or die $sth->errstr;
-
- ($tuples, $rows) = $sth->execute_array(\%attr) or die $sth->errstr;
- ($tuples, $rows) = $sth->execute_array(\%attr, @bind_values) or die $sth->errstr;
-
-Execute the prepared statement once for each parameter tuple
-(group of values) provided either in the @bind_values, or by prior
-calls to L</bind_param_array>, or via a reference passed in \%attr.
-
-When called in scalar context the execute_array() method returns the
-number of tuples executed, or C<undef> if an error occurred. Like
-execute(), a successful execute_array() always returns true regardless
-of the number of tuples executed, even if it's zero. If there were any
-errors the ArrayTupleStatus array can be used to discover which tuples
-failed and with what errors.
-
-When called in list context the execute_array() method returns two scalars;
-$tuples is the same as calling execute_array() in scalar context and $rows is
-the number of rows affected for each tuple, if available or
--1 if the driver cannot determine this. NOTE, some drivers cannot determine
-the number of rows affected per tuple but can provide the number of rows
-affected for the batch.
-If you are doing an update operation the returned rows affected may not be what
-you expect if, for instance, one or more of the tuples affected the same row
-multiple times. Some drivers may not yet support list context, in which case
-$rows will be undef, or may not be able to provide the number of rows affected
-when performing this batch operation, in which case $rows will be -1.
-
-Bind values for the tuples to be executed may be supplied row-wise
-by an C<ArrayTupleFetch> attribute, or else column-wise in the
-C<@bind_values> argument, or else column-wise by prior calls to
-L</bind_param_array>.
-
-Where column-wise binding is used (via the C<@bind_values> argument
-or calls to bind_param_array()) the maximum number of elements in
-any one of the bound value arrays determines the number of tuples
-executed. Placeholders with fewer values in their parameter arrays
-are treated as if padded with undef (NULL) values.
-
-If a scalar value is bound, instead of an array reference, it is
-treated as a I<variable> length array with all elements having the
-same value. It does not influence the number of tuples executed,
-so if all bound arrays have zero elements then zero tuples will
-be executed. If I<all> bound values are scalars then one tuple
-will be executed, making execute_array() act just like execute().
-
-The C<ArrayTupleFetch> attribute can be used to specify a reference
-to a subroutine that will be called to provide the bind values for
-each tuple execution. The subroutine should return an reference to
-an array which contains the appropriate number of bind values, or
-return an undef if there is no more data to execute.
-
-As a convenience, the C<ArrayTupleFetch> attribute can also be
-used to specify a statement handle. In which case the fetchrow_arrayref()
-method will be called on the given statement handle in order to
-provide the bind values for each tuple execution.
-
-The values specified via bind_param_array() or the @bind_values
-parameter may be either scalars, or arrayrefs. If any C<@bind_values>
-are given, then C<execute_array> will effectively call L</bind_param_array>
-for each value before executing the statement. Values bound in
-this way are usually treated as C<SQL_VARCHAR> types unless the
-driver can determine the correct type (which is rare), or unless
-C<bind_param>, C<bind_param_inout>, C<bind_param_array>, or
-C<bind_param_inout_array> has already been used to specify the type.
-See L</bind_param_array> for details.
-
-The C<ArrayTupleStatus> attribute can be used to specify a
-reference to an array which will receive the execute status of each
-executed parameter tuple. Note the C<ArrayTupleStatus> attribute was
-mandatory until DBI 1.38.
-
-For tuples which are successfully executed, the element at the same
-ordinal position in the status array is the resulting rowcount (or -1
-if unknown).
-If the execution of a tuple causes an error, then the corresponding
-status array element will be set to a reference to an array containing
-L</err>, L</errstr> and L</state> set by the failed execution.
-
-If B<any> tuple execution returns an error, C<execute_array> will
-return C<undef>. In that case, the application should inspect the
-status array to determine which parameter tuples failed.
-Some databases may not continue executing tuples beyond the first
-failure. In this case the status array will either hold fewer
-elements, or the elements beyond the failure will be undef.
-
-If all parameter tuples are successfully executed, C<execute_array>
-returns the number tuples executed. If no tuples were executed,
-then execute_array() returns "C<0E0>", just like execute() does,
-which Perl will treat as 0 but will regard as true.
-
-For example:
-
- $sth = $dbh->prepare("INSERT INTO staff (first_name, last_name) VALUES (?, ?)");
- my $tuples = $sth->execute_array(
- { ArrayTupleStatus => \my @tuple_status },
- \@first_names,
- \@last_names,
- );
- if ($tuples) {
- print "Successfully inserted $tuples records\n";
- }
- else {
- for my $tuple (0..@last_names-1) {
- my $status = $tuple_status[$tuple];
- $status = [0, "Skipped"] unless defined $status;
- next unless ref $status;
- printf "Failed to insert (%s, %s): %s\n",
- $first_names[$tuple], $last_names[$tuple], $status->[1];
- }
- }
-
-Support for data returning statements such as SELECT is driver-specific
-and subject to change. At present, the default implementation
-provided by DBI only supports non-data returning statements.
-
-Transaction semantics when using array binding are driver and
-database specific. If C<AutoCommit> is on, the default DBI
-implementation will cause each parameter tuple to be individually
-committed (or rolled back in the event of an error). If C<AutoCommit>
-is off, the application is responsible for explicitly committing
-the entire set of bound parameter tuples. Note that different
-drivers and databases may have different behaviours when some
-parameter tuples cause failures. In some cases, the driver or
-database may automatically rollback the effect of all prior parameter
-tuples that succeeded in the transaction; other drivers or databases
-may retain the effect of prior successfully executed parameter
-tuples. Be sure to check your driver and database for its specific
-behaviour.
-
-Note that, in general, performance will usually be better with
-C<AutoCommit> turned off, and using explicit C<commit> after each
-C<execute_array> call.
-
-The C<execute_array> method was added in DBI 1.22, and ArrayTupleFetch
-was added in 1.36.
-
-=head3 C<execute_for_fetch>
-
- $tuples = $sth->execute_for_fetch($fetch_tuple_sub);
- $tuples = $sth->execute_for_fetch($fetch_tuple_sub, \@tuple_status);
-
- ($tuples, $rows) = $sth->execute_for_fetch($fetch_tuple_sub);
- ($tuples, $rows) = $sth->execute_for_fetch($fetch_tuple_sub, \@tuple_status);
-
-The execute_for_fetch() method is used to perform bulk operations and
-although it is most often used via the execute_array() method you can
-use it directly. The main difference between execute_array and
-execute_for_fetch is the former does column or row-wise binding and
-the latter uses row-wise binding.
-
-The fetch subroutine, referenced by $fetch_tuple_sub, is expected
-to return a reference to an array (known as a 'tuple') or undef.
-
-The execute_for_fetch() method calls $fetch_tuple_sub, without any
-parameters, until it returns a false value. Each tuple returned is
-used to provide bind values for an $sth->execute(@$tuple) call.
-
-In scalar context execute_for_fetch() returns C<undef> if there were any
-errors and the number of tuples executed otherwise. Like execute() and
-execute_array() a zero is returned as "0E0" so execute_for_fetch() is
-only false on error. If there were any errors the @tuple_status array
-can be used to discover which tuples failed and with what errors.
-
-When called in list context execute_for_fetch() returns two scalars;
-$tuples is the same as calling execute_for_fetch() in scalar context and $rows is
-the sum of the number of rows affected for each tuple, if available or -1
-if the driver cannot determine this.
-If you are doing an update operation the returned rows affected may not be what
-you expect if, for instance, one or more of the tuples affected the same row
-multiple times. Some drivers may not yet support list context, in which case
-$rows will be undef, or may not be able to provide the number of rows affected
-when performing this batch operation, in which case $rows will be -1.
-
-If \@tuple_status is passed then the execute_for_fetch method uses
-it to return status information. The tuple_status array holds one
-element per tuple. If the corresponding execute() did not fail then
-the element holds the return value from execute(), which is typically
-a row count. If the execute() did fail then the element holds a
-reference to an array containing ($sth->err, $sth->errstr, $sth->state).
-
-If the driver detects an error that it knows means no further tuples can be
-executed then it may return, with an error status, even though $fetch_tuple_sub
-may still have more tuples to be executed.
-
-Although each tuple returned by $fetch_tuple_sub is effectively used
-to call $sth->execute(@$tuple_array_ref) the exact timing may vary.
-Drivers are free to accumulate sets of tuples to pass to the
-database server in bulk group operations for more efficient execution.
-However, the $fetch_tuple_sub is specifically allowed to return
-the same array reference each time (which is what fetchrow_arrayref()
-usually does).
-
-For example:
-
- my $sel = $dbh1->prepare("select foo, bar from table1");
- $sel->execute;
-
- my $ins = $dbh2->prepare("insert into table2 (foo, bar) values (?,?)");
- my $fetch_tuple_sub = sub { $sel->fetchrow_arrayref };
-
- my @tuple_status;
- $rc = $ins->execute_for_fetch($fetch_tuple_sub, \@tuple_status);
- my @errors = grep { ref $_ } @tuple_status;
-
-Similarly, if you already have an array containing the data rows
-to be processed you'd use a subroutine to shift off and return
-each array ref in turn:
-
- $ins->execute_for_fetch( sub { shift @array_of_arrays }, \@tuple_status);
-
-The C<execute_for_fetch> method was added in DBI 1.38.
-
-
-=head3 C<fetchrow_arrayref>
-
- $ary_ref = $sth->fetchrow_arrayref;
- $ary_ref = $sth->fetch; # alias
-
-Fetches the next row of data and returns a reference to an array
-holding the field values. Null fields are returned as C<undef>
-values in the array.
-This is the fastest way to fetch data, particularly if used with
-C<$sth-E<gt>bind_columns>.
-
-If there are no more rows or if an error occurs, then C<fetchrow_arrayref>
-returns an C<undef>. You should check C<$sth-E<gt>err> afterwards (or use the
-C<RaiseError> attribute) to discover if the C<undef> returned was due to an
-error.
-
-Note that the same array reference is returned for each fetch, so don't
-store the reference and then use it after a later fetch. Also, the
-elements of the array are also reused for each row, so take care if you
-want to take a reference to an element. See also L</bind_columns>.
-
-=head3 C<fetchrow_array>
-
- @ary = $sth->fetchrow_array;
-
-An alternative to C<fetchrow_arrayref>. Fetches the next row of data
-and returns it as a list containing the field values. Null fields
-are returned as C<undef> values in the list.
-
-If there are no more rows or if an error occurs, then C<fetchrow_array>
-returns an empty list. You should check C<$sth-E<gt>err> afterwards (or use
-the C<RaiseError> attribute) to discover if the empty list returned was
-due to an error.
-
-If called in a scalar context for a statement handle that has more
-than one column, it is undefined whether the driver will return
-the value of the first column or the last. So don't do that.
-Also, in a scalar context, an C<undef> is returned if there are no
-more rows or if an error occurred. That C<undef> can't be distinguished
-from an C<undef> returned because the first field value was NULL.
-For these reasons you should exercise some caution if you use
-C<fetchrow_array> in a scalar context.
-
-=head3 C<fetchrow_hashref>
-
- $hash_ref = $sth->fetchrow_hashref;
- $hash_ref = $sth->fetchrow_hashref($name);
-
-An alternative to C<fetchrow_arrayref>. Fetches the next row of data
-and returns it as a reference to a hash containing field name and field
-value pairs. Null fields are returned as C<undef> values in the hash.
-
-If there are no more rows or if an error occurs, then C<fetchrow_hashref>
-returns an C<undef>. You should check C<$sth-E<gt>err> afterwards (or use the
-C<RaiseError> attribute) to discover if the C<undef> returned was due to an
-error.
-
-The optional C<$name> parameter specifies the name of the statement handle
-attribute. For historical reasons it defaults to "C<NAME>", however using
-either "C<NAME_lc>" or "C<NAME_uc>" is recommended for portability.
-
-The keys of the hash are the same names returned by C<$sth-E<gt>{$name}>. If
-more than one field has the same name, there will only be one entry in the
-returned hash for those fields, so statements like "C<select foo, foo from bar>"
-will return only a single key from C<fetchrow_hashref>. In these cases use
-column aliases or C<fetchrow_arrayref>. Note that it is the database server
-(and not the DBD implementation) which provides the I<name> for fields
-containing functions like "C<count(*)>" or "C<max(c_foo)>" and they may clash
-with existing column names (most databases don't care about duplicate column
-names in a result-set). If you want these to return as unique names that are
-the same across databases, use I<aliases>, as in "C<select count(*) as cnt>"
-or "C<select max(c_foo) mx_foo, ...>" depending on the syntax your database
-supports.
-
-Because of the extra work C<fetchrow_hashref> and Perl have to perform, it
-is not as efficient as C<fetchrow_arrayref> or C<fetchrow_array>.
-
-By default a reference to a new hash is returned for each row.
-It is likely that a future version of the DBI will support an
-attribute which will enable the same hash to be reused for each
-row. This will give a significant performance boost, but it won't
-be enabled by default because of the risk of breaking old code.
-
-
-=head3 C<fetchall_arrayref>
-
- $tbl_ary_ref = $sth->fetchall_arrayref;
- $tbl_ary_ref = $sth->fetchall_arrayref( $slice );
- $tbl_ary_ref = $sth->fetchall_arrayref( $slice, $max_rows );
-
-The C<fetchall_arrayref> method can be used to fetch all the data to be
-returned from a prepared and executed statement handle. It returns a
-reference to an array that contains one reference per row.
-
-If called on an I<inactive> statement handle, C<fetchall_arrayref> returns undef.
-
-If there are no rows left to return from an I<active> statement handle, C<fetchall_arrayref> returns a reference
-to an empty array. If an error occurs, C<fetchall_arrayref> returns the
-data fetched thus far, which may be none. You should check C<$sth-E<gt>err>
-afterwards (or use the C<RaiseError> attribute) to discover if the data is
-complete or was truncated due to an error.
-
-If $slice is an array reference, C<fetchall_arrayref> uses L</fetchrow_arrayref>
-to fetch each row as an array ref. If the $slice array is not empty
-then it is used as a slice to select individual columns by perl array
-index number (starting at 0, unlike column and parameter numbers which
-start at 1).
-
-With no parameters, or if $slice is undefined, C<fetchall_arrayref>
-acts as if passed an empty array ref.
-
-For example, to fetch just the first column of every row:
-
- $tbl_ary_ref = $sth->fetchall_arrayref([0]);
-
-To fetch the second to last and last column of every row:
-
- $tbl_ary_ref = $sth->fetchall_arrayref([-2,-1]);
-
-Those two examples both return a reference to an array of array refs.
-
-If $slice is a hash reference, C<fetchall_arrayref> fetches each row as a hash
-reference. If the $slice hash is empty then the keys in the hashes have
-whatever name lettercase is returned by default. (See L</FetchHashKeyName>
-attribute.) If the $slice hash is I<not> empty, then it is used as a slice to
-select individual columns by name. The values of the hash should be set to 1.
-The key names of the returned hashes match the letter case of the names in the
-parameter hash, regardless of the L</FetchHashKeyName> attribute.
-
-For example, to fetch all fields of every row as a hash ref:
-
- $tbl_ary_ref = $sth->fetchall_arrayref({});
-
-To fetch only the fields called "foo" and "bar" of every row as a hash ref
-(with keys named "foo" and "BAR", regardless of the original capitalization):
-
- $tbl_ary_ref = $sth->fetchall_arrayref({ foo=>1, BAR=>1 });
-
-Those two examples both return a reference to an array of hash refs.
-
-If $slice is a I<reference to a hash reference>, that hash is used to select
-and rename columns. The keys are 0-based column index numbers and the values
-are the corresponding keys for the returned row hashes.
-
-For example, to fetch only the first and second columns of every row as a hash
-ref (with keys named "k" and "v" regardless of their original names):
-
- $tbl_ary_ref = $sth->fetchall_arrayref( \{ 0 => 'k', 1 => 'v' } );
-
-If $max_rows is defined and greater than or equal to zero then it
-is used to limit the number of rows fetched before returning.
-fetchall_arrayref() can then be called again to fetch more rows.
-This is especially useful when you need the better performance of
-fetchall_arrayref() but don't have enough memory to fetch and return
-all the rows in one go.
-
-Here's an example (assumes RaiseError is enabled):
-
- my $rows = []; # cache for batches of rows
- while( my $row = ( shift(@$rows) || # get row from cache, or reload cache:
- shift(@{$rows=$sth->fetchall_arrayref(undef,10_000)||[]}) )
- ) {
- ...
- }
-
-That I<might> be the fastest way to fetch and process lots of rows using the DBI,
-but it depends on the relative cost of method calls vs memory allocation.
-
-A standard C<while> loop with column binding is often faster because
-the cost of allocating memory for the batch of rows is greater than
-the saving by reducing method calls. It's possible that the DBI may
-provide a way to reuse the memory of a previous batch in future, which
-would then shift the balance back towards fetchall_arrayref().
-
-
-=head3 C<fetchall_hashref>
-
- $hash_ref = $sth->fetchall_hashref($key_field);
-
-The C<fetchall_hashref> method can be used to fetch all the data to be
-returned from a prepared and executed statement handle. It returns a reference
-to a hash containing a key for each distinct value of the $key_field column
-that was fetched. For each key the corresponding value is a reference to a hash
-containing all the selected columns and their values, as returned by
-C<fetchrow_hashref()>.
-
-If there are no rows to return, C<fetchall_hashref> returns a reference
-to an empty hash. If an error occurs, C<fetchall_hashref> returns the
-data fetched thus far, which may be none. You should check
-C<$sth-E<gt>err> afterwards (or use the C<RaiseError> attribute) to
-discover if the data is complete or was truncated due to an error.
-
-The $key_field parameter provides the name of the field that holds the
-value to be used for the key for the returned hash. For example:
-
- $dbh->{FetchHashKeyName} = 'NAME_lc';
- $sth = $dbh->prepare("SELECT FOO, BAR, ID, NAME, BAZ FROM TABLE");
- $sth->execute;
- $hash_ref = $sth->fetchall_hashref('id');
- print "Name for id 42 is $hash_ref->{42}->{name}\n";
-
-The $key_field parameter can also be specified as an integer column
-number (counting from 1). If $key_field doesn't match any column in
-the statement, as a name first then as a number, then an error is
-returned.
-
-For queries returning more than one 'key' column, you can specify
-multiple column names by passing $key_field as a reference to an
-array containing one or more key column names (or index numbers).
-For example:
-
- $sth = $dbh->prepare("SELECT foo, bar, baz FROM table");
- $sth->execute;
- $hash_ref = $sth->fetchall_hashref( [ qw(foo bar) ] );
- print "For foo 42 and bar 38, baz is $hash_ref->{42}->{38}->{baz}\n";
-
-The fetchall_hashref() method is normally used only where the key
-fields values for each row are unique. If multiple rows are returned
-with the same values for the key fields then later rows overwrite
-earlier ones.
-
-=head3 C<finish>
-
- $rc = $sth->finish;
-
-Indicate that no more data will be fetched from this statement handle
-before it is either executed again or destroyed. You almost certainly
-do I<not> need to call this method.
-
-Adding calls to C<finish> after loop that fetches all rows is a common mistake,
-don't do it, it can mask genuine problems like uncaught fetch errors.
-
-When all the data has been fetched from a C<SELECT> statement, the driver will
-automatically call C<finish> for you. So you should I<not> call it explicitly
-I<except> when you know that you've not fetched all the data from a statement
-handle I<and> the handle won't be destroyed soon.
-
-The most common example is when you only want to fetch just one row,
-but in that case the C<selectrow_*> methods are usually better anyway.
-
-Consider a query like:
-
- SELECT foo FROM table WHERE bar=? ORDER BY baz
-
-on a very large table. When executed, the database server will have to use
-temporary buffer space to store the sorted rows. If, after executing
-the handle and selecting just a few rows, the handle won't be re-executed for
-some time and won't be destroyed, the C<finish> method can be used to tell
-the server that the buffer space can be freed.
-
-Calling C<finish> resets the L</Active> attribute for the statement. It
-may also make some statement handle attributes (such as C<NAME> and C<TYPE>)
-unavailable if they have not already been accessed (and thus cached).
-
-The C<finish> method does not affect the transaction status of the
-database connection. It has nothing to do with transactions. It's mostly an
-internal "housekeeping" method that is rarely needed.
-See also L</disconnect> and the L</Active> attribute.
-
-The C<finish> method should have been called C<discard_pending_rows>.
-
-
-=head3 C<rows>
-
- $rv = $sth->rows;
-
-Returns the number of rows affected by the last row affecting command,
-or -1 if the number of rows is not known or not available.
-
-Generally, you can only rely on a row count after a I<non>-C<SELECT>
-C<execute> (for some specific operations like C<UPDATE> and C<DELETE>), or
-after fetching all the rows of a C<SELECT> statement.
-
-For C<SELECT> statements, it is generally not possible to know how many
-rows will be returned except by fetching them all. Some drivers will
-return the number of rows the application has fetched so far, but
-others may return -1 until all rows have been fetched. So use of the
-C<rows> method or C<$DBI::rows> with C<SELECT> statements is not
-recommended.
-
-One alternative method to get a row count for a C<SELECT> is to execute a
-"SELECT COUNT(*) FROM ..." SQL statement with the same "..." as your
-query and then fetch the row count from that.
-
-
-=head3 C<bind_col>
-
- $rc = $sth->bind_col($column_number, \$var_to_bind);
- $rc = $sth->bind_col($column_number, \$var_to_bind, \%attr );
- $rc = $sth->bind_col($column_number, \$var_to_bind, $bind_type );
-
-Binds a Perl variable and/or some attributes to an output column
-(field) of a C<SELECT> statement. Column numbers count up from 1.
-You do not need to bind output columns in order to fetch data.
-For maximum portability between drivers, bind_col() should be called
-after execute() and not before.
-See also L</bind_columns> for an example.
-
-The binding is performed at a low level using Perl aliasing.
-Whenever a row is fetched from the database $var_to_bind appears
-to be automatically updated simply because it now refers to the same
-memory location as the corresponding column value. This makes using
-bound variables very efficient.
-Binding a tied variable doesn't work, currently.
-
-The L</bind_param> method
-performs a similar, but opposite, function for input variables.
-
-B<Data Types for Column Binding>
-
-The C<\%attr> parameter can be used to hint at the data type
-formatting the column should have. For example, you can use:
-
- $sth->bind_col(1, undef, { TYPE => SQL_DATETIME });
-
-to specify that you'd like the column (which presumably is some
-kind of datetime type) to be returned in the standard format for
-SQL_DATETIME, which is 'YYYY-MM-DD HH:MM:SS', rather than the
-native formatting the database would normally use.
-
-There's no $var_to_bind in that example to emphasize the point
-that bind_col() works on the underlying column and not just
-a particular bound variable.
-
-As a short-cut for the common case, the data type can be passed
-directly, in place of the C<\%attr> hash reference. This example is
-equivalent to the one above:
-
- $sth->bind_col(1, undef, SQL_DATETIME);
-
-The C<TYPE> value indicates the standard (non-driver-specific) type for
-this parameter. To specify the driver-specific type, the driver may
-support a driver-specific attribute, such as C<{ ora_type =E<gt> 97 }>.
-
-The SQL_DATETIME and other related constants can be imported using
-
- use DBI qw(:sql_types);
-
-See L</"DBI Constants"> for more information.
-
-Few drivers support specifying a data type via a C<bind_col> call
-(most will simply ignore the data type). Fewer still allow the data
-type to be altered once set. If you do set a column type the type
-should remain sticky through further calls to bind_col for the same
-column if the type is not overridden (this is important for instance
-when you are using a slice in fetchall_arrayref).
-
-The TYPE attribute for bind_col() was first specified in DBI 1.41.
-
-From DBI 1.611, drivers can use the C<TYPE> attribute to attempt to
-cast the bound scalar to a perl type which more closely matches
-C<TYPE>. At present DBI supports C<SQL_INTEGER>, C<SQL_DOUBLE> and
-C<SQL_NUMERIC>. See L</sql_type_cast> for details of how types are
-cast.
-
-B<Other attributes for Column Binding>
-
-The C<\%attr> parameter may also contain the following attributes:
-
-=over
-
-=item C<StrictlyTyped>
-
-If a C<TYPE> attribute is passed to bind_col, then the driver will
-attempt to change the bound perl scalar to match the type more
-closely. If the bound value cannot be cast to the requested C<TYPE>
-then by default it is left untouched and no error is generated. If you
-specify C<StrictlyTyped> as 1 and the cast fails, this will generate
-an error.
-
-This attribute was first added in DBI 1.611. When 1.611 was released
-few drivers actually supported this attribute but DBD::Oracle and
-DBD::ODBC should from versions 1.24.
-
-=item C<DiscardString>
-
-When the C<TYPE> attribute is passed to L</bind_col> and the driver
-successfully casts the bound perl scalar to a non-string type
-then if C<DiscardString> is set to 1, the string portion of the
-scalar will be discarded. By default, C<DiscardString> is not set.
-
-This attribute was first added in DBI 1.611. When 1.611 was released
-few drivers actually supported this attribute but DBD::Oracle and
-DBD::ODBC should from versions 1.24.
-
-=back
-
-
-=head3 C<bind_columns>
-
- $rc = $sth->bind_columns(@list_of_refs_to_vars_to_bind);
-
-Calls L</bind_col> for each column of the C<SELECT> statement.
-
-The list of references should have the same number of elements as the number of
-columns in the C<SELECT> statement. If it doesn't then C<bind_columns> will
-bind the elements given, up to the number of columns, and then return an error.
-
-For maximum portability between drivers, bind_columns() should be called
-after execute() and not before.
-
-For example:
-
- $dbh->{RaiseError} = 1; # do this, or check every call for errors
- $sth = $dbh->prepare(q{ SELECT region, sales FROM sales_by_region });
- $sth->execute;
- my ($region, $sales);
-
- # Bind Perl variables to columns:
- $rv = $sth->bind_columns(\$region, \$sales);
-
- # you can also use Perl's \(...) syntax (see perlref docs):
- # $sth->bind_columns(\($region, $sales));
-
- # Column binding is the most efficient way to fetch data
- while ($sth->fetch) {
- print "$region: $sales\n";
- }
-
-For compatibility with old scripts, the first parameter will be
-ignored if it is C<undef> or a hash reference.
-
-Here's a more fancy example that binds columns to the values I<inside>
-a hash (thanks to H.Merijn Brand):
-
- $sth->execute;
- my %row;
- $sth->bind_columns( \( @row{ @{$sth->{NAME_lc} } } ));
- while ($sth->fetch) {
- print "$row{region}: $row{sales}\n";
- }
-
-
-=head3 C<dump_results>
-
- $rows = $sth->dump_results($maxlen, $lsep, $fsep, $fh);
-
-Fetches all the rows from C<$sth>, calls C<DBI::neat_list> for each row, and
-prints the results to C<$fh> (defaults to C<STDOUT>) separated by C<$lsep>
-(default C<"\n">). C<$fsep> defaults to C<", "> and C<$maxlen> defaults to 35.
-
-This method is designed as a handy utility for prototyping and
-testing queries. Since it uses L</neat_list> to
-format and edit the string for reading by humans, it is not recommended
-for data transfer applications.
-
-
-=head2 Statement Handle Attributes
-
-This section describes attributes specific to statement handles. Most
-of these attributes are read-only.
-
-Changes to these statement handle attributes do not affect any other
-existing or future statement handles.
-
-Attempting to set or get the value of an unknown attribute generates a warning,
-except for private driver specific attributes (which all have names
-starting with a lowercase letter).
-
-Example:
-
- ... = $h->{NUM_OF_FIELDS}; # get/read
-
-Some drivers cannot provide valid values for some or all of these
-attributes until after C<$sth-E<gt>execute> has been successfully
-called. Typically the attribute will be C<undef> in these situations.
-
-Some attributes, like NAME, are not appropriate to some types of
-statement, like SELECT. Typically the attribute will be C<undef>
-in these situations.
-
-For drivers which support stored procedures and multiple result sets
-(see L</more_results>) these attributes relate to the I<current> result set.
-
-See also L</finish> to learn more about the effect it
-may have on some attributes.
-
-=head3 C<NUM_OF_FIELDS>
-
-Type: integer, read-only
-
-Number of fields (columns) in the data the prepared statement may return.
-Statements that don't return rows of data, like C<DELETE> and C<CREATE>
-set C<NUM_OF_FIELDS> to 0 (though it may be undef in some drivers).
-
-
-=head3 C<NUM_OF_PARAMS>
-
-Type: integer, read-only
-
-The number of parameters (placeholders) in the prepared statement.
-See SUBSTITUTION VARIABLES below for more details.
-
-
-=head3 C<NAME>
-
-Type: array-ref, read-only
-
-Returns a reference to an array of field names for each column. The
-names may contain spaces but should not be truncated or have any
-trailing space. Note that the names have the letter case (upper, lower
-or mixed) as returned by the driver being used. Portable applications
-should use L</NAME_lc> or L</NAME_uc>.
-
- print "First column name: $sth->{NAME}->[0]\n";
-
-Also note that the name returned for (aggregate) functions like C<count(*)>
-or C<max(c_foo)> is determined by the database server and not by C<DBI> or
-the C<DBD> backend.
-
-=head3 C<NAME_lc>
-
-Type: array-ref, read-only
-
-Like C</NAME> but always returns lowercase names.
-
-=head3 C<NAME_uc>
-
-Type: array-ref, read-only
-
-Like C</NAME> but always returns uppercase names.
-
-=head3 C<NAME_hash>
-
-Type: hash-ref, read-only
-
-=head3 C<NAME_lc_hash>
-
-Type: hash-ref, read-only
-
-=head3 C<NAME_uc_hash>
-
-Type: hash-ref, read-only
-
-The C<NAME_hash>, C<NAME_lc_hash>, and C<NAME_uc_hash> attributes
-return column name information as a reference to a hash.
-
-The keys of the hash are the names of the columns. The letter case of
-the keys corresponds to the letter case returned by the C<NAME>,
-C<NAME_lc>, and C<NAME_uc> attributes respectively (as described above).
-
-The value of each hash entry is the perl index number of the
-corresponding column (counting from 0). For example:
-
- $sth = $dbh->prepare("select Id, Name from table");
- $sth->execute;
- @row = $sth->fetchrow_array;
- print "Name $row[ $sth->{NAME_lc_hash}{name} ]\n";
-
-
-=head3 C<TYPE>
-
-Type: array-ref, read-only
-
-Returns a reference to an array of integer values for each
-column. The value indicates the data type of the corresponding column.
-
-The values correspond to the international standards (ANSI X3.135
-and ISO/IEC 9075) which, in general terms, means ODBC. Driver-specific
-types that don't exactly match standard types should generally return
-the same values as an ODBC driver supplied by the makers of the
-database. That might include private type numbers in ranges the vendor
-has officially registered with the ISO working group:
-
- ftp://sqlstandards.org/SC32/SQL_Registry/
-
-Where there's no vendor-supplied ODBC driver to be compatible with,
-the DBI driver can use type numbers in the range that is now
-officially reserved for use by the DBI: -9999 to -9000.
-
-All possible values for C<TYPE> should have at least one entry in the
-output of the C<type_info_all> method (see L</type_info_all>).
-
-=head3 C<PRECISION>
-
-Type: array-ref, read-only
-
-Returns a reference to an array of integer values for each column.
-
-For numeric columns, the value is the maximum number of digits
-(without considering a sign character or decimal point). Note that
-the "display size" for floating point types (REAL, FLOAT, DOUBLE)
-can be up to 7 characters greater than the precision (for the
-sign + decimal point + the letter E + a sign + 2 or 3 digits).
-
-For any character type column the value is the OCTET_LENGTH,
-in other words the number of bytes, not characters.
-
-(More recent standards refer to this as COLUMN_SIZE but we stick
-with PRECISION for backwards compatibility.)
-
-=head3 C<SCALE>
-
-Type: array-ref, read-only
-
-Returns a reference to an array of integer values for each column.
-NULL (C<undef>) values indicate columns where scale is not applicable.
-
-=head3 C<NULLABLE>
-
-Type: array-ref, read-only
-
-Returns a reference to an array indicating the possibility of each
-column returning a null. Possible values are C<0>
-(or an empty string) = no, C<1> = yes, C<2> = unknown.
-
- print "First column may return NULL\n" if $sth->{NULLABLE}->[0];
-
-
-=head3 C<CursorName>
-
-Type: string, read-only
-
-Returns the name of the cursor associated with the statement handle, if
-available. If not available or if the database driver does not support the
-C<"where current of ..."> SQL syntax, then it returns C<undef>.
-
-
-=head3 C<Database>
-
-Type: dbh, read-only
-
-Returns the parent $dbh of the statement handle.
-
-
-=head3 C<Statement>
-
-Type: string, read-only
-
-Returns the statement string passed to the L</prepare> method.
-
-
-=head3 C<ParamValues>
-
-Type: hash ref, read-only
-
-Returns a reference to a hash containing the values currently bound
-to placeholders. The keys of the hash are the 'names' of the
-placeholders, typically integers starting at 1. Returns undef if
-not supported by the driver.
-
-See L</ShowErrorStatement> for an example of how this is used.
-
-* Keys:
-
-If the driver supports C<ParamValues> but no values have been bound
-yet then the driver should return a hash with placeholders names
-in the keys but all the values undef, but some drivers may return
-a ref to an empty hash because they can't pre-determine the names.
-
-It is possible that the keys in the hash returned by C<ParamValues>
-are not exactly the same as those implied by the prepared statement.
-For example, DBD::Oracle translates 'C<?>' placeholders into 'C<:pN>'
-where N is a sequence number starting at 1.
-
-* Values:
-
-It is possible that the values in the hash returned by C<ParamValues>
-are not I<exactly> the same as those passed to bind_param() or execute().
-The driver may have slightly modified values in some way based on the
-TYPE the value was bound with. For example a floating point value
-bound as an SQL_INTEGER type may be returned as an integer.
-The values returned by C<ParamValues> can be passed to another
-bind_param() method with the same TYPE and will be seen by the
-database as the same value. See also L</ParamTypes> below.
-
-The C<ParamValues> attribute was added in DBI 1.28.
-
-=head3 C<ParamTypes>
-
-Type: hash ref, read-only
-
-Returns a reference to a hash containing the type information
-currently bound to placeholders.
-Returns undef if not supported by the driver.
-
-* Keys:
-
-See L</ParamValues> above.
-
-* Values:
-
-The hash values are hashrefs of type information in the same form as that
-passed to the various bind_param() methods (See L</bind_param> for the format
-and values).
-
-It is possible that the values in the hash returned by C<ParamTypes>
-are not exactly the same as those passed to bind_param() or execute().
-Param attributes specified using the abbreviated form, like this:
-
- $sth->bind_param(1, SQL_INTEGER);
-
-are returned in the expanded form, as if called like this:
-
- $sth->bind_param(1, { TYPE => SQL_INTEGER });
-
-The driver may have modified the type information in some way based
-on the bound values, other hints provided by the prepare()'d
-SQL statement, or alternate type mappings required by the driver or target
-database system. The driver may also add private keys (with names beginning
-with the drivers reserved prefix, e.g., odbc_xxx).
-
-* Example:
-
-The keys and values in the returned hash can be passed to the various
-bind_param() methods to effectively reproduce a previous param binding.
-For example:
-
- # assuming $sth1 is a previously prepared statement handle
- my $sth2 = $dbh->prepare( $sth1->{Statement} );
- my $ParamValues = $sth1->{ParamValues} || {};
- my $ParamTypes = $sth1->{ParamTypes} || {};
- $sth2->bind_param($_, $ParamValues->{$_}, $ParamTypes->{$_})
- for keys %{ {%$ParamValues, %$ParamTypes} };
- $sth2->execute();
-
-The C<ParamTypes> attribute was added in DBI 1.49. Implementation
-is the responsibility of individual drivers; the DBI layer default
-implementation simply returns undef.
-
-
-=head3 C<ParamArrays>
-
-Type: hash ref, read-only
-
-Returns a reference to a hash containing the values currently bound to
-placeholders with L</execute_array> or L</bind_param_array>. The
-keys of the hash are the 'names' of the placeholders, typically
-integers starting at 1. Returns undef if not supported by the driver
-or no arrays of parameters are bound.
-
-Each key value is an array reference containing a list of the bound
-parameters for that column.
-
-For example:
-
- $sth = $dbh->prepare("INSERT INTO staff (id, name) values (?,?)");
- $sth->execute_array({},[1,2], ['fred','dave']);
- if ($sth->{ParamArrays}) {
- foreach $param (keys %{$sth->{ParamArrays}}) {
- printf "Parameters for %s : %s\n", $param,
- join(",", @{$sth->{ParamArrays}->{$param}});
- }
- }
-
-It is possible that the values in the hash returned by C<ParamArrays>
-are not I<exactly> the same as those passed to L</bind_param_array> or
-L</execute_array>. The driver may have slightly modified values in some
-way based on the TYPE the value was bound with. For example a floating
-point value bound as an SQL_INTEGER type may be returned as an
-integer.
-
-It is also possible that the keys in the hash returned by
-C<ParamArrays> are not exactly the same as those implied by the
-prepared statement. For example, DBD::Oracle translates 'C<?>'
-placeholders into 'C<:pN>' where N is a sequence number starting at 1.
-
-=head3 C<RowsInCache>
-
-Type: integer, read-only
-
-If the driver supports a local row cache for C<SELECT> statements, then
-this attribute holds the number of un-fetched rows in the cache. If the
-driver doesn't, then it returns C<undef>. Note that some drivers pre-fetch
-rows on execute, whereas others wait till the first fetch.
-
-See also the L</RowCacheSize> database handle attribute.
-
-=head1 FURTHER INFORMATION
-
-=head2 Catalog Methods
-
-An application can retrieve metadata information from the DBMS by issuing
-appropriate queries on the views of the Information Schema. Unfortunately,
-C<INFORMATION_SCHEMA> views are seldom supported by the DBMS.
-Special methods (catalog methods) are available to return result sets
-for a small but important portion of that metadata:
-
- column_info
- foreign_key_info
- primary_key_info
- table_info
- statistics_info
-
-All catalog methods accept arguments in order to restrict the result sets.
-Passing C<undef> to an optional argument does not constrain the search for
-that argument.
-However, an empty string ('') is treated as a regular search criteria
-and will only match an empty value.
-
-B<Note>: SQL/CLI and ODBC differ in the handling of empty strings. An
-empty string will not restrict the result set in SQL/CLI.
-
-Most arguments in the catalog methods accept only I<ordinary values>, e.g.
-the arguments of C<primary_key_info()>.
-Such arguments are treated as a literal string, i.e. the case is significant
-and quote characters are taken literally.
-
-Some arguments in the catalog methods accept I<search patterns> (strings
-containing '_' and/or '%'), e.g. the C<$table> argument of C<column_info()>.
-Passing '%' is equivalent to leaving the argument C<undef>.
-
-B<Caveat>: The underscore ('_') is valid and often used in SQL identifiers.
-Passing such a value to a search pattern argument may return more rows than
-expected!
-To include pattern characters as literals, they must be preceded by an
-escape character which can be achieved with
-
- $esc = $dbh->get_info( 14 ); # SQL_SEARCH_PATTERN_ESCAPE
- $search_pattern =~ s/([_%])/$esc$1/g;
-
-The ODBC and SQL/CLI specifications define a way to change the default
-behaviour described above: All arguments (except I<list value arguments>)
-are treated as I<identifier> if the C<SQL_ATTR_METADATA_ID> attribute is
-set to C<SQL_TRUE>.
-I<Quoted identifiers> are very similar to I<ordinary values>, i.e. their
-body (the string within the quotes) is interpreted literally.
-I<Unquoted identifiers> are compared in UPPERCASE.
-
-The DBI (currently) does not support the C<SQL_ATTR_METADATA_ID> attribute,
-i.e. it behaves like an ODBC driver where C<SQL_ATTR_METADATA_ID> is set to
-C<SQL_FALSE>.
-
-
-=head2 Transactions
-
-Transactions are a fundamental part of any robust database system. They
-protect against errors and database corruption by ensuring that sets of
-related changes to the database take place in atomic (indivisible,
-all-or-nothing) units.
-
-This section applies to databases that support transactions and where
-C<AutoCommit> is off. See L</AutoCommit> for details of using C<AutoCommit>
-with various types of databases.
-
-The recommended way to implement robust transactions in Perl
-applications is to enable L</RaiseError> and catch the error that's 'thrown' as
-an exception. For example, using L<Try::Tiny>:
-
- use Try::Tiny;
- $dbh->{AutoCommit} = 0; # enable transactions, if possible
- $dbh->{RaiseError} = 1;
- try {
- foo(...) # do lots of work here
- bar(...) # including inserts
- baz(...) # and updates
- $dbh->commit; # commit the changes if we get this far
- } catch {
- warn "Transaction aborted because $_"; # Try::Tiny copies $@ into $_
- # now rollback to undo the incomplete changes
- # but do it in an eval{} as it may also fail
- eval { $dbh->rollback };
- # add other application on-error-clean-up code here
- };
-
-If the C<RaiseError> attribute is not set, then DBI calls would need to be
-manually checked for errors, typically like this:
-
- $h->method(@args) or die $h->errstr;
-
-With C<RaiseError> set, the DBI will automatically C<die> if any DBI method
-call on that handle (or a child handle) fails, so you don't have to
-test the return value of each method call. See L</RaiseError> for more
-details.
-
-A major advantage of the C<eval> approach is that the transaction will be
-properly rolled back if I<any> code (not just DBI calls) in the inner
-application dies for any reason. The major advantage of using the
-C<$h-E<gt>{RaiseError}> attribute is that all DBI calls will be checked
-automatically. Both techniques are strongly recommended.
-
-After calling C<commit> or C<rollback> many drivers will not let you
-fetch from a previously active C<SELECT> statement handle that's a child
-of the same database handle. A typical way round this is to connect the
-the database twice and use one connection for C<SELECT> statements.
-
-See L</AutoCommit> and L</disconnect> for other important information
-about transactions.
-
-
-=head2 Handling BLOB / LONG / Memo Fields
-
-Many databases support "blob" (binary large objects), "long", or similar
-datatypes for holding very long strings or large amounts of binary
-data in a single field. Some databases support variable length long
-values over 2,000,000,000 bytes in length.
-
-Since values of that size can't usually be held in memory, and because
-databases can't usually know in advance the length of the longest long
-that will be returned from a C<SELECT> statement (unlike other data
-types), some special handling is required.
-
-In this situation, the value of the C<$h-E<gt>{LongReadLen}>
-attribute is used to determine how much buffer space to allocate
-when fetching such fields. The C<$h-E<gt>{LongTruncOk}> attribute
-is used to determine how to behave if a fetched value can't fit
-into the buffer.
-
-See the description of L</LongReadLen> for more information.
-
-When trying to insert long or binary values, placeholders should be used
-since there are often limits on the maximum size of an C<INSERT>
-statement and the L</quote> method generally can't cope with binary
-data. See L</Placeholders and Bind Values>.
-
-
-=head2 Simple Examples
-
-Here's a complete example program to select and fetch some data:
-
- my $data_source = "dbi::DriverName:db_name";
- my $dbh = DBI->connect($data_source, $user, $password)
- or die "Can't connect to $data_source: $DBI::errstr";
-
- my $sth = $dbh->prepare( q{
- SELECT name, phone
- FROM mytelbook
- }) or die "Can't prepare statement: $DBI::errstr";
-
- my $rc = $sth->execute
- or die "Can't execute statement: $DBI::errstr";
-
- print "Query will return $sth->{NUM_OF_FIELDS} fields.\n\n";
- print "Field names: @{ $sth->{NAME} }\n";
-
- while (($name, $phone) = $sth->fetchrow_array) {
- print "$name: $phone\n";
- }
- # check for problems which may have terminated the fetch early
- die $sth->errstr if $sth->err;
-
- $dbh->disconnect;
-
-Here's a complete example program to insert some data from a file.
-(This example uses C<RaiseError> to avoid needing to check each call).
-
- my $dbh = DBI->connect("dbi:DriverName:db_name", $user, $password, {
- RaiseError => 1, AutoCommit => 0
- });
-
- my $sth = $dbh->prepare( q{
- INSERT INTO table (name, phone) VALUES (?, ?)
- });
-
- open FH, "<phone.csv" or die "Unable to open phone.csv: $!";
- while (<FH>) {
- chomp;
- my ($name, $phone) = split /,/;
- $sth->execute($name, $phone);
- }
- close FH;
-
- $dbh->commit;
- $dbh->disconnect;
-
-Here's how to convert fetched NULLs (undefined values) into empty strings:
-
- while($row = $sth->fetchrow_arrayref) {
- # this is a fast and simple way to deal with nulls:
- foreach (@$row) { $_ = '' unless defined }
- print "@$row\n";
- }
-
-The C<q{...}> style quoting used in these examples avoids clashing with
-quotes that may be used in the SQL statement. Use the double-quote like
-C<qq{...}> operator if you want to interpolate variables into the string.
-See L<perlop/"Quote and Quote-like Operators"> for more details.
-
-=head2 Threads and Thread Safety
-
-Perl 5.7 and later support a new threading model called iThreads.
-(The old "5.005 style" threads are not supported by the DBI.)
-
-In the iThreads model each thread has its own copy of the perl
-interpreter. When a new thread is created the original perl
-interpreter is 'cloned' to create a new copy for the new thread.
-
-If the DBI and drivers are loaded and handles created before the
-thread is created then it will get a cloned copy of the DBI, the
-drivers and the handles.
-
-However, the internal pointer data within the handles will refer
-to the DBI and drivers in the original interpreter. Using those
-handles in the new interpreter thread is not safe, so the DBI detects
-this and croaks on any method call using handles that don't belong
-to the current thread (except for DESTROY).
-
-Because of this (possibly temporary) restriction, newly created
-threads must make their own connections to the database. Handles
-can't be shared across threads.
-
-But BEWARE, some underlying database APIs (the code the DBD driver
-uses to talk to the database, often supplied by the database vendor)
-are not thread safe. If it's not thread safe, then allowing more
-than one thread to enter the code at the same time may cause
-subtle/serious problems. In some cases allowing more than
-one thread to enter the code, even if I<not> at the same time,
-can cause problems. You have been warned.
-
-Using DBI with perl threads is not yet recommended for production
-environments. For more information see
-L<http://www.perlmonks.org/index.pl?node_id=288022>
-
-Note: There is a bug in perl 5.8.2 when configured with threads
-and debugging enabled (bug #24463) which causes a DBI test to fail.
-
-=head2 Signal Handling and Canceling Operations
-
-[The following only applies to systems with unix-like signal handling.
-I'd welcome additions for other systems, especially Windows.]
-
-The first thing to say is that signal handling in Perl versions less
-than 5.8 is I<not> safe. There is always a small risk of Perl
-crashing and/or core dumping when, or after, handling a signal
-because the signal could arrive and be handled while internal data
-structures are being changed. If the signal handling code
-used those same internal data structures it could cause all manner
-of subtle and not-so-subtle problems. The risk was reduced with
-5.4.4 but was still present in all perls up through 5.8.0.
-
-Beginning in perl 5.8.0 perl implements 'safe' signal handling if
-your system has the POSIX sigaction() routine. Now when a signal
-is delivered perl just makes a note of it but does I<not> run the
-%SIG handler. The handling is 'deferred' until a 'safe' moment.
-
-Although this change made signal handling safe, it also lead to
-a problem with signals being deferred for longer than you'd like.
-If a signal arrived while executing a system call, such as waiting
-for data on a network connection, the signal is noted and then the
-system call that was executing returns with an EINTR error code
-to indicate that it was interrupted. All fine so far.
-
-The problem comes when the code that made the system call sees the
-EINTR code and decides it's going to call it again. Perl doesn't
-do that, but database code sometimes does. If that happens then the
-signal handler doesn't get called until later. Maybe much later.
-
-Fortunately there are ways around this which we'll discuss below.
-Unfortunately they make signals unsafe again.
-
-The two most common uses of signals in relation to the DBI are for
-canceling operations when the user types Ctrl-C (interrupt), and for
-implementing a timeout using C<alarm()> and C<$SIG{ALRM}>.
-
-=over 4
-
-=item Cancel
-
-The DBI provides a C<cancel> method for statement handles. The
-C<cancel> method should abort the current operation and is designed
-to be called from a signal handler. For example:
-
- $SIG{INT} = sub { $sth->cancel };
-
-However, few drivers implement this (the DBI provides a default
-method that just returns C<undef>) and, even if implemented, there
-is still a possibility that the statement handle, and even the
-parent database handle, will not be usable afterwards.
-
-If C<cancel> returns true, then it has successfully
-invoked the database engine's own cancel function. If it returns false,
-then C<cancel> failed. If it returns C<undef>, then the database
-driver does not have cancel implemented - very few do.
-
-=item Timeout
-
-The traditional way to implement a timeout is to set C<$SIG{ALRM}>
-to refer to some code that will be executed when an ALRM signal
-arrives and then to call alarm($seconds) to schedule an ALRM signal
-to be delivered $seconds in the future. For example:
-
- my $failed;
- eval {
- local $SIG{ALRM} = sub { die "TIMEOUT\n" }; # N.B. \n required
- eval {
- alarm($seconds);
- ... code to execute with timeout here (which may die) ...
- 1;
- } or $failed = 1;
- # outer eval catches alarm that might fire JUST before this alarm(0)
- alarm(0); # cancel alarm (if code ran fast)
- die "$@" if $failed;
- 1;
- } or $failed = 1;
- if ( $failed ) {
- if ( defined $@ and $@ eq "TIMEOUT\n" ) { ... }
- else { ... } # some other error
- }
-
-The first (outer) eval is used to avoid the unlikely but possible
-chance that the "code to execute" dies and the alarm fires before it
-is cancelled. Without the outer eval, if this happened your program
-will die if you have no ALRM handler or a non-local alarm handler
-will be called.
-
-Unfortunately, as described above, this won't always work as expected,
-depending on your perl version and the underlying database code.
-
-With Oracle for instance (DBD::Oracle), if the system which hosts
-the database is down the DBI->connect() call will hang for several
-minutes before returning an error.
-
-=back
-
-The solution on these systems is to use the C<POSIX::sigaction()>
-routine to gain low level access to how the signal handler is installed.
-
-The code would look something like this (for the DBD-Oracle connect()):
-
- use POSIX qw(:signal_h);
-
- my $mask = POSIX::SigSet->new( SIGALRM ); # signals to mask in the handler
- my $action = POSIX::SigAction->new(
- sub { die "connect timeout\n" }, # the handler code ref
- $mask,
- # not using (perl 5.8.2 and later) 'safe' switch or sa_flags
- );
- my $oldaction = POSIX::SigAction->new();
- sigaction( SIGALRM, $action, $oldaction );
- my $dbh;
- my $failed;
- eval {
- eval {
- alarm(5); # seconds before time out
- $dbh = DBI->connect("dbi:Oracle:$dsn" ... );
- 1;
- } or $failed = 1;
- alarm(0); # cancel alarm (if connect worked fast)
- die "$@\n" if $failed; # connect died
- 1;
- } or $failed = 1;
- sigaction( SIGALRM, $oldaction ); # restore original signal handler
- if ( $failed ) {
- if ( defined $@ and $@ eq "connect timeout\n" ) {...}
- else { # connect died }
- }
-
-See previous example for the reasoning around the double eval.
-
-Similar techniques can be used for canceling statement execution.
-
-Unfortunately, this solution is somewhat messy, and it does I<not> work with
-perl versions less than perl 5.8 where C<POSIX::sigaction()> appears to be broken.
-
-For a cleaner implementation that works across perl versions, see Lincoln Baxter's
-Sys::SigAction module at L<Sys::SigAction>.
-The documentation for Sys::SigAction includes an longer discussion
-of this problem, and a DBD::Oracle test script.
-
-Be sure to read all the signal handling sections of the L<perlipc> manual.
-
-And finally, two more points to keep firmly in mind. Firstly,
-remember that what we've done here is essentially revert to old
-style I<unsafe> handling of these signals. So do as little as
-possible in the handler. Ideally just die(). Secondly, the handles
-in use at the time the signal is handled may not be safe to use
-afterwards.
-
-
-=head2 Subclassing the DBI
-
-DBI can be subclassed and extended just like any other object
-oriented module. Before we talk about how to do that, it's important
-to be clear about the various DBI classes and how they work together.
-
-By default C<$dbh = DBI-E<gt>connect(...)> returns a $dbh blessed
-into the C<DBI::db> class. And the C<$dbh-E<gt>prepare> method
-returns an $sth blessed into the C<DBI::st> class (actually it
-simply changes the last four characters of the calling handle class
-to be C<::st>).
-
-The leading 'C<DBI>' is known as the 'root class' and the extra
-'C<::db>' or 'C<::st>' are the 'handle type suffixes'. If you want
-to subclass the DBI you'll need to put your overriding methods into
-the appropriate classes. For example, if you want to use a root class
-of C<MySubDBI> and override the do(), prepare() and execute() methods,
-then your do() and prepare() methods should be in the C<MySubDBI::db>
-class and the execute() method should be in the C<MySubDBI::st> class.
-
-To setup the inheritance hierarchy the @ISA variable in C<MySubDBI::db>
-should include C<DBI::db> and the @ISA variable in C<MySubDBI::st>
-should include C<DBI::st>. The C<MySubDBI> root class itself isn't
-currently used for anything visible and so, apart from setting @ISA
-to include C<DBI>, it can be left empty.
-
-So, having put your overriding methods into the right classes, and
-setup the inheritance hierarchy, how do you get the DBI to use them?
-You have two choices, either a static method call using the name
-of your subclass:
-
- $dbh = MySubDBI->connect(...);
-
-or specifying a C<RootClass> attribute:
-
- $dbh = DBI->connect(..., { RootClass => 'MySubDBI' });
-
-If both forms are used then the attribute takes precedence.
-
-The only differences between the two are that using an explicit
-RootClass attribute will a) make the DBI automatically attempt to load
-a module by that name if the class doesn't exist, and b) won't call
-your MySubDBI::connect() method, if you have one.
-
-When subclassing is being used then, after a successful new
-connect, the DBI->connect method automatically calls:
-
- $dbh->connected($dsn, $user, $pass, \%attr);
-
-The default method does nothing. The call is made just to simplify
-any post-connection setup that your subclass may want to perform.
-The parameters are the same as passed to DBI->connect.
-If your subclass supplies a connected method, it should be part of the
-MySubDBI::db package.
-
-One more thing to note: you must let the DBI do the handle creation. If you
-want to override the connect() method in your *::dr class then it must still
-call SUPER::connect to get a $dbh to work with. Similarly, an overridden
-prepare() method in *::db must still call SUPER::prepare to get a $sth.
-If you try to create your own handles using bless() then you'll find the DBI
-will reject them with an "is not a DBI handle (has no magic)" error.
-
-Here's a brief example of a DBI subclass. A more thorough example
-can be found in F<t/subclass.t> in the DBI distribution.
-
- package MySubDBI;
-
- use strict;
-
- use DBI;
- use vars qw(@ISA);
- @ISA = qw(DBI);
-
- package MySubDBI::db;
- use vars qw(@ISA);
- @ISA = qw(DBI::db);
-
- sub prepare {
- my ($dbh, @args) = @_;
- my $sth = $dbh->SUPER::prepare(@args)
- or return;
- $sth->{private_mysubdbi_info} = { foo => 'bar' };
- return $sth;
- }
-
- package MySubDBI::st;
- use vars qw(@ISA);
- @ISA = qw(DBI::st);
-
- sub fetch {
- my ($sth, @args) = @_;
- my $row = $sth->SUPER::fetch(@args)
- or return;
- do_something_magical_with_row_data($row)
- or return $sth->set_err(1234, "The magic failed", undef, "fetch");
- return $row;
- }
-
-When calling a SUPER::method that returns a handle, be careful to
-check the return value before trying to do other things with it in
-your overridden method. This is especially important if you want to
-set a hash attribute on the handle, as Perl's autovivification will
-bite you by (in)conveniently creating an unblessed hashref, which your
-method will then return with usually baffling results later on like
-the error "dbih_getcom handle HASH(0xa4451a8) is not a DBI handle (has
-no magic". It's best to check right after the call and return undef
-immediately on error, just like DBI would and just like the example
-above.
-
-If your method needs to record an error it should call the set_err()
-method with the error code and error string, as shown in the example
-above. The error code and error string will be recorded in the
-handle and available via C<$h-E<gt>err> and C<$DBI::errstr> etc.
-The set_err() method always returns an undef or empty list as
-appropriate. Since your method should nearly always return an undef
-or empty list as soon as an error is detected it's handy to simply
-return what set_err() returns, as shown in the example above.
-
-If the handle has C<RaiseError>, C<PrintError>, or C<HandleError>
-etc. set then the set_err() method will honour them. This means
-that if C<RaiseError> is set then set_err() won't return in the
-normal way but will 'throw an exception' that can be caught with
-an C<eval> block.
-
-You can stash private data into DBI handles
-via C<$h-E<gt>{private_..._*}>. See the entry under L</ATTRIBUTES
-COMMON TO ALL HANDLES> for info and important caveats.
-
-=head2 Memory Leaks
-
-When tracking down memory leaks using tools like L<Devel::Leak>
-you'll find that some DBI internals are reported as 'leaking' memory.
-This is very unlikely to be a real leak. The DBI has various caches to improve
-performance and the apparrent leaks are simply the normal operation of these
-caches.
-
-The most frequent sources of the apparrent leaks are L</ChildHandles>,
-L</prepare_cached> and L</connect_cached>.
-
-For example http://stackoverflow.com/questions/13338308/perl-dbi-memory-leak
-
-Given how widely the DBI is used, you can rest assured that if a new release of
-the DBI did have a real leak it would be discovered, reported, and fixed
-immediately. The leak you're looking for is probably elsewhere. Good luck!
-
-
-=head1 TRACING
-
-The DBI has a powerful tracing mechanism built in. It enables you
-to see what's going on 'behind the scenes', both within the DBI and
-the drivers you're using.
-
-=head2 Trace Settings
-
-Which details are written to the trace output is controlled by a
-combination of a I<trace level>, an integer from 0 to 15, and a set
-of I<trace flags> that are either on or off. Together these are known
-as the I<trace settings> and are stored together in a single integer.
-For normal use you only need to set the trace level, and generally
-only to a value between 1 and 4.
-
-Each handle has its own trace settings, and so does the DBI.
-When you call a method the DBI merges the handles settings into its
-own for the duration of the call: the trace flags of the handle are
-OR'd into the trace flags of the DBI, and if the handle has a higher
-trace level then the DBI trace level is raised to match it.
-The previous DBI trace settings are restored when the called method
-returns.
-
-=head2 Trace Levels
-
-Trace I<levels> are as follows:
-
- 0 - Trace disabled.
- 1 - Trace top-level DBI method calls returning with results or errors.
- 2 - As above, adding tracing of top-level method entry with parameters.
- 3 - As above, adding some high-level information from the driver
- and some internal information from the DBI.
- 4 - As above, adding more detailed information from the driver.
- This is the first level to trace all the rows being fetched.
- 5 to 15 - As above but with more and more internal information.
-
-Trace level 1 is best for a simple overview of what's happening.
-Trace levels 2 thru 4 a good choice for general purpose tracing.
-Levels 5 and above are best reserved for investigating a specific
-problem, when you need to see "inside" the driver and DBI.
-
-The trace output is detailed and typically very useful. Much of the
-trace output is formatted using the L</neat> function, so strings
-in the trace output may be edited and truncated by that function.
-
-=head2 Trace Flags
-
-Trace I<flags> are used to enable tracing of specific activities
-within the DBI and drivers. The DBI defines some trace flags and
-drivers can define others. DBI trace flag names begin with a capital
-letter and driver specific names begin with a lowercase letter, as
-usual.
-
-Currently the DBI defines these trace flags:
-
- ALL - turn on all DBI and driver flags (not recommended)
- SQL - trace SQL statements executed
- (not yet implemented in DBI but implemented in some DBDs)
- CON - trace connection process
- ENC - trace encoding (unicode translations etc)
- (not yet implemented in DBI but implemented in some DBDs)
- DBD - trace only DBD messages
- (not implemented by all DBDs yet)
- TXN - trace transactions
- (not implemented in all DBDs yet)
-
-The L</parse_trace_flags> and L</parse_trace_flag> methods are used
-to convert trace flag names into the corresponding integer bit flags.
-
-=head2 Enabling Trace
-
-The C<$h-E<gt>trace> method sets the trace settings for a handle
-and C<DBI-E<gt>trace> does the same for the DBI.
-
-In addition to the L</trace> method, you can enable the same trace
-information, and direct the output to a file, by setting the
-C<DBI_TRACE> environment variable before starting Perl.
-See L</DBI_TRACE> for more information.
-
-Finally, you can set, or get, the trace settings for a handle using
-the C<TraceLevel> attribute.
-
-All of those methods use parse_trace_flags() and so allow you set
-both the trace level and multiple trace flags by using a string
-containing the trace level and/or flag names separated by vertical
-bar ("C<|>") or comma ("C<,>") characters. For example:
-
- local $h->{TraceLevel} = "3|SQL|foo";
-
-=head2 Trace Output
-
-Initially trace output is written to C<STDERR>. Both the
-C<$h-E<gt>trace> and C<DBI-E<gt>trace> methods take an optional
-$trace_file parameter, which may be either the name of a file to be
-opened by DBI in append mode, or a reference to an existing writable
-(possibly layered) filehandle. If $trace_file is a filename,
-and can be opened in append mode, or $trace_file is a writable
-filehandle, then I<all> trace output (currently including that from
-other handles) is redirected to that file. A warning is generated
-if $trace_file can't be opened or is not writable.
-
-Further calls to trace() without $trace_file do not alter where
-the trace output is sent. If $trace_file is undefined, then
-trace output is sent to C<STDERR> and, if the prior trace was opened with
-$trace_file as a filename, the previous trace file is closed; if $trace_file was
-a filehandle, the filehandle is B<not> closed.
-
-B<NOTE>: If $trace_file is specified as a filehandle, the filehandle
-should not be closed until all DBI operations are completed, or the
-application has reset the trace file via another call to
-C<trace()> that changes the trace file.
-
-=head2 Tracing to Layered Filehandles
-
-B<NOTE>:
-
-=over 4
-
-=item *
-Tied filehandles are not currently supported, as
-tie operations are not available to the PerlIO
-methods used by the DBI.
-
-=item *
-PerlIO layer support requires Perl version 5.8 or higher.
-
-=back
-
-As of version 5.8, Perl provides the ability to layer various
-"disciplines" on an open filehandle via the L<PerlIO> module.
-
-A simple example of using PerlIO layers is to use a scalar as the output:
-
- my $scalar = '';
- open( my $fh, "+>:scalar", \$scalar );
- $dbh->trace( 2, $fh );
-
-Now all trace output is simply appended to $scalar.
-
-A more complex application of tracing to a layered filehandle is the
-use of a custom layer (I<Refer to >L<Perlio::via> I<for details
-on creating custom PerlIO layers.>). Consider an application with the
-following logger module:
-
- package MyFancyLogger;
-
- sub new
- {
- my $self = {};
- my $fh;
- open $fh, '>', 'fancylog.log';
- $self->{_fh} = $fh;
- $self->{_buf} = '';
- return bless $self, shift;
- }
-
- sub log
- {
- my $self = shift;
- return unless exists $self->{_fh};
- my $fh = $self->{_fh};
- $self->{_buf} .= shift;
- #
- # DBI feeds us pieces at a time, so accumulate a complete line
- # before outputing
- #
- print $fh "At ", scalar localtime(), ':', $self->{_buf}, "\n" and
- $self->{_buf} = ''
- if $self->{_buf}=~tr/\n//;
- }
-
- sub close {
- my $self = shift;
- return unless exists $self->{_fh};
- my $fh = $self->{_fh};
- print $fh "At ", scalar localtime(), ':', $self->{_buf}, "\n" and
- $self->{_buf} = ''
- if $self->{_buf};
- close $fh;
- delete $self->{_fh};
- }
-
- 1;
-
-To redirect DBI traces to this logger requires creating
-a package for the layer:
-
- package PerlIO::via::MyFancyLogLayer;
-
- sub PUSHED
- {
- my ($class,$mode,$fh) = @_;
- my $logger;
- return bless \$logger,$class;
- }
-
- sub OPEN {
- my ($self, $path, $mode, $fh) = @_;
- #
- # $path is actually our logger object
- #
- $$self = $path;
- return 1;
- }
-
- sub WRITE
- {
- my ($self, $buf, $fh) = @_;
- $$self->log($buf);
- return length($buf);
- }
-
- sub CLOSE {
- my $self = shift;
- $$self->close();
- return 0;
- }
-
- 1;
-
-
-The application can then cause DBI traces to be routed to the
-logger using
-
- use PerlIO::via::MyFancyLogLayer;
-
- open my $fh, '>:via(MyFancyLogLayer)', MyFancyLogger->new();
-
- $dbh->trace('SQL', $fh);
-
-Now all trace output will be processed by MyFancyLogger's
-log() method.
-
-=head2 Trace Content
-
-Many of the values embedded in trace output are formatted using the neat()
-utility function. This means they may be quoted, sanitized, and possibly
-truncated if longer than C<$DBI::neat_maxlen>. See L</neat> for more details.
-
-=head2 Tracing Tips
-
-You can add tracing to your own application code using the L</trace_msg> method.
-
-It can sometimes be handy to compare trace files from two different runs of the
-same script. However using a tool like C<diff> on the original log output
-doesn't work well because the trace file is full of object addresses that may
-differ on each run.
-
-The DBI includes a handy utility called dbilogstrip that can be used to
-'normalize' the log content. It can be used as a filter like this:
-
- DBI_TRACE=2 perl yourscript.pl ...args1... 2>&1 | dbilogstrip > dbitrace1.log
- DBI_TRACE=2 perl yourscript.pl ...args2... 2>&1 | dbilogstrip > dbitrace2.log
- diff -u dbitrace1.log dbitrace2.log
-
-See L<dbilogstrip> for more information.
-
-=head1 DBI ENVIRONMENT VARIABLES
-
-The DBI module recognizes a number of environment variables, but most of
-them should not be used most of the time.
-It is better to be explicit about what you are doing to avoid the need
-for environment variables, especially in a web serving system where web
-servers are stingy about which environment variables are available.
-
-=head2 DBI_DSN
-
-The DBI_DSN environment variable is used by DBI->connect if you do not
-specify a data source when you issue the connect.
-It should have a format such as "dbi:Driver:databasename".
-
-=head2 DBI_DRIVER
-
-The DBI_DRIVER environment variable is used to fill in the database
-driver name in DBI->connect if the data source string starts "dbi::"
-(thereby omitting the driver).
-If DBI_DSN omits the driver name, DBI_DRIVER can fill the gap.
-
-=head2 DBI_AUTOPROXY
-
-The DBI_AUTOPROXY environment variable takes a string value that starts
-"dbi:Proxy:" and is typically followed by "hostname=...;port=...".
-It is used to alter the behaviour of DBI->connect.
-For full details, see DBI::Proxy documentation.
-
-=head2 DBI_USER
-
-The DBI_USER environment variable takes a string value that is used as
-the user name if the DBI->connect call is given undef (as distinct from
-an empty string) as the username argument.
-Be wary of the security implications of using this.
-
-=head2 DBI_PASS
-
-The DBI_PASS environment variable takes a string value that is used as
-the password if the DBI->connect call is given undef (as distinct from
-an empty string) as the password argument.
-Be extra wary of the security implications of using this.
-
-=head2 DBI_DBNAME (obsolete)
-
-The DBI_DBNAME environment variable takes a string value that is used only when the
-obsolescent style of DBI->connect (with driver name as fourth parameter) is used, and
-when no value is provided for the first (database name) argument.
-
-=head2 DBI_TRACE
-
-The DBI_TRACE environment variable specifies the global default
-trace settings for the DBI at startup. Can also be used to direct
-trace output to a file. When the DBI is loaded it does:
-
- DBI->trace(split /=/, $ENV{DBI_TRACE}, 2) if $ENV{DBI_TRACE};
-
-So if C<DBI_TRACE> contains an "C<=>" character then what follows
-it is used as the name of the file to append the trace to.
-
-output appended to that file. If the name begins with a number
-followed by an equal sign (C<=>), then the number and the equal sign are
-stripped off from the name, and the number is used to set the trace
-level. For example:
-
- DBI_TRACE=1=dbitrace.log perl your_test_script.pl
-
-On Unix-like systems using a Bourne-like shell, you can do this easily
-on the command line:
-
- DBI_TRACE=2 perl your_test_script.pl
-
-See L</TRACING> for more information.
-
-=head2 PERL_DBI_DEBUG (obsolete)
-
-An old variable that should no longer be used; equivalent to DBI_TRACE.
-
-=head2 DBI_PROFILE
-
-The DBI_PROFILE environment variable can be used to enable profiling
-of DBI method calls. See L<DBI::Profile> for more information.
-
-=head2 DBI_PUREPERL
-
-The DBI_PUREPERL environment variable can be used to enable the
-use of DBI::PurePerl. See L<DBI::PurePerl> for more information.
-
-=head1 WARNING AND ERROR MESSAGES
-
-=head2 Fatal Errors
-
-=over 4
-
-=item Can't call method "prepare" without a package or object reference
-
-The C<$dbh> handle you're using to call C<prepare> is probably undefined because
-the preceding C<connect> failed. You should always check the return status of
-DBI methods, or use the L</RaiseError> attribute.
-
-=item Can't call method "execute" without a package or object reference
-
-The C<$sth> handle you're using to call C<execute> is probably undefined because
-the preceding C<prepare> failed. You should always check the return status of
-DBI methods, or use the L</RaiseError> attribute.
-
-=item DBI/DBD internal version mismatch
-
-The DBD driver module was built with a different version of DBI than
-the one currently being used. You should rebuild the DBD module under
-the current version of DBI.
-
-(Some rare platforms require "static linking". On those platforms, there
-may be an old DBI or DBD driver version actually embedded in the Perl
-executable being used.)
-
-=item DBD driver has not implemented the AutoCommit attribute
-
-The DBD driver implementation is incomplete. Consult the author.
-
-=item Can't [sg]et %s->{%s}: unrecognised attribute
-
-You attempted to set or get an unknown attribute of a handle. Make
-sure you have spelled the attribute name correctly; case is significant
-(e.g., "Autocommit" is not the same as "AutoCommit").
-
-=back
-
-=head1 Pure-Perl DBI
-
-A pure-perl emulation of the DBI is included in the distribution
-for people using pure-perl drivers who, for whatever reason, can't
-install the compiled DBI. See L<DBI::PurePerl>.
-
-=head1 SEE ALSO
-
-=head2 Driver and Database Documentation
-
-Refer to the documentation for the DBD driver that you are using.
-
-Refer to the SQL Language Reference Manual for the database engine that you are using.
-
-=head2 ODBC and SQL/CLI Standards Reference Information
-
-More detailed information about the semantics of certain DBI methods
-that are based on ODBC and SQL/CLI standards is available on-line
-via microsoft.com, for ODBC, and www.jtc1sc32.org for the SQL/CLI
-standard:
-
- DBI method ODBC function SQL/CLI Working Draft
- ---------- ------------- ---------------------
- column_info SQLColumns Page 124
- foreign_key_info SQLForeignKeys Page 163
- get_info SQLGetInfo Page 214
- primary_key_info SQLPrimaryKeys Page 254
- table_info SQLTables Page 294
- type_info SQLGetTypeInfo Page 239
- statistics_info SQLStatistics
-
-To find documentation on the ODBC function you can use
-the MSDN search facility at:
-
- http://msdn.microsoft.com/Search
-
-and search for something like C<"SQLColumns returns">.
-
-And for SQL/CLI standard information on SQLColumns you'd read page 124 of
-the (very large) SQL/CLI Working Draft available from:
-
- http://jtc1sc32.org/doc/N0701-0750/32N0744T.pdf
-
-=head2 Standards Reference Information
-
-A hyperlinked, browsable version of the BNF syntax for SQL92 (plus
-Oracle 7 SQL and PL/SQL) is available here:
-
- http://cui.unige.ch/db-research/Enseignement/analyseinfo/SQL92/BNFindex.html
-
-You can find more information about SQL standards online by searching for the
-appropriate standard names and numbers. For example, searching for
-"ANSI/ISO/IEC International Standard (IS) Database Language SQL - Part 1:
-SQL/Framework" you'll find a copy at:
-
- ftp://ftp.iks-jena.de/mitarb/lutz/standards/sql/ansi-iso-9075-1-1999.pdf
-
-=head2 Books and Articles
-
-Programming the Perl DBI, by Alligator Descartes and Tim Bunce.
-L<http://books.perl.org/book/154>
-
-Programming Perl 3rd Ed. by Larry Wall, Tom Christiansen & Jon Orwant.
-L<http://books.perl.org/book/134>
-
-Learning Perl by Randal Schwartz.
-L<http://books.perl.org/book/101>
-
-Details of many other books related to perl can be found at L<http://books.perl.org>
-
-=head2 Perl Modules
-
-Index of DBI related modules available from CPAN:
-
- L<https://metacpan.org/search?q=DBD%3A%3A>
- L<https://metacpan.org/search?q=DBIx%3A%3A>
- L<https://metacpan.org/search?q=DBI>
-
-For a good comparison of RDBMS-OO mappers and some OO-RDBMS mappers
-(including Class::DBI, Alzabo, and DBIx::RecordSet in the former
-category and Tangram and SPOPS in the latter) see the Perl
-Object-Oriented Persistence project pages at:
-
- http://poop.sourceforge.net
-
-A similar page for Java toolkits can be found at:
-
- http://c2.com/cgi-bin/wiki?ObjectRelationalToolComparison
-
-=head2 Mailing List
-
-The I<dbi-users> mailing list is the primary means of communication among
-users of the DBI and its related modules. For details send email to:
-
- L<dbi-users-help@perl.org>
-
-There are typically between 700 and 900 messages per month. You have
-to subscribe in order to be able to post. However you can opt for a
-'post-only' subscription.
-
-Mailing list archives (of variable quality) are held at:
-
- http://groups.google.com/groups?group=perl.dbi.users
- http://www.xray.mpe.mpg.de/mailing-lists/dbi/
- http://www.mail-archive.com/dbi-users%40perl.org/
-
-=head2 Assorted Related Links
-
-The DBI "Home Page":
-
- http://dbi.perl.org/
-
-Other DBI related links:
-
- http://www.perlmonks.org/?node=DBI%20recipes
- http://www.perlmonks.org/?node=Speeding%20up%20the%20DBI
-
-Other database related links:
-
- http://www.connectionstrings.com/
-
-Security, especially the "SQL Injection" attack:
-
- http://bobby-tables.com/
- http://online.securityfocus.com/infocus/1644
-
-
-=head2 FAQ
-
-See L<http://faq.dbi-support.com/>
-
-=head1 AUTHORS
-
-DBI by Tim Bunce, L<http://www.tim.bunce.name>
-
-This pod text by Tim Bunce, J. Douglas Dunlop, Jonathan Leffler and others.
-Perl by Larry Wall and the C<perl5-porters>.
-
-=head1 COPYRIGHT
-
-The DBI module is Copyright (c) 1994-2012 Tim Bunce. Ireland.
-All rights reserved.
-
-You may distribute under the terms of either the GNU General Public
-License or the Artistic License, as specified in the Perl 5.10.0 README file.
-
-=head1 SUPPORT / WARRANTY
-
-The DBI is free Open Source software. IT COMES WITHOUT WARRANTY OF ANY KIND.
-
-=head2 Support
-
-My consulting company, Data Plan Services, offers annual and
-multi-annual support contracts for the DBI. These provide sustained
-support for DBI development, and sustained value for you in return.
-Contact me for details.
-
-=head2 Sponsor Enhancements
-
-If your company would benefit from a specific new DBI feature,
-please consider sponsoring its development. Work is performed
-rapidly, and usually on a fixed-price payment-on-delivery basis.
-Contact me for details.
-
-Using such targeted financing allows you to contribute to DBI
-development, and rapidly get something specific and valuable in return.
-
-=head1 ACKNOWLEDGEMENTS
-
-I would like to acknowledge the valuable contributions of the many
-people I have worked with on the DBI project, especially in the early
-years (1992-1994). In no particular order: Kevin Stock, Buzz Moschetti,
-Kurt Andersen, Ted Lemon, William Hails, Garth Kennedy, Michael Peppler,
-Neil S. Briscoe, Jeff Urlwin, David J. Hughes, Jeff Stander,
-Forrest D Whitcher, Larry Wall, Jeff Fried, Roy Johnson, Paul Hudson,
-Georg Rehfeld, Steve Sizemore, Ron Pool, Jon Meek, Tom Christiansen,
-Steve Baumgarten, Randal Schwartz, and a whole lot more.
-
-Then, of course, there are the poor souls who have struggled through
-untold and undocumented obstacles to actually implement DBI drivers.
-Among their ranks are Jochen Wiedmann, Alligator Descartes, Jonathan
-Leffler, Jeff Urlwin, Michael Peppler, Henrik Tougaard, Edwin Pratomo,
-Davide Migliavacca, Jan Pazdziora, Peter Haworth, Edmund Mergl, Steve
-Williams, Thomas Lowery, and Phlip Plumlee. Without them, the DBI would
-not be the practical reality it is today. I'm also especially grateful
-to Alligator Descartes for starting work on the first edition of the
-"Programming the Perl DBI" book and letting me jump on board.
-
-The DBI and DBD::Oracle were originally developed while I was Technical
-Director (CTO) of the Paul Ingram Group in the UK. So I'd especially like
-to thank Paul for his generosity and vision in supporting this work for many years.
-
-A couple of specific DBI features have been sponsored by enlightened companies:
-
-The development of the swap_inner_handle() method was sponsored by BizRate.com (L<http://BizRate.com>)
-
-The development of DBD::Gofer and related modules was sponsored by
-Shopzilla.com (L<http://Shopzilla.com>), where I currently work.
-
-=head1 CONTRIBUTING
-
-As you can see above, many people have contributed to the DBI and
-drivers in many ways over many years.
-
-If you'd like to help then see L<http://dbi.perl.org/contributing>.
-
-If you'd like the DBI to do something new or different then a good way
-to make that happen is to do it yourself and send me a patch to the
-source code that shows the changes. (But read "Speak before you patch"
-below.)
-
-=head2 Browsing the source code repository
-
-Use https://github.com/perl5-dbi/dbi
-
-=head2 How to create a patch using Git
-
-The DBI source code is maintained using Git. To access the source
-you'll need to install a Git client. Then, to get the source code, do:
-
- git clone https://github.com/perl5-dbi/dbi.git DBI-git
-
-The source code will now be available in the new subdirectory C<DBI-git>.
-
-When you want to synchronize later, issue the command
-
- git pull --all
-
-Make your changes, test them, test them again until everything passes.
-If there are no tests for the new feature you added or a behaviour change,
-the change should include a new test. Then commit the changes. Either use
-
- git gui
-
-or
-
- git commit -a -m 'Message to my changes'
-
-If you get any conflicts reported you'll need to fix them first.
-
-Then generate the patch file to be mailed:
-
- git format-patch -1 --attach
-
-which will create a file 0001-*.patch (where * relates to the commit message).
-Read the patch file, as a sanity check, and then email it to dbi-dev@perl.org.
-
-If you have a L<github|https://github.com> account, you can also fork the
-repository, commit your changes to the forked repository and then do a
-pull request.
-
-=head2 How to create a patch without Git
-
-Unpack a fresh copy of the distribution:
-
- wget http://cpan.metacpan.org/authors/id/T/TI/TIMB/DBI-1.627.tar.gz
- tar xfz DBI-1.627.tar.gz
-
-Rename the newly created top level directory:
-
- mv DBI-1.627 DBI-1.627.your_foo
-
-Edit the contents of DBI-1.627.your_foo/* till it does what you want.
-
-Test your changes and then remove all temporary files:
-
- make test && make distclean
-
-Go back to the directory you originally unpacked the distribution:
-
- cd ..
-
-Unpack I<another> copy of the original distribution you started with:
-
- tar xfz DBI-1.627.tar.gz
-
-Then create a patch file by performing a recursive C<diff> on the two
-top level directories:
-
- diff -purd DBI-1.627 DBI-1.627.your_foo > DBI-1.627.your_foo.patch
-
-=head2 Speak before you patch
-
-For anything non-trivial or possibly controversial it's a good idea
-to discuss (on dbi-dev@perl.org) the changes you propose before
-actually spending time working on them. Otherwise you run the risk
-of them being rejected because they don't fit into some larger plans
-you may not be aware of.
-
-You can also reach the developers on IRC (chat). If they are on-line,
-the most likely place to talk to them is the #dbi channel on irc.perl.org
-
-=head1 TRANSLATIONS
-
-A German translation of this manual (possibly slightly out of date) is
-available, thanks to O'Reilly, at:
-
- http://www.oreilly.de/catalog/perldbiger/
-
-=head1 TRAINING
-
-References to DBI related training resources. No recommendation implied.
-
- http://www.treepax.co.uk/
- http://www.keller.com/dbweb/
-
-(If you offer professional DBI related training services,
-please send me your details so I can add them here.)
-
-=head1 OTHER RELATED WORK AND PERL MODULES
-
-=over 4
-
-=item L<Apache::DBI>
-
-To be used with the Apache daemon together with an embedded Perl
-interpreter like C<mod_perl>. Establishes a database connection which
-remains open for the lifetime of the HTTP daemon. This way the CGI
-connect and disconnect for every database access becomes superfluous.
-
-=item SQL Parser
-
-See also the L<SQL::Statement> module, SQL parser and engine.
-
-=back
-
-=cut
-
-# LocalWords: DBI
+++ /dev/null
-/* vim: ts=8:sw=4:expandtab
- *
- * $Id$
- *
- * Copyright (c) 1994-2012 Tim Bunce Ireland.
- *
- * See COPYRIGHT section in DBI.pm for usage and distribution rights.
- */
-
-#define IN_DBI_XS 1 /* see DBIXS.h */
-#define PERL_NO_GET_CONTEXT
-
-#include "DBIXS.h" /* DBI public interface for DBD's written in C */
-
-# if (defined(_WIN32) && (! defined(HAS_GETTIMEOFDAY)))
-#include <sys/timeb.h>
-# endif
-
-/* The XS dispatcher code can optimize calls to XS driver methods,
- * bypassing the usual call_sv() and argument handling overheads.
- * Just-in-case it causes problems there's an (undocumented) way
- * to disable it by setting an env var.
- */
-static int use_xsbypass = 1; /* set in dbi_bootinit() */
-
-#ifndef CvISXSUB
-#define CvISXSUB(sv) CvXSUB(sv)
-#endif
-
-#define DBI_MAGIC '~'
-
-/* HvMROMETA introduced in 5.9.5, but mro_meta_init not exported in 5.10.0 */
-#if (PERL_VERSION < 10)
-# define MY_cache_gen(stash) 0
-#else
-# if ((PERL_VERSION == 10) && (PERL_SUBVERSION == 0))
-# define MY_cache_gen(stash) \
- (HvAUX(stash)->xhv_mro_meta \
- ? HvAUX(stash)->xhv_mro_meta->cache_gen \
- : 0)
-# else
-# define MY_cache_gen(stash) HvMROMETA(stash)->cache_gen
-# endif
-#endif
-
-/* If the tests fail with errors about 'setlinebuf' then try */
-/* deleting the lines in the block below except the setvbuf one */
-#ifndef PerlIO_setlinebuf
-#ifdef HAS_SETLINEBUF
-#define PerlIO_setlinebuf(f) setlinebuf(f)
-#else
-#ifndef USE_PERLIO
-#define PerlIO_setlinebuf(f) setvbuf(f, Nullch, _IOLBF, 0)
-#endif
-#endif
-#endif
-
-#ifndef CopFILEGV
-# define CopFILEGV(cop) cop->cop_filegv
-# define CopLINE(cop) cop->cop_line
-# define CopSTASH(cop) cop->cop_stash
-# define CopSTASHPV(cop) (CopSTASH(cop) ? HvNAME(CopSTASH(cop)) : Nullch)
-#endif
-#ifndef PERL_GET_THX
-#define PERL_GET_THX ((void*)0)
-#endif
-#ifndef PerlProc_getpid
-#define PerlProc_getpid() getpid()
-extern Pid_t getpid (void);
-#endif
-#ifndef aTHXo_
-#define aTHXo_
-#endif
-
-#if (PERL_VERSION < 8) || ((PERL_VERSION == 8) && (PERL_SUBVERSION == 0))
-#define DBI_save_hv_fetch_ent
-#endif
-
-/* prior to 5.8.9: when a CV is duped, the mg dup method is called,
- * then *afterwards*, any_ptr is copied from the old CV to the new CV.
- * This wipes out anything which the dup method did to any_ptr.
- * This needs working around */
-#if defined(USE_ITHREADS) && (PERL_VERSION == 8) && (PERL_SUBVERSION < 9)
-# define BROKEN_DUP_ANY_PTR
-#endif
-
-#ifndef warn_sv
-static void warn_sv(SV *sv) { dTHX; warn("%" SVf, SVfARG(sv)); }
-#endif
-#ifndef croak_sv
-static void croak_sv(SV *sv) { dTHX; sv_setsv(ERRSV, sv); croak(NULL); }
-#endif
-
-/* types of method name */
-
-typedef enum {
- methtype_ordinary, /* nothing special about this method name */
- methtype_DESTROY,
- methtype_FETCH,
- methtype_can,
- methtype_fetch_star, /* fetch*, i.e. fetch() or fetch_...() */
- methtype_set_err
-} meth_types;
-
-
-static imp_xxh_t *dbih_getcom _((SV *h));
-static imp_xxh_t *dbih_getcom2 _((pTHX_ SV *h, MAGIC **mgp));
-static void dbih_clearcom _((imp_xxh_t *imp_xxh));
-static int dbih_logmsg _((imp_xxh_t *imp_xxh, const char *fmt, ...));
-static SV *dbih_make_com _((SV *parent_h, imp_xxh_t *p_imp_xxh, const char *imp_class, STRLEN imp_size, STRLEN extra, SV *copy));
-static SV *dbih_make_fdsv _((SV *sth, const char *imp_class, STRLEN imp_size, const char *col_name));
-static AV *dbih_get_fbav _((imp_sth_t *imp_sth));
-static SV *dbih_event _((SV *h, const char *name, SV*, SV*));
-static int dbih_set_attr_k _((SV *h, SV *keysv, int dbikey, SV *valuesv));
-static SV *dbih_get_attr_k _((SV *h, SV *keysv, int dbikey));
-static int dbih_sth_bind_col _((SV *sth, SV *col, SV *ref, SV *attribs));
-
-static int set_err_char _((SV *h, imp_xxh_t *imp_xxh, const char *err_c, IV err_i, const char *errstr, const char *state, const char *method));
-static int set_err_sv _((SV *h, imp_xxh_t *imp_xxh, SV *err, SV *errstr, SV *state, SV *method));
-static int quote_type _((int sql_type, int p, int s, int *base_type, void *v));
-static int sql_type_cast_svpv _((pTHX_ SV *sv, int sql_type, U32 flags, void *v));
-static I32 dbi_hash _((const char *string, long i));
-static void dbih_dumphandle _((pTHX_ SV *h, const char *msg, int level));
-static int dbih_dumpcom _((pTHX_ imp_xxh_t *imp_xxh, const char *msg, int level));
-static int dbi_ima_free(pTHX_ SV* sv, MAGIC* mg);
-#if defined(USE_ITHREADS) && !defined(BROKEN_DUP_ANY_PTR)
-static int dbi_ima_dup(pTHX_ MAGIC* mg, CLONE_PARAMS *param);
-#endif
-char *neatsvpv _((SV *sv, STRLEN maxlen));
-SV * preparse(SV *dbh, const char *statement, IV ps_return, IV ps_accept, void *foo);
-static meth_types get_meth_type(const char * const name);
-
-struct imp_drh_st { dbih_drc_t com; };
-struct imp_dbh_st { dbih_dbc_t com; };
-struct imp_sth_st { dbih_stc_t com; };
-struct imp_fdh_st { dbih_fdc_t com; };
-
-/* identify the type of a method name for dispatch behaviour */
-/* (should probably be folded into the IMA flags mechanism) */
-
-static meth_types
-get_meth_type(const char * const name)
-{
- switch (name[0]) {
- case 'D':
- if strEQ(name,"DESTROY")
- return methtype_DESTROY;
- break;
- case 'F':
- if strEQ(name,"FETCH")
- return methtype_FETCH;
- break;
- case 'c':
- if strEQ(name,"can")
- return methtype_can;
- break;
- case 'f':
- if strnEQ(name,"fetch", 5) /* fetch* */
- return methtype_fetch_star;
- break;
- case 's':
- if strEQ(name,"set_err")
- return methtype_set_err;
- break;
- }
- return methtype_ordinary;
-}
-
-
-/* Internal Method Attributes (attached to dispatch methods when installed) */
-/* NOTE: when adding SVs to dbi_ima_t, update dbi_ima_dup() dbi_ima_free()
- * to ensure that they are duped and correctly ref-counted */
-
-typedef struct dbi_ima_st {
- U8 minargs;
- U8 maxargs;
- IV hidearg;
- /* method_trace controls tracing of method calls in the dispatcher:
- - if the current trace flags include a trace flag in method_trace
- then set trace_level to min(2,trace_level) for duration of the call.
- - else, if trace_level < (method_trace & DBIc_TRACE_LEVEL_MASK)
- then don't trace the call
- */
- U32 method_trace;
- const char *usage_msg;
- U32 flags;
- meth_types meth_type;
-
- /* cached outer to inner method mapping */
- HV *stash; /* the stash we found the GV in */
- GV *gv; /* the GV containing the inner sub */
- U32 generation; /* cache invalidation */
-#ifdef BROKEN_DUP_ANY_PTR
- PerlInterpreter *my_perl; /* who owns this struct */
-#endif
-
-} dbi_ima_t;
-
-/* These values are embedded in the data passed to install_method */
-#define IMA_HAS_USAGE 0x00000001 /* check parameter usage */
-#define IMA_FUNC_REDIRECT 0x00000002 /* is $h->func(..., "method") */
-#define IMA_KEEP_ERR 0x00000004 /* don't reset err & errstr */
-#define IMA_KEEP_ERR_SUB 0x00000008 /* '' if in a nested call */
-#define IMA_NO_TAINT_IN 0x00000010 /* don't check for PL_tainted args */
-#define IMA_NO_TAINT_OUT 0x00000020 /* don't taint results */
-#define IMA_COPY_UP_STMT 0x00000040 /* copy sth Statement to dbh */
-#define IMA_END_WORK 0x00000080 /* method is commit or rollback */
-#define IMA_STUB 0x00000100 /* donothing eg $dbh->connected */
-#define IMA_CLEAR_STMT 0x00000200 /* clear Statement before call */
-#define IMA_UNRELATED_TO_STMT 0x00000400 /* profile as empty Statement */
-#define IMA_NOT_FOUND_OKAY 0x00000800 /* no error if not found */
-#define IMA_EXECUTE 0x00001000 /* do/execute: DBIcf_Executed */
-#define IMA_SHOW_ERR_STMT 0x00002000 /* dbh meth relates to Statement*/
-#define IMA_HIDE_ERR_PARAMVALUES 0x00004000 /* ParamValues are not relevant */
-#define IMA_IS_FACTORY 0x00008000 /* new h ie connect and prepare */
-#define IMA_CLEAR_CACHED_KIDS 0x00010000 /* clear CachedKids before call */
-
-#define DBIc_STATE_adjust(imp_xxh, state) \
- (SvOK(state) /* SQLSTATE is implemented by driver */ \
- ? (strEQ(SvPV_nolen(state),"00000") ? &PL_sv_no : sv_mortalcopy(state))\
- : (SvTRUE(DBIc_ERR(imp_xxh)) \
- ? sv_2mortal(newSVpv("S1000",5)) /* General error */ \
- : &PL_sv_no) /* Success ("00000") */ \
- )
-
-#define DBI_LAST_HANDLE g_dbi_last_h /* special fake inner handle */
-#define DBI_IS_LAST_HANDLE(h) ((DBI_LAST_HANDLE) == SvRV(h))
-#define DBI_SET_LAST_HANDLE(h) ((DBI_LAST_HANDLE) = SvRV(h))
-#define DBI_UNSET_LAST_HANDLE ((DBI_LAST_HANDLE) = &PL_sv_undef)
-#define DBI_LAST_HANDLE_OK ((DBI_LAST_HANDLE) != &PL_sv_undef)
-
-#define DBIS_TRACE_LEVEL (DBIS->debug & DBIc_TRACE_LEVEL_MASK)
-#define DBIS_TRACE_FLAGS (DBIS->debug) /* includes level */
-
-#ifdef PERL_LONG_MAX
-#define MAX_LongReadLen PERL_LONG_MAX
-#else
-#define MAX_LongReadLen 2147483647L
-#endif
-
-#ifdef DBI_USE_THREADS
-static char *dbi_build_opt = "-ithread";
-#else
-static char *dbi_build_opt = "-nothread";
-#endif
-
-/* 32 bit magic FNV-0 and FNV-1 prime */
-#define FNV_32_PRIME ((UV)0x01000193)
-
-
-/* perl doesn't know anything about the dbi_ima_t struct attached to the
- * CvXSUBANY(cv).any_ptr slot, so add some magic to the CV to handle
- * duping and freeing.
- */
-
-static MGVTBL dbi_ima_vtbl = { 0, 0, 0, 0, dbi_ima_free,
- 0,
-#if defined(USE_ITHREADS) && !defined(BROKEN_DUP_ANY_PTR)
- dbi_ima_dup
-#else
- 0
-#endif
-#if (PERL_VERSION > 8) || ((PERL_VERSION == 8) && (PERL_SUBVERSION >= 9))
- , 0
-#endif
- };
-
-static int dbi_ima_free(pTHX_ SV* sv, MAGIC* mg)
-{
- dbi_ima_t *ima = (dbi_ima_t *)(CvXSUBANY((CV*)sv).any_ptr);
-#ifdef BROKEN_DUP_ANY_PTR
- if (ima->my_perl != my_perl)
- return 0;
-#endif
- SvREFCNT_dec(ima->stash);
- SvREFCNT_dec(ima->gv);
- Safefree(ima);
- return 0;
-}
-
-#if defined(USE_ITHREADS) && !defined(BROKEN_DUP_ANY_PTR)
-static int dbi_ima_dup(pTHX_ MAGIC* mg, CLONE_PARAMS *param)
-{
- dbi_ima_t *ima, *nima;
- CV *cv = (CV*) mg->mg_ptr;
- CV *ncv = (CV*)ptr_table_fetch(PL_ptr_table, (cv));
-
- PERL_UNUSED_VAR(param);
- mg->mg_ptr = (char *)ncv;
- ima = (dbi_ima_t*) CvXSUBANY(cv).any_ptr;
- Newx(nima, 1, dbi_ima_t);
- *nima = *ima; /* structure copy */
- CvXSUBANY(ncv).any_ptr = nima;
- nima->stash = NULL;
- nima->gv = NULL;
- return 0;
-}
-#endif
-
-
-
-/* --- make DBI safe for multiple perl interpreters --- */
-/* Originally contributed by Murray Nesbitt of ActiveState, */
-/* but later updated to use MY_CTX */
-
-#define MY_CXT_KEY "DBI::_guts" XS_VERSION
-
-typedef struct {
- SV *dbi_last_h; /* maybe better moved into dbistate_t? */
- dbistate_t* dbi_state;
-} my_cxt_t;
-
-START_MY_CXT
-
-#undef DBIS
-#define DBIS (MY_CXT.dbi_state)
-
-#define g_dbi_last_h (MY_CXT.dbi_last_h)
-
-/* allow the 'static' dbi_state struct to be accessed from other files */
-dbistate_t**
-_dbi_state_lval(pTHX)
-{
- dMY_CXT;
- return &(MY_CXT.dbi_state);
-}
-
-
-/* --- */
-
-static void *
-malloc_using_sv(STRLEN len)
-{
- dTHX;
- SV *sv = newSV(len);
- void *p = SvPVX(sv);
- memzero(p, len);
- return p;
-}
-
-static char *
-savepv_using_sv(char *str)
-{
- char *buf = malloc_using_sv(strlen(str));
- strcpy(buf, str);
- return buf;
-}
-
-
-/* --- support functions for concat_hash_sorted --- */
-
-typedef struct str_uv_sort_pair_st {
- char *key;
- UV numeric;
-} str_uv_sort_pair_t;
-
-static int
-_cmp_number(const void *val1, const void *val2)
-{
- UV first = ((str_uv_sort_pair_t *)val1)->numeric;
- UV second = ((str_uv_sort_pair_t *)val2)->numeric;
-
- if (first > second)
- return 1;
- if (first < second)
- return -1;
- /* only likely to reach here if numeric sort forced for non-numeric keys */
- /* fallback to comparing the key strings */
- return strcmp(
- ((str_uv_sort_pair_t *)val1)->key,
- ((str_uv_sort_pair_t *)val2)->key
- );
-}
-
-static int
-_cmp_str (const void *val1, const void *val2)
-{
- return strcmp( *(char **)val1, *(char **)val2);
-}
-
-static char **
-_sort_hash_keys (HV *hash, int num_sort, STRLEN *total_length)
-{
- dTHX;
- I32 hv_len, key_len;
- HE *entry;
- char **keys;
- unsigned int idx = 0;
- STRLEN tot_len = 0;
- bool has_non_numerics = 0;
- str_uv_sort_pair_t *numbers;
-
- hv_len = hv_iterinit(hash);
- if (!hv_len)
- return 0;
-
- Newz(0, keys, hv_len, char *);
- Newz(0, numbers, hv_len, str_uv_sort_pair_t);
-
- while ((entry = hv_iternext(hash))) {
- *(keys+idx) = hv_iterkey(entry, &key_len);
- tot_len += key_len;
-
- if (grok_number(*(keys+idx), key_len, &(numbers+idx)->numeric) != IS_NUMBER_IN_UV) {
- has_non_numerics = 1;
- (numbers+idx)->numeric = 0;
- }
-
- (numbers+idx)->key = *(keys+idx);
- ++idx;
- }
-
- if (total_length)
- *total_length = tot_len;
-
- if (num_sort < 0)
- num_sort = (has_non_numerics) ? 0 : 1;
-
- if (!num_sort) {
- qsort(keys, hv_len, sizeof(char*), _cmp_str);
- }
- else {
- qsort(numbers, hv_len, sizeof(str_uv_sort_pair_t), _cmp_number);
- for (idx = 0; idx < hv_len; ++idx)
- *(keys+idx) = (numbers+idx)->key;
- }
-
- Safefree(numbers);
- return keys;
-}
-
-
-static SV *
-_join_hash_sorted(HV *hash, char *kv_sep, STRLEN kv_sep_len, char *pair_sep, STRLEN pair_sep_len, int use_neat, int num_sort)
-{
- dTHX;
- I32 hv_len;
- STRLEN total_len = 0;
- char **keys;
- unsigned int i = 0;
- SV *return_sv;
-
- keys = _sort_hash_keys(hash, num_sort, &total_len);
- if (!keys)
- return newSVpv("", 0);
-
- if (!kv_sep_len)
- kv_sep_len = strlen(kv_sep);
- if (!pair_sep_len)
- pair_sep_len = strlen(pair_sep);
-
- hv_len = hv_iterinit(hash);
- /* total_len += Separators + quotes + term null */
- total_len += kv_sep_len*hv_len + pair_sep_len*hv_len+2*hv_len+1;
- return_sv = newSV(total_len);
- sv_setpv(return_sv, ""); /* quell undef warnings */
-
- for (i=0; i<hv_len; ++i) {
- SV **hash_svp = hv_fetch(hash, keys[i], strlen(keys[i]), 0);
-
- sv_catpv(return_sv, keys[i]); /* XXX keys can't contain nul chars */
- sv_catpvn(return_sv, kv_sep, kv_sep_len);
-
- if (!hash_svp) { /* should never happen */
- warn("No hash entry with key '%s'", keys[i]);
- sv_catpvn(return_sv, "???", 3);
- continue;
- }
-
- if (use_neat) {
- sv_catpv(return_sv, neatsvpv(*hash_svp,0));
- }
- else {
- if (SvOK(*hash_svp)) {
- STRLEN hv_val_len;
- char *hv_val = SvPV(*hash_svp, hv_val_len);
- sv_catpvn(return_sv, "'", 1);
- sv_catpvn(return_sv, hv_val, hv_val_len);
- sv_catpvn(return_sv, "'", 1);
- }
- else sv_catpvn(return_sv, "undef", 5);
- }
-
- if (i < hv_len-1)
- sv_catpvn(return_sv, pair_sep, pair_sep_len);
- }
-
- Safefree(keys);
-
- return return_sv;
-}
-
-
-
-/* handy for embedding into condition expression for debugging */
-/*
-static int warn1(char *s) { warn("%s", s); return 1; }
-static int dump1(SV *sv) { dTHX; sv_dump(sv); return 1; }
-*/
-
-
-/* --- */
-
-static void
-check_version(const char *name, int dbis_cv, int dbis_cs, int need_dbixs_cv, int drc_s,
- int dbc_s, int stc_s, int fdc_s)
-{
- dTHX;
- dMY_CXT;
- static const char msg[] = "you probably need to rebuild the DBD driver (or possibly the DBI)";
- (void)need_dbixs_cv;
- if (dbis_cv != DBISTATE_VERSION || dbis_cs != sizeof(*DBIS))
- croak("DBI/DBD internal version mismatch (DBI is v%d/s%lu, DBD %s expected v%d/s%d) %s.\n",
- DBISTATE_VERSION, (long unsigned int)sizeof(*DBIS), name, dbis_cv, dbis_cs, msg);
- /* Catch structure size changes - We should probably force a recompile if the DBI */
- /* runtime version is different from the build time. That would be harsh but safe. */
- if (drc_s != sizeof(dbih_drc_t) || dbc_s != sizeof(dbih_dbc_t) ||
- stc_s != sizeof(dbih_stc_t) || fdc_s != sizeof(dbih_fdc_t) )
- croak("%s (dr:%d/%ld, db:%d/%ld, st:%d/%ld, fd:%d/%ld), %s.\n",
- "DBI/DBD internal structure mismatch",
- drc_s, (long)sizeof(dbih_drc_t), dbc_s, (long)sizeof(dbih_dbc_t),
- stc_s, (long)sizeof(dbih_stc_t), fdc_s, (long)sizeof(dbih_fdc_t), msg);
-}
-
-static void
-dbi_bootinit(dbistate_t * parent_dbis)
-{
- dTHX;
- dMY_CXT;
- dbistate_t* DBISx;
-
- DBISx = (struct dbistate_st*)malloc_using_sv(sizeof(struct dbistate_st));
- DBIS = DBISx;
-
- /* make DBIS available to DBD modules the "old" (<= 1.618) way,
- * so that unrecompiled DBD's will still work against a newer DBI */
- sv_setiv(get_sv("DBI::_dbistate", GV_ADDMULTI),
- PTR2IV(MY_CXT.dbi_state));
-
- /* store version and size so we can spot DBI/DBD version mismatch */
- DBIS->check_version = check_version;
- DBIS->version = DBISTATE_VERSION;
- DBIS->size = sizeof(*DBIS);
- DBIS->xs_version = DBIXS_VERSION;
-
- DBIS->logmsg = dbih_logmsg;
- DBIS->logfp = PerlIO_stderr();
- DBIS->debug = (parent_dbis) ? parent_dbis->debug
- : SvIV(get_sv("DBI::dbi_debug",0x5));
- DBIS->neatsvpvlen = (parent_dbis) ? parent_dbis->neatsvpvlen
- : get_sv("DBI::neat_maxlen", GV_ADDMULTI);
-#ifdef DBI_USE_THREADS
- DBIS->thr_owner = PERL_GET_THX;
-#endif
-
- /* store some function pointers so DBD's can call our functions */
- DBIS->getcom = dbih_getcom;
- DBIS->clearcom = dbih_clearcom;
- DBIS->event = dbih_event;
- DBIS->set_attr_k = dbih_set_attr_k;
- DBIS->get_attr_k = dbih_get_attr_k;
- DBIS->get_fbav = dbih_get_fbav;
- DBIS->make_fdsv = dbih_make_fdsv;
- DBIS->neat_svpv = neatsvpv;
- DBIS->bind_as_num = quote_type; /* XXX deprecated */
- DBIS->hash = dbi_hash;
- DBIS->set_err_sv = set_err_sv;
- DBIS->set_err_char= set_err_char;
- DBIS->bind_col = dbih_sth_bind_col;
- DBIS->sql_type_cast_svpv = sql_type_cast_svpv;
-
-
- /* Remember the last handle used. BEWARE! Sneaky stuff here! */
- /* We want a handle reference but we don't want to increment */
- /* the handle's reference count and we don't want perl to try */
- /* to destroy it during global destruction. Take care! */
- DBI_UNSET_LAST_HANDLE; /* ensure setup the correct way */
-
- /* trick to avoid 'possible typo' warnings */
- gv_fetchpv("DBI::state", GV_ADDMULTI, SVt_PV);
- gv_fetchpv("DBI::err", GV_ADDMULTI, SVt_PV);
- gv_fetchpv("DBI::errstr", GV_ADDMULTI, SVt_PV);
- gv_fetchpv("DBI::lasth", GV_ADDMULTI, SVt_PV);
- gv_fetchpv("DBI::rows", GV_ADDMULTI, SVt_PV);
-
- /* we only need to check the env var on the initial boot
- * which is handy because it can core dump during CLONE on windows
- */
- if (!parent_dbis && getenv("PERL_DBI_XSBYPASS"))
- use_xsbypass = atoi(getenv("PERL_DBI_XSBYPASS"));
-}
-
-
-/* ----------------------------------------------------------------- */
-/* Utility functions */
-
-
-static char *
-dbih_htype_name(int htype)
-{
- switch(htype) {
- case DBIt_DR: return "dr";
- case DBIt_DB: return "db";
- case DBIt_ST: return "st";
- case DBIt_FD: return "fd";
- default: return "??";
- }
-}
-
-
-char *
-neatsvpv(SV *sv, STRLEN maxlen) /* return a tidy ascii value, for debugging only */
-{
- dTHX;
- dMY_CXT;
- STRLEN len;
- SV *nsv = Nullsv;
- SV *infosv = Nullsv;
- char *v, *quote;
-
- /* We take care not to alter the supplied sv in any way at all. */
- /* (but if it is SvGMAGICAL we have to call mg_get and that can */
- /* have side effects, especially as it may be called twice overall.) */
-
- if (!sv)
- return "Null!"; /* should never happen */
-
- /* try to do the right thing with magical values */
- if (SvMAGICAL(sv)) {
- if (DBIS_TRACE_LEVEL >= 5) { /* add magic details to help debugging */
- MAGIC* mg;
- infosv = sv_2mortal(newSVpv(" (magic-",0));
- if (SvSMAGICAL(sv)) sv_catpvn(infosv,"s",1);
- if (SvGMAGICAL(sv)) sv_catpvn(infosv,"g",1);
- if (SvRMAGICAL(sv)) sv_catpvn(infosv,"r",1);
- sv_catpvn(infosv,":",1);
- for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic)
- sv_catpvn(infosv, &mg->mg_type, 1);
- sv_catpvn(infosv, ")", 1);
- }
- if (SvGMAGICAL(sv) && !PL_dirty)
- mg_get(sv); /* trigger magic to FETCH the value */
- }
-
- if (!SvOK(sv)) {
- if (SvTYPE(sv) >= SVt_PVAV)
- return (char *)sv_reftype(sv,0); /* raw AV/HV etc, not via a ref */
- if (!infosv)
- return "undef";
- sv_insert(infosv, 0,0, "undef",5);
- return SvPVX(infosv);
- }
-
- if (SvNIOK(sv)) { /* is a numeric value - so no surrounding quotes */
- if (SvPOK(sv)) { /* already has string version of the value, so use it */
- v = SvPV(sv,len);
- if (len == 0) { v="''"; len=2; } /* catch &sv_no style special case */
- if (!infosv)
- return v;
- sv_insert(infosv, 0,0, v, len);
- return SvPVX(infosv);
- }
- /* we don't use SvPV here since we don't want to alter sv in _any_ way */
- if (SvUOK(sv))
- nsv = newSVpvf("%"UVuf, SvUVX(sv));
- else if (SvIOK(sv))
- nsv = newSVpvf("%"IVdf, SvIVX(sv));
- else nsv = newSVpvf("%"NVgf, SvNVX(sv));
- if (infosv)
- sv_catsv(nsv, infosv);
- return SvPVX(sv_2mortal(nsv));
- }
-
- nsv = sv_newmortal();
- sv_upgrade(nsv, SVt_PV);
-
- if (SvROK(sv)) {
- if (!SvAMAGIC(sv)) /* (un-amagic'd) refs get no special treatment */
- v = SvPV(sv,len);
- else {
- /* handle Overload magic refs */
- (void)SvAMAGIC_off(sv); /* should really be done via local scoping */
- v = SvPV(sv,len); /* XXX how does this relate to SvGMAGIC? */
- SvAMAGIC_on(sv);
- }
- sv_setpvn(nsv, v, len);
- if (infosv)
- sv_catsv(nsv, infosv);
- return SvPV(nsv, len);
- }
-
- if (SvPOK(sv)) /* usual simple string case */
- v = SvPV(sv,len);
- else /* handles all else via sv_2pv() */
- v = SvPV(sv,len); /* XXX how does this relate to SvGMAGIC? */
-
- /* for strings we limit the length and translate codes */
- if (maxlen == 0)
- maxlen = SvIV(DBIS->neatsvpvlen);
- if (maxlen < 6) /* handle daft values */
- maxlen = 6;
- maxlen -= 2; /* account for quotes */
-
- quote = (SvUTF8(sv)) ? "\"" : "'";
- if (len > maxlen) {
- SvGROW(nsv, (1+maxlen+1+1));
- sv_setpvn(nsv, quote, 1);
- sv_catpvn(nsv, v, maxlen-3); /* account for three dots */
- sv_catpvn(nsv, "...", 3);
- } else {
- SvGROW(nsv, (1+len+1+1));
- sv_setpvn(nsv, quote, 1);
- sv_catpvn(nsv, v, len);
- }
- sv_catpvn(nsv, quote, 1);
- if (infosv)
- sv_catsv(nsv, infosv);
- v = SvPV(nsv, len);
- if (!SvUTF8(sv)) {
- while(len-- > 0) { /* cleanup string (map control chars to ascii etc) */
- const char c = v[len] & 0x7F; /* ignore top bit for multinational chars */
- if (!isPRINT(c) && !isSPACE(c))
- v[len] = '.';
- }
- }
- return v;
-}
-
-
-static void
-copy_statement_to_parent(pTHX_ SV *h, imp_xxh_t *imp_xxh)
-{
- SV *parent;
- if (PL_dirty)
- return;
- parent = DBIc_PARENT_H(imp_xxh);
- if (parent && SvROK(parent)) {
- SV *tmp_sv = *hv_fetch((HV*)SvRV(h), "Statement", 9, 1);
- if (SvOK(tmp_sv))
- (void)hv_store((HV*)SvRV(parent), "Statement", 9, SvREFCNT_inc(tmp_sv), 0);
- }
-}
-
-
-static int
-set_err_char(SV *h, imp_xxh_t *imp_xxh, const char *err_c, IV err_i, const char *errstr, const char *state, const char *method)
-{
- dTHX;
- char err_buf[28];
- SV *err_sv, *errstr_sv, *state_sv, *method_sv;
- if (!err_c) {
- sprintf(err_buf, "%ld", (long)err_i);
- err_c = &err_buf[0];
- }
- err_sv = (strEQ(err_c,"1")) ? &PL_sv_yes : sv_2mortal(newSVpvn(err_c, strlen(err_c)));
- errstr_sv = sv_2mortal(newSVpvn(errstr, strlen(errstr)));
- state_sv = (state && *state) ? sv_2mortal(newSVpvn(state, strlen(state))) : &PL_sv_undef;
- method_sv = (method && *method) ? sv_2mortal(newSVpvn(method, strlen(method))) : &PL_sv_undef;
- return set_err_sv(h, imp_xxh, err_sv, errstr_sv, state_sv, method_sv);
-}
-
-
-static int
-set_err_sv(SV *h, imp_xxh_t *imp_xxh, SV *err, SV *errstr, SV *state, SV *method)
-{
- dTHX;
- SV *h_err;
- SV *h_errstr;
- SV *h_state;
- SV **hook_svp;
- int err_changed = 0;
-
- if ( DBIc_has(imp_xxh, DBIcf_HandleSetErr)
- && (hook_svp = hv_fetch((HV*)SvRV(h),"HandleSetErr",12,0))
- && hook_svp
- && ((void)(SvGMAGICAL(*hook_svp) && mg_get(*hook_svp)), SvOK(*hook_svp))
- ) {
- dSP;
- IV items;
- SV *response_sv;
- if (SvREADONLY(err)) err = sv_mortalcopy(err);
- if (SvREADONLY(errstr)) errstr = sv_mortalcopy(errstr);
- if (SvREADONLY(state)) state = sv_mortalcopy(state);
- if (SvREADONLY(method)) method = sv_mortalcopy(method);
- if (DBIc_TRACE_LEVEL(imp_xxh) >= 2)
- PerlIO_printf(DBIc_LOGPIO(imp_xxh)," -> HandleSetErr(%s, err=%s, errstr=%s, state=%s, %s)\n",
- neatsvpv(h,0), neatsvpv(err,0), neatsvpv(errstr,0), neatsvpv(state,0),
- neatsvpv(method,0)
- );
- PUSHMARK(SP);
- XPUSHs(sv_2mortal(newRV_inc((SV*)DBIc_MY_H(imp_xxh))));
- XPUSHs(err);
- XPUSHs(errstr);
- XPUSHs(state);
- XPUSHs(method);
- PUTBACK;
- items = call_sv(*hook_svp, G_SCALAR);
- SPAGAIN;
- response_sv = (items) ? POPs : &PL_sv_undef;
- PUTBACK;
- if (DBIc_TRACE_LEVEL(imp_xxh) >= 1)
- PerlIO_printf(DBIc_LOGPIO(imp_xxh)," <- HandleSetErr= %s (err=%s, errstr=%s, state=%s, %s)\n",
- neatsvpv(response_sv,0), neatsvpv(err,0), neatsvpv(errstr,0), neatsvpv(state,0),
- neatsvpv(method,0)
- );
- if (SvTRUE(response_sv)) /* handler says it has handled it, so... */
- return 0;
- }
- else {
- if (DBIc_TRACE_LEVEL(imp_xxh) >= 2)
- PerlIO_printf(DBIc_LOGPIO(imp_xxh)," -- HandleSetErr err=%s, errstr=%s, state=%s, %s\n",
- neatsvpv(err,0), neatsvpv(errstr,0), neatsvpv(state,0), neatsvpv(method,0)
- );
- }
-
- if (!SvOK(err)) { /* clear err / errstr / state */
- DBIh_CLEAR_ERROR(imp_xxh);
- return 1;
- }
-
- /* fetch these after calling HandleSetErr */
- h_err = DBIc_ERR(imp_xxh);
- h_errstr = DBIc_ERRSTR(imp_xxh);
- h_state = DBIc_STATE(imp_xxh);
-
- if (SvTRUE(h_errstr)) {
- /* append current err, if any, to errstr if it's going to change */
- if (SvTRUE(h_err) && SvTRUE(err) && strNE(SvPV_nolen(h_err), SvPV_nolen(err)))
- sv_catpvf(h_errstr, " [err was %s now %s]", SvPV_nolen(h_err), SvPV_nolen(err));
- if (SvTRUE(h_state) && SvTRUE(state) && strNE(SvPV_nolen(h_state), SvPV_nolen(state)))
- sv_catpvf(h_errstr, " [state was %s now %s]", SvPV_nolen(h_state), SvPV_nolen(state));
- if (strNE(SvPV_nolen(h_errstr), SvPV_nolen(errstr))) {
- sv_catpvn(h_errstr, "\n", 1);
- sv_catsv(h_errstr, errstr);
- }
- }
- else
- sv_setsv(h_errstr, errstr);
-
- /* SvTRUE(err) > "0" > "" > undef */
- if (SvTRUE(err) /* new error: so assign */
- || !SvOK(h_err) /* no existing warn/info: so assign */
- /* new warn ("0" len 1) > info ("" len 0): so assign */
- || (SvOK(err) && strlen(SvPV_nolen(err)) > strlen(SvPV_nolen(h_err)))
- ) {
- sv_setsv(h_err, err);
- err_changed = 1;
- if (SvTRUE(h_err)) /* new error */
- ++DBIc_ErrCount(imp_xxh);
- }
-
- if (err_changed) {
- if (SvTRUE(state)) {
- if (strlen(SvPV_nolen(state)) != 5) {
- warn("set_err: state (%s) is not a 5 character string, using 'S1000' instead", neatsvpv(state,0));
- sv_setpv(h_state, "S1000");
- }
- else
- sv_setsv(h_state, state);
- }
- else
- (void)SvOK_off(h_state); /* see DBIc_STATE_adjust */
-
- /* ensure that the parent's Statement attribute reflects the latest error */
- /* so that ShowErrorStatement is reliable */
- copy_statement_to_parent(aTHX_ h, imp_xxh);
- }
-
- return 1;
-}
-
-
-/* err_hash returns a U32 'hash' value representing the current err 'level'
- * (err/warn/info) and errstr. It's used by the dispatcher as a way to detect
- * a new or changed warning during a 'keep err' method like STORE. Always returns >0.
- * The value is 1 for no err/warn/info and guarantees that err > warn > info.
- * (It's a bit of a hack but the original approach in 70fe6bd76 using a new
- * ErrChangeCount attribute would break binary compatibility with drivers.)
- * The chance that two realistic errstr values would hash the same, even with
- * only 30 bits, is deemed to small to even bother documenting.
- */
-static U32
-err_hash(pTHX_ imp_xxh_t *imp_xxh)
-{
- SV *err_sv = DBIc_ERR(imp_xxh);
- SV *errstr_sv;
- I32 hash = 1;
- if (SvOK(err_sv)) {
- errstr_sv = DBIc_ERRSTR(imp_xxh);
- if (SvOK(errstr_sv))
- hash = -dbi_hash(SvPV_nolen(errstr_sv), 0); /* make positive */
- else hash = 0;
- hash >>= 1; /* free up extra bit (top bit is already free) */
- hash |= (SvTRUE(err_sv)) ? 0x80000000 /* err */
- : (SvPOK(err_sv) && !SvCUR(err_sv)) ? 0x20000000 /* '' = info */
- : 0x40000000;/* 0 or '0' = warn */
- }
- return hash;
-}
-
-
-static char *
-mkvname(pTHX_ HV *stash, const char *item, int uplevel) /* construct a variable name */
-{
- SV *sv = sv_newmortal();
- sv_setpv(sv, HvNAME(stash));
- if(uplevel) {
- while(SvCUR(sv) && *SvEND(sv)!=':')
- --SvCUR(sv);
- if (SvCUR(sv))
- --SvCUR(sv);
- }
- sv_catpv(sv, "::");
- sv_catpv(sv, item);
- return SvPV_nolen(sv);
-}
-
-/* 32 bit magic FNV-0 and FNV-1 prime */
-#define FNV_32_PRIME ((UV)0x01000193)
-
-static I32
-dbi_hash(const char *key, long type)
-{
- if (type == 0) {
- STRLEN klen = strlen(key);
- U32 hash = 0;
- while (klen--)
- hash = hash * 33 + *key++;
- hash &= 0x7FFFFFFF; /* limit to 31 bits */
- hash |= 0x40000000; /* set bit 31 */
- return -(I32)hash; /* return negative int */
- }
- else if (type == 1) { /* Fowler/Noll/Vo hash */
- /* see http://www.isthe.com/chongo/tech/comp/fnv/ */
- U32 hash = 0x811c9dc5;
- const unsigned char *s = (unsigned char *)key; /* unsigned string */
- while (*s) {
- /* multiply by the 32 bit FNV magic prime mod 2^32 */
- hash *= FNV_32_PRIME;
- /* xor the bottom with the current octet */
- hash ^= (U32)*s++;
- }
- return hash;
- }
- croak("DBI::hash(%ld): invalid type", type);
- return 0; /* NOT REACHED */
-}
-
-
-static int
-dbih_logmsg(imp_xxh_t *imp_xxh, const char *fmt, ...)
-{
- dTHX;
- va_list args;
-#ifdef I_STDARG
- va_start(args, fmt);
-#else
- va_start(args);
-#endif
- (void) PerlIO_vprintf(DBIc_DBISTATE(imp_xxh)->logfp, fmt, args);
- va_end(args);
- (void)imp_xxh;
- return 1;
-}
-
-static void
-close_trace_file(pTHX)
-{
- dMY_CXT;
- if (DBILOGFP == PerlIO_stderr() || DBILOGFP == PerlIO_stdout())
- return;
-
- if (DBIS->logfp_ref == NULL)
- PerlIO_close(DBILOGFP);
- else {
- /* DAA dec refcount and discard */
- SvREFCNT_dec(DBIS->logfp_ref);
- DBIS->logfp_ref = NULL;
- }
-}
-
-static int
-set_trace_file(SV *file)
-{
- dTHX;
- dMY_CXT;
- const char *filename;
- PerlIO *fp = Nullfp;
- IO *io;
-
- if (!file) /* no arg == no change */
- return 0;
-
- /* DAA check for a filehandle */
- if (SvROK(file)) {
- io = sv_2io(file);
- if (!io || !(fp = IoOFP(io))) {
- warn("DBI trace filehandle is not valid");
- return 0;
- }
- close_trace_file(aTHX);
- (void)SvREFCNT_inc(io);
- DBIS->logfp_ref = io;
- }
- else if (isGV_with_GP(file)) {
- io = GvIO(file);
- if (!io || !(fp = IoOFP(io))) {
- warn("DBI trace filehandle from GLOB is not valid");
- return 0;
- }
- close_trace_file(aTHX);
- (void)SvREFCNT_inc(io);
- DBIS->logfp_ref = io;
- }
- else {
- filename = (SvOK(file)) ? SvPV_nolen(file) : Nullch;
- /* undef arg == reset back to stderr */
- if (!filename || strEQ(filename,"STDERR")
- || strEQ(filename,"*main::STDERR")) {
- close_trace_file(aTHX);
- DBILOGFP = PerlIO_stderr();
- return 1;
- }
- if (strEQ(filename,"STDOUT")) {
- close_trace_file(aTHX);
- DBILOGFP = PerlIO_stdout();
- return 1;
- }
- fp = PerlIO_open(filename, "a+");
- if (fp == Nullfp) {
- warn("Can't open trace file %s: %s", filename, Strerror(errno));
- return 0;
- }
- close_trace_file(aTHX);
- }
- DBILOGFP = fp;
- /* if this line causes your compiler or linker to choke */
- /* then just comment it out, it's not essential. */
- PerlIO_setlinebuf(fp); /* force line buffered output */
- return 1;
-}
-
-static IV
-parse_trace_flags(SV *h, SV *level_sv, IV old_level)
-{
- dTHX;
- IV level;
- if (!level_sv || !SvOK(level_sv))
- level = old_level; /* undef: no change */
- else
- if (SvTRUE(level_sv)) {
- if (looks_like_number(level_sv))
- level = SvIV(level_sv); /* number: number */
- else { /* string: parse it */
- dSP;
- PUSHMARK(sp);
- XPUSHs(h);
- XPUSHs(level_sv);
- PUTBACK;
- if (call_method("parse_trace_flags", G_SCALAR) != 1)
- croak("panic: parse_trace_flags");/* should never happen */
- SPAGAIN;
- level = POPi;
- PUTBACK;
- }
- }
- else /* defined but false: 0 */
- level = 0;
- return level;
-}
-
-
-static int
-set_trace(SV *h, SV *level_sv, SV *file)
-{
- dTHX;
- D_imp_xxh(h);
- int RETVAL = DBIc_DBISTATE(imp_xxh)->debug; /* Return trace level in effect now */
- IV level = parse_trace_flags(h, level_sv, RETVAL);
- set_trace_file(file);
- if (level != RETVAL) { /* set value */
- if ((level & DBIc_TRACE_LEVEL_MASK) > 0) {
- PerlIO_printf(DBIc_LOGPIO(imp_xxh),
- " %s trace level set to 0x%lx/%ld (DBI @ 0x%lx/%ld) in DBI %s%s (pid %d)\n",
- neatsvpv(h,0),
- (long)(level & DBIc_TRACE_FLAGS_MASK),
- (long)(level & DBIc_TRACE_LEVEL_MASK),
- (long)DBIc_TRACE_FLAGS(imp_xxh), (long)DBIc_TRACE_LEVEL(imp_xxh),
- XS_VERSION, dbi_build_opt, (int)PerlProc_getpid());
- if (!PL_dowarn)
- PerlIO_printf(DBIc_LOGPIO(imp_xxh)," Note: perl is running without the recommended perl -w option\n");
- PerlIO_flush(DBIc_LOGPIO(imp_xxh));
- }
- sv_setiv(DBIc_DEBUG(imp_xxh), level);
- }
- return RETVAL;
-}
-
-
-static SV *
-dbih_inner(pTHX_ SV *orv, const char *what)
-{ /* convert outer to inner handle else croak(what) if what is not NULL */
- /* if what is NULL then return NULL for invalid handles */
- MAGIC *mg;
- SV *ohv; /* outer HV after derefing the RV */
- SV *hrv; /* dbi inner handle RV-to-HV */
-
- /* enable a raw HV (not ref-to-HV) to be passed in, eg DBIc_MY_H */
- ohv = SvROK(orv) ? SvRV(orv) : orv;
-
- if (!ohv || SvTYPE(ohv) != SVt_PVHV) {
- if (!what)
- return NULL;
- if (1) {
- dMY_CXT;
- if (DBIS_TRACE_LEVEL)
- sv_dump(orv);
- }
- if (!SvOK(orv))
- croak("%s given an undefined handle %s",
- what, "(perhaps returned from a previous call which failed)");
- croak("%s handle %s is not a DBI handle", what, neatsvpv(orv,0));
- }
- if (!SvMAGICAL(ohv)) {
- if (!what)
- return NULL;
- sv_dump(orv);
- croak("%s handle %s is not a DBI handle (has no magic)",
- what, neatsvpv(orv,0));
- }
-
- if ( (mg=mg_find(ohv,'P')) == NULL) { /* hash tie magic */
- /* not tied, maybe it's already an inner handle... */
- if (mg_find(ohv, DBI_MAGIC) == NULL) {
- if (!what)
- return NULL;
- sv_dump(orv);
- croak("%s handle %s is not a valid DBI handle",
- what, neatsvpv(orv,0));
- }
- hrv = orv; /* was already a DBI handle inner hash */
- }
- else {
- hrv = mg->mg_obj; /* inner hash of tie */
- }
-
- return hrv;
-}
-
-
-
-/* -------------------------------------------------------------------- */
-/* Functions to manage a DBI handle (magic and attributes etc). */
-
-static imp_xxh_t *
-dbih_getcom(SV *hrv) /* used by drivers via DBIS func ptr */
-{
- MAGIC *mg;
- SV *sv;
-
- /* short-cut common case */
- if ( SvROK(hrv)
- && (sv = SvRV(hrv))
- && SvRMAGICAL(sv)
- && (mg = SvMAGIC(sv))
- && mg->mg_type == DBI_MAGIC
- && mg->mg_ptr
- )
- return (imp_xxh_t *) mg->mg_ptr;
-
- {
- dTHX;
- imp_xxh_t *imp_xxh = dbih_getcom2(aTHX_ hrv, 0);
- if (!imp_xxh) /* eg after take_imp_data */
- croak("Invalid DBI handle %s, has no dbi_imp_data", neatsvpv(hrv,0));
- return imp_xxh;
- }
-}
-
-static imp_xxh_t *
-dbih_getcom2(pTHX_ SV *hrv, MAGIC **mgp) /* Get com struct for handle. Must be fast. */
-{
- MAGIC *mg;
- SV *sv;
-
- /* important and quick sanity check (esp non-'safe' Oraperl) */
- if (SvROK(hrv)) /* must at least be a ref */
- sv = SvRV(hrv);
- else {
- dMY_CXT;
- if (hrv == DBI_LAST_HANDLE) /* special for var::FETCH */
- sv = DBI_LAST_HANDLE;
- else if (sv_derived_from(hrv, "DBI::common")) {
- /* probably a class name, if ref($h)->foo() */
- return 0;
- }
- else {
- sv_dump(hrv);
- croak("Invalid DBI handle %s", neatsvpv(hrv,0));
- sv = &PL_sv_undef; /* avoid "might be used uninitialized" warning */
- }
- }
-
- /* Short cut for common case. We assume that a magic var always */
- /* has magic and that DBI_MAGIC, if present, will be the first. */
- if (SvRMAGICAL(sv) && (mg=SvMAGIC(sv))->mg_type == DBI_MAGIC) {
- /* nothing to do here */
- }
- else {
- /* Validate handle (convert outer to inner if required) */
- hrv = dbih_inner(aTHX_ hrv, "dbih_getcom");
- mg = mg_find(SvRV(hrv), DBI_MAGIC);
- }
- if (mgp) /* let caller pickup magic struct for this handle */
- *mgp = mg;
-
- if (!mg) /* may happen during global destruction */
- return (imp_xxh_t *) 0;
-
- return (imp_xxh_t *) mg->mg_ptr;
-}
-
-
-static SV *
-dbih_setup_attrib(pTHX_ SV *h, imp_xxh_t *imp_xxh, char *attrib, SV *parent, int read_only, int optional)
-{
- STRLEN len = strlen(attrib);
- SV **asvp;
-
- asvp = hv_fetch((HV*)SvRV(h), attrib, len, !optional);
- /* we assume that we won't have any existing 'undef' attributes here */
- /* (or, alternately, we take undef to mean 'copy from parent') */
- if (!(asvp && SvOK(*asvp))) { /* attribute doesn't already exists (the common case) */
- SV **psvp;
- if ((!parent || !SvROK(parent)) && !optional) {
- croak("dbih_setup_attrib(%s): %s not set and no parent supplied",
- neatsvpv(h,0), attrib);
- }
- psvp = hv_fetch((HV*)SvRV(parent), attrib, len, 0);
- if (psvp) {
- if (!asvp)
- asvp = hv_fetch((HV*)SvRV(h), attrib, len, 1);
- sv_setsv(*asvp, *psvp); /* copy attribute from parent to handle */
- }
- else {
- if (!optional)
- croak("dbih_setup_attrib(%s): %s not set and not in parent",
- neatsvpv(h,0), attrib);
- }
- }
- if (DBIc_TRACE_LEVEL(imp_xxh) >= 5) {
- PerlIO *logfp = DBIc_LOGPIO(imp_xxh);
- PerlIO_printf(logfp," dbih_setup_attrib(%s, %s, %s)",
- neatsvpv(h,0), attrib, neatsvpv(parent,0));
- if (!asvp)
- PerlIO_printf(logfp," undef (not defined)\n");
- else
- if (SvOK(*asvp))
- PerlIO_printf(logfp," %s (already defined)\n", neatsvpv(*asvp,0));
- else PerlIO_printf(logfp," %s (copied from parent)\n", neatsvpv(*asvp,0));
- }
- if (read_only && asvp)
- SvREADONLY_on(*asvp);
- return asvp ? *asvp : &PL_sv_undef;
-}
-
-
-static SV *
-dbih_make_fdsv(SV *sth, const char *imp_class, STRLEN imp_size, const char *col_name)
-{
- dTHX;
- D_imp_sth(sth);
- const STRLEN cn_len = strlen(col_name);
- imp_fdh_t *imp_fdh;
- SV *fdsv;
- if (imp_size < sizeof(imp_fdh_t) || cn_len<10 || strNE("::fd",&col_name[cn_len-4]))
- croak("panic: dbih_makefdsv %s '%s' imp_size %ld invalid",
- imp_class, col_name, (long)imp_size);
- if (DBIc_TRACE_LEVEL(imp_sth) >= 5)
- PerlIO_printf(DBIc_LOGPIO(imp_sth)," dbih_make_fdsv(%s, %s, %ld, '%s')\n",
- neatsvpv(sth,0), imp_class, (long)imp_size, col_name);
- fdsv = dbih_make_com(sth, (imp_xxh_t*)imp_sth, imp_class, imp_size, cn_len+2, 0);
- imp_fdh = (imp_fdh_t*)(void*)SvPVX(fdsv);
- imp_fdh->com.col_name = ((char*)imp_fdh) + imp_size;
- strcpy(imp_fdh->com.col_name, col_name);
- return fdsv;
-}
-
-
-static SV *
-dbih_make_com(SV *p_h, imp_xxh_t *p_imp_xxh, const char *imp_class, STRLEN imp_size, STRLEN extra, SV* imp_templ)
-{
- dTHX;
- static const char *errmsg = "Can't make DBI com handle for %s: %s";
- HV *imp_stash;
- SV *dbih_imp_sv;
- imp_xxh_t *imp;
- int trace_level;
- PERL_UNUSED_VAR(extra);
-
- if ( (imp_stash = gv_stashpv(imp_class, FALSE)) == NULL)
- croak(errmsg, imp_class, "unknown package");
-
- if (imp_size == 0) {
- /* get size of structure to allocate for common and imp specific data */
- const char *imp_size_name = mkvname(aTHX_ imp_stash, "imp_data_size", 0);
- imp_size = SvIV(get_sv(imp_size_name, 0x05));
- if (imp_size == 0) {
- imp_size = sizeof(imp_sth_t);
- if (sizeof(imp_dbh_t) > imp_size)
- imp_size = sizeof(imp_dbh_t);
- if (sizeof(imp_drh_t) > imp_size)
- imp_size = sizeof(imp_drh_t);
- imp_size += 4;
- }
- }
-
- if (p_imp_xxh) {
- trace_level = DBIc_TRACE_LEVEL(p_imp_xxh);
- }
- else {
- dMY_CXT;
- trace_level = DBIS_TRACE_LEVEL;
- }
- if (trace_level >= 5) {
- dMY_CXT;
- PerlIO_printf(DBILOGFP," dbih_make_com(%s, %p, %s, %ld, %p) thr#%p\n",
- neatsvpv(p_h,0), (void*)p_imp_xxh, imp_class, (long)imp_size, (void*)imp_templ, (void*)PERL_GET_THX);
- }
-
- if (imp_templ && SvOK(imp_templ)) {
- U32 imp_templ_flags;
- /* validate the supplied dbi_imp_data looks reasonable, */
- if (SvCUR(imp_templ) != imp_size)
- croak("Can't use dbi_imp_data of wrong size (%ld not %ld)",
- (long)SvCUR(imp_templ), (long)imp_size);
-
- /* copy the whole template */
- dbih_imp_sv = newSVsv(imp_templ);
- imp = (imp_xxh_t*)(void*)SvPVX(dbih_imp_sv);
-
- /* sanity checks on the supplied imp_data */
- if (DBIc_TYPE(imp) != ((p_imp_xxh) ? DBIc_TYPE(p_imp_xxh)+1 :1) )
- croak("Can't use dbi_imp_data from different type of handle");
- if (!DBIc_has(imp, DBIcf_IMPSET))
- croak("Can't use dbi_imp_data that not from a setup handle");
-
- /* copy flags, zero out our imp_xxh struct, restore some flags */
- imp_templ_flags = DBIc_FLAGS(imp);
- switch ( (p_imp_xxh) ? DBIc_TYPE(p_imp_xxh)+1 : DBIt_DR ) {
- case DBIt_DR: memzero((char*)imp, sizeof(imp_drh_t)); break;
- case DBIt_DB: memzero((char*)imp, sizeof(imp_dbh_t)); break;
- case DBIt_ST: memzero((char*)imp, sizeof(imp_sth_t)); break;
- default: croak("dbih_make_com dbi_imp_data bad h type");
- }
- /* Only pass on DBIcf_IMPSET to indicate to driver that the imp */
- /* structure has been copied and it doesn't need to reconnect. */
- /* Similarly DBIcf_ACTIVE is also passed along but isn't key. */
- DBIc_FLAGS(imp) = imp_templ_flags & (DBIcf_IMPSET|DBIcf_ACTIVE);
- }
- else {
- dbih_imp_sv = newSV(imp_size); /* is grown to at least imp_size+1 */
- imp = (imp_xxh_t*)(void*)SvPVX(dbih_imp_sv);
- memzero((char*)imp, imp_size);
- /* set up SV with SvCUR set ready for take_imp_data */
- SvCUR_set(dbih_imp_sv, imp_size);
- *SvEND(dbih_imp_sv) = '\0';
- }
-
- if (p_imp_xxh) {
- DBIc_DBISTATE(imp) = DBIc_DBISTATE(p_imp_xxh);
- }
- else {
- dMY_CXT;
- DBIc_DBISTATE(imp) = DBIS;
- }
- DBIc_IMP_STASH(imp) = imp_stash;
-
- if (!p_h) { /* only a driver (drh) has no parent */
- DBIc_PARENT_H(imp) = &PL_sv_undef;
- DBIc_PARENT_COM(imp) = NULL;
- DBIc_TYPE(imp) = DBIt_DR;
- DBIc_on(imp,DBIcf_WARN /* set only here, children inherit */
- |DBIcf_ACTIVE /* drivers are 'Active' by default */
- |DBIcf_AutoCommit /* advisory, driver must manage this */
- );
- DBIc_set(imp, DBIcf_PrintWarn, 1);
- }
- else {
- DBIc_PARENT_H(imp) = (SV*)SvREFCNT_inc(p_h); /* ensure it lives */
- DBIc_PARENT_COM(imp) = p_imp_xxh; /* shortcut for speed */
- DBIc_TYPE(imp) = DBIc_TYPE(p_imp_xxh) + 1;
- /* inherit some flags from parent and carry forward some from template */
- DBIc_FLAGS(imp) = (DBIc_FLAGS(p_imp_xxh) & ~DBIcf_INHERITMASK)
- | (DBIc_FLAGS(imp) & (DBIcf_IMPSET|DBIcf_ACTIVE));
- ++DBIc_KIDS(p_imp_xxh);
- }
-#ifdef DBI_USE_THREADS
- DBIc_THR_USER(imp) = PERL_GET_THX ;
-#endif
-
- if (DBIc_TYPE(imp) == DBIt_ST) {
- imp_sth_t *imp_sth = (imp_sth_t*)imp;
- DBIc_ROW_COUNT(imp_sth) = -1;
- }
-
- DBIc_COMSET_on(imp); /* common data now set up */
-
- /* The implementor should DBIc_IMPSET_on(imp) when setting up */
- /* any private data which will need clearing/freeing later. */
-
- return dbih_imp_sv;
-}
-
-
-static void
-dbih_setup_handle(pTHX_ SV *orv, char *imp_class, SV *parent, SV *imp_datasv)
-{
- SV *h;
- char *errmsg = "Can't setup DBI handle of %s to %s: %s";
- SV *dbih_imp_sv;
- SV *dbih_imp_rv;
- SV *dbi_imp_data = Nullsv;
- SV **svp;
- char imp_mem_name[300];
- HV *imp_mem_stash;
- imp_xxh_t *imp;
- imp_xxh_t *parent_imp;
- int trace_level;
-
- h = dbih_inner(aTHX_ orv, "dbih_setup_handle");
- parent = dbih_inner(aTHX_ parent, NULL); /* check parent valid (& inner) */
- if (parent) {
- parent_imp = DBIh_COM(parent);
- trace_level = DBIc_TRACE_LEVEL(parent_imp);
- }
- else {
- dMY_CXT;
- parent_imp = NULL;
- trace_level = DBIS_TRACE_LEVEL;
- }
-
- if (trace_level >= 5) {
- dMY_CXT;
- PerlIO_printf(DBILOGFP," dbih_setup_handle(%s=>%s, %s, %lx, %s)\n",
- neatsvpv(orv,0), neatsvpv(h,0), imp_class, (long)parent, neatsvpv(imp_datasv,0));
- }
-
- if (mg_find(SvRV(h), DBI_MAGIC) != NULL)
- croak(errmsg, neatsvpv(orv,0), imp_class, "already a DBI (or ~magic) handle");
-
- strcpy(imp_mem_name, imp_class);
- strcat(imp_mem_name, "_mem");
- if ( (imp_mem_stash = gv_stashpv(imp_mem_name, FALSE)) == NULL)
- croak(errmsg, neatsvpv(orv,0), imp_mem_name, "unknown _mem package");
-
- if ((svp = hv_fetch((HV*)SvRV(h), "dbi_imp_data", 12, 0))) {
- dbi_imp_data = *svp;
- if (SvGMAGICAL(dbi_imp_data)) /* call FETCH via magic */
- mg_get(dbi_imp_data);
- }
-
- DBI_LOCK;
-
- dbih_imp_sv = dbih_make_com(parent, parent_imp, imp_class, 0, 0, dbi_imp_data);
- imp = (imp_xxh_t*)(void*)SvPVX(dbih_imp_sv);
-
- dbih_imp_rv = newRV_inc(dbih_imp_sv); /* just needed for sv_bless */
- sv_bless(dbih_imp_rv, imp_mem_stash);
- sv_free(dbih_imp_rv);
-
- DBIc_MY_H(imp) = (HV*)SvRV(orv); /* take _copy_ of pointer, not new ref */
- DBIc_IMP_DATA(imp) = (imp_datasv) ? newSVsv(imp_datasv) : &PL_sv_undef;
- _imp2com(imp, std.pid) = (U32)PerlProc_getpid();
-
- if (DBIc_TYPE(imp) <= DBIt_ST) {
- SV **tmp_svp;
- /* Copy some attributes from parent if not defined locally and */
- /* also take address of attributes for speed of direct access. */
- /* parent is null for drh, in which case h must hold the values */
-#define COPY_PARENT(name,ro,opt) SvREFCNT_inc(dbih_setup_attrib(aTHX_ h,imp,(name),parent,ro,opt))
-#define DBIc_ATTR(imp, f) _imp2com(imp, attr.f)
- /* XXX we should validate that these are the right type (refs etc) */
- DBIc_ATTR(imp, Err) = COPY_PARENT("Err",1,0); /* scalar ref */
- DBIc_ATTR(imp, State) = COPY_PARENT("State",1,0); /* scalar ref */
- DBIc_ATTR(imp, Errstr) = COPY_PARENT("Errstr",1,0); /* scalar ref */
- DBIc_ATTR(imp, TraceLevel)=COPY_PARENT("TraceLevel",0,0);/* scalar (int)*/
- DBIc_ATTR(imp, FetchHashKeyName) = COPY_PARENT("FetchHashKeyName",0,0); /* scalar ref */
-
- if (parent) {
- dbih_setup_attrib(aTHX_ h,imp,"HandleSetErr",parent,0,1);
- dbih_setup_attrib(aTHX_ h,imp,"HandleError",parent,0,1);
- dbih_setup_attrib(aTHX_ h,imp,"ReadOnly",parent,0,1);
- dbih_setup_attrib(aTHX_ h,imp,"Profile",parent,0,1);
-
- /* setup Callbacks from parents' ChildCallbacks */
- if (DBIc_has(parent_imp, DBIcf_Callbacks)
- && (tmp_svp = hv_fetch((HV*)SvRV(parent), "Callbacks", 9, 0))
- && SvROK(*tmp_svp) && SvTYPE(SvRV(*tmp_svp)) == SVt_PVHV
- && (tmp_svp = hv_fetch((HV*)SvRV(*tmp_svp), "ChildCallbacks", 14, 0))
- && SvROK(*tmp_svp) && SvTYPE(SvRV(*tmp_svp)) == SVt_PVHV
- ) {
- /* XXX mirrors behaviour of dbih_set_attr_k() of Callbacks */
- (void)hv_store((HV*)SvRV(h), "Callbacks", 9, newRV_inc(SvRV(*tmp_svp)), 0);
- DBIc_set(imp, DBIcf_Callbacks, 1);
- }
-
- DBIc_LongReadLen(imp) = DBIc_LongReadLen(parent_imp);
-#ifdef sv_rvweaken
- if (1) {
- AV *av;
- /* add weakref to new (outer) handle into parents ChildHandles array */
- tmp_svp = hv_fetch((HV*)SvRV(parent), "ChildHandles", 12, 1);
- if (!SvROK(*tmp_svp)) {
- SV *ChildHandles_rvav = newRV_noinc((SV*)newAV());
- sv_setsv(*tmp_svp, ChildHandles_rvav);
- sv_free(ChildHandles_rvav);
- }
- av = (AV*)SvRV(*tmp_svp);
- av_push(av, (SV*)sv_rvweaken(newRV_inc((SV*)SvRV(orv))));
- if (av_len(av) % 120 == 0) {
- /* time to do some housekeeping to remove dead handles */
- I32 i = av_len(av); /* 0 = 1 element */
- while (i-- >= 0) {
- SV *sv = av_shift(av);
- if (SvOK(sv))
- av_push(av, sv);
- else
- sv_free(sv); /* keep it leak-free by Doru Petrescu pdoru.dbi@from.ro */
- }
- }
- }
-#endif
- }
- else {
- DBIc_LongReadLen(imp) = DBIc_LongReadLen_init;
- }
-
- switch (DBIc_TYPE(imp)) {
- case DBIt_DB:
- /* cache _inner_ handle, but also see quick_FETCH */
- (void)hv_store((HV*)SvRV(h), "Driver", 6, newRV_inc(SvRV(parent)), 0);
- (void)hv_fetch((HV*)SvRV(h), "Statement", 9, 1); /* store writable undef */
- break;
- case DBIt_ST:
- DBIc_NUM_FIELDS((imp_sth_t*)imp) = -1;
- /* cache _inner_ handle, but also see quick_FETCH */
- (void)hv_store((HV*)SvRV(h), "Database", 8, newRV_inc(SvRV(parent)), 0);
- /* copy (alias) Statement from the sth up into the dbh */
- tmp_svp = hv_fetch((HV*)SvRV(h), "Statement", 9, 1);
- (void)hv_store((HV*)SvRV(parent), "Statement", 9, SvREFCNT_inc(*tmp_svp), 0);
- break;
- }
- }
- else
- die("panic: invalid DBIc_TYPE");
-
- /* Use DBI magic on inner handle to carry handle attributes */
- /* Note that we store the imp_sv in mg_obj, but as a shortcut, */
- /* also store a direct pointer to imp, aka PVX(dbih_imp_sv), */
- /* in mg_ptr (with mg_len set to null, so it wont be freed) */
- sv_magic(SvRV(h), dbih_imp_sv, DBI_MAGIC, (char*)imp, 0);
- SvREFCNT_dec(dbih_imp_sv); /* since sv_magic() incremented it */
- SvRMAGICAL_on(SvRV(h)); /* so DBI magic gets sv_clear'd ok */
-
- {
- dMY_CXT; /* XXX would be nice to get rid of this */
- DBI_SET_LAST_HANDLE(h);
- }
-
- if (1) {
- /* This is a hack to work-around the fast but poor way old versions of
- * DBD::Oracle (and possibly other drivers) check for a valid handle
- * using (SvMAGIC(SvRV(h)))->mg_type == 'P'). That doesn't work now
- * because the weakref magic is inserted ahead of the tie magic.
- * So here we swap the tie and weakref magic so the tie comes first.
- */
- MAGIC *tie_mg = mg_find(SvRV(orv),'P');
- MAGIC *first = SvMAGIC(SvRV(orv));
- if (tie_mg && first->mg_moremagic == tie_mg && !tie_mg->mg_moremagic) {
- MAGIC *next = tie_mg->mg_moremagic;
- SvMAGIC(SvRV(orv)) = tie_mg;
- tie_mg->mg_moremagic = first;
- first->mg_moremagic = next;
- }
- }
-
- DBI_UNLOCK;
-}
-
-
-static void
-dbih_dumphandle(pTHX_ SV *h, const char *msg, int level)
-{
- D_imp_xxh(h);
- if (level >= 9) {
- sv_dump(h);
- }
- dbih_dumpcom(aTHX_ imp_xxh, msg, level);
-}
-
-static int
-dbih_dumpcom(pTHX_ imp_xxh_t *imp_xxh, const char *msg, int level)
-{
- dMY_CXT;
- SV *flags = sv_2mortal(newSVpv("",0));
- SV *inner;
- static const char pad[] = " ";
- if (!msg)
- msg = "dbih_dumpcom";
- PerlIO_printf(DBILOGFP," %s (%sh 0x%lx, com 0x%lx, imp %s):\n",
- msg, dbih_htype_name(DBIc_TYPE(imp_xxh)),
- (long)DBIc_MY_H(imp_xxh), (long)imp_xxh,
- (PL_dirty) ? "global destruction" : HvNAME(DBIc_IMP_STASH(imp_xxh)));
- if (DBIc_COMSET(imp_xxh)) sv_catpv(flags,"COMSET ");
- if (DBIc_IMPSET(imp_xxh)) sv_catpv(flags,"IMPSET ");
- if (DBIc_ACTIVE(imp_xxh)) sv_catpv(flags,"Active ");
- if (DBIc_WARN(imp_xxh)) sv_catpv(flags,"Warn ");
- if (DBIc_COMPAT(imp_xxh)) sv_catpv(flags,"CompatMode ");
- if (DBIc_is(imp_xxh, DBIcf_ChopBlanks)) sv_catpv(flags,"ChopBlanks ");
- if (DBIc_is(imp_xxh, DBIcf_HandleSetErr)) sv_catpv(flags,"HandleSetErr ");
- if (DBIc_is(imp_xxh, DBIcf_HandleError)) sv_catpv(flags,"HandleError ");
- if (DBIc_is(imp_xxh, DBIcf_RaiseError)) sv_catpv(flags,"RaiseError ");
- if (DBIc_is(imp_xxh, DBIcf_PrintError)) sv_catpv(flags,"PrintError ");
- if (DBIc_is(imp_xxh, DBIcf_PrintWarn)) sv_catpv(flags,"PrintWarn ");
- if (DBIc_is(imp_xxh, DBIcf_ShowErrorStatement)) sv_catpv(flags,"ShowErrorStatement ");
- if (DBIc_is(imp_xxh, DBIcf_AutoCommit)) sv_catpv(flags,"AutoCommit ");
- if (DBIc_is(imp_xxh, DBIcf_BegunWork)) sv_catpv(flags,"BegunWork ");
- if (DBIc_is(imp_xxh, DBIcf_LongTruncOk)) sv_catpv(flags,"LongTruncOk ");
- if (DBIc_is(imp_xxh, DBIcf_MultiThread)) sv_catpv(flags,"MultiThread ");
- if (DBIc_is(imp_xxh, DBIcf_TaintIn)) sv_catpv(flags,"TaintIn ");
- if (DBIc_is(imp_xxh, DBIcf_TaintOut)) sv_catpv(flags,"TaintOut ");
- if (DBIc_is(imp_xxh, DBIcf_Profile)) sv_catpv(flags,"Profile ");
- if (DBIc_is(imp_xxh, DBIcf_Callbacks)) sv_catpv(flags,"Callbacks ");
- PerlIO_printf(DBILOGFP,"%s FLAGS 0x%lx: %s\n", pad, (long)DBIc_FLAGS(imp_xxh), SvPV_nolen(flags));
- if (SvOK(DBIc_ERR(imp_xxh)))
- PerlIO_printf(DBILOGFP,"%s ERR %s\n", pad, neatsvpv((SV*)DBIc_ERR(imp_xxh),0));
- if (SvOK(DBIc_ERR(imp_xxh)))
- PerlIO_printf(DBILOGFP,"%s ERRSTR %s\n", pad, neatsvpv((SV*)DBIc_ERRSTR(imp_xxh),0));
- PerlIO_printf(DBILOGFP,"%s PARENT %s\n", pad, neatsvpv((SV*)DBIc_PARENT_H(imp_xxh),0));
- PerlIO_printf(DBILOGFP,"%s KIDS %ld (%ld Active)\n", pad,
- (long)DBIc_KIDS(imp_xxh), (long)DBIc_ACTIVE_KIDS(imp_xxh));
- if (DBIc_IMP_DATA(imp_xxh) && SvOK(DBIc_IMP_DATA(imp_xxh)))
- PerlIO_printf(DBILOGFP,"%s IMP_DATA %s\n", pad, neatsvpv(DBIc_IMP_DATA(imp_xxh),0));
- if (DBIc_LongReadLen(imp_xxh) != DBIc_LongReadLen_init)
- PerlIO_printf(DBILOGFP,"%s LongReadLen %ld\n", pad, (long)DBIc_LongReadLen(imp_xxh));
-
- if (DBIc_TYPE(imp_xxh) == DBIt_ST) {
- const imp_sth_t *imp_sth = (imp_sth_t*)imp_xxh;
- PerlIO_printf(DBILOGFP,"%s NUM_OF_FIELDS %d\n", pad, DBIc_NUM_FIELDS(imp_sth));
- PerlIO_printf(DBILOGFP,"%s NUM_OF_PARAMS %d\n", pad, DBIc_NUM_PARAMS(imp_sth));
- }
- inner = dbih_inner(aTHX_ (SV*)DBIc_MY_H(imp_xxh), msg);
- if (!inner || !SvROK(inner))
- return 1;
- if (DBIc_TYPE(imp_xxh) <= DBIt_DB) {
- SV **svp = hv_fetch((HV*)SvRV(inner), "CachedKids", 10, 0);
- if (svp && SvROK(*svp) && SvTYPE(SvRV(*svp)) == SVt_PVHV) {
- HV *hv = (HV*)SvRV(*svp);
- PerlIO_printf(DBILOGFP,"%s CachedKids %d\n", pad, (int)HvKEYS(hv));
- }
- }
- if (level > 0) {
- SV* value;
- char *key;
- I32 keylen;
- PerlIO_printf(DBILOGFP,"%s cached attributes:\n", pad);
- while ( (value = hv_iternextsv((HV*)SvRV(inner), &key, &keylen)) ) {
- PerlIO_printf(DBILOGFP,"%s '%s' => %s\n", pad, key, neatsvpv(value,0));
- }
- }
- else if (DBIc_TYPE(imp_xxh) == DBIt_DB) {
- SV **svp = hv_fetch((HV*)SvRV(inner), "Name", 4, 0);
- if (svp && SvOK(*svp))
- PerlIO_printf(DBILOGFP,"%s Name %s\n", pad, neatsvpv(*svp,0));
- }
- else if (DBIc_TYPE(imp_xxh) == DBIt_ST) {
- SV **svp = hv_fetch((HV*)SvRV(inner), "Statement", 9, 0);
- if (svp && SvOK(*svp))
- PerlIO_printf(DBILOGFP,"%s Statement %s\n", pad, neatsvpv(*svp,0));
- }
- return 1;
-}
-
-
-static void
-dbih_clearcom(imp_xxh_t *imp_xxh)
-{
- dTHX;
- dTHR;
- int dump = FALSE;
- int debug = DBIc_TRACE_LEVEL(imp_xxh);
- int auto_dump = (debug >= 6);
- imp_xxh_t * const parent_xxh = DBIc_PARENT_COM(imp_xxh);
- /* Note that we're very much on our own here. DBIc_MY_H(imp_xxh) almost */
- /* certainly points to memory which has been freed. Don't use it! */
-
- /* --- pre-clearing sanity checks --- */
-
-#ifdef DBI_USE_THREADS
- if (DBIc_THR_USER(imp_xxh) != my_perl) { /* don't clear handle that belongs to another thread */
- if (debug >= 3) {
- PerlIO_printf(DBIc_LOGPIO(imp_xxh)," skipped dbih_clearcom: DBI handle (type=%d, %s) is owned by thread %p not current thread %p\n",
- DBIc_TYPE(imp_xxh), HvNAME(DBIc_IMP_STASH(imp_xxh)), (void*)DBIc_THR_USER(imp_xxh), (void*)my_perl) ;
- PerlIO_flush(DBIc_LOGPIO(imp_xxh));
- }
- return;
- }
-#endif
-
- if (!DBIc_COMSET(imp_xxh)) { /* should never happen */
- dbih_dumpcom(aTHX_ imp_xxh, "dbih_clearcom: DBI handle already cleared", 0);
- return;
- }
-
- if (auto_dump)
- dbih_dumpcom(aTHX_ imp_xxh,"DESTROY (dbih_clearcom)", 0);
-
- if (!PL_dirty) {
-
- if (DBIc_ACTIVE(imp_xxh)) { /* bad news, potentially */
- /* warn for sth, warn for dbh only if it has active sth or isn't AutoCommit */
- if (DBIc_TYPE(imp_xxh) >= DBIt_ST
- || (DBIc_ACTIVE_KIDS(imp_xxh) || !DBIc_has(imp_xxh, DBIcf_AutoCommit))
- ) {
- warn("DBI %s handle 0x%lx cleared whilst still active",
- dbih_htype_name(DBIc_TYPE(imp_xxh)), (unsigned long)DBIc_MY_H(imp_xxh));
- dump = TRUE;
- }
- }
-
- /* check that the implementor has done its own housekeeping */
- if (DBIc_IMPSET(imp_xxh)) {
- warn("DBI %s handle 0x%lx has uncleared implementors data",
- dbih_htype_name(DBIc_TYPE(imp_xxh)), (unsigned long)DBIc_MY_H(imp_xxh));
- dump = TRUE;
- }
-
- if (DBIc_KIDS(imp_xxh)) {
- warn("DBI %s handle 0x%lx has %d uncleared child handles",
- dbih_htype_name(DBIc_TYPE(imp_xxh)),
- (unsigned long)DBIc_MY_H(imp_xxh), (int)DBIc_KIDS(imp_xxh));
- dump = TRUE;
- }
- }
-
- if (dump && !auto_dump) /* else was already dumped above */
- dbih_dumpcom(aTHX_ imp_xxh, "dbih_clearcom", 0);
-
- /* --- pre-clearing adjustments --- */
-
- if (!PL_dirty) {
- if (parent_xxh) {
- if (DBIc_ACTIVE(imp_xxh)) /* see also DBIc_ACTIVE_off */
- --DBIc_ACTIVE_KIDS(parent_xxh);
- --DBIc_KIDS(parent_xxh);
- }
- }
-
- /* --- clear fields (may invoke object destructors) --- */
-
- if (DBIc_TYPE(imp_xxh) == DBIt_ST) {
- imp_sth_t *imp_sth = (imp_sth_t*)imp_xxh;
- sv_free((SV*)DBIc_FIELDS_AV(imp_sth));
- }
-
- sv_free(DBIc_IMP_DATA(imp_xxh)); /* do this first */
- if (DBIc_TYPE(imp_xxh) <= DBIt_ST) { /* DBIt_FD doesn't have attr */
- sv_free(_imp2com(imp_xxh, attr.TraceLevel));
- sv_free(_imp2com(imp_xxh, attr.State));
- sv_free(_imp2com(imp_xxh, attr.Err));
- sv_free(_imp2com(imp_xxh, attr.Errstr));
- sv_free(_imp2com(imp_xxh, attr.FetchHashKeyName));
- }
-
-
- sv_free((SV*)DBIc_PARENT_H(imp_xxh)); /* do this last */
-
- DBIc_COMSET_off(imp_xxh);
-
- if (debug >= 4)
- PerlIO_printf(DBIc_LOGPIO(imp_xxh)," dbih_clearcom 0x%lx (com 0x%lx, type %d) done.\n\n",
- (long)DBIc_MY_H(imp_xxh), (long)imp_xxh, DBIc_TYPE(imp_xxh));
-}
-
-
-/* --- Functions for handling field buffer arrays --- */
-
-static AV *
-dbih_setup_fbav(imp_sth_t *imp_sth)
-{
- /* Usually called to setup the row buffer for new sth.
- * Also called if the value of NUM_OF_FIELDS is altered,
- * in which case it adjusts the row buffer to match NUM_OF_FIELDS.
- */
- dTHX;
- I32 i = DBIc_NUM_FIELDS(imp_sth);
- AV *av = DBIc_FIELDS_AV(imp_sth);
-
- if (i < 0)
- i = 0;
-
- if (av) {
- if (av_len(av)+1 == i) /* is existing array the right size? */
- return av;
- /* we need to adjust the size of the array */
- if (DBIc_TRACE_LEVEL(imp_sth) >= 2)
- PerlIO_printf(DBIc_LOGPIO(imp_sth)," dbih_setup_fbav realloc from %ld to %ld fields\n", (long)(av_len(av)+1), (long)i);
- SvREADONLY_off(av);
- if (i < av_len(av)+1) /* trim to size if too big */
- av_fill(av, i-1);
- }
- else {
- if (DBIc_TRACE_LEVEL(imp_sth) >= 5)
- PerlIO_printf(DBIc_LOGPIO(imp_sth)," dbih_setup_fbav alloc for %ld fields\n", (long)i);
- av = newAV();
- DBIc_FIELDS_AV(imp_sth) = av;
-
- /* row_count will need to be manually reset by the driver if the */
- /* sth is re-executed (since this code won't get rerun) */
- DBIc_ROW_COUNT(imp_sth) = 0;
- }
-
- /* load array with writeable SV's. Do this backwards so */
- /* the array only gets extended once. */
- while(i--) /* field 1 stored at index 0 */
- av_store(av, i, newSV(0));
- if (DBIc_TRACE_LEVEL(imp_sth) >= 6)
- PerlIO_printf(DBIc_LOGPIO(imp_sth)," dbih_setup_fbav now %ld fields\n", (long)(av_len(av)+1));
- SvREADONLY_on(av); /* protect against shift @$row etc */
- return av;
-}
-
-
-static AV *
-dbih_get_fbav(imp_sth_t *imp_sth)
-{
- AV *av;
-
- if ( (av = DBIc_FIELDS_AV(imp_sth)) == Nullav) {
- av = dbih_setup_fbav(imp_sth);
- }
- else {
- dTHX;
- int i = av_len(av) + 1;
- if (i != DBIc_NUM_FIELDS(imp_sth)) {
- /*SV *sth = dbih_inner(aTHX_ (SV*)DBIc_MY_H(imp_sth), "_get_fbav");*/
- /* warn via PrintWarn */
- set_err_char(SvRV(DBIc_MY_H(imp_sth)), (imp_xxh_t*)imp_sth,
- "0", 0, "Number of row fields inconsistent with NUM_OF_FIELDS (driver bug)", "", "_get_fbav");
- /*
- DBIc_NUM_FIELDS(imp_sth) = i;
- hv_delete((HV*)SvRV(sth), "NUM_OF_FIELDS", 13, G_DISCARD);
- */
- }
- /* don't let SvUTF8 flag persist from one row to the next */
- /* (only affects drivers that use sv_setpv, but most XS do) */
- /* XXX turn into option later (force on/force off/ignore) */
- while(i--) /* field 1 stored at index 0 */
- SvUTF8_off(AvARRAY(av)[i]);
- }
-
- if (DBIc_is(imp_sth, DBIcf_TaintOut)) {
- dTHX;
- dTHR;
- TAINT; /* affects sv_setsv()'s called within same perl statement */
- }
-
- /* XXX fancy stuff to happen here later (re scrolling etc) */
- ++DBIc_ROW_COUNT(imp_sth);
- return av;
-}
-
-
-static int
-dbih_sth_bind_col(SV *sth, SV *col, SV *ref, SV *attribs)
-{
- dTHX;
- D_imp_sth(sth);
- AV *av;
- int idx = SvIV(col);
- int fields = DBIc_NUM_FIELDS(imp_sth);
-
- if (fields <= 0) {
- PERL_UNUSED_VAR(attribs);
- croak("Statement has no result columns to bind%s",
- DBIc_ACTIVE(imp_sth)
- ? "" : " (perhaps you need to successfully call execute first, or again)");
- }
-
- if ( (av = DBIc_FIELDS_AV(imp_sth)) == Nullav)
- av = dbih_setup_fbav(imp_sth);
-
- if (DBIc_TRACE_LEVEL(imp_sth) >= 5)
- PerlIO_printf(DBIc_LOGPIO(imp_sth)," dbih_sth_bind_col %s => %s %s\n",
- neatsvpv(col,0), neatsvpv(ref,0), neatsvpv(attribs,0));
-
- if (idx < 1 || idx > fields)
- croak("bind_col: column %d is not a valid column (1..%d)",
- idx, fields);
-
- if (!SvOK(ref) && SvREADONLY(ref)) { /* binding to literal undef */
- /* presumably the call is just setting the TYPE or other atribs */
- /* but this default method ignores attribs, so we just return */
- return 1;
- }
-
- /* Write this as > SVt_PVMG because in 5.8.x the next type */
- /* is SVt_PVBM, whereas in 5.9.x it's SVt_PVGV. */
- if (!SvROK(ref) || SvTYPE(SvRV(ref)) > SVt_PVMG) /* XXX LV */
- croak("Can't %s->bind_col(%s, %s,...), need a reference to a scalar",
- neatsvpv(sth,0), neatsvpv(col,0), neatsvpv(ref,0));
-
- /* use supplied scalar as storage for this column */
- SvREADONLY_off(av);
- av_store(av, idx-1, SvREFCNT_inc(SvRV(ref)) );
- SvREADONLY_on(av);
- return 1;
-}
-
-
-static int
-quote_type(int sql_type, int p, int s, int *t, void *v)
-{
- /* Returns true if type should be bound as a number else */
- /* false implying that binding as a string should be okay. */
- /* The true value is either SQL_INTEGER or SQL_DOUBLE which */
- /* can be used as a hint if desired. */
- (void)p;
- (void)s;
- (void)t;
- (void)v;
- /* looks like it's never been used, and doesn't make much sense anyway */
- warn("Use of DBI internal bind_as_num/quote_type function is deprecated");
- switch(sql_type) {
- case SQL_INTEGER:
- case SQL_SMALLINT:
- case SQL_TINYINT:
- case SQL_BIGINT:
- return 0;
- case SQL_FLOAT:
- case SQL_REAL:
- case SQL_DOUBLE:
- return 0;
- case SQL_NUMERIC:
- case SQL_DECIMAL:
- return 0; /* bind as string to attempt to retain precision */
- }
- return 1;
-}
-
-
-/* Convert a simple string representation of a value into a more specific
- * perl type based on an sql_type value.
- * The semantics of SQL standard TYPE values are interpreted _very_ loosely
- * on the basis of "be liberal in what you accept and let's throw in some
- * extra semantics while we're here" :)
- * Returns:
- * -2: sql_type isn't handled, value unchanged
- * -1: sv is undef, value unchanged
- * 0: sv couldn't be cast cleanly and DBIstcf_STRICT was used
- * 1: sv couldn't be cast cleanly and DBIstcf_STRICT was not used
- * 2: sv was cast ok
- */
-
-int
-sql_type_cast_svpv(pTHX_ SV *sv, int sql_type, U32 flags, void *v)
-{
- int cast_ok = 0;
- int grok_flags;
- UV uv;
-
- /* do nothing for undef (NULL) or non-string values */
- if (!sv || !SvOK(sv))
- return -1;
-
- switch(sql_type) {
-
- default:
- return -2; /* not a recognised SQL TYPE, value unchanged */
-
- case SQL_INTEGER:
- /* sv_2iv is liberal, may return SvIV, SvUV, or SvNV */
- sv_2iv(sv);
- /* SvNOK will be set if value is out of range for IV/UV.
- * SvIOK should be set but won't if sv is not numeric (in which
- * case perl would have warn'd already if -w or warnings are in effect)
- */
- cast_ok = (SvIOK(sv) && !SvNOK(sv));
- break;
-
- case SQL_DOUBLE:
- sv_2nv(sv);
- /* SvNOK should be set but won't if sv is not numeric (in which
- * case perl would have warn'd already if -w or warnings are in effect)
- */
- cast_ok = SvNOK(sv);
- break;
-
- /* caller would like IV else UV else NV */
- /* else no error and sv is untouched */
- case SQL_NUMERIC:
- /* based on the code in perl's toke.c */
- uv = 0;
- grok_flags = grok_number(SvPVX(sv), SvCUR(sv), &uv);
- cast_ok = 1;
- if (grok_flags == IS_NUMBER_IN_UV) { /* +ve int */
- if (uv <= IV_MAX) /* prefer IV over UV */
- sv_2iv(sv);
- else sv_2uv(sv);
- }
- else if (grok_flags == (IS_NUMBER_IN_UV | IS_NUMBER_NEG)
- && uv <= IV_MAX
- ) {
- sv_2iv(sv);
- }
- else if (grok_flags) { /* is numeric */
- sv_2nv(sv);
- }
- else
- cast_ok = 0;
- break;
-
-#if 0 /* XXX future possibilities */
- case SQL_BIGINT: /* use Math::BigInt if too large for IV/UV */
-#endif
- }
-
- if (cast_ok) {
-
- if (flags & DBIstcf_DISCARD_STRING
- && SvNIOK(sv) /* we set a numeric value */
- && SvPVX(sv) /* we have a buffer to discard */
- ) {
- SvOOK_off(sv);
- sv_force_normal(sv);
- if (SvLEN(sv))
- Safefree(SvPVX(sv));
- SvPOK_off(sv);
- SvPV_set(sv, NULL);
- SvLEN_set(sv, 0);
- SvCUR_set(sv, 0);
- }
- }
-
- if (cast_ok)
- return 2;
- else if (flags & DBIstcf_STRICT)
- return 0;
- else return 1;
-}
-
-
-
-/* --- Generic Handle Attributes (for all handle types) --- */
-
-static int
-dbih_set_attr_k(SV *h, SV *keysv, int dbikey, SV *valuesv)
-{
- dTHX;
- dTHR;
- D_imp_xxh(h);
- STRLEN keylen;
- const char *key = SvPV(keysv, keylen);
- const int htype = DBIc_TYPE(imp_xxh);
- int on = (SvTRUE(valuesv));
- int internal = 1; /* DBIh_IN_PERL_DBD(imp_xxh); -- for DBD's in perl */
- int cacheit = 0;
- int weakenit = 0; /* eg for CachedKids ref */
- (void)dbikey;
-
- if (DBIc_TRACE_LEVEL(imp_xxh) >= 3)
- PerlIO_printf(DBIc_LOGPIO(imp_xxh)," STORE %s %s => %s\n",
- neatsvpv(h,0), neatsvpv(keysv,0), neatsvpv(valuesv,0));
-
- if (internal && strEQ(key, "Active")) {
- if (on) {
- D_imp_sth(h);
- DBIc_ACTIVE_on(imp_xxh);
- /* for pure-perl drivers on second and subsequent */
- /* execute()'s, else row count keeps rising. */
- if (htype==DBIt_ST && DBIc_FIELDS_AV(imp_sth))
- DBIc_ROW_COUNT(imp_sth) = 0;
- }
- else {
- DBIc_ACTIVE_off(imp_xxh);
- }
- }
- else if (strEQ(key, "FetchHashKeyName")) {
- if (htype >= DBIt_ST)
- croak("Can't set FetchHashKeyName for a statement handle, set in parent before prepare()");
- cacheit = 1; /* just save it */
- }
- else if (strEQ(key, "CompatMode")) {
- (on) ? DBIc_COMPAT_on(imp_xxh) : DBIc_COMPAT_off(imp_xxh);
- }
- else if (strEQ(key, "Warn")) {
- (on) ? DBIc_WARN_on(imp_xxh) : DBIc_WARN_off(imp_xxh);
- }
- else if (strEQ(key, "AutoInactiveDestroy")) {
- (on) ? DBIc_AIADESTROY_on(imp_xxh) : DBIc_AIADESTROY_off(imp_xxh);
- }
- else if (strEQ(key, "InactiveDestroy")) {
- (on) ? DBIc_IADESTROY_on(imp_xxh) : DBIc_IADESTROY_off(imp_xxh);
- }
- else if (strEQ(key, "RootClass")) {
- cacheit = 1; /* just save it */
- }
- else if (strEQ(key, "RowCacheSize")) {
- cacheit = 0; /* ignore it */
- }
- else if (strEQ(key, "Executed")) {
- DBIc_set(imp_xxh, DBIcf_Executed, on);
- }
- else if (strEQ(key, "ChopBlanks")) {
- DBIc_set(imp_xxh, DBIcf_ChopBlanks, on);
- }
- else if (strEQ(key, "ErrCount")) {
- DBIc_ErrCount(imp_xxh) = SvUV(valuesv);
- }
- else if (strEQ(key, "LongReadLen")) {
- if (SvNV(valuesv) < 0 || SvNV(valuesv) > MAX_LongReadLen)
- croak("Can't set LongReadLen < 0 or > %ld",MAX_LongReadLen);
- DBIc_LongReadLen(imp_xxh) = SvIV(valuesv);
- cacheit = 1; /* save it for clone */
- }
- else if (strEQ(key, "LongTruncOk")) {
- DBIc_set(imp_xxh,DBIcf_LongTruncOk, on);
- }
- else if (strEQ(key, "RaiseError")) {
- DBIc_set(imp_xxh,DBIcf_RaiseError, on);
- }
- else if (strEQ(key, "PrintError")) {
- DBIc_set(imp_xxh,DBIcf_PrintError, on);
- }
- else if (strEQ(key, "PrintWarn")) {
- DBIc_set(imp_xxh,DBIcf_PrintWarn, on);
- }
- else if (strEQ(key, "HandleError")) {
- if ( on && (!SvROK(valuesv) || (SvTYPE(SvRV(valuesv)) != SVt_PVCV)) ) {
- croak("Can't set %s to '%s'", "HandleError", neatsvpv(valuesv,0));
- }
- DBIc_set(imp_xxh,DBIcf_HandleError, on);
- cacheit = 1; /* child copy setup by dbih_setup_handle() */
- }
- else if (strEQ(key, "HandleSetErr")) {
- if ( on && (!SvROK(valuesv) || (SvTYPE(SvRV(valuesv)) != SVt_PVCV)) ) {
- croak("Can't set %s to '%s'","HandleSetErr",neatsvpv(valuesv,0));
- }
- DBIc_set(imp_xxh,DBIcf_HandleSetErr, on);
- cacheit = 1; /* child copy setup by dbih_setup_handle() */
- }
- else if (strEQ(key, "ChildHandles")) {
- if ( on && (!SvROK(valuesv) || (SvTYPE(SvRV(valuesv)) != SVt_PVAV)) ) {
- croak("Can't set %s to '%s'", "ChildHandles", neatsvpv(valuesv,0));
- }
- cacheit = 1; /* just save it in the hash */
- }
- else if (strEQ(key, "Profile")) {
- static const char profile_class[] = "DBI::Profile";
- if (on && (!SvROK(valuesv) || (SvTYPE(SvRV(valuesv)) != SVt_PVHV)) ) {
- /* not a hash ref so use DBI::Profile to work out what to do */
- dTHR;
- dSP;
- I32 returns;
- TAINT_NOT; /* the require is presumed innocent till proven guilty */
- perl_require_pv("DBI/Profile.pm");
- if (SvTRUE(ERRSV)) {
- warn("Can't load %s: %s", profile_class, SvPV_nolen(ERRSV));
- valuesv = &PL_sv_undef;
- }
- else {
- PUSHMARK(SP);
- XPUSHs(sv_2mortal(newSVpv(profile_class,0)));
- XPUSHs(valuesv);
- PUTBACK;
- returns = call_method("_auto_new", G_SCALAR);
- if (returns != 1)
- croak("%s _auto_new", profile_class);
- SPAGAIN;
- valuesv = POPs;
- PUTBACK;
- }
- on = SvTRUE(valuesv); /* in case it returns undef */
- }
- if (on && !sv_isobject(valuesv)) {
- /* not blessed already - so default to DBI::Profile */
- HV *stash;
- perl_require_pv(profile_class);
- stash = gv_stashpv(profile_class, GV_ADDWARN);
- sv_bless(valuesv, stash);
- }
- DBIc_set(imp_xxh,DBIcf_Profile, on);
- cacheit = 1; /* child copy setup by dbih_setup_handle() */
- }
- else if (strEQ(key, "ShowErrorStatement")) {
- DBIc_set(imp_xxh,DBIcf_ShowErrorStatement, on);
- }
- else if (strEQ(key, "MultiThread") && internal) {
- /* here to allow pure-perl drivers to set MultiThread */
- DBIc_set(imp_xxh,DBIcf_MultiThread, on);
- if (on && DBIc_WARN(imp_xxh)) {
- warn("MultiThread support not yet implemented in DBI");
- }
- }
- else if (strEQ(key, "Taint")) {
- /* 'Taint' is a shortcut for both in and out mode */
- DBIc_set(imp_xxh,DBIcf_TaintIn|DBIcf_TaintOut, on);
- }
- else if (strEQ(key, "TaintIn")) {
- DBIc_set(imp_xxh,DBIcf_TaintIn, on);
- }
- else if (strEQ(key, "TaintOut")) {
- DBIc_set(imp_xxh,DBIcf_TaintOut, on);
- }
- else if (htype<=DBIt_DB && keylen==10 && strEQ(key, "CachedKids")
- /* only allow hash refs */
- && SvROK(valuesv) && SvTYPE(SvRV(valuesv))==SVt_PVHV
- ) {
- cacheit = 1;
- weakenit = 1;
- }
- else if (keylen==9 && strEQ(key, "Callbacks")) {
- if ( on && (!SvROK(valuesv) || (SvTYPE(SvRV(valuesv)) != SVt_PVHV)) )
- croak("Can't set Callbacks to '%s'",neatsvpv(valuesv,0));
- /* see also dbih_setup_handle for ChildCallbacks handling */
- DBIc_set(imp_xxh, DBIcf_Callbacks, on);
- cacheit = 1;
- }
- else if (htype<=DBIt_DB && keylen==10 && strEQ(key, "AutoCommit")) {
- /* driver should have intercepted this and either handled it */
- /* or set valuesv to either the 'magic' on or off value. */
- if (SvIV(valuesv) != -900 && SvIV(valuesv) != -901)
- croak("DBD driver has not implemented the AutoCommit attribute");
- DBIc_set(imp_xxh,DBIcf_AutoCommit, (SvIV(valuesv)==-901));
- }
- else if (htype==DBIt_DB && keylen==9 && strEQ(key, "BegunWork")) {
- DBIc_set(imp_xxh,DBIcf_BegunWork, on);
- }
- else if (keylen==10 && strEQ(key, "TraceLevel")) {
- set_trace(h, valuesv, Nullsv);
- }
- else if (keylen==9 && strEQ(key, "TraceFile")) { /* XXX undocumented and readonly */
- set_trace_file(valuesv);
- }
- else if (htype==DBIt_ST && strEQ(key, "NUM_OF_FIELDS")) {
- D_imp_sth(h);
- int new_num_fields = (SvOK(valuesv)) ? SvIV(valuesv) : -1;
- DBIc_NUM_FIELDS(imp_sth) = new_num_fields;
- if (DBIc_FIELDS_AV(imp_sth)) { /* modify existing fbav */
- dbih_setup_fbav(imp_sth);
- }
- cacheit = 1;
- }
- else if (htype==DBIt_ST && strEQ(key, "NUM_OF_PARAMS")) {
- D_imp_sth(h);
- DBIc_NUM_PARAMS(imp_sth) = SvIV(valuesv);
- cacheit = 1;
- }
- /* these are here due to clone() needing to set attribs through a public api */
- else if (htype<=DBIt_DB && (strEQ(key, "Name")
- || strEQ(key,"ImplementorClass")
- || strEQ(key,"ReadOnly")
- || strEQ(key,"Statement")
- || strEQ(key,"Username")
- /* these are here for backwards histerical raisons */
- || strEQ(key,"USER") || strEQ(key,"CURRENT_USER")
- ) ) {
- cacheit = 1;
- }
- /* deal with: NAME_(uc|lc), NAME_hash, NAME_(uc|lc)_hash */
- else if ((keylen==7 || keylen==9 || keylen==12)
- && strnEQ(key, "NAME_", 5)
- && ( (keylen==9 && strEQ(key, "NAME_hash"))
- || ((key[5]=='u' || key[5]=='l') && key[6] == 'c'
- && (!key[7] || strnEQ(&key[7], "_hash", 5)))
- )
- ) {
- cacheit = 1;
- }
- else { /* XXX should really be an event ? */
- if (isUPPER(*key)) {
- char *msg = "Can't set %s->{%s}: unrecognised attribute name or invalid value%s";
- char *hint = "";
- if (strEQ(key, "NUM_FIELDS"))
- hint = ", perhaps you meant NUM_OF_FIELDS";
- warn(msg, neatsvpv(h,0), key, hint);
- return FALSE; /* don't store it */
- }
- /* Allow private_* attributes to be stored in the cache. */
- /* This is designed to make life easier for people subclassing */
- /* the DBI classes and may be of use to simple perl DBD's. */
- if (strnNE(key,"private_",8) && strnNE(key,"dbd_",4) && strnNE(key,"dbi_",4)) {
- if (DBIc_TRACE_LEVEL(imp_xxh)) { /* change to DBIc_WARN(imp_xxh) once we can validate prefix against registry */
- PerlIO_printf(DBIc_LOGPIO(imp_xxh),"$h->{%s}=%s ignored for invalid driver-specific attribute\n",
- neatsvpv(keysv,0), neatsvpv(valuesv,0));
- }
- return FALSE;
- }
- cacheit = 1;
- }
- if (cacheit) {
- SV *sv_for_cache = newSVsv(valuesv);
- (void)hv_store((HV*)SvRV(h), key, keylen, sv_for_cache, 0);
- if (weakenit) {
-#ifdef sv_rvweaken
- sv_rvweaken(sv_for_cache);
-#endif
- }
- }
- return TRUE;
-}
-
-
-static SV *
-dbih_get_attr_k(SV *h, SV *keysv, int dbikey)
-{
- dTHX;
- dTHR;
- D_imp_xxh(h);
- STRLEN keylen;
- char *key = SvPV(keysv, keylen);
- int htype = DBIc_TYPE(imp_xxh);
- SV *valuesv = Nullsv;
- int cacheit = FALSE;
- char *p;
- int i;
- SV *sv;
- SV **svp;
- (void)dbikey;
-
- /* DBI quick_FETCH will service some requests (e.g., cached values) */
-
- if (htype == DBIt_ST) {
- switch (*key) {
-
- case 'D':
- if (keylen==8 && strEQ(key, "Database")) {
- D_imp_from_child(imp_dbh, imp_dbh_t, imp_xxh);
- valuesv = newRV_inc((SV*)DBIc_MY_H(imp_dbh));
- cacheit = FALSE; /* else creates ref loop */
- }
- break;
-
- case 'N':
- if (keylen==8 && strEQ(key, "NULLABLE")) {
- valuesv = &PL_sv_undef;
- break;
- }
-
- if (keylen==4 && strEQ(key, "NAME")) {
- valuesv = &PL_sv_undef;
- break;
- }
-
- /* deal with: NAME_(uc|lc), NAME_hash, NAME_(uc|lc)_hash */
- if ((keylen==7 || keylen==9 || keylen==12)
- && strnEQ(key, "NAME_", 5)
- && ( (keylen==9 && strEQ(key, "NAME_hash"))
- || ((key[5]=='u' || key[5]=='l') && key[6] == 'c'
- && (!key[7] || strnEQ(&key[7], "_hash", 5)))
- )
- ) {
- D_imp_sth(h);
- valuesv = &PL_sv_undef;
-
- /* fetch from tied outer handle to trigger FETCH magic */
- svp = hv_fetch((HV*)DBIc_MY_H(imp_sth), "NAME",4, FALSE);
- sv = (svp) ? *svp : &PL_sv_undef;
- if (SvGMAGICAL(sv)) /* call FETCH via magic */
- mg_get(sv);
-
- if (SvROK(sv)) {
- AV *name_av = (AV*)SvRV(sv);
- char *name;
- int upcase = (key[5] == 'u');
- AV *av = Nullav;
- HV *hv = Nullhv;
- int num_fields_mismatch = 0;
-
- if (strEQ(&key[strlen(key)-5], "_hash"))
- hv = newHV();
- else av = newAV();
- i = DBIc_NUM_FIELDS(imp_sth);
-
- /* catch invalid NUM_FIELDS */
- if (i != AvFILL(name_av)+1) {
- /* flag as mismatch, except for "-1 and empty" case */
- if ( ! (i == -1 && 0 == AvFILL(name_av)+1) )
- num_fields_mismatch = 1;
- i = AvFILL(name_av)+1; /* limit for safe iteration over array */
- }
-
- if (DBIc_TRACE_LEVEL(imp_sth) >= 10 || (num_fields_mismatch && DBIc_WARN(imp_xxh))) {
- PerlIO_printf(DBIc_LOGPIO(imp_sth)," FETCH $h->{%s} from $h->{NAME} with $h->{NUM_OF_FIELDS} = %d"
- " and %ld entries in $h->{NAME}%s\n",
- neatsvpv(keysv,0), DBIc_NUM_FIELDS(imp_sth), AvFILL(name_av)+1,
- (num_fields_mismatch) ? " (possible bug in driver)" : "");
- }
-
- while (--i >= 0) {
- sv = newSVsv(AvARRAY(name_av)[i]);
- name = SvPV_nolen(sv);
- if (key[5] != 'h') { /* "NAME_hash" */
- for (p = name; p && *p; ++p) {
-#ifdef toUPPER_LC
- *p = (upcase) ? toUPPER_LC(*p) : toLOWER_LC(*p);
-#else
- *p = (upcase) ? toUPPER(*p) : toLOWER(*p);
-#endif
- }
- }
- if (av)
- av_store(av, i, sv);
- else {
- (void)hv_store(hv, name, SvCUR(sv), newSViv(i), 0);
- sv_free(sv);
- }
- }
- valuesv = newRV_noinc( (av ? (SV*)av : (SV*)hv) );
- cacheit = TRUE; /* can't change */
- }
- }
- else if (keylen==13 && strEQ(key, "NUM_OF_FIELDS")) {
- D_imp_sth(h);
- IV num_fields = DBIc_NUM_FIELDS(imp_sth);
- valuesv = (num_fields < 0) ? &PL_sv_undef : newSViv(num_fields);
- if (num_fields > 0)
- cacheit = TRUE; /* can't change once set (XXX except for multiple result sets) */
- }
- else if (keylen==13 && strEQ(key, "NUM_OF_PARAMS")) {
- D_imp_sth(h);
- valuesv = newSViv(DBIc_NUM_PARAMS(imp_sth));
- cacheit = TRUE; /* can't change */
- }
- break;
-
- case 'P':
- if (strEQ(key, "PRECISION"))
- valuesv = &PL_sv_undef;
- else if (strEQ(key, "ParamValues"))
- valuesv = &PL_sv_undef;
- else if (strEQ(key, "ParamTypes"))
- valuesv = &PL_sv_undef;
- break;
-
- case 'R':
- if (strEQ(key, "RowsInCache"))
- valuesv = &PL_sv_undef;
- break;
-
- case 'S':
- if (strEQ(key, "SCALE"))
- valuesv = &PL_sv_undef;
- break;
-
- case 'T':
- if (strEQ(key, "TYPE"))
- valuesv = &PL_sv_undef;
- break;
- }
-
- }
- else
- if (htype == DBIt_DB) {
- /* this is here but is, sadly, not called because
- * not-preloading them into the handle attrib cache caused
- * wierdness in t/proxy.t that I never got to the bottom
- * of. One day maybe. */
- if (keylen==6 && strEQ(key, "Driver")) {
- D_imp_from_child(imp_dbh, imp_dbh_t, imp_xxh);
- valuesv = newRV_inc((SV*)DBIc_MY_H(imp_dbh));
- cacheit = FALSE; /* else creates ref loop */
- }
- }
-
- if (valuesv == Nullsv && htype <= DBIt_DB) {
- if (keylen==10 && strEQ(key, "AutoCommit")) {
- valuesv = boolSV(DBIc_has(imp_xxh,DBIcf_AutoCommit));
- }
- }
-
- if (valuesv == Nullsv) {
- switch (*key) {
- case 'A':
- if (keylen==6 && strEQ(key, "Active")) {
- valuesv = boolSV(DBIc_ACTIVE(imp_xxh));
- }
- else if (keylen==10 && strEQ(key, "ActiveKids")) {
- valuesv = newSViv(DBIc_ACTIVE_KIDS(imp_xxh));
- }
- else if (strEQ(key, "AutoInactiveDestroy")) {
- valuesv = boolSV(DBIc_AIADESTROY(imp_xxh));
- }
- break;
-
- case 'B':
- if (keylen==9 && strEQ(key, "BegunWork")) {
- valuesv = boolSV(DBIc_has(imp_xxh,DBIcf_BegunWork));
- }
- break;
-
- case 'C':
- if (strEQ(key, "ChildHandles")) {
- svp = hv_fetch((HV*)SvRV(h), key, keylen, FALSE);
- /* if something has been stored then return it.
- * otherwise return a dummy empty array if weakrefs are
- * available, else an undef to indicate that they're not */
- if (svp) {
- valuesv = newSVsv(*svp);
- } else {
-#ifdef sv_rvweaken
- valuesv = newRV_noinc((SV*)newAV());
-#else
- valuesv = &PL_sv_undef;
-#endif
- }
- }
- else if (strEQ(key, "ChopBlanks")) {
- valuesv = boolSV(DBIc_has(imp_xxh,DBIcf_ChopBlanks));
- }
- else if (strEQ(key, "CachedKids")) {
- valuesv = &PL_sv_undef;
- }
- else if (strEQ(key, "CompatMode")) {
- valuesv = boolSV(DBIc_COMPAT(imp_xxh));
- }
- break;
-
- case 'E':
- if (strEQ(key, "Executed")) {
- valuesv = boolSV(DBIc_is(imp_xxh, DBIcf_Executed));
- }
- else if (strEQ(key, "ErrCount")) {
- valuesv = newSVuv(DBIc_ErrCount(imp_xxh));
- }
- break;
-
- case 'I':
- if (strEQ(key, "InactiveDestroy")) {
- valuesv = boolSV(DBIc_IADESTROY(imp_xxh));
- }
- break;
-
- case 'K':
- if (keylen==4 && strEQ(key, "Kids")) {
- valuesv = newSViv(DBIc_KIDS(imp_xxh));
- }
- break;
-
- case 'L':
- if (keylen==11 && strEQ(key, "LongReadLen")) {
- valuesv = newSVnv((NV)DBIc_LongReadLen(imp_xxh));
- }
- else if (keylen==11 && strEQ(key, "LongTruncOk")) {
- valuesv = boolSV(DBIc_has(imp_xxh,DBIcf_LongTruncOk));
- }
- break;
-
- case 'M':
- if (keylen==10 && strEQ(key, "MultiThread")) {
- valuesv = boolSV(DBIc_has(imp_xxh,DBIcf_MultiThread));
- }
- break;
-
- case 'P':
- if (keylen==10 && strEQ(key, "PrintError")) {
- valuesv = boolSV(DBIc_has(imp_xxh,DBIcf_PrintError));
- }
- else if (keylen==9 && strEQ(key, "PrintWarn")) {
- valuesv = boolSV(DBIc_has(imp_xxh,DBIcf_PrintWarn));
- }
- break;
-
- case 'R':
- if (keylen==10 && strEQ(key, "RaiseError")) {
- valuesv = boolSV(DBIc_has(imp_xxh,DBIcf_RaiseError));
- }
- else if (keylen==12 && strEQ(key, "RowCacheSize")) {
- valuesv = &PL_sv_undef;
- }
- break;
-
- case 'S':
- if (keylen==18 && strEQ(key, "ShowErrorStatement")) {
- valuesv = boolSV(DBIc_has(imp_xxh,DBIcf_ShowErrorStatement));
- }
- break;
-
- case 'T':
- if (keylen==4 && strEQ(key, "Type")) {
- char *type = dbih_htype_name(htype);
- valuesv = newSVpv(type,0);
- cacheit = TRUE; /* can't change */
- }
- else if (keylen==10 && strEQ(key, "TraceLevel")) {
- valuesv = newSViv( DBIc_DEBUGIV(imp_xxh) );
- }
- else if (keylen==5 && strEQ(key, "Taint")) {
- valuesv = boolSV(DBIc_has(imp_xxh,DBIcf_TaintIn) &&
- DBIc_has(imp_xxh,DBIcf_TaintOut));
- }
- else if (keylen==7 && strEQ(key, "TaintIn")) {
- valuesv = boolSV(DBIc_has(imp_xxh,DBIcf_TaintIn));
- }
- else if (keylen==8 && strEQ(key, "TaintOut")) {
- valuesv = boolSV(DBIc_has(imp_xxh,DBIcf_TaintOut));
- }
- break;
-
- case 'W':
- if (keylen==4 && strEQ(key, "Warn")) {
- valuesv = boolSV(DBIc_WARN(imp_xxh));
- }
- break;
- }
- }
-
- /* finally check the actual hash */
- if (valuesv == Nullsv) {
- valuesv = &PL_sv_undef;
- cacheit = 0;
- svp = hv_fetch((HV*)SvRV(h), key, keylen, FALSE);
- if (svp)
- valuesv = newSVsv(*svp); /* take copy to mortalize */
- else /* warn unless it's known attribute name */
- if ( !( (*key=='H' && strEQ(key, "HandleError"))
- || (*key=='H' && strEQ(key, "HandleSetErr"))
- || (*key=='S' && strEQ(key, "Statement"))
- || (*key=='P' && strEQ(key, "ParamArrays"))
- || (*key=='P' && strEQ(key, "ParamValues"))
- || (*key=='P' && strEQ(key, "Profile"))
- || (*key=='R' && strEQ(key, "ReadOnly"))
- || (*key=='C' && strEQ(key, "CursorName"))
- || (*key=='C' && strEQ(key, "Callbacks"))
- || (*key=='U' && strEQ(key, "Username"))
- || !isUPPER(*key) /* dbd_*, private_* etc */
- ))
- warn("Can't get %s->{%s}: unrecognised attribute name",neatsvpv(h,0),key);
- }
-
- if (cacheit) {
- (void)hv_store((HV*)SvRV(h), key, keylen, newSVsv(valuesv), 0);
- }
- if (DBIc_TRACE_LEVEL(imp_xxh) >= 3)
- PerlIO_printf(DBIc_LOGPIO(imp_xxh)," .. FETCH %s %s = %s%s\n", neatsvpv(h,0),
- neatsvpv(keysv,0), neatsvpv(valuesv,0), cacheit?" (cached)":"");
- if (valuesv == &PL_sv_yes || valuesv == &PL_sv_no || valuesv == &PL_sv_undef)
- return valuesv; /* no need to mortalize yes or no */
- return sv_2mortal(valuesv);
-}
-
-
-
-/* -------------------------------------------------------------------- */
-/* Functions implementing Error and Event Handling. */
-
-
-static SV *
-dbih_event(SV *hrv, const char *evtype, SV *a1, SV *a2)
-{
- dTHX;
- /* We arrive here via DBIh_EVENT* macros (see DBIXS.h) called from */
- /* DBD driver C code OR $h->event() method (in DBD::_::common) */
- /* XXX VERY OLD INTERFACE/CONCEPT MAY GO SOON */
- /* OR MAY EVOLVE INTO A WAY TO HANDLE 'SUCCESS_WITH_INFO'/'WARNINGS' from db */
- (void)hrv;
- (void)evtype;
- (void)a1;
- (void)a2;
- return &PL_sv_undef;
-}
-
-
-/* ----------------------------------------------------------------- */
-
-
-STATIC I32
-dbi_dopoptosub_at(PERL_CONTEXT *cxstk, I32 startingblock)
-{
- dTHX;
- I32 i;
- register PERL_CONTEXT *cx;
- for (i = startingblock; i >= 0; i--) {
- cx = &cxstk[i];
- switch (CxTYPE(cx)) {
- default:
- continue;
- case CXt_EVAL:
- case CXt_SUB:
-#ifdef CXt_FORMAT
- case CXt_FORMAT:
-#endif
- DEBUG_l( Perl_deb(aTHX_ "(Found sub #%ld)\n", (long)i));
- return i;
- }
- }
- return i;
-}
-
-
-static COP *
-dbi_caller_cop()
-{
- dTHX;
- register I32 cxix;
- register PERL_CONTEXT *cx;
- register PERL_CONTEXT *ccstack = cxstack;
- PERL_SI *top_si = PL_curstackinfo;
- char *stashname;
-
- for ( cxix = dbi_dopoptosub_at(ccstack, cxstack_ix) ;; cxix = dbi_dopoptosub_at(ccstack, cxix - 1)) {
- /* we may be in a higher stacklevel, so dig down deeper */
- while (cxix < 0 && top_si->si_type != PERLSI_MAIN) {
- top_si = top_si->si_prev;
- ccstack = top_si->si_cxstack;
- cxix = dbi_dopoptosub_at(ccstack, top_si->si_cxix);
- }
- if (cxix < 0) {
- break;
- }
- if (PL_DBsub && cxix >= 0 && ccstack[cxix].blk_sub.cv == GvCV(PL_DBsub))
- continue;
- cx = &ccstack[cxix];
- stashname = CopSTASHPV(cx->blk_oldcop);
- if (!stashname)
- continue;
- if (!(stashname[0] == 'D' && stashname[1] == 'B'
- && strchr("DI", stashname[2])
- && (!stashname[3] || (stashname[3] == ':' && stashname[4] == ':'))))
- {
- return cx->blk_oldcop;
- }
- cxix = dbi_dopoptosub_at(ccstack, cxix - 1);
- }
- return NULL;
-}
-
-static void
-dbi_caller_string(SV *buf, COP *cop, char *prefix, int show_line, int show_path)
-{
- dTHX;
- STRLEN len;
- long line = CopLINE(cop);
- char *file = SvPV(GvSV(CopFILEGV(cop)), len);
- if (!show_path) {
- char *sep;
- if ( (sep=strrchr(file,'/')) || (sep=strrchr(file,'\\')))
- file = sep+1;
- }
- if (show_line) {
- sv_catpvf(buf, "%s%s line %ld", (prefix) ? prefix : "", file, line);
- }
- else {
- sv_catpvf(buf, "%s%s", (prefix) ? prefix : "", file);
- }
-}
-
-static char *
-log_where(SV *buf, int append, char *prefix, char *suffix, int show_line, int show_caller, int show_path)
-{
- dTHX;
- dTHR;
- if (!buf)
- buf = sv_2mortal(newSVpv("",0));
- else if (!append)
- sv_setpv(buf,"");
- if (CopLINE(PL_curcop)) {
- COP *cop;
- dbi_caller_string(buf, PL_curcop, prefix, show_line, show_path);
- if (show_caller && (cop = dbi_caller_cop())) {
- SV *via = sv_2mortal(newSVpv("",0));
- dbi_caller_string(via, cop, prefix, show_line, show_path);
- sv_catpvf(buf, " via %s", SvPV_nolen(via));
- }
- }
- if (PL_dirty)
- sv_catpvf(buf, " during global destruction");
- if (suffix)
- sv_catpv(buf, suffix);
- return SvPVX(buf);
-}
-
-
-static void
-clear_cached_kids(pTHX_ SV *h, imp_xxh_t *imp_xxh, const char *meth_name, int trace_level)
-{
- if (DBIc_TYPE(imp_xxh) <= DBIt_DB) {
- SV **svp = hv_fetch((HV*)SvRV(h), "CachedKids", 10, 0);
- if (svp && SvROK(*svp) && SvTYPE(SvRV(*svp)) == SVt_PVHV) {
- HV *hv = (HV*)SvRV(*svp);
- if (HvKEYS(hv)) {
- if (DBIc_TRACE_LEVEL(imp_xxh) > trace_level)
- trace_level = DBIc_TRACE_LEVEL(imp_xxh);
- if (trace_level >= 2) {
- PerlIO_printf(DBIc_LOGPIO(imp_xxh)," >> %s %s clearing %d CachedKids\n",
- meth_name, neatsvpv(h,0), (int)HvKEYS(hv));
- PerlIO_flush(DBIc_LOGPIO(imp_xxh));
- }
- /* This will probably recurse through dispatch to DESTROY the kids */
- /* For drh we should probably explicitly do dbh disconnects */
- hv_clear(hv);
- }
- }
- }
-}
-
-
-static NV
-dbi_time() {
-# ifdef HAS_GETTIMEOFDAY
-# ifdef PERL_IMPLICIT_SYS
- dTHX;
-# endif
- struct timeval when;
- gettimeofday(&when, (struct timezone *) 0);
- return when.tv_sec + (when.tv_usec / 1000000.0);
-# else /* per-second is almost useless */
-# ifdef _WIN32 /* use _ftime() on Win32 (MS Visual C++ 6.0) */
-# if defined(__BORLANDC__)
-# define _timeb timeb
-# define _ftime ftime
-# endif
- struct _timeb when;
- _ftime( &when );
- return when.time + (when.millitm / 1000.0);
-# else
- return time(NULL);
-# endif
-# endif
-}
-
-
-static SV *
-_profile_next_node(SV *node, const char *name)
-{
- /* step one level down profile Data tree and auto-vivify if required */
- dTHX;
- SV *orig_node = node;
- if (SvROK(node))
- node = SvRV(node);
- if (SvTYPE(node) != SVt_PVHV) {
- HV *hv = newHV();
- if (SvOK(node)) {
- char *key = "(demoted)";
- warn("Profile data element %s replaced with new hash ref (for %s) and original value stored with key '%s'",
- neatsvpv(orig_node,0), name, key);
- (void)hv_store(hv, key, strlen(key), SvREFCNT_inc(orig_node), 0);
- }
- sv_setsv(node, newRV_noinc((SV*)hv));
- node = (SV*)hv;
- }
- node = *hv_fetch((HV*)node, name, strlen(name), 1);
- return node;
-}
-
-
-static SV*
-dbi_profile(SV *h, imp_xxh_t *imp_xxh, SV *statement_sv, SV *method, NV t1, NV t2)
-{
-#define DBIprof_MAX_PATH_ELEM 100
-#define DBIprof_COUNT 0
-#define DBIprof_TOTAL_TIME 1
-#define DBIprof_FIRST_TIME 2
-#define DBIprof_MIN_TIME 3
-#define DBIprof_MAX_TIME 4
-#define DBIprof_FIRST_CALLED 5
-#define DBIprof_LAST_CALLED 6
-#define DBIprof_max_index 6
- dTHX;
- NV ti = t2 - t1;
- int src_idx = 0;
- HV *dbh_outer_hv = NULL;
- HV *dbh_inner_hv = NULL;
- char *statement_pv;
- char *method_pv;
- SV *profile;
- SV *tmp;
- SV *dest_node;
- AV *av;
- HV *h_hv;
-
- const int call_depth = DBIc_CALL_DEPTH(imp_xxh);
- const int parent_call_depth = DBIc_PARENT_COM(imp_xxh) ? DBIc_CALL_DEPTH(DBIc_PARENT_COM(imp_xxh)) : 0;
- /* Only count calls originating from the application code */
- if (call_depth > 1 || parent_call_depth > 0)
- return &PL_sv_undef;
-
- if (!DBIc_has(imp_xxh, DBIcf_Profile))
- return &PL_sv_undef;
-
- method_pv = (SvTYPE(method)==SVt_PVCV) ? GvNAME(CvGV(method))
- : isGV(method) ? GvNAME(method)
- : SvOK(method) ? SvPV_nolen(method)
- : "";
-
- /* we don't profile DESTROY during global destruction */
- if (PL_dirty && instr(method_pv, "DESTROY"))
- return &PL_sv_undef;
-
- h_hv = (HV*)SvRV(dbih_inner(aTHX_ h, "dbi_profile"));
-
- profile = *hv_fetch(h_hv, "Profile", 7, 1);
- if (profile && SvMAGICAL(profile))
- mg_get(profile); /* FETCH */
- if (!profile || !SvROK(profile)) {
- DBIc_set(imp_xxh, DBIcf_Profile, 0); /* disable */
- if (SvOK(profile) && !PL_dirty)
- warn("Profile attribute isn't a hash ref (%s,%ld)", neatsvpv(profile,0), (long)SvTYPE(profile));
- return &PL_sv_undef;
- }
-
- /* statement_sv: undef = use $h->{Statement}, "" (&sv_no) = use empty string */
-
- if (!SvOK(statement_sv)) {
- SV **psv = hv_fetch(h_hv, "Statement", 9, 0);
- statement_sv = (psv && SvOK(*psv)) ? *psv : &PL_sv_no;
- }
- statement_pv = SvPV_nolen(statement_sv);
-
- if (DBIc_TRACE_LEVEL(imp_xxh) >= 4)
- PerlIO_printf(DBIc_LOGPIO(imp_xxh), " dbi_profile +%" NVff "s %s %s\n",
- ti, method_pv, neatsvpv(statement_sv,0));
-
- dest_node = _profile_next_node(profile, "Data");
-
- tmp = *hv_fetch((HV*)SvRV(profile), "Path", 4, 1);
- if (SvROK(tmp) && SvTYPE(SvRV(tmp))==SVt_PVAV) {
- int len;
- av = (AV*)SvRV(tmp);
- len = av_len(av); /* -1=empty, 0=one element */
-
- while ( src_idx <= len ) {
- SV *pathsv = AvARRAY(av)[src_idx++];
-
- if (SvROK(pathsv) && SvTYPE(SvRV(pathsv))==SVt_PVCV) {
- /* call sub, use returned list of values as path */
- /* returning a ref to undef vetos this profile data */
- dSP;
- I32 ax;
- SV *code_sv = SvRV(pathsv);
- I32 items;
- I32 item_idx;
- EXTEND(SP, 4);
- PUSHMARK(SP);
- PUSHs(h); /* push inner handle, then others params */
- PUSHs( sv_2mortal(newSVpv(method_pv,0)));
- PUTBACK;
- SAVE_DEFSV; /* local($_) = $statement */
- DEFSV_set(statement_sv);
- items = call_sv(code_sv, G_ARRAY);
- SPAGAIN;
- SP -= items ;
- ax = (SP - PL_stack_base) + 1 ;
- for (item_idx=0; item_idx < items; ++item_idx) {
- SV *item_sv = ST(item_idx);
- if (SvROK(item_sv)) {
- if (!SvOK(SvRV(item_sv)))
- items = -2; /* flag that we're rejecting this profile data */
- else /* other refs reserved */
- warn("Ignored ref returned by code ref in Profile Path");
- break;
- }
- dest_node = _profile_next_node(dest_node, (SvOK(item_sv) ? SvPV_nolen(item_sv) : "undef"));
- }
- PUTBACK;
- if (items == -2) /* this profile data was vetoed */
- return &PL_sv_undef;
- }
- else if (SvROK(pathsv)) {
- /* only meant for refs to scalars currently */
- const char *p = SvPV_nolen(SvRV(pathsv));
- dest_node = _profile_next_node(dest_node, p);
- }
- else if (SvOK(pathsv)) {
- STRLEN len;
- const char *p = SvPV(pathsv,len);
- if (p[0] == '!') { /* special cases */
- if (p[1] == 'S' && strEQ(p, "!Statement")) {
- dest_node = _profile_next_node(dest_node, statement_pv);
- }
- else if (p[1] == 'M' && strEQ(p, "!MethodName")) {
- dest_node = _profile_next_node(dest_node, method_pv);
- }
- else if (p[1] == 'M' && strEQ(p, "!MethodClass")) {
- if (SvTYPE(method) == SVt_PVCV) {
- p = SvPV_nolen((SV*)CvGV(method));
- }
- else if (isGV(method)) {
- /* just using SvPV_nolen(method) sometimes causes an error: */
- /* "Can't coerce GLOB to string" so we use gv_efullname() */
- SV *tmpsv = sv_2mortal(newSVpv("",0));
-#if (PERL_VERSION < 6)
- gv_efullname(tmpsv, (GV*)method);
-#else
- gv_efullname4(tmpsv, (GV*)method, "", TRUE);
-#endif
- p = SvPV_nolen(tmpsv);
- if (*p == '*') ++p; /* skip past leading '*' glob sigil */
- }
- else {
- p = method_pv;
- }
- dest_node = _profile_next_node(dest_node, p);
- }
- else if (p[1] == 'F' && strEQ(p, "!File")) {
- dest_node = _profile_next_node(dest_node, log_where(0, 0, "", "", 0, 0, 0));
- }
- else if (p[1] == 'F' && strEQ(p, "!File2")) {
- dest_node = _profile_next_node(dest_node, log_where(0, 0, "", "", 0, 1, 0));
- }
- else if (p[1] == 'C' && strEQ(p, "!Caller")) {
- dest_node = _profile_next_node(dest_node, log_where(0, 0, "", "", 1, 0, 0));
- }
- else if (p[1] == 'C' && strEQ(p, "!Caller2")) {
- dest_node = _profile_next_node(dest_node, log_where(0, 0, "", "", 1, 1, 0));
- }
- else if (p[1] == 'T' && (strEQ(p, "!Time") || strnEQ(p, "!Time~", 6))) {
- char timebuf[20];
- int factor = 1;
- if (p[5] == '~') {
- factor = atoi(&p[6]);
- if (factor == 0) /* sanity check to avoid div by zero error */
- factor = 3600;
- }
- sprintf(timebuf, "%ld", ((long)(dbi_time()/factor))*factor);
- dest_node = _profile_next_node(dest_node, timebuf);
- }
- else {
- warn("Unknown ! element in DBI::Profile Path: %s", p);
- dest_node = _profile_next_node(dest_node, p);
- }
- }
- else if (p[0] == '{' && p[len-1] == '}') { /* treat as name of dbh attribute to use */
- SV **attr_svp;
- if (!dbh_inner_hv) { /* cache dbh handles the first time we need them */
- imp_dbh_t *imp_dbh = (DBIc_TYPE(imp_xxh) <= DBIt_DB) ? (imp_dbh_t*)imp_xxh : (imp_dbh_t*)DBIc_PARENT_COM(imp_xxh);
- dbh_outer_hv = DBIc_MY_H(imp_dbh);
- if (SvTYPE(dbh_outer_hv) != SVt_PVHV)
- return &PL_sv_undef; /* presumably global destruction - bail */
- dbh_inner_hv = (HV*)SvRV(dbih_inner(aTHX_ (SV*)dbh_outer_hv, "profile"));
- if (SvTYPE(dbh_inner_hv) != SVt_PVHV)
- return &PL_sv_undef; /* presumably global destruction - bail */
- }
- /* fetch from inner first, then outer if key doesn't exist */
- /* (yes, this is an evil premature optimization) */
- p += 1; len -= 2; /* ignore the braces */
- if ((attr_svp = hv_fetch(dbh_inner_hv, p, len, 0)) == NULL) {
- /* try outer (tied) hash - for things like AutoCommit */
- /* (will always return something even for unknowns) */
- if ((attr_svp = hv_fetch(dbh_outer_hv, p, len, 0))) {
- if (SvGMAGICAL(*attr_svp))
- mg_get(*attr_svp); /* FETCH */
- }
- }
- if (!attr_svp)
- p -= 1; /* unignore the braces */
- else if (!SvOK(*attr_svp))
- p = "";
- else if (!SvTRUE(*attr_svp) && SvPOK(*attr_svp) && SvNIOK(*attr_svp))
- p = "0"; /* catch &sv_no style special case */
- else
- p = SvPV_nolen(*attr_svp);
- dest_node = _profile_next_node(dest_node, p);
- }
- else {
- dest_node = _profile_next_node(dest_node, p);
- }
- }
- /* else undef, so ignore */
- }
- }
- else { /* a bad Path value is treated as a Path of just Statement */
- dest_node = _profile_next_node(dest_node, statement_pv);
- }
-
-
- if (!SvOK(dest_node)) {
- av = newAV();
- sv_setsv(dest_node, newRV_noinc((SV*)av));
- av_store(av, DBIprof_COUNT, newSViv(1));
- av_store(av, DBIprof_TOTAL_TIME, newSVnv(ti));
- av_store(av, DBIprof_FIRST_TIME, newSVnv(ti));
- av_store(av, DBIprof_MIN_TIME, newSVnv(ti));
- av_store(av, DBIprof_MAX_TIME, newSVnv(ti));
- av_store(av, DBIprof_FIRST_CALLED, newSVnv(t1));
- av_store(av, DBIprof_LAST_CALLED, newSVnv(t1));
- }
- else {
- tmp = dest_node;
- if (SvROK(tmp))
- tmp = SvRV(tmp);
- if (SvTYPE(tmp) != SVt_PVAV)
- croak("Invalid Profile data leaf element: %s (type %ld)",
- neatsvpv(tmp,0), (long)SvTYPE(tmp));
- av = (AV*)tmp;
- sv_inc( *av_fetch(av, DBIprof_COUNT, 1));
- tmp = *av_fetch(av, DBIprof_TOTAL_TIME, 1);
- sv_setnv(tmp, SvNV(tmp) + ti);
- tmp = *av_fetch(av, DBIprof_MIN_TIME, 1);
- if (ti < SvNV(tmp)) sv_setnv(tmp, ti);
- tmp = *av_fetch(av, DBIprof_MAX_TIME, 1);
- if (ti > SvNV(tmp)) sv_setnv(tmp, ti);
- sv_setnv( *av_fetch(av, DBIprof_LAST_CALLED, 1), t1);
- }
- return dest_node; /* use with caution - copy first, ie sv_mortalcopy() */
-}
-
-
-static void
-dbi_profile_merge_nodes(SV *dest, SV *increment)
-{
- dTHX;
- AV *d_av, *i_av;
- SV *tmp;
- SV *tmp2;
- NV i_nv;
- int i_is_earlier;
-
- if (!SvROK(dest) || SvTYPE(SvRV(dest)) != SVt_PVAV)
- croak("dbi_profile_merge_nodes(%s, ...) requires array ref", neatsvpv(dest,0));
- d_av = (AV*)SvRV(dest);
-
- if (av_len(d_av) < DBIprof_max_index) {
- int idx;
- av_extend(d_av, DBIprof_max_index);
- for(idx=0; idx<=DBIprof_max_index; ++idx) {
- tmp = *av_fetch(d_av, idx, 1);
- if (!SvOK(tmp) && idx != DBIprof_MIN_TIME && idx != DBIprof_FIRST_CALLED)
- sv_setnv(tmp, 0.0); /* leave 'min' values as undef */
- }
- }
-
- if (!SvOK(increment))
- return;
-
- if (SvROK(increment) && SvTYPE(SvRV(increment)) == SVt_PVHV) {
- HV *hv = (HV*)SvRV(increment);
- char *key;
- I32 keylen = 0;
- hv_iterinit(hv);
- while ( (tmp = hv_iternextsv(hv, &key, &keylen)) != NULL ) {
- dbi_profile_merge_nodes(dest, tmp);
- };
- return;
- }
-
- if (!SvROK(increment) || SvTYPE(SvRV(increment)) != SVt_PVAV)
- croak("dbi_profile_merge_nodes: increment %s not an array or hash ref", neatsvpv(increment,0));
- i_av = (AV*)SvRV(increment);
-
- tmp = *av_fetch(d_av, DBIprof_COUNT, 1);
- tmp2 = *av_fetch(i_av, DBIprof_COUNT, 1);
- if (SvIOK(tmp) && SvIOK(tmp2))
- sv_setiv( tmp, SvIV(tmp) + SvIV(tmp2) );
- else
- sv_setnv( tmp, SvNV(tmp) + SvNV(tmp2) );
-
- tmp = *av_fetch(d_av, DBIprof_TOTAL_TIME, 1);
- sv_setnv( tmp, SvNV(tmp) + SvNV( *av_fetch(i_av, DBIprof_TOTAL_TIME, 1)) );
-
- i_nv = SvNV(*av_fetch(i_av, DBIprof_MIN_TIME, 1));
- tmp = *av_fetch(d_av, DBIprof_MIN_TIME, 1);
- if (!SvOK(tmp) || i_nv < SvNV(tmp)) sv_setnv(tmp, i_nv);
-
- i_nv = SvNV(*av_fetch(i_av, DBIprof_MAX_TIME, 1));
- tmp = *av_fetch(d_av, DBIprof_MAX_TIME, 1);
- if (i_nv > SvNV(tmp)) sv_setnv(tmp, i_nv);
-
- i_nv = SvNV(*av_fetch(i_av, DBIprof_FIRST_CALLED, 1));
- tmp = *av_fetch(d_av, DBIprof_FIRST_CALLED, 1);
- i_is_earlier = (!SvOK(tmp) || i_nv < SvNV(tmp));
- if (i_is_earlier)
- sv_setnv(tmp, i_nv);
-
- i_nv = SvNV(*av_fetch(i_av, DBIprof_FIRST_TIME, 1));
- tmp = *av_fetch(d_av, DBIprof_FIRST_TIME, 1);
- if (i_is_earlier || !SvOK(tmp)) {
- /* If the increment has an earlier DBIprof_FIRST_CALLED
- then we set the DBIprof_FIRST_TIME from the increment */
- sv_setnv(tmp, i_nv);
- }
-
- i_nv = SvNV(*av_fetch(i_av, DBIprof_LAST_CALLED, 1));
- tmp = *av_fetch(d_av, DBIprof_LAST_CALLED, 1);
- if (i_nv > SvNV(tmp)) sv_setnv(tmp, i_nv);
-}
-
-
-/* ----------------------------------------------------------------- */
-/* --- The DBI dispatcher. The heart of the perl DBI. --- */
-
-XS(XS_DBI_dispatch); /* prototype to pass -Wmissing-prototypes */
-XS(XS_DBI_dispatch)
-{
- dXSARGS;
- dORIGMARK;
- dMY_CXT;
-
- SV *h = ST(0); /* the DBI handle we are working with */
- SV *st1 = ST(1); /* used in debugging */
- SV *st2 = ST(2); /* used in debugging */
- SV *orig_h = h;
- SV *err_sv;
- SV **tmp_svp;
- SV **hook_svp = 0;
- MAGIC *mg;
- int gimme = GIMME;
- I32 trace_flags = DBIS->debug; /* local copy may change during dispatch */
- I32 trace_level = (trace_flags & DBIc_TRACE_LEVEL_MASK);
- int is_DESTROY;
- meth_types meth_type;
- int is_unrelated_to_Statement = 0;
- U32 keep_error = FALSE;
- UV ErrCount = UV_MAX;
- int i, outitems;
- int call_depth;
- int is_nested_call;
- NV profile_t1 = 0.0;
- int is_orig_method_name = 1;
-
- const char *meth_name = GvNAME(CvGV(cv));
- dbi_ima_t *ima = (dbi_ima_t*)CvXSUBANY(cv).any_ptr;
- U32 ima_flags;
- imp_xxh_t *imp_xxh = NULL;
- SV *imp_msv = Nullsv;
- SV *qsv = Nullsv; /* quick result from a shortcut method */
-
-
-#ifdef BROKEN_DUP_ANY_PTR
- if (ima->my_perl != my_perl) {
- /* we couldn't dup the ima struct at clone time, so do it now */
- dbi_ima_t *nima;
- Newx(nima, 1, dbi_ima_t);
- *nima = *ima; /* structure copy */
- CvXSUBANY(cv).any_ptr = nima;
- nima->stash = NULL;
- nima->gv = NULL;
- nima->my_perl = my_perl;
- ima = nima;
- }
-#endif
-
- ima_flags = ima->flags;
- meth_type = ima->meth_type;
- if (trace_level >= 9) {
- PerlIO *logfp = DBILOGFP;
- PerlIO_printf(logfp,"%c >> %-11s DISPATCH (%s rc%ld/%ld @%ld g%x ima%lx pid#%ld)",
- (PL_dirty?'!':' '), meth_name, neatsvpv(h,0),
- (long)SvREFCNT(h), (SvROK(h) ? (long)SvREFCNT(SvRV(h)) : (long)-1),
- (long)items, (int)gimme, (long)ima_flags, (long)PerlProc_getpid());
- PerlIO_puts(logfp, log_where(0, 0, " at ","\n", 1, (trace_level >= 3), (trace_level >= 4)));
- PerlIO_flush(logfp);
- }
-
- if ( ( (is_DESTROY=(meth_type == methtype_DESTROY))) ) {
- /* note that croak()'s won't propagate, only append to $@ */
- keep_error = TRUE;
- }
-
- /* If h is a tied hash ref, switch to the inner ref 'behind' the tie.
- This means *all* DBI methods work with the inner (non-tied) ref.
- This makes it much easier for methods to access the real hash
- data (without having to go through FETCH and STORE methods) and
- for tie and non-tie methods to call each other.
- */
- if (SvROK(h)
- && SvRMAGICAL(SvRV(h))
- && (
- ((mg=SvMAGIC(SvRV(h)))->mg_type == 'P')
- || ((mg=mg_find(SvRV(h),'P')) != NULL)
- )
- ) {
- if (mg->mg_obj==NULL || !SvOK(mg->mg_obj) || SvRV(mg->mg_obj)==NULL) { /* maybe global destruction */
- if (trace_level >= 3)
- PerlIO_printf(DBILOGFP,
- "%c <> %s for %s ignored (inner handle gone)\n",
- (PL_dirty?'!':' '), meth_name, neatsvpv(h,0));
- XSRETURN(0);
- }
- /* Distinguish DESTROY of tie (outer) from DESTROY of inner ref */
- /* This may one day be used to manually destroy extra internal */
- /* refs if the application ceases to use the handle. */
- if (is_DESTROY) {
- imp_xxh = DBIh_COM(mg->mg_obj);
-#ifdef DBI_USE_THREADS
- if (imp_xxh && DBIc_THR_USER(imp_xxh) != my_perl) {
- goto is_DESTROY_wrong_thread;
- }
-#endif
- if (imp_xxh && DBIc_TYPE(imp_xxh) <= DBIt_DB)
- clear_cached_kids(aTHX_ mg->mg_obj, imp_xxh, meth_name, trace_level);
- /* XXX might be better to move this down to after call_depth has been
- * incremented and then also SvREFCNT_dec(mg->mg_obj) to force an immediate
- * DESTROY of the inner handle if there are no other refs to it.
- * That way the inner DESTROY is properly flagged as a nested call,
- * and the outer DESTROY gets profiled more accurately, and callbacks work.
- */
- if (trace_level >= 3) {
- PerlIO_printf(DBILOGFP,
- "%c <> DESTROY(%s) ignored for outer handle (inner %s has ref cnt %ld)\n",
- (PL_dirty?'!':' '), neatsvpv(h,0), neatsvpv(mg->mg_obj,0),
- (long)SvREFCNT(SvRV(mg->mg_obj))
- );
- }
- /* for now we ignore it since it'll be followed soon by */
- /* a destroy of the inner hash and that'll do the real work */
-
- /* However, we must at least modify DBIc_MY_H() as that is */
- /* pointing (without a refcnt inc) to the scalar that is */
- /* being destroyed, so it'll contain random values later. */
- if (imp_xxh)
- DBIc_MY_H(imp_xxh) = (HV*)SvRV(mg->mg_obj); /* inner (untied) HV */
-
- XSRETURN(0);
- }
- h = mg->mg_obj; /* switch h to inner ref */
- ST(0) = h; /* switch handle on stack to inner ref */
- }
-
- imp_xxh = dbih_getcom2(aTHX_ h, 0); /* get common Internal Handle Attributes */
- if (!imp_xxh) {
- if (meth_type == methtype_can) { /* ref($h)->can("foo") */
- const char *can_meth = SvPV_nolen(st1);
- SV *rv = &PL_sv_undef;
- GV *gv = gv_fetchmethod_autoload(gv_stashsv(orig_h,FALSE), can_meth, FALSE);
- if (gv && isGV(gv))
- rv = sv_2mortal(newRV_inc((SV*)GvCV(gv)));
- if (trace_level >= 1) {
- PerlIO_printf(DBILOGFP," <- %s(%s) = %p\n", meth_name, can_meth, neatsvpv(rv,0));
- }
- ST(0) = rv;
- XSRETURN(1);
- }
- if (trace_level)
- PerlIO_printf(DBILOGFP, "%c <> %s for %s ignored (no imp_data)\n",
- (PL_dirty?'!':' '), meth_name, neatsvpv(h,0));
- if (!is_DESTROY)
- warn("Can't call %s method on handle %s%s", meth_name, neatsvpv(h,0),
- SvROK(h) ? " after take_imp_data()" : " (not a reference)");
- XSRETURN(0);
- }
-
- if (DBIc_has(imp_xxh,DBIcf_Profile)) {
- profile_t1 = dbi_time(); /* just get start time here */
- }
-
-#ifdef DBI_USE_THREADS
-{
- PerlInterpreter * h_perl;
- is_DESTROY_wrong_thread:
- h_perl = DBIc_THR_USER(imp_xxh) ;
- if (h_perl != my_perl) {
- /* XXX could call a 'handle clone' method here?, for dbh's at least */
- if (is_DESTROY) {
- if (trace_level >= 3) {
- PerlIO_printf(DBILOGFP," DESTROY ignored because DBI %sh handle (%s) is owned by thread %p not current thread %p\n",
- dbih_htype_name(DBIc_TYPE(imp_xxh)), HvNAME(DBIc_IMP_STASH(imp_xxh)),
- (void*)DBIc_THR_USER(imp_xxh), (void*)my_perl) ;
- PerlIO_flush(DBILOGFP);
- }
- XSRETURN(0); /* don't DESTROY handle, if it is not our's !*/
- }
- croak("%s %s failed: handle %d is owned by thread %lx not current thread %lx (%s)",
- HvNAME(DBIc_IMP_STASH(imp_xxh)), meth_name, DBIc_TYPE(imp_xxh),
- (unsigned long)h_perl, (unsigned long)my_perl,
- "handles can't be shared between threads and your driver may need a CLONE method added");
- }
-}
-#endif
-
- if ((i = DBIc_DEBUGIV(imp_xxh))) { /* merge handle into global */
- I32 h_trace_level = (i & DBIc_TRACE_LEVEL_MASK);
- if ( h_trace_level > trace_level )
- trace_level = h_trace_level;
- trace_flags = (trace_flags & ~DBIc_TRACE_LEVEL_MASK)
- | ( i & ~DBIc_TRACE_LEVEL_MASK)
- | trace_level;
- }
-
- /* Check method call against Internal Method Attributes */
- if (ima_flags) {
-
- if (ima_flags & (IMA_STUB|IMA_FUNC_REDIRECT|IMA_KEEP_ERR|IMA_KEEP_ERR_SUB|IMA_CLEAR_STMT)) {
-
- if (ima_flags & IMA_STUB) {
- if (meth_type == methtype_can) {
- const char *can_meth = SvPV_nolen(st1);
- SV *dbi_msv = Nullsv;
- /* find handle implementors method (GV or CV) */
- if ( (imp_msv = (SV*)gv_fetchmethod_autoload(DBIc_IMP_STASH(imp_xxh), can_meth, FALSE)) ) {
- /* return DBI's CV, not the implementors CV (else we'd bypass dispatch) */
- /* and anyway, we may have hit a private method not part of the DBI */
- GV *gv = gv_fetchmethod_autoload(SvSTASH(SvRV(orig_h)), can_meth, FALSE);
- if (gv && isGV(gv))
- dbi_msv = (SV*)GvCV(gv);
- }
- if (trace_level >= 1) {
- PerlIO *logfp = DBILOGFP;
- PerlIO_printf(logfp," <- %s(%s) = %p (%s %p)\n", meth_name, can_meth, (void*)dbi_msv,
- (imp_msv && isGV(imp_msv)) ? HvNAME(GvSTASH(imp_msv)) : "?", (void*)imp_msv);
- }
- ST(0) = (dbi_msv) ? sv_2mortal(newRV_inc(dbi_msv)) : &PL_sv_undef;
- XSRETURN(1);
- }
- XSRETURN(0);
- }
- if (ima_flags & IMA_FUNC_REDIRECT) {
- /* XXX this doesn't redispatch, nor consider the IMA of the new method */
- SV *meth_name_sv = POPs;
- PUTBACK;
- --items;
- if (!SvPOK(meth_name_sv) || SvNIOK(meth_name_sv))
- croak("%s->%s() invalid redirect method name %s",
- neatsvpv(h,0), meth_name, neatsvpv(meth_name_sv,0));
- meth_name = SvPV_nolen(meth_name_sv);
- meth_type = get_meth_type(meth_name);
- is_orig_method_name = 0;
- }
- if (ima_flags & IMA_KEEP_ERR)
- keep_error = TRUE;
- if ((ima_flags & IMA_KEEP_ERR_SUB)
- && !PL_dirty
- && DBIc_PARENT_COM(imp_xxh) && DBIc_CALL_DEPTH(DBIc_PARENT_COM(imp_xxh)) > 0)
- keep_error = TRUE;
- if (ima_flags & IMA_CLEAR_STMT) {
- /* don't use SvOK_off: dbh's Statement may be ref to sth's */
- (void)hv_store((HV*)SvRV(h), "Statement", 9, &PL_sv_undef, 0);
- }
- if (ima_flags & IMA_CLEAR_CACHED_KIDS)
- clear_cached_kids(aTHX_ h, imp_xxh, meth_name, trace_flags);
-
- }
-
- if (ima_flags & IMA_HAS_USAGE) {
- const char *err = NULL;
- char msg[200];
-
- if (ima->minargs && (items < ima->minargs
- || (ima->maxargs>0 && items > ima->maxargs))) {
- sprintf(msg,
- "DBI %s: invalid number of arguments: got handle + %ld, expected handle + between %d and %d\n",
- meth_name, (long)items-1, (int)ima->minargs-1, (int)ima->maxargs-1);
- err = msg;
- }
- /* arg type checking could be added here later */
- if (err) {
- croak("%sUsage: %s->%s(%s)", err, "$h", meth_name,
- (ima->usage_msg) ? ima->usage_msg : "...?");
- }
- }
- }
-
- is_unrelated_to_Statement = ( (DBIc_TYPE(imp_xxh) == DBIt_ST) ? 0
- : (DBIc_TYPE(imp_xxh) == DBIt_DR) ? 1
- : (ima_flags & IMA_UNRELATED_TO_STMT) );
-
- if (PL_tainting && items > 1 /* method call has args */
- && DBIc_is(imp_xxh, DBIcf_TaintIn) /* taint checks requested */
- && !(ima_flags & IMA_NO_TAINT_IN)
- ) {
- for(i=1; i < items; ++i) {
- if (SvTAINTED(ST(i))) {
- char buf[100];
- sprintf(buf,"parameter %d of %s->%s method call",
- i, SvPV_nolen(h), meth_name);
- PL_tainted = 1; /* needed for TAINT_PROPER to work */
- TAINT_PROPER(buf); /* die's */
- }
- }
- }
-
- /* record this inner handle for use by DBI::var::FETCH */
- if (is_DESTROY) {
-
- /* force destruction of any outstanding children */
- if ((tmp_svp = hv_fetch((HV*)SvRV(h), "ChildHandles", 12, FALSE)) && SvROK(*tmp_svp)) {
- AV *av = (AV*)SvRV(*tmp_svp);
- I32 kidslots;
- PerlIO *logfp = DBILOGFP;
-
- for (kidslots = AvFILL(av); kidslots >= 0; --kidslots) {
- SV **hp = av_fetch(av, kidslots, FALSE);
- if (!hp || !SvROK(*hp) || SvTYPE(SvRV(*hp))!=SVt_PVHV)
- break;
-
- if (trace_level >= 1) {
- PerlIO_printf(logfp, "on DESTROY handle %s still has child %s (refcnt %ld, obj %d, dirty=%d)\n",
- neatsvpv(h,0), neatsvpv(*hp, 0), (long)SvREFCNT(*hp), !!sv_isobject(*hp), PL_dirty);
- if (trace_level >= 9)
- sv_dump(SvRV(*hp));
- }
- if (sv_isobject(*hp)) { /* call DESTROY on the handle */
- PUSHMARK(SP);
- XPUSHs(*hp);
- PUTBACK;
- call_method("DESTROY", G_VOID|G_EVAL|G_KEEPERR);
- MSPAGAIN;
- }
- else {
- imp_xxh_t *imp_xxh = dbih_getcom2(aTHX_ *hp, 0);
- if (imp_xxh && DBIc_COMSET(imp_xxh)) {
- dbih_clearcom(imp_xxh);
- sv_setsv(*hp, &PL_sv_undef);
- }
- }
- }
- }
-
- if (DBIc_TYPE(imp_xxh) <= DBIt_DB ) { /* is dbh or drh */
- imp_xxh_t *parent_imp;
-
- if (SvOK(DBIc_ERR(imp_xxh)) && (parent_imp = DBIc_PARENT_COM(imp_xxh))
- && !PL_dirty /* XXX - remove? */
- ) {
- /* copy err/errstr/state values to $DBI::err etc still work */
- sv_setsv(DBIc_ERR(parent_imp), DBIc_ERR(imp_xxh));
- sv_setsv(DBIc_ERRSTR(parent_imp), DBIc_ERRSTR(imp_xxh));
- sv_setsv(DBIc_STATE(parent_imp), DBIc_STATE(imp_xxh));
- }
- }
-
- if (DBIc_AIADESTROY(imp_xxh)) { /* wants ineffective destroy after fork */
- if ((U32)PerlProc_getpid() != _imp2com(imp_xxh, std.pid))
- DBIc_set(imp_xxh, DBIcf_IADESTROY, 1);
- }
- if (DBIc_IADESTROY(imp_xxh)) { /* wants ineffective destroy */
- DBIc_ACTIVE_off(imp_xxh);
- }
- call_depth = 0;
- is_nested_call = 0;
- }
- else {
- DBI_SET_LAST_HANDLE(h);
- SAVEINT(DBIc_CALL_DEPTH(imp_xxh));
- call_depth = ++DBIc_CALL_DEPTH(imp_xxh);
-
- if (ima_flags & IMA_COPY_UP_STMT) { /* execute() */
- copy_statement_to_parent(aTHX_ h, imp_xxh);
- }
- is_nested_call =
- (call_depth > 1
- || (!PL_dirty /* not in global destruction [CPAN #75614] */
- && DBIc_PARENT_COM(imp_xxh)
- && DBIc_CALL_DEPTH(DBIc_PARENT_COM(imp_xxh))) >= 1);
-
- }
-
-
- /* --- dispatch --- */
-
- if (!keep_error && meth_type != methtype_set_err) {
- SV *err_sv;
- if (trace_level && SvOK(err_sv=DBIc_ERR(imp_xxh))) {
- PerlIO *logfp = DBILOGFP;
- PerlIO_printf(logfp, " !! The %s '%s' was CLEARED by call to %s method\n",
- SvTRUE(err_sv) ? "ERROR" : strlen(SvPV_nolen(err_sv)) ? "warn" : "info",
- neatsvpv(DBIc_ERR(imp_xxh),0), meth_name);
- }
- DBIh_CLEAR_ERROR(imp_xxh);
- }
- else { /* we check for change in ErrCount/err_hash during call */
- ErrCount = DBIc_ErrCount(imp_xxh);
- if (keep_error)
- keep_error = err_hash(aTHX_ imp_xxh);
- }
-
- if (DBIc_has(imp_xxh,DBIcf_Callbacks)
- && (tmp_svp = hv_fetch((HV*)SvRV(h), "Callbacks", 9, 0))
- && ( (hook_svp = hv_fetch((HV*)SvRV(*tmp_svp), meth_name, strlen(meth_name), 0))
- /* the "*" fallback callback only applies to non-nested calls
- * and also doesn't apply to the 'set_err' or DESTROY methods.
- * Nor during global destruction.
- * Other restrictions may be added over time.
- * It's an undocumented hack.
- */
- || (!is_nested_call && !PL_dirty && meth_type != methtype_set_err &&
- meth_type != methtype_DESTROY &&
- (hook_svp = hv_fetch((HV*)SvRV(*tmp_svp), "*", 1, 0))
- )
- )
- && SvROK(*hook_svp)
- ) {
- SV *orig_defsv;
- SV *temp_defsv;
- SV *code = SvRV(*hook_svp);
- I32 skip_dispatch = 0;
- if (trace_level)
- PerlIO_printf(DBILOGFP, "%c {{ %s callback %s being invoked with %ld args\n",
- (PL_dirty?'!':' '), meth_name, neatsvpv(*hook_svp,0), (long)items);
-
- /* we don't use ENTER,SAVETMPS & FREETMPS,LEAVE because we may need mortal
- * results to live long enough to be returned to our caller
- */
- /* we want to localize $_ for the callback but can't just do that alone
- * because we're not using SAVETMPS & FREETMPS, so we have to get sneaky.
- * We still localize, so we're safe from the callback die-ing,
- * but after the callback we manually restore the original $_.
- */
- orig_defsv = DEFSV; /* remember the current $_ */
- SAVE_DEFSV; /* local($_) = $method_name */
- temp_defsv = sv_2mortal(newSVpv(meth_name,0));
-# ifdef SvTEMP_off
- SvTEMP_off(temp_defsv);
-# endif
- DEFSV_set(temp_defsv);
-
- EXTEND(SP, items+1);
- PUSHMARK(SP);
- PUSHs(orig_h); /* push outer handle, then others params */
- for (i=1; i < items; ++i) { /* start at 1 to skip handle */
- PUSHs( ST(i) );
- }
- PUTBACK;
- outitems = call_sv(code, G_ARRAY); /* call the callback code */
- MSPAGAIN;
-
- /* The callback code can undef $_ to indicate to skip dispatch */
- skip_dispatch = !SvOK(DEFSV);
- /* put $_ back now, but with an incremented ref count to compensate
- * for the ref count decrement that will happen when we exit the scope.
- */
- DEFSV_set(SvREFCNT_inc(orig_defsv));
-
- if (trace_level)
- PerlIO_printf(DBILOGFP, "%c }} %s callback %s returned%s\n",
- (PL_dirty?'!':' '), meth_name, neatsvpv(*hook_svp,0),
- skip_dispatch ? ", actual method will not be called" : ""
- );
- if (skip_dispatch) { /* XXX experimental */
- int ix = outitems;
- /* copy the new items down to the destination list */
- while (ix-- > 0) {
- if(0)warn("\tcopy down %d: %s overwriting %s\n", ix, SvPV_nolen(TOPs), SvPV_nolen(ST(ix)) );
- ST(ix) = POPs;
- }
- imp_msv = *hook_svp; /* for trace and profile */
- goto post_dispatch;
- }
- else {
- if (outitems != 0)
- die("Callback for %s returned %d values but must not return any (temporary restriction in current version)",
- meth_name, (int)outitems);
- /* POP's and PUTBACK? to clear stack */
- }
- }
-
- /* set Executed after Callbacks so it's not set if callback elects to skip the method */
- if (ima_flags & IMA_EXECUTE) {
- imp_xxh_t *parent = DBIc_PARENT_COM(imp_xxh);
- DBIc_on(imp_xxh, DBIcf_Executed);
- if (parent)
- DBIc_on(parent, DBIcf_Executed);
- }
-
- /* The "quick_FETCH" logic... */
- /* Shortcut for fetching attributes to bypass method call overheads */
- if (meth_type == methtype_FETCH && !DBIc_COMPAT(imp_xxh)) {
- STRLEN kl;
- const char *key = SvPV(st1, kl);
- SV **attr_svp;
- if (*key != '_' && (attr_svp=hv_fetch((HV*)SvRV(h), key, kl, 0))) {
- qsv = *attr_svp;
- /* disable FETCH from cache for special attributes */
- if (SvROK(qsv) && SvTYPE(SvRV(qsv))==SVt_PVHV && *key=='D' &&
- ( (kl==6 && DBIc_TYPE(imp_xxh)==DBIt_DB && strEQ(key,"Driver"))
- || (kl==8 && DBIc_TYPE(imp_xxh)==DBIt_ST && strEQ(key,"Database")) )
- ) {
- qsv = Nullsv;
- }
- /* disable profiling of FETCH of Profile data */
- if (*key == 'P' && strEQ(key, "Profile"))
- profile_t1 = 0.0;
- }
- if (qsv) { /* skip real method call if we already have a 'quick' value */
- ST(0) = sv_mortalcopy(qsv);
- outitems = 1;
- goto post_dispatch;
- }
- }
-
- {
- CV *meth_cv;
-#ifdef DBI_save_hv_fetch_ent
- HE save_mh;
- if (meth_type == methtype_FETCH)
- save_mh = PL_hv_fetch_ent_mh; /* XXX nested tied FETCH bug17575 workaround */
-#endif
-
- if (trace_flags) {
- SAVEI32(DBIS->debug); /* fall back to orig value later */
- DBIS->debug = trace_flags; /* make new value global (for now) */
- if (ima) {
- /* enabling trace via flags takes precedence over disabling due to min level */
- if ((trace_flags & DBIc_TRACE_FLAGS_MASK) & (ima->method_trace & DBIc_TRACE_FLAGS_MASK))
- trace_level = (trace_level < 2) ? 2 : trace_level; /* min */
- else
- if (trace_level < (DBIc_TRACE_LEVEL_MASK & ima->method_trace))
- trace_level = 0; /* silence dispatch log for this method */
- }
- }
-
- if (is_orig_method_name
- && ima->stash == DBIc_IMP_STASH(imp_xxh)
- && ima->generation == PL_sub_generation +
- MY_cache_gen(DBIc_IMP_STASH(imp_xxh))
- )
- imp_msv = (SV*)ima->gv;
- else {
- imp_msv = (SV*)gv_fetchmethod_autoload(DBIc_IMP_STASH(imp_xxh),
- meth_name, FALSE);
- if (is_orig_method_name) {
- /* clear stale entry, if any */
- SvREFCNT_dec(ima->stash);
- SvREFCNT_dec(ima->gv);
- if (!imp_msv) {
- ima->stash = NULL;
- ima->gv = NULL;
- }
- else {
- ima->stash = (HV*)SvREFCNT_inc(DBIc_IMP_STASH(imp_xxh));
- ima->gv = (GV*)SvREFCNT_inc(imp_msv);
- ima->generation = PL_sub_generation +
- MY_cache_gen(DBIc_IMP_STASH(imp_xxh));
- }
- }
- }
-
- /* if method was a 'func' then try falling back to real 'func' method */
- if (!imp_msv && (ima_flags & IMA_FUNC_REDIRECT)) {
- imp_msv = (SV*)gv_fetchmethod_autoload(DBIc_IMP_STASH(imp_xxh), "func", FALSE);
- if (imp_msv) {
- /* driver does have func method so undo the earlier 'func' stack changes */
- PUSHs(sv_2mortal(newSVpv(meth_name,0)));
- PUTBACK;
- ++items;
- meth_name = "func";
- meth_type = methtype_ordinary;
- }
- }
-
- if (trace_level >= (is_nested_call ? 4 : 2)) {
- PerlIO *logfp = DBILOGFP;
- /* Full pkg method name (or just meth_name for ANON CODE) */
- const char *imp_meth_name = (imp_msv && isGV(imp_msv)) ? GvNAME(imp_msv) : meth_name;
- HV *imp_stash = DBIc_IMP_STASH(imp_xxh);
- PerlIO_printf(logfp, "%c -> %s ",
- call_depth>1 ? '0'+call_depth-1 : (PL_dirty?'!':' '), imp_meth_name);
- if (imp_meth_name[0] == 'A' && strEQ(imp_meth_name,"AUTOLOAD"))
- PerlIO_printf(logfp, "\"%s\" ", meth_name);
- if (imp_msv && isGV(imp_msv) && GvSTASH(imp_msv) != imp_stash)
- PerlIO_printf(logfp, "in %s ", HvNAME(GvSTASH(imp_msv)));
- PerlIO_printf(logfp, "for %s (%s", HvNAME(imp_stash),
- SvPV_nolen(orig_h));
- if (h != orig_h) /* show inner handle to aid tracing */
- PerlIO_printf(logfp, "~0x%lx", (long)SvRV(h));
- else PerlIO_printf(logfp, "~INNER");
- for(i=1; i<items; ++i) {
- PerlIO_printf(logfp," %s",
- (ima && i==ima->hidearg) ? "****" : neatsvpv(ST(i),0));
- }
-#ifdef DBI_USE_THREADS
- PerlIO_printf(logfp, ") thr#%p\n", (void*)DBIc_THR_USER(imp_xxh));
-#else
- PerlIO_printf(logfp, ")\n");
-#endif
- PerlIO_flush(logfp);
- }
-
- if (!imp_msv || ! ((meth_cv = GvCV(imp_msv))) ) {
- if (PL_dirty || is_DESTROY) {
- outitems = 0;
- goto post_dispatch;
- }
- if (ima_flags & IMA_NOT_FOUND_OKAY) {
- outitems = 0;
- goto post_dispatch;
- }
- croak("Can't locate DBI object method \"%s\" via package \"%s\"",
- meth_name, HvNAME(DBIc_IMP_STASH(imp_xxh)));
- }
-
- PUSHMARK(mark); /* mark arguments again so we can pass them on */
-
- /* Note: the handle on the stack is still an object blessed into a
- * DBI::* class and not the DBD::*::* class whose method is being
- * invoked. This is correct and should be largely transparent.
- */
-
- /* SHORT-CUT ALERT! */
- if (use_xsbypass && CvISXSUB(meth_cv) && CvXSUB(meth_cv)) {
-
- /* If we are calling an XSUB we jump directly to its C code and
- * bypass perl_call_sv(), pp_entersub() etc. This is fast.
- * This code is based on a small section of pp_entersub().
- */
- (void)(*CvXSUB(meth_cv))(aTHXo_ meth_cv); /* Call the C code directly */
-
- if (gimme == G_SCALAR) { /* Enforce sanity in scalar context */
- if (ax != PL_stack_sp - PL_stack_base ) { /* outitems != 1 */
- ST(0) =
- (ax > PL_stack_sp - PL_stack_base)
- ? &PL_sv_undef /* outitems == 0 */
- : *PL_stack_sp; /* outitems > 1 */
- PL_stack_sp = PL_stack_base + ax;
- }
- outitems = 1;
- }
- else {
- outitems = PL_stack_sp - (PL_stack_base + ax - 1);
- }
-
- }
- else {
- /* sv_dump(imp_msv); */
- outitems = call_sv((SV*)meth_cv,
- (is_DESTROY ? gimme | G_EVAL | G_KEEPERR : gimme) );
- }
-
- XSprePUSH; /* reset SP to base of stack frame */
-
-#ifdef DBI_save_hv_fetch_ent
- if (meth_type == methtype_FETCH)
- PL_hv_fetch_ent_mh = save_mh; /* see start of block */
-#endif
- }
-
- post_dispatch:
-
- if (is_DESTROY && DBI_IS_LAST_HANDLE(h)) { /* if destroying _this_ handle */
- SV *lhp = DBIc_PARENT_H(imp_xxh);
- if (lhp && SvROK(lhp)) {
- DBI_SET_LAST_HANDLE(lhp);
- }
- else {
- DBI_UNSET_LAST_HANDLE;
- }
- }
-
- if (keep_error) {
- /* if we didn't clear err before the call, check to see if a new error
- * or warning has been recorded. If so, turn off keep_error so it gets acted on
- */
- if (DBIc_ErrCount(imp_xxh) > ErrCount || err_hash(aTHX_ imp_xxh) != keep_error) {
- keep_error = 0;
- }
- }
-
- err_sv = DBIc_ERR(imp_xxh);
-
- if (trace_level >= (is_nested_call ? 3 : 1)) {
- PerlIO *logfp = DBILOGFP;
- const int is_fetch = (meth_type == methtype_fetch_star && DBIc_TYPE(imp_xxh)==DBIt_ST);
- const IV row_count = (is_fetch) ? DBIc_ROW_COUNT((imp_sth_t*)imp_xxh) : 0;
- if (is_fetch && row_count>=2 && trace_level<=4 && SvOK(ST(0))) {
- /* skip the 'middle' rows to reduce output */
- goto skip_meth_return_trace;
- }
- if (SvOK(err_sv)) {
- PerlIO_printf(logfp, " %s %s %s %s (err#%ld)\n", (keep_error) ? " " : "!!",
- SvTRUE(err_sv) ? "ERROR:" : strlen(SvPV_nolen(err_sv)) ? "warn:" : "info:",
- neatsvpv(err_sv,0), neatsvpv(DBIc_ERRSTR(imp_xxh),0), (long)DBIc_ErrCount(imp_xxh));
- }
- PerlIO_printf(logfp,"%c%c <%c %s",
- (call_depth > 1) ? '0'+call_depth-1 : (PL_dirty?'!':' '),
- (DBIc_is(imp_xxh, DBIcf_TaintIn|DBIcf_TaintOut)) ? 'T' : ' ',
- (qsv) ? '>' : '-',
- meth_name);
- if (trace_level==1 && (items>=2||is_DESTROY)) { /* make level 1 more useful */
- /* we only have the first two parameters available here */
- if (is_DESTROY) /* show handle as first arg to DESTROY */
- /* want to show outer handle so trace makes sense */
- /* but outer handle has been destroyed so we fake it */
- PerlIO_printf(logfp,"(%s=HASH(0x%p)", HvNAME(SvSTASH(SvRV(orig_h))), (void*)DBIc_MY_H(imp_xxh));
- else
- PerlIO_printf(logfp,"(%s", neatsvpv(st1,0));
- if (items >= 3)
- PerlIO_printf(logfp,", %s", neatsvpv(st2,0));
- PerlIO_printf(logfp,"%s)", (items > 3) ? ", ..." : "");
- }
-
- if (gimme & G_ARRAY)
- PerlIO_printf(logfp,"= (");
- else PerlIO_printf(logfp,"=");
- for(i=0; i < outitems; ++i) {
- SV *s = ST(i);
- if ( SvROK(s) && SvTYPE(SvRV(s))==SVt_PVAV) {
- AV *av = (AV*)SvRV(s);
- int avi;
- int avi_last = SvIV(DBIS->neatsvpvlen) / 10;
- if (avi_last < 39)
- avi_last = 39;
- PerlIO_printf(logfp, " [");
- for (avi=0; avi <= AvFILL(av); ++avi) {
- PerlIO_printf(logfp, " %s", neatsvpv(AvARRAY(av)[avi],0));
- if (avi >= avi_last && AvFILL(av) - avi > 1) {
- PerlIO_printf(logfp, " ... %ld others skipped", AvFILL(av) - avi);
- break;
- }
- }
- PerlIO_printf(logfp, " ]");
- }
- else {
- PerlIO_printf(logfp, " %s", neatsvpv(s,0));
- if ( SvROK(s) && SvTYPE(SvRV(s))==SVt_PVHV && !SvOBJECT(SvRV(s)) )
- PerlIO_printf(logfp, "%ldkeys", (long)HvKEYS(SvRV(s)));
- }
- }
- if (gimme & G_ARRAY) {
- PerlIO_printf(logfp," ) [%d items]", outitems);
- }
- if (is_fetch && row_count) {
- PerlIO_printf(logfp," row%"IVdf, row_count);
- }
- if (qsv) /* flag as quick and peek at the first arg (still on the stack) */
- PerlIO_printf(logfp," (%s from cache)", neatsvpv(st1,0));
- else if (!imp_msv)
- PerlIO_printf(logfp," (not implemented)");
- /* XXX add flag to show pid here? */
- /* add file and line number information */
- PerlIO_puts(logfp, log_where(0, 0, " at ", "\n", 1, (trace_level >= 3), (trace_level >= 4)));
- skip_meth_return_trace:
- PerlIO_flush(logfp);
- }
-
- if (ima_flags & IMA_END_WORK) { /* commit() or rollback() */
- /* XXX does not consider if the method call actually worked or not */
- DBIc_off(imp_xxh, DBIcf_Executed);
-
- if (DBIc_has(imp_xxh, DBIcf_BegunWork)) {
- DBIc_off(imp_xxh, DBIcf_BegunWork);
- if (!DBIc_has(imp_xxh, DBIcf_AutoCommit)) {
- /* We only get here if the driver hasn't implemented their own code */
- /* for begin_work, or has but hasn't correctly turned AutoCommit */
- /* back on in their commit or rollback code. So we have to do it. */
- /* This is bad because it'll probably trigger a spurious commit() */
- /* and may mess up the error handling below for the commit/rollback */
- PUSHMARK(SP);
- XPUSHs(h);
- XPUSHs(sv_2mortal(newSVpv("AutoCommit",0)));
- XPUSHs(&PL_sv_yes);
- PUTBACK;
- call_method("STORE", G_VOID);
- MSPAGAIN;
- }
- }
- }
-
- if (PL_tainting
- && DBIc_is(imp_xxh, DBIcf_TaintOut) /* taint checks requested */
- /* XXX this would taint *everything* being returned from *any* */
- /* method that doesn't have IMA_NO_TAINT_OUT set. */
- /* DISABLED: just tainting fetched data in get_fbav seems ok */
- && 0/* XXX disabled*/ /* !(ima_flags & IMA_NO_TAINT_OUT) */
- ) {
- dTHR;
- TAINT; /* affects sv_setsv()'s within same perl statement */
- for(i=0; i < outitems; ++i) {
- I32 avi;
- char *p;
- SV *s;
- SV *agg = ST(i);
- if ( !SvROK(agg) )
- continue;
- agg = SvRV(agg);
-#define DBI_OUT_TAINTABLE(s) (!SvREADONLY(s) && !SvTAINTED(s))
- switch (SvTYPE(agg)) {
- case SVt_PVAV:
- for(avi=0; avi <= AvFILL((AV*)agg); ++avi) {
- s = AvARRAY((AV*)agg)[avi];
- if (DBI_OUT_TAINTABLE(s))
- SvTAINTED_on(s);
- }
- break;
- case SVt_PVHV:
- hv_iterinit((HV*)agg);
- while( (s = hv_iternextsv((HV*)agg, &p, &avi)) ) {
- if (DBI_OUT_TAINTABLE(s))
- SvTAINTED_on(s);
- }
- break;
- default:
- if (DBIc_WARN(imp_xxh)) {
- PerlIO_printf(DBILOGFP,"Don't know how to taint contents of returned %s (type %d)\n",
- neatsvpv(agg,0), (int)SvTYPE(agg));
- }
- }
- }
- }
-
- /* if method returned a new handle, and that handle has an error on it
- * then copy the error up into the parent handle
- */
- if (ima_flags & IMA_IS_FACTORY && SvROK(ST(0))) {
- SV *h_new = ST(0);
- D_impdata(imp_xxh_new, imp_xxh_t, h_new);
- if (SvOK(DBIc_ERR(imp_xxh_new))) {
- set_err_sv(h, imp_xxh, DBIc_ERR(imp_xxh_new), DBIc_ERRSTR(imp_xxh_new), DBIc_STATE(imp_xxh_new), &PL_sv_no);
- }
- }
-
- if ( !keep_error /* is a new err/warn/info */
- && !is_nested_call /* skip nested (internal) calls */
- && (
- /* is an error and has RaiseError|PrintError|HandleError set */
- (SvTRUE(err_sv) && DBIc_has(imp_xxh, DBIcf_RaiseError|DBIcf_PrintError|DBIcf_HandleError))
- /* is a warn (not info) and has PrintWarn set */
- || ( SvOK(err_sv) && strlen(SvPV_nolen(err_sv)) && DBIc_has(imp_xxh, DBIcf_PrintWarn))
- )
- ) {
- SV *msg;
- SV **statement_svp = NULL;
- const int is_warning = (!SvTRUE(err_sv) && strlen(SvPV_nolen(err_sv))==1);
- const char *err_meth_name = meth_name;
- char intro[200];
-
- if (meth_type == methtype_set_err) {
- SV **sem_svp = hv_fetch((HV*)SvRV(h), "dbi_set_err_method", 18, GV_ADDWARN);
- if (SvOK(*sem_svp))
- err_meth_name = SvPV_nolen(*sem_svp);
- }
-
- /* XXX change to vsprintf into sv directly */
- sprintf(intro,"%s %s %s: ", HvNAME(DBIc_IMP_STASH(imp_xxh)), err_meth_name,
- SvTRUE(err_sv) ? "failed" : is_warning ? "warning" : "information");
- msg = sv_2mortal(newSVpv(intro,0));
- if (SvOK(DBIc_ERRSTR(imp_xxh)))
- sv_catsv(msg, DBIc_ERRSTR(imp_xxh));
- else
- sv_catpvf(msg, "(err=%s, errstr=undef, state=%s)",
- neatsvpv(DBIc_ERR(imp_xxh),0), neatsvpv(DBIc_STATE(imp_xxh),0) );
-
- if ( DBIc_has(imp_xxh, DBIcf_ShowErrorStatement)
- && !is_unrelated_to_Statement
- && (DBIc_TYPE(imp_xxh) == DBIt_ST || ima_flags & IMA_SHOW_ERR_STMT)
- && (statement_svp = hv_fetch((HV*)SvRV(h), "Statement", 9, 0))
- && statement_svp && SvOK(*statement_svp)
- ) {
- SV **svp = 0;
- sv_catpv(msg, " [for Statement \"");
- sv_catsv(msg, *statement_svp);
-
- /* fetch from tied outer handle to trigger FETCH magic */
- /* could add DBIcf_ShowErrorParams (default to on?) */
- if (!(ima_flags & IMA_HIDE_ERR_PARAMVALUES)) {
- svp = hv_fetch((HV*)DBIc_MY_H(imp_xxh),"ParamValues",11,FALSE);
- if (svp && SvMAGICAL(*svp))
- mg_get(*svp); /* XXX may recurse, may croak. could use eval */
- }
- if (svp && SvRV(*svp) && SvTYPE(SvRV(*svp)) == SVt_PVHV && HvKEYS(SvRV(*svp))>0 ) {
- SV *param_values_sv = sv_2mortal(_join_hash_sorted((HV*)SvRV(*svp), "=",1, ", ",2, 1, -1));
- sv_catpv(msg, "\" with ParamValues: ");
- sv_catsv(msg, param_values_sv);
- sv_catpvn(msg, "]", 1);
- }
- else {
- sv_catpv(msg, "\"]");
- }
- }
-
- if (0) {
- COP *cop = dbi_caller_cop();
- if (cop && (CopLINE(cop) != CopLINE(PL_curcop) || CopFILEGV(cop) != CopFILEGV(PL_curcop))) {
- dbi_caller_string(msg, cop, " called via ", 1, 0);
- }
- }
-
- hook_svp = NULL;
- if ( SvTRUE(err_sv)
- && DBIc_has(imp_xxh, DBIcf_HandleError)
- && (hook_svp = hv_fetch((HV*)SvRV(h),"HandleError",11,0))
- && hook_svp && SvOK(*hook_svp)
- ) {
- dSP;
- PerlIO *logfp = DBILOGFP;
- IV items;
- SV *status;
- SV *result; /* point to result SV that's pointed to by the stack */
- if (outitems) {
- result = *(sp-outitems+1);
- if (SvREADONLY(result)) {
- *(sp-outitems+1) = result = sv_2mortal(newSVsv(result));
- }
- }
- else {
- result = sv_newmortal();
- }
- if (trace_level)
- PerlIO_printf(logfp," -> HandleError on %s via %s%s%s%s\n",
- neatsvpv(h,0), neatsvpv(*hook_svp,0),
- (!outitems ? "" : " ("),
- (!outitems ? "" : neatsvpv(result ,0)),
- (!outitems ? "" : ")")
- );
- PUSHMARK(SP);
- XPUSHs(msg);
- XPUSHs(sv_2mortal(newRV_inc((SV*)DBIc_MY_H(imp_xxh))));
- XPUSHs( result );
- PUTBACK;
- items = call_sv(*hook_svp, G_SCALAR);
- MSPAGAIN;
- status = (items) ? POPs : &PL_sv_undef;
- PUTBACK;
- if (trace_level)
- PerlIO_printf(logfp," <- HandleError= %s%s%s%s\n",
- neatsvpv(status,0),
- (!outitems ? "" : " ("),
- (!outitems ? "" : neatsvpv(result,0)),
- (!outitems ? "" : ")")
- );
- if (!SvTRUE(status)) /* handler says it didn't handle it, so... */
- hook_svp = 0; /* pretend we didn't have a handler... */
- }
-
- if (profile_t1) { /* see also dbi_profile() call a few lines below */
- SV *statement_sv = (is_unrelated_to_Statement) ? &PL_sv_no : &PL_sv_undef;
- dbi_profile(h, imp_xxh, statement_sv, imp_msv ? imp_msv : (SV*)cv,
- profile_t1, dbi_time());
- }
- if (is_warning) {
- if (DBIc_has(imp_xxh, DBIcf_PrintWarn))
- warn_sv(msg);
- }
- else if (!hook_svp && SvTRUE(err_sv)) {
- if (DBIc_has(imp_xxh, DBIcf_PrintError))
- warn_sv(msg);
- if (DBIc_has(imp_xxh, DBIcf_RaiseError))
- croak_sv(msg);
- }
- }
- else if (profile_t1) { /* see also dbi_profile() call a few lines above */
- SV *statement_sv = (is_unrelated_to_Statement) ? &PL_sv_no : &PL_sv_undef;
- dbi_profile(h, imp_xxh, statement_sv, imp_msv ? imp_msv : (SV*)cv,
- profile_t1, dbi_time());
- }
- XSRETURN(outitems);
-}
-
-
-
-/* -------------------------------------------------------------------- */
-
-/* comment and placeholder styles to accept and return */
-
-#define DBIpp_cm_cs 0x000001 /* C style */
-#define DBIpp_cm_hs 0x000002 /* # */
-#define DBIpp_cm_dd 0x000004 /* -- */
-#define DBIpp_cm_br 0x000008 /* {} */
-#define DBIpp_cm_dw 0x000010 /* '-- ' dash dash whitespace */
-#define DBIpp_cm_XX 0x00001F /* any of the above */
-
-#define DBIpp_ph_qm 0x000100 /* ? */
-#define DBIpp_ph_cn 0x000200 /* :1 */
-#define DBIpp_ph_cs 0x000400 /* :name */
-#define DBIpp_ph_sp 0x000800 /* %s (as return only, not accept) */
-#define DBIpp_ph_XX 0x000F00 /* any of the above */
-
-#define DBIpp_st_qq 0x010000 /* '' char escape */
-#define DBIpp_st_bs 0x020000 /* \ char escape */
-#define DBIpp_st_XX 0x030000 /* any of the above */
-
-#define DBIpp_L_BRACE '{'
-#define DBIpp_R_BRACE '}'
-#define PS_accept(flag) DBIbf_has(ps_accept,(flag))
-#define PS_return(flag) DBIbf_has(ps_return,(flag))
-
-SV *
-preparse(SV *dbh, const char *statement, IV ps_return, IV ps_accept, void *foo)
-{
- dTHX;
- D_imp_xxh(dbh);
-/*
- The idea here is that ps_accept defines which constructs to
- recognize (accept) as valid in the source string (other
- constructs are ignored), and ps_return defines which
- constructs are valid to return in the result string.
-
- If a construct that is valid in the input is also valid in the
- output then it's simply copied. If it's not valid in the output
- then it's editied into one of the valid forms (ideally the most
- 'standard' and/or information preserving one).
-
- For example, if ps_accept includes '--' style comments but
- ps_return doesn't, but ps_return does include '#' style
- comments then any '--' style comments would be rewritten as '#'
- style comments.
-
- Similarly for placeholders. DBD::Oracle, for example, would say
- '?', ':1' and ':name' are all acceptable input, but only
- ':name' should be returned.
-
- (There's a tricky issue with the '--' comment style because it can
- clash with valid syntax, i.e., "... set foo=foo--1 ..." so it
- would be *bad* to misinterpret that as the start of a comment.
- Perhaps we need a DBIpp_cm_dw (for dash-dash-whitespace) style
- to allow for that.)
-
- Also, we'll only support DBIpp_cm_br as an input style. And
- even then, only with reluctance. We may (need to) drop it when
- we add support for odbc escape sequences.
-*/
- int idx = 1;
-
- char in_quote = '\0';
- char in_comment = '\0';
- char rt_comment = '\0';
- char *dest, *start;
- const char *src;
- const char *style = "", *laststyle = NULL;
- SV *new_stmt_sv;
-
- (void)foo;
-
- if (!(ps_return | DBIpp_ph_XX)) { /* no return ph type specified */
- ps_return |= ps_accept | DBIpp_ph_XX; /* so copy from ps_accept */
- }
-
- /* XXX this allocation strategy won't work when we get to more advanced stuff */
- new_stmt_sv = newSV(strlen(statement) * 3);
- sv_setpv(new_stmt_sv,"");
- src = statement;
- dest = SvPVX(new_stmt_sv);
-
- while( *src )
- {
- if (*src == '%' && PS_return(DBIpp_ph_sp))
- *dest++ = '%';
-
- if (in_comment)
- {
- if ( (in_comment == '-' && (*src == '\n' || *(src+1) == '\0'))
- || (in_comment == '#' && (*src == '\n' || *(src+1) == '\0'))
- || (in_comment == DBIpp_L_BRACE && *src == DBIpp_R_BRACE) /* XXX nesting? */
- || (in_comment == '/' && *src == '*' && *(src+1) == '/')
- ) {
- switch (rt_comment) {
- case '/': *dest++ = '*'; *dest++ = '/'; break;
- case '-': *dest++ = '\n'; break;
- case '#': *dest++ = '\n'; break;
- case DBIpp_L_BRACE: *dest++ = DBIpp_R_BRACE; break;
- case '\0': /* ensure deleting a comment doesn't join two tokens */
- if (in_comment=='/' || in_comment==DBIpp_L_BRACE)
- *dest++ = ' '; /* ('-' and '#' styles use the newline) */
- break;
- }
- if (in_comment == '/')
- src++;
- src += (*src != '\n' || *(dest-1)=='\n') ? 1 : 0;
- in_comment = '\0';
- rt_comment = '\0';
- }
- else
- if (rt_comment)
- *dest++ = *src++;
- else
- src++; /* delete (don't copy) the comment */
- continue;
- }
-
- if (in_quote)
- {
- if (*src == in_quote) {
- in_quote = 0;
- }
- *dest++ = *src++;
- continue;
- }
-
- /* Look for comments */
- if (*src == '-' && *(src+1) == '-' &&
- (PS_accept(DBIpp_cm_dd) || (*(src+2) == ' ' && PS_accept(DBIpp_cm_dw)))
- )
- {
- in_comment = *src;
- src += 2; /* skip past 2nd char of double char delimiters */
- if (PS_return(DBIpp_cm_dd) || PS_return(DBIpp_cm_dw)) {
- *dest++ = rt_comment = '-';
- *dest++ = '-';
- if (PS_return(DBIpp_cm_dw) && *src!=' ')
- *dest++ = ' '; /* insert needed white space */
- }
- else if (PS_return(DBIpp_cm_cs)) {
- *dest++ = rt_comment = '/';
- *dest++ = '*';
- }
- else if (PS_return(DBIpp_cm_hs)) {
- *dest++ = rt_comment = '#';
- }
- else if (PS_return(DBIpp_cm_br)) {
- *dest++ = rt_comment = DBIpp_L_BRACE;
- }
- continue;
- }
- else if (*src == '/' && *(src+1) == '*' && PS_accept(DBIpp_cm_cs))
- {
- in_comment = *src;
- src += 2; /* skip past 2nd char of double char delimiters */
- if (PS_return(DBIpp_cm_cs)) {
- *dest++ = rt_comment = '/';
- *dest++ = '*';
- }
- else if (PS_return(DBIpp_cm_dd) || PS_return(DBIpp_cm_dw)) {
- *dest++ = rt_comment = '-';
- *dest++ = '-';
- if (PS_return(DBIpp_cm_dw)) *dest++ = ' ';
- }
- else if (PS_return(DBIpp_cm_hs)) {
- *dest++ = rt_comment = '#';
- }
- else if (PS_return(DBIpp_cm_br)) {
- *dest++ = rt_comment = DBIpp_L_BRACE;
- }
- continue;
- }
- else if (*src == '#' && PS_accept(DBIpp_cm_hs))
- {
- in_comment = *src;
- src++;
- if (PS_return(DBIpp_cm_hs)) {
- *dest++ = rt_comment = '#';
- }
- else if (PS_return(DBIpp_cm_dd) || PS_return(DBIpp_cm_dw)) {
- *dest++ = rt_comment = '-';
- *dest++ = '-';
- if (PS_return(DBIpp_cm_dw)) *dest++ = ' ';
- }
- else if (PS_return(DBIpp_cm_cs)) {
- *dest++ = rt_comment = '/';
- *dest++ = '*';
- }
- else if (PS_return(DBIpp_cm_br)) {
- *dest++ = rt_comment = DBIpp_L_BRACE;
- }
- continue;
- }
- else if (*src == DBIpp_L_BRACE && PS_accept(DBIpp_cm_br))
- {
- in_comment = *src;
- src++;
- if (PS_return(DBIpp_cm_br)) {
- *dest++ = rt_comment = DBIpp_L_BRACE;
- }
- else if (PS_return(DBIpp_cm_dd) || PS_return(DBIpp_cm_dw)) {
- *dest++ = rt_comment = '-';
- *dest++ = '-';
- if (PS_return(DBIpp_cm_dw)) *dest++ = ' ';
- }
- else if (PS_return(DBIpp_cm_cs)) {
- *dest++ = rt_comment = '/';
- *dest++ = '*';
- }
- else if (PS_return(DBIpp_cm_hs)) {
- *dest++ = rt_comment = '#';
- }
- continue;
- }
-
- if ( !(*src==':' && (PS_accept(DBIpp_ph_cn) || PS_accept(DBIpp_ph_cs)))
- && !(*src=='?' && PS_accept(DBIpp_ph_qm))
- ){
- if (*src == '\'' || *src == '"')
- in_quote = *src;
- *dest++ = *src++;
- continue;
- }
-
- /* only here for : or ? outside of a comment or literal */
-
- start = dest; /* save name inc colon */
- *dest++ = *src++; /* copy and move past first char */
-
- if (*start == '?') /* X/Open Standard */
- {
- style = "?";
-
- if (PS_return(DBIpp_ph_qm))
- ;
- else if (PS_return(DBIpp_ph_cn)) { /* '?' -> ':p1' (etc) */
- sprintf(start,":p%d", idx++);
- dest = start+strlen(start);
- }
- else if (PS_return(DBIpp_ph_sp)) { /* '?' -> '%s' */
- *start = '%';
- *dest++ = 's';
- }
- }
- else if (isDIGIT(*src)) { /* :1 */
- const int pln = atoi(src);
- style = ":1";
-
- if (PS_return(DBIpp_ph_cn)) { /* ':1'->':p1' */
- idx = pln;
- *dest++ = 'p';
- while(isDIGIT(*src))
- *dest++ = *src++;
- }
- else if (PS_return(DBIpp_ph_qm) /* ':1' -> '?' */
- || PS_return(DBIpp_ph_sp) /* ':1' -> '%s' */
- ) {
- PS_return(DBIpp_ph_qm) ? sprintf(start,"?") : sprintf(start,"%%s");
- dest = start + strlen(start);
- if (pln != idx) {
- char buf[99];
- sprintf(buf, "preparse found placeholder :%d out of sequence, expected :%d", pln, idx);
- set_err_char(dbh, imp_xxh, "1", 1, buf, 0, "preparse");
- return &PL_sv_undef;
- }
- while(isDIGIT(*src)) src++;
- idx++;
- }
- }
- else if (isALNUM(*src)) /* :name */
- {
- style = ":name";
-
- if (PS_return(DBIpp_ph_cs)) {
- ;
- }
- else if (PS_return(DBIpp_ph_qm) /* ':name' -> '?' */
- || PS_return(DBIpp_ph_sp) /* ':name' -> '%s' */
- ) {
- PS_return(DBIpp_ph_qm) ? sprintf(start,"?") : sprintf(start,"%%s");
- dest = start + strlen(start);
- while (isALNUM(*src)) /* consume name, includes '_' */
- src++;
- }
- }
- /* perhaps ':=' PL/SQL construct */
- else { continue; }
-
- *dest = '\0'; /* handy for debugging */
-
- if (laststyle && style != laststyle) {
- char buf[99];
- sprintf(buf, "preparse found mixed placeholder styles (%s / %s)", style, laststyle);
- set_err_char(dbh, imp_xxh, "1", 1, buf, 0, "preparse");
- return &PL_sv_undef;
- }
- laststyle = style;
- }
- *dest = '\0';
-
- /* warn about probable parsing errors, but continue anyway (returning processed string) */
- switch (in_quote)
- {
- case '\'':
- set_err_char(dbh, imp_xxh, "1", 1, "preparse found unterminated single-quoted string", 0, "preparse");
- break;
- case '\"':
- set_err_char(dbh, imp_xxh, "1", 1, "preparse found unterminated double-quoted string", 0, "preparse");
- break;
- }
- switch (in_comment)
- {
- case DBIpp_L_BRACE:
- set_err_char(dbh, imp_xxh, "1", 1, "preparse found unterminated bracketed {...} comment", 0, "preparse");
- break;
- case '/':
- set_err_char(dbh, imp_xxh, "1", 1, "preparse found unterminated bracketed C-style comment", 0, "preparse");
- break;
- }
-
- SvCUR_set(new_stmt_sv, strlen(SvPVX(new_stmt_sv)));
- *SvEND(new_stmt_sv) = '\0';
- return new_stmt_sv;
-}
-
-
-/* -------------------------------------------------------------------- */
-/* The DBI Perl interface (via XS) starts here. Currently these are */
-/* all internal support functions. Note install_method and see DBI.pm */
-
-MODULE = DBI PACKAGE = DBI
-
-REQUIRE: 1.929
-PROTOTYPES: DISABLE
-
-
-BOOT:
- {
- MY_CXT_INIT;
- PERL_UNUSED_VAR(MY_CXT);
- }
- PERL_UNUSED_VAR(cv);
- PERL_UNUSED_VAR(items);
- dbi_bootinit(NULL);
- /* make this sub into a fake XS so it can bee seen by DBD::* modules;
- * never actually call it as an XS sub, or it will crash and burn! */
- (void) newXS("DBI::_dbi_state_lval", (XSUBADDR_t)_dbi_state_lval, __FILE__);
-
-
-I32
-constant()
- PROTOTYPE:
- ALIAS:
- SQL_ALL_TYPES = SQL_ALL_TYPES
- SQL_ARRAY = SQL_ARRAY
- SQL_ARRAY_LOCATOR = SQL_ARRAY_LOCATOR
- SQL_BIGINT = SQL_BIGINT
- SQL_BINARY = SQL_BINARY
- SQL_BIT = SQL_BIT
- SQL_BLOB = SQL_BLOB
- SQL_BLOB_LOCATOR = SQL_BLOB_LOCATOR
- SQL_BOOLEAN = SQL_BOOLEAN
- SQL_CHAR = SQL_CHAR
- SQL_CLOB = SQL_CLOB
- SQL_CLOB_LOCATOR = SQL_CLOB_LOCATOR
- SQL_DATE = SQL_DATE
- SQL_DATETIME = SQL_DATETIME
- SQL_DECIMAL = SQL_DECIMAL
- SQL_DOUBLE = SQL_DOUBLE
- SQL_FLOAT = SQL_FLOAT
- SQL_GUID = SQL_GUID
- SQL_INTEGER = SQL_INTEGER
- SQL_INTERVAL = SQL_INTERVAL
- SQL_INTERVAL_DAY = SQL_INTERVAL_DAY
- SQL_INTERVAL_DAY_TO_HOUR = SQL_INTERVAL_DAY_TO_HOUR
- SQL_INTERVAL_DAY_TO_MINUTE = SQL_INTERVAL_DAY_TO_MINUTE
- SQL_INTERVAL_DAY_TO_SECOND = SQL_INTERVAL_DAY_TO_SECOND
- SQL_INTERVAL_HOUR = SQL_INTERVAL_HOUR
- SQL_INTERVAL_HOUR_TO_MINUTE = SQL_INTERVAL_HOUR_TO_MINUTE
- SQL_INTERVAL_HOUR_TO_SECOND = SQL_INTERVAL_HOUR_TO_SECOND
- SQL_INTERVAL_MINUTE = SQL_INTERVAL_MINUTE
- SQL_INTERVAL_MINUTE_TO_SECOND = SQL_INTERVAL_MINUTE_TO_SECOND
- SQL_INTERVAL_MONTH = SQL_INTERVAL_MONTH
- SQL_INTERVAL_SECOND = SQL_INTERVAL_SECOND
- SQL_INTERVAL_YEAR = SQL_INTERVAL_YEAR
- SQL_INTERVAL_YEAR_TO_MONTH = SQL_INTERVAL_YEAR_TO_MONTH
- SQL_LONGVARBINARY = SQL_LONGVARBINARY
- SQL_LONGVARCHAR = SQL_LONGVARCHAR
- SQL_MULTISET = SQL_MULTISET
- SQL_MULTISET_LOCATOR = SQL_MULTISET_LOCATOR
- SQL_NUMERIC = SQL_NUMERIC
- SQL_REAL = SQL_REAL
- SQL_REF = SQL_REF
- SQL_ROW = SQL_ROW
- SQL_SMALLINT = SQL_SMALLINT
- SQL_TIME = SQL_TIME
- SQL_TIMESTAMP = SQL_TIMESTAMP
- SQL_TINYINT = SQL_TINYINT
- SQL_TYPE_DATE = SQL_TYPE_DATE
- SQL_TYPE_TIME = SQL_TYPE_TIME
- SQL_TYPE_TIMESTAMP = SQL_TYPE_TIMESTAMP
- SQL_TYPE_TIMESTAMP_WITH_TIMEZONE = SQL_TYPE_TIMESTAMP_WITH_TIMEZONE
- SQL_TYPE_TIME_WITH_TIMEZONE = SQL_TYPE_TIME_WITH_TIMEZONE
- SQL_UDT = SQL_UDT
- SQL_UDT_LOCATOR = SQL_UDT_LOCATOR
- SQL_UNKNOWN_TYPE = SQL_UNKNOWN_TYPE
- SQL_VARBINARY = SQL_VARBINARY
- SQL_VARCHAR = SQL_VARCHAR
- SQL_WCHAR = SQL_WCHAR
- SQL_WLONGVARCHAR = SQL_WLONGVARCHAR
- SQL_WVARCHAR = SQL_WVARCHAR
- SQL_CURSOR_FORWARD_ONLY = SQL_CURSOR_FORWARD_ONLY
- SQL_CURSOR_KEYSET_DRIVEN = SQL_CURSOR_KEYSET_DRIVEN
- SQL_CURSOR_DYNAMIC = SQL_CURSOR_DYNAMIC
- SQL_CURSOR_STATIC = SQL_CURSOR_STATIC
- SQL_CURSOR_TYPE_DEFAULT = SQL_CURSOR_TYPE_DEFAULT
- DBIpp_cm_cs = DBIpp_cm_cs
- DBIpp_cm_hs = DBIpp_cm_hs
- DBIpp_cm_dd = DBIpp_cm_dd
- DBIpp_cm_dw = DBIpp_cm_dw
- DBIpp_cm_br = DBIpp_cm_br
- DBIpp_cm_XX = DBIpp_cm_XX
- DBIpp_ph_qm = DBIpp_ph_qm
- DBIpp_ph_cn = DBIpp_ph_cn
- DBIpp_ph_cs = DBIpp_ph_cs
- DBIpp_ph_sp = DBIpp_ph_sp
- DBIpp_ph_XX = DBIpp_ph_XX
- DBIpp_st_qq = DBIpp_st_qq
- DBIpp_st_bs = DBIpp_st_bs
- DBIpp_st_XX = DBIpp_st_XX
- DBIstcf_DISCARD_STRING = DBIstcf_DISCARD_STRING
- DBIstcf_STRICT = DBIstcf_STRICT
- DBIf_TRACE_SQL = DBIf_TRACE_SQL
- DBIf_TRACE_CON = DBIf_TRACE_CON
- DBIf_TRACE_ENC = DBIf_TRACE_ENC
- DBIf_TRACE_DBD = DBIf_TRACE_DBD
- DBIf_TRACE_TXN = DBIf_TRACE_TXN
- CODE:
- RETVAL = ix;
- OUTPUT:
- RETVAL
-
-
-void
-_clone_dbis()
- CODE:
- dMY_CXT;
- dbistate_t * parent_dbis = DBIS;
-
- (void)cv;
- {
- MY_CXT_CLONE;
- }
- dbi_bootinit(parent_dbis);
-
-
-void
-_new_handle(class, parent, attr_ref, imp_datasv, imp_class)
- SV * class
- SV * parent
- SV * attr_ref
- SV * imp_datasv
- SV * imp_class
- PPCODE:
- dMY_CXT;
- HV *outer;
- SV *outer_ref;
- HV *class_stash = gv_stashsv(class, GV_ADDWARN);
-
- if (DBIS_TRACE_LEVEL >= 5) {
- PerlIO_printf(DBILOGFP, " New %s (for %s, parent=%s, id=%s)\n",
- neatsvpv(class,0), SvPV_nolen(imp_class), neatsvpv(parent,0), neatsvpv(imp_datasv,0));
- PERL_UNUSED_VAR(cv);
- }
-
- (void)hv_store((HV*)SvRV(attr_ref), "ImplementorClass", 16, SvREFCNT_inc(imp_class), 0);
-
- /* make attr into inner handle by blessing it into class */
- sv_bless(attr_ref, class_stash);
- /* tie new outer hash to inner handle */
- outer = newHV(); /* create new hash to be outer handle */
- outer_ref = newRV_noinc((SV*)outer);
- /* make outer hash into a handle by blessing it into class */
- sv_bless(outer_ref, class_stash);
- /* tie outer handle to inner handle */
- sv_magic((SV*)outer, attr_ref, PERL_MAGIC_tied, Nullch, 0);
-
- dbih_setup_handle(aTHX_ outer_ref, SvPV_nolen(imp_class), parent, SvOK(imp_datasv) ? imp_datasv : Nullsv);
-
- /* return outer handle, plus inner handle if not in scalar context */
- sv_2mortal(outer_ref);
- EXTEND(SP, 2);
- PUSHs(outer_ref);
- if (GIMME != G_SCALAR) {
- PUSHs(attr_ref);
- }
-
-
-void
-_setup_handle(sv, imp_class, parent, imp_datasv)
- SV * sv
- char * imp_class
- SV * parent
- SV * imp_datasv
- CODE:
- (void)cv;
- dbih_setup_handle(aTHX_ sv, imp_class, parent, SvOK(imp_datasv) ? imp_datasv : Nullsv);
- ST(0) = &PL_sv_undef;
-
-
-void
-_get_imp_data(sv)
- SV * sv
- CODE:
- D_imp_xxh(sv);
- (void)cv;
- ST(0) = sv_mortalcopy(DBIc_IMP_DATA(imp_xxh)); /* okay if NULL */
-
-
-void
-_handles(sv)
- SV * sv
- PPCODE:
- /* return the outer and inner handle for any given handle */
- D_imp_xxh(sv);
- SV *ih = sv_mortalcopy( dbih_inner(aTHX_ sv, "_handles") );
- SV *oh = sv_2mortal(newRV_inc((SV*)DBIc_MY_H(imp_xxh))); /* XXX dangerous */
- (void)cv;
- EXTEND(SP, 2);
- PUSHs(oh); /* returns outer handle then inner */
- if (GIMME != G_SCALAR) {
- PUSHs(ih);
- }
-
-
-void
-neat(sv, maxlen=0)
- SV * sv
- U32 maxlen
- CODE:
- ST(0) = sv_2mortal(newSVpv(neatsvpv(sv, maxlen), 0));
- (void)cv;
-
-
-I32
-hash(key, type=0)
- const char *key
- long type
- CODE:
- (void)cv;
- RETVAL = dbi_hash(key, type);
- OUTPUT:
- RETVAL
-
-void
-looks_like_number(...)
- PPCODE:
- int i;
- EXTEND(SP, items);
- (void)cv;
- for(i=0; i < items ; ++i) {
- SV *sv = ST(i);
- if (!SvOK(sv) || (SvPOK(sv) && SvCUR(sv)==0))
- PUSHs(&PL_sv_undef);
- else if ( looks_like_number(sv) )
- PUSHs(&PL_sv_yes);
- else
- PUSHs(&PL_sv_no);
- }
-
-
-void
-_install_method(dbi_class, meth_name, file, attribs=Nullsv)
- const char * dbi_class
- char * meth_name
- char * file
- SV * attribs
- CODE:
- {
- dMY_CXT;
- /* install another method name/interface for the DBI dispatcher */
- SV *trace_msg = (DBIS_TRACE_LEVEL >= 10) ? sv_2mortal(newSVpv("",0)) : Nullsv;
- CV *cv;
- SV **svp;
- dbi_ima_t *ima;
- MAGIC *mg;
- (void)dbi_class;
-
- if (strnNE(meth_name, "DBI::", 5)) /* XXX m/^DBI::\w+::\w+$/ */
- croak("install_method %s: invalid class", meth_name);
-
- if (trace_msg)
- sv_catpvf(trace_msg, "install_method %-21s", meth_name);
-
- Newxz(ima, 1, dbi_ima_t);
-
- if (attribs && SvOK(attribs)) {
- /* convert and store method attributes in a fast access form */
- if (SvTYPE(SvRV(attribs)) != SVt_PVHV)
- croak("install_method %s: bad attribs", meth_name);
-
- DBD_ATTRIB_GET_IV(attribs, "O",1, svp, ima->flags);
- DBD_ATTRIB_GET_UV(attribs, "T",1, svp, ima->method_trace);
- DBD_ATTRIB_GET_IV(attribs, "H",1, svp, ima->hidearg);
-
- if (trace_msg) {
- if (ima->flags) sv_catpvf(trace_msg, ", flags 0x%04x", (unsigned)ima->flags);
- if (ima->method_trace)sv_catpvf(trace_msg, ", T 0x%08lx", (unsigned long)ima->method_trace);
- if (ima->hidearg) sv_catpvf(trace_msg, ", H %u", (unsigned)ima->hidearg);
- }
- if ( (svp=DBD_ATTRIB_GET_SVP(attribs, "U",1)) != NULL) {
- AV *av = (AV*)SvRV(*svp);
- ima->minargs = (U8)SvIV(*av_fetch(av, 0, 1));
- ima->maxargs = (U8)SvIV(*av_fetch(av, 1, 1));
- svp = av_fetch(av, 2, 0);
- ima->usage_msg = (svp) ? savepv_using_sv(SvPV_nolen(*svp)) : "";
- ima->flags |= IMA_HAS_USAGE;
- if (trace_msg && DBIS_TRACE_LEVEL >= 11)
- sv_catpvf(trace_msg, ",\n usage: min %d, max %d, '%s'",
- ima->minargs, ima->maxargs, ima->usage_msg);
- }
- }
- if (trace_msg)
- PerlIO_printf(DBILOGFP,"%s\n", SvPV_nolen(trace_msg));
- file = savepv(file);
- cv = newXS(meth_name, XS_DBI_dispatch, file);
- SvPVX((SV *)cv) = file;
- SvLEN((SV *)cv) = 1;
- CvXSUBANY(cv).any_ptr = ima;
- ima->meth_type = get_meth_type(GvNAME(CvGV(cv)));
-
- /* Attach magic to handle duping and freeing of the dbi_ima_t struct.
- * Due to the poor interface of the mg dup function, sneak a pointer
- * to the original CV in the mg_ptr field (we get called with a
- * pointer to the mg, but not the SV) */
- mg = sv_magicext((SV*)cv, NULL, DBI_MAGIC, &dbi_ima_vtbl,
- (char *)cv, 0);
-#ifdef BROKEN_DUP_ANY_PTR
- ima->my_perl = my_perl; /* who owns this struct */
-#else
- mg->mg_flags |= MGf_DUP;
-#endif
- ST(0) = &PL_sv_yes;
- }
-
-
-int
-trace(class, level_sv=&PL_sv_undef, file=Nullsv)
- SV * class
- SV * level_sv
- SV * file
- ALIAS:
- _debug_dispatch = 1
- CODE:
- {
- dMY_CXT;
- IV level;
- if (!DBIS) {
- PERL_UNUSED_VAR(ix);
- croak("DBI not initialised");
- }
- /* Return old/current value. No change if new value not given. */
- RETVAL = (DBIS) ? DBIS->debug : 0;
- level = parse_trace_flags(class, level_sv, RETVAL);
- if (level) /* call before or after altering DBI trace level */
- set_trace_file(file);
- if (level != RETVAL) {
- if ((level & DBIc_TRACE_LEVEL_MASK) > 0) {
- PerlIO_printf(DBILOGFP," DBI %s%s default trace level set to 0x%lx/%ld (pid %d pi %p) at %s\n",
- XS_VERSION, dbi_build_opt,
- (long)(level & DBIc_TRACE_FLAGS_MASK),
- (long)(level & DBIc_TRACE_LEVEL_MASK),
- (int)PerlProc_getpid(),
-#ifdef MULTIPLICITY
- (void *)my_perl,
-#else
- (void*)NULL,
-#endif
- log_where(Nullsv, 0, "", "", 1, 1, 0)
- );
- if (!PL_dowarn)
- PerlIO_printf(DBILOGFP," Note: perl is running without the recommended perl -w option\n");
- PerlIO_flush(DBILOGFP);
- }
- DBIS->debug = level;
- sv_setiv(get_sv("DBI::dbi_debug",0x5), level);
- }
- if (!level) /* call before or after altering DBI trace level */
- set_trace_file(file);
- }
- OUTPUT:
- RETVAL
-
-
-
-void
-dump_handle(sv, msg="DBI::dump_handle", level=0)
- SV * sv
- const char *msg
- int level
- CODE:
- (void)cv;
- dbih_dumphandle(aTHX_ sv, msg, level);
-
-
-
-void
-_svdump(sv)
- SV * sv
- CODE:
- {
- dMY_CXT;
- (void)cv;
- PerlIO_printf(DBILOGFP, "DBI::_svdump(%s)", neatsvpv(sv,0));
-#ifdef DEBUGGING
- sv_dump(sv);
-#endif
- }
-
-
-NV
-dbi_time()
-
-
-void
-dbi_profile(h, statement, method, t1, t2)
- SV *h
- SV *statement
- SV *method
- NV t1
- NV t2
- CODE:
- SV *leaf = &PL_sv_undef;
- PERL_UNUSED_VAR(cv);
- if (SvROK(method))
- method = SvRV(method);
- if (dbih_inner(aTHX_ h, NULL)) { /* is a DBI handle */
- D_imp_xxh(h);
- leaf = dbi_profile(h, imp_xxh, statement, method, t1, t2);
- }
- else if (SvROK(h) && SvTYPE(SvRV(h)) == SVt_PVHV) {
- /* iterate over values %$h */
- HV *hv = (HV*)SvRV(h);
- SV *tmp;
- char *key;
- I32 keylen = 0;
- hv_iterinit(hv);
- while ( (tmp = hv_iternextsv(hv, &key, &keylen)) != NULL ) {
- if (SvOK(tmp)) {
- D_imp_xxh(tmp);
- leaf = dbi_profile(tmp, imp_xxh, statement, method, t1, t2);
- }
- };
- }
- else {
- croak("dbi_profile(%s,...) invalid handle argument", neatsvpv(h,0));
- }
- if (GIMME_V == G_VOID)
- ST(0) = &PL_sv_undef; /* skip sv_mortalcopy if not needed */
- else
- ST(0) = sv_mortalcopy(leaf);
-
-
-
-SV *
-dbi_profile_merge_nodes(dest, ...)
- SV * dest
- ALIAS:
- dbi_profile_merge = 1
- CODE:
- {
- if (!SvROK(dest) || SvTYPE(SvRV(dest)) != SVt_PVAV)
- croak("dbi_profile_merge_nodes(%s,...) destination is not an array reference", neatsvpv(dest,0));
- if (items <= 1) {
- PERL_UNUSED_VAR(cv);
- PERL_UNUSED_VAR(ix);
- RETVAL = 0;
- }
- else {
- /* items==2 for dest + 1 arg, ST(0) is dest, ST(1) is first arg */
- while (--items >= 1) {
- SV *thingy = ST(items);
- dbi_profile_merge_nodes(dest, thingy);
- }
- RETVAL = newSVsv(*av_fetch((AV*)SvRV(dest), DBIprof_TOTAL_TIME, 1));
- }
- }
- OUTPUT:
- RETVAL
-
-
-SV *
-_concat_hash_sorted(hash_sv, kv_sep_sv, pair_sep_sv, use_neat_sv, num_sort_sv)
- SV *hash_sv
- SV *kv_sep_sv
- SV *pair_sep_sv
- SV *use_neat_sv
- SV *num_sort_sv
- PREINIT:
- char *kv_sep, *pair_sep;
- STRLEN kv_sep_len, pair_sep_len;
- CODE:
- if (!SvOK(hash_sv))
- XSRETURN_UNDEF;
- if (!SvROK(hash_sv) || SvTYPE(SvRV(hash_sv))!=SVt_PVHV)
- croak("hash is not a hash reference");
-
- kv_sep = SvPV(kv_sep_sv, kv_sep_len);
- pair_sep = SvPV(pair_sep_sv, pair_sep_len);
-
- RETVAL = _join_hash_sorted( (HV*)SvRV(hash_sv),
- kv_sep, kv_sep_len,
- pair_sep, pair_sep_len,
- /* use_neat should be undef, 0 or 1, may allow sprintf format strings later */
- (SvOK(use_neat_sv)) ? SvIV(use_neat_sv) : 0,
- (SvOK(num_sort_sv)) ? SvIV(num_sort_sv) : -1
- );
- OUTPUT:
- RETVAL
-
-
-int
-sql_type_cast(sv, sql_type, flags=0)
- SV * sv
- int sql_type
- U32 flags
- CODE:
- RETVAL = sql_type_cast_svpv(aTHX_ sv, sql_type, flags, 0);
- OUTPUT:
- RETVAL
-
-
-
-MODULE = DBI PACKAGE = DBI::var
-
-void
-FETCH(sv)
- SV * sv
- CODE:
- dMY_CXT;
- /* Note that we do not come through the dispatcher to get here. */
- char *meth = SvPV_nolen(SvRV(sv)); /* what should this tie do ? */
- char type = *meth++; /* is this a $ or & style */
- imp_xxh_t *imp_xxh = (DBI_LAST_HANDLE_OK) ? DBIh_COM(DBI_LAST_HANDLE) : NULL;
- int trace_level = (imp_xxh ? DBIc_TRACE_LEVEL(imp_xxh) : DBIS_TRACE_LEVEL);
- NV profile_t1 = 0.0;
-
- if (imp_xxh && DBIc_has(imp_xxh,DBIcf_Profile))
- profile_t1 = dbi_time();
-
- if (trace_level >= 2) {
- PerlIO_printf(DBILOGFP," -> $DBI::%s (%c) FETCH from lasth=%s\n", meth, type,
- (imp_xxh) ? neatsvpv(DBI_LAST_HANDLE,0): "none");
- }
-
- if (type == '!') { /* special case for $DBI::lasth */
- /* Currently we can only return the INNER handle. */
- /* This handle should only be used for true/false tests */
- ST(0) = (imp_xxh) ? sv_2mortal(newRV_inc(DBI_LAST_HANDLE)) : &PL_sv_undef;
- }
- else if ( !imp_xxh ) {
- if (trace_level)
- warn("Can't read $DBI::%s, last handle unknown or destroyed", meth);
- ST(0) = &PL_sv_undef;
- }
- else if (type == '*') { /* special case for $DBI::err, see also err method */
- SV *errsv = DBIc_ERR(imp_xxh);
- ST(0) = sv_mortalcopy(errsv);
- }
- else if (type == '"') { /* special case for $DBI::state */
- SV *state = DBIc_STATE(imp_xxh);
- ST(0) = DBIc_STATE_adjust(imp_xxh, state);
- }
- else if (type == '$') { /* lookup scalar variable in implementors stash */
- const char *vname = mkvname(aTHX_ DBIc_IMP_STASH(imp_xxh), meth, 0);
- SV *vsv = get_sv(vname, 1);
- ST(0) = sv_mortalcopy(vsv);
- }
- else {
- /* default to method call via stash of implementor of DBI_LAST_HANDLE */
- GV *imp_gv;
- HV *imp_stash = DBIc_IMP_STASH(imp_xxh);
-#ifdef DBI_save_hv_fetch_ent
- HE save_mh = PL_hv_fetch_ent_mh; /* XXX nested tied FETCH bug17575 workaround */
-#endif
- profile_t1 = 0.0; /* profile this via dispatch only (else we'll double count) */
- if (trace_level >= 3)
- PerlIO_printf(DBILOGFP," >> %s::%s\n", HvNAME(imp_stash), meth);
- ST(0) = sv_2mortal(newRV_inc(DBI_LAST_HANDLE));
- if ((imp_gv = gv_fetchmethod(imp_stash,meth)) == NULL) {
- croak("Can't locate $DBI::%s object method \"%s\" via package \"%s\"",
- meth, meth, HvNAME(imp_stash));
- }
- PUSHMARK(mark); /* reset mark (implies one arg as we were called with one arg?) */
- call_sv((SV*)GvCV(imp_gv), GIMME);
- SPAGAIN;
-#ifdef DBI_save_hv_fetch_ent
- PL_hv_fetch_ent_mh = save_mh;
-#endif
- }
- if (trace_level)
- PerlIO_printf(DBILOGFP," <- $DBI::%s= %s\n", meth, neatsvpv(ST(0),0));
- if (profile_t1) {
- SV *h = sv_2mortal(newRV_inc(DBI_LAST_HANDLE));
- dbi_profile(h, imp_xxh, &PL_sv_undef, (SV*)cv, profile_t1, dbi_time());
- }
-
-
-MODULE = DBI PACKAGE = DBD::_::dr
-
-void
-dbixs_revision(h)
- SV * h
- CODE:
- PERL_UNUSED_VAR(h);
- ST(0) = sv_2mortal(newSViv(DBIXS_REVISION));
-
-
-MODULE = DBI PACKAGE = DBD::_::db
-
-void
-connected(...)
- CODE:
- /* defined here just to avoid AUTOLOAD */
- (void)cv;
- (void)items;
- ST(0) = &PL_sv_undef;
-
-
-SV *
-preparse(dbh, statement, ps_accept, ps_return, foo=Nullch)
- SV * dbh
- char * statement
- IV ps_accept
- IV ps_return
- void *foo
-
-
-void
-take_imp_data(h)
- SV * h
- PREINIT:
- /* take_imp_data currently in DBD::_::db not DBD::_::common, so for dbh's only */
- D_imp_xxh(h);
- MAGIC *mg;
- SV *imp_xxh_sv;
- SV **tmp_svp;
- CODE:
- PERL_UNUSED_VAR(cv);
- /*
- * Remove and return the imp_xxh_t structure that's attached to the inner
- * hash of the handle. Effectively this removes the 'brain' of the handle
- * leaving it as an empty shell - brain dead. All method calls on it fail.
- *
- * The imp_xxh_t structure that's removed and returned is a plain scalar
- * (containing binary data). It can be passed to a new DBI->connect call
- * in order to have the new $dbh use the same 'connection' as the original
- * handle. In this way a multi-threaded connection pool can be implemented.
- *
- * If the drivers imp_xxh_t structure contains SV*'s, or other interpreter
- * specific items, they should be freed by the drivers own take_imp_data()
- * method before it then calls SUPER::take_imp_data() to finalize removal
- * of the imp_xxh_t structure.
- *
- * The driver needs to view the take_imp_data method as being nearly the
- * same as disconnect+DESTROY only not actually calling the database API to
- * disconnect. All that needs to remain valid in the imp_xxh_t structure
- * is the underlying database API connection data. Everything else should
- * in a 'clean' state such that if the drivers own DESTROY method was
- * called it would be able to properly handle the contents of the
- * structure. This is important in case a new handle created using this
- * imp_data, possibly in a new thread, might end up being DESTROY'd before
- * the driver has had a chance to 're-setup' the data. See dbih_setup_handle()
- *
- * All the above relates to the 'typical use case' for a compiled driver.
- * For a pure-perl driver using a socket pair, for example, the drivers
- * take_imp_data method might just return a string containing the fileno()
- * values of the sockets (without calling this SUPER::take_imp_data() code).
- * The key point is that the take_imp_data() method returns an opaque buffer
- * containing whatever the driver would need to reuse the same underlying
- * 'connection to the database' in a new handle.
- *
- * In all cases, care should be taken that driver attributes (such as
- * AutoCommit) match the state of the underlying connection.
- */
-
- if (!DBIc_ACTIVE(imp_xxh)) {/* sanity check, may be relaxed later */
- set_err_char(h, imp_xxh, "1", 1, "Can't take_imp_data from handle that's not Active", 0, "take_imp_data");
- XSRETURN(0);
- }
-
- /* Ideally there should be no child statement handles existing when
- * take_imp_data is called because when those statement handles are
- * destroyed they may need to interact with the 'zombie' parent dbh.
- * So we do our best to neautralize them (finish & rebless)
- */
- if ((tmp_svp = hv_fetch((HV*)SvRV(h), "ChildHandles", 12, FALSE)) && SvROK(*tmp_svp)) {
- AV *av = (AV*)SvRV(*tmp_svp);
- HV *zombie_stash = gv_stashpv("DBI::zombie", GV_ADDWARN);
- I32 kidslots;
- for (kidslots = AvFILL(av); kidslots >= 0; --kidslots) {
- SV **hp = av_fetch(av, kidslots, FALSE);
- if (hp && SvROK(*hp) && SvMAGICAL(SvRV(*hp))) {
- PUSHMARK(sp);
- XPUSHs(*hp);
- PUTBACK;
- call_method("finish", G_VOID);
- SPAGAIN;
- PUTBACK;
- sv_unmagic(SvRV(*hp), 'P'); /* untie */
- sv_bless(*hp, zombie_stash); /* neutralise */
- }
- }
- }
- /* The above measures may not be sufficient if weakrefs aren't available
- * or something has a reference to the inner-handle of an sth.
- * We'll require no Active kids, but just warn about others.
- */
- if (DBIc_ACTIVE_KIDS(imp_xxh)) {
- set_err_char(h, imp_xxh, "1", 1, "Can't take_imp_data from handle while it still has Active kids", 0, "take_imp_data");
- XSRETURN(0);
- }
- if (DBIc_KIDS(imp_xxh))
- warn("take_imp_data from handle while it still has kids");
-
- /* it may be better here to return a copy and poison the original
- * rather than detatching and returning the original
- */
-
- /* --- perform the surgery */
- dbih_getcom2(aTHX_ h, &mg); /* get the MAGIC so we can change it */
- imp_xxh_sv = mg->mg_obj; /* take local copy of the imp_data pointer */
- mg->mg_obj = Nullsv; /* sever the link from handle to imp_xxh */
- mg->mg_ptr = NULL; /* and sever the shortcut too */
- if (DBIc_TRACE_LEVEL(imp_xxh) >= 9)
- sv_dump(imp_xxh_sv);
- /* --- housekeeping */
- DBIc_ACTIVE_off(imp_xxh); /* silence warning from dbih_clearcom */
- DBIc_IMPSET_off(imp_xxh); /* silence warning from dbih_clearcom */
- dbih_clearcom(imp_xxh); /* free SVs like DBD::_mem::common::DESTROY */
- SvOBJECT_off(imp_xxh_sv); /* no longer needs DESTROY via dbih_clearcom */
- /* restore flags to mark fact imp data holds active connection */
- /* (don't use magical DBIc_ACTIVE_on here) */
- DBIc_FLAGS(imp_xxh) |= DBIcf_IMPSET | DBIcf_ACTIVE;
- /* --- tidy up the raw PV for life as a more normal string */
- SvPOK_on(imp_xxh_sv); /* SvCUR & SvEND were set at creation */
- /* --- return the actual imp_xxh_sv on the stack */
- ST(0) = imp_xxh_sv;
-
-
-
-MODULE = DBI PACKAGE = DBD::_::st
-
-void
-_get_fbav(sth)
- SV * sth
- CODE:
- D_imp_sth(sth);
- AV *av = dbih_get_fbav(imp_sth);
- (void)cv;
- ST(0) = sv_2mortal(newRV_inc((SV*)av));
-
-void
-_set_fbav(sth, src_rv)
- SV * sth
- SV * src_rv
- CODE:
- D_imp_sth(sth);
- int i;
- AV *src_av;
- AV *dst_av = dbih_get_fbav(imp_sth);
- int dst_fields = AvFILL(dst_av)+1;
- int src_fields;
- (void)cv;
-
- if (!SvROK(src_rv) || SvTYPE(SvRV(src_rv)) != SVt_PVAV)
- croak("_set_fbav(%s): not an array ref", neatsvpv(src_rv,0));
- src_av = (AV*)SvRV(src_rv);
- src_fields = AvFILL(src_av)+1;
- if (src_fields != dst_fields) {
- warn("_set_fbav(%s): array has %d elements, the statement handle row buffer has %d (and NUM_OF_FIELDS is %d)",
- neatsvpv(src_rv,0), src_fields, dst_fields, DBIc_NUM_FIELDS(imp_sth));
- SvREADONLY_off(dst_av);
- if (src_fields < dst_fields) {
- /* shrink the array - sadly this looses column bindings for the lost columns */
- av_fill(dst_av, src_fields-1);
- dst_fields = src_fields;
- }
- else {
- av_fill(dst_av, src_fields-1);
- /* av_fill pads with immutable undefs which we need to change */
- for(i=dst_fields-1; i < src_fields; ++i) {
- sv_setsv(AvARRAY(dst_av)[i], newSV(0));
- }
- }
- SvREADONLY_on(dst_av);
- }
- for(i=0; i < dst_fields; ++i) { /* copy over the row */
- /* If we're given the values, then taint them if required */
- if (DBIc_is(imp_sth, DBIcf_TaintOut))
- SvTAINT(AvARRAY(src_av)[i]);
- sv_setsv(AvARRAY(dst_av)[i], AvARRAY(src_av)[i]);
- }
- ST(0) = sv_2mortal(newRV_inc((SV*)dst_av));
-
-
-void
-bind_col(sth, col, ref, attribs=Nullsv)
- SV * sth
- SV * col
- SV * ref
- SV * attribs
- CODE:
- DBD_ATTRIBS_CHECK("bind_col", sth, attribs);
- ST(0) = boolSV(dbih_sth_bind_col(sth, col, ref, attribs));
- (void)cv;
-
-
-void
-fetchrow_array(sth)
- SV * sth
- ALIAS:
- fetchrow = 1
- PPCODE:
- SV *retsv;
- if (CvDEPTH(cv) == 99) {
- PERL_UNUSED_VAR(ix);
- croak("Deep recursion, probably fetchrow-fetch-fetchrow loop");
- }
- PUSHMARK(sp);
- XPUSHs(sth);
- PUTBACK;
- if (call_method("fetch", G_SCALAR) != 1)
- croak("panic: DBI fetch"); /* should never happen */
- SPAGAIN;
- retsv = POPs;
- PUTBACK;
- if (SvROK(retsv) && SvTYPE(SvRV(retsv)) == SVt_PVAV) {
- D_imp_sth(sth);
- int num_fields, i;
- AV *bound_av;
- AV *av = (AV*)SvRV(retsv);
- num_fields = AvFILL(av)+1;
- EXTEND(sp, num_fields+1);
-
- /* We now check for bind_col() having been called but fetch */
- /* not returning the fields_svav array. Probably because the */
- /* driver is implemented in perl. XXX This logic may change later. */
- bound_av = DBIc_FIELDS_AV(imp_sth); /* bind_col() called ? */
- if (bound_av && av != bound_av) {
- /* let dbih_get_fbav know what's going on */
- bound_av = dbih_get_fbav(imp_sth);
- if (DBIc_TRACE_LEVEL(imp_sth) >= 3) {
- PerlIO_printf(DBIc_LOGPIO(imp_sth),
- "fetchrow: updating fbav 0x%lx from 0x%lx\n",
- (long)bound_av, (long)av);
- }
- for(i=0; i < num_fields; ++i) { /* copy over the row */
- sv_setsv(AvARRAY(bound_av)[i], AvARRAY(av)[i]);
- }
- }
- for(i=0; i < num_fields; ++i) {
- PUSHs(AvARRAY(av)[i]);
- }
- }
-
-
-SV *
-fetchrow_hashref(sth, keyattrib=Nullch)
- SV * sth
- const char *keyattrib
- PREINIT:
- SV *rowavr;
- SV *ka_rv;
- D_imp_sth(sth);
- CODE:
- (void)cv;
- PUSHMARK(sp);
- XPUSHs(sth);
- PUTBACK;
- if (!keyattrib || !*keyattrib) {
- SV *kn = DBIc_FetchHashKeyName(imp_sth);
- if (kn && SvOK(kn))
- keyattrib = SvPVX(kn);
- else
- keyattrib = "NAME";
- }
- ka_rv = *hv_fetch((HV*)DBIc_MY_H(imp_sth), keyattrib,strlen(keyattrib), TRUE);
- /* we copy to invoke FETCH magic, and we do that before fetch() so if tainting */
- /* then the taint triggered by the fetch won't then apply to the fetched name */
- ka_rv = newSVsv(ka_rv);
- if (call_method("fetch", G_SCALAR) != 1)
- croak("panic: DBI fetch"); /* should never happen */
- SPAGAIN;
- rowavr = POPs;
- PUTBACK;
- /* have we got an array ref in rowavr */
- if (SvROK(rowavr) && SvTYPE(SvRV(rowavr)) == SVt_PVAV) {
- int i;
- AV *rowav = (AV*)SvRV(rowavr);
- const int num_fields = AvFILL(rowav)+1;
- HV *hv;
- AV *ka_av;
- if (!(SvROK(ka_rv) && SvTYPE(SvRV(ka_rv))==SVt_PVAV)) {
- sv_setiv(DBIc_ERR(imp_sth), 1);
- sv_setpvf(DBIc_ERRSTR(imp_sth),
- "Can't use attribute '%s' because it doesn't contain a reference to an array (%s)",
- keyattrib, neatsvpv(ka_rv,0));
- XSRETURN_UNDEF;
- }
- ka_av = (AV*)SvRV(ka_rv);
- hv = newHV();
- for (i=0; i < num_fields; ++i) { /* honor the original order as sent by the database */
- SV **field_name_svp = av_fetch(ka_av, i, 1);
- (void)hv_store_ent(hv, *field_name_svp, newSVsv((SV*)(AvARRAY(rowav)[i])), 0);
- }
- RETVAL = newRV_inc((SV*)hv);
- SvREFCNT_dec(hv); /* since newRV incremented it */
- }
- else {
- RETVAL = &PL_sv_undef;
-#if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION <= 4))
- RETVAL = newSV(0); /* mutable undef for 5.004_04 */
-#endif
- }
- SvREFCNT_dec(ka_rv); /* since we created it */
- OUTPUT:
- RETVAL
-
-
-void
-fetch(sth)
- SV * sth
- ALIAS:
- fetchrow_arrayref = 1
- CODE:
- int num_fields;
- if (CvDEPTH(cv) == 99) {
- PERL_UNUSED_VAR(ix);
- croak("Deep recursion. Probably fetch-fetchrow-fetch loop.");
- }
- PUSHMARK(sp);
- XPUSHs(sth);
- PUTBACK;
- num_fields = call_method("fetchrow", G_ARRAY); /* XXX change the name later */
- SPAGAIN;
- if (num_fields == 0) {
- ST(0) = &PL_sv_undef;
- } else {
- D_imp_sth(sth);
- AV *av = dbih_get_fbav(imp_sth);
- if (num_fields != AvFILL(av)+1)
- croak("fetchrow returned %d fields, expected %d",
- num_fields, (int)AvFILL(av)+1);
- SPAGAIN;
- while(--num_fields >= 0)
- sv_setsv(AvARRAY(av)[num_fields], POPs);
- PUTBACK;
- ST(0) = sv_2mortal(newRV_inc((SV*)av));
- }
-
-
-void
-rows(sth)
- SV * sth
- CODE:
- D_imp_sth(sth);
- const IV rows = DBIc_ROW_COUNT(imp_sth);
- ST(0) = sv_2mortal(newSViv(rows));
- (void)cv;
-
-
-void
-finish(sth)
- SV * sth
- CODE:
- D_imp_sth(sth);
- DBIc_ACTIVE_off(imp_sth);
- ST(0) = &PL_sv_yes;
- (void)cv;
-
-
-void
-DESTROY(sth)
- SV * sth
- PPCODE:
- /* keep in sync with DESTROY in Driver.xst */
- D_imp_sth(sth);
- ST(0) = &PL_sv_yes;
- /* we don't test IMPSET here because this code applies to pure-perl drivers */
- if (DBIc_IADESTROY(imp_sth)) { /* want's ineffective destroy */
- DBIc_ACTIVE_off(imp_sth);
- if (DBIc_TRACE_LEVEL(imp_sth))
- PerlIO_printf(DBIc_LOGPIO(imp_sth), " DESTROY %s skipped due to InactiveDestroy\n", SvPV_nolen(sth));
- }
- if (DBIc_ACTIVE(imp_sth)) {
- D_imp_dbh_from_sth;
- if (!PL_dirty && DBIc_ACTIVE(imp_dbh)) {
- dSP;
- PUSHMARK(sp);
- XPUSHs(sth);
- PUTBACK;
- call_method("finish", G_SCALAR);
- SPAGAIN;
- PUTBACK;
- }
- else {
- DBIc_ACTIVE_off(imp_sth);
- }
- }
-
-
-MODULE = DBI PACKAGE = DBI::st
-
-void
-TIEHASH(class, inner_ref)
- SV * class
- SV * inner_ref
- CODE:
- HV *stash = gv_stashsv(class, GV_ADDWARN); /* a new hash is supplied to us, we just need to bless and apply tie magic */
- sv_bless(inner_ref, stash);
- ST(0) = inner_ref;
-
-MODULE = DBI PACKAGE = DBD::_::common
-
-
-void
-DESTROY(h)
- SV * h
- CODE:
- /* DESTROY defined here just to avoid AUTOLOAD */
- (void)cv;
- (void)h;
- ST(0) = &PL_sv_undef;
-
-
-void
-STORE(h, keysv, valuesv)
- SV * h
- SV * keysv
- SV * valuesv
- CODE:
- ST(0) = &PL_sv_yes;
- if (!dbih_set_attr_k(h, keysv, 0, valuesv))
- ST(0) = &PL_sv_no;
- (void)cv;
-
-
-void
-FETCH(h, keysv)
- SV * h
- SV * keysv
- CODE:
- ST(0) = dbih_get_attr_k(h, keysv, 0);
- (void)cv;
-
-void
-DELETE(h, keysv)
- SV * h
- SV * keysv
- CODE:
- /* only private_* keys can be deleted, for others DELETE acts like FETCH */
- /* because the DBI internals rely on certain handle attributes existing */
- if (strnEQ(SvPV_nolen(keysv),"private_",8))
- ST(0) = hv_delete_ent((HV*)SvRV(h), keysv, 0, 0);
- else
- ST(0) = dbih_get_attr_k(h, keysv, 0);
- (void)cv;
-
-
-void
-private_data(h)
- SV * h
- CODE:
- D_imp_xxh(h);
- (void)cv;
- ST(0) = sv_mortalcopy(DBIc_IMP_DATA(imp_xxh));
-
-
-void
-err(h)
- SV * h
- CODE:
- D_imp_xxh(h);
- SV *errsv = DBIc_ERR(imp_xxh);
- (void)cv;
- ST(0) = sv_mortalcopy(errsv);
-
-void
-state(h)
- SV * h
- CODE:
- D_imp_xxh(h);
- SV *state = DBIc_STATE(imp_xxh);
- (void)cv;
- ST(0) = DBIc_STATE_adjust(imp_xxh, state);
-
-void
-errstr(h)
- SV * h
- CODE:
- D_imp_xxh(h);
- SV *errstr = DBIc_ERRSTR(imp_xxh);
- SV *err;
- /* If there's no errstr but there is an err then use err */
- (void)cv;
- if (!SvTRUE(errstr) && (err=DBIc_ERR(imp_xxh)) && SvTRUE(err))
- errstr = err;
- ST(0) = sv_mortalcopy(errstr);
-
-
-void
-set_err(h, err, errstr=&PL_sv_no, state=&PL_sv_undef, method=&PL_sv_undef, result=Nullsv)
- SV * h
- SV * err
- SV * errstr
- SV * state
- SV * method
- SV * result
- PPCODE:
- {
- D_imp_xxh(h);
- SV **sem_svp;
- (void)cv;
-
- if (DBIc_has(imp_xxh, DBIcf_HandleSetErr) && SvREADONLY(method))
- method = sv_mortalcopy(method); /* HandleSetErr may want to change it */
-
- if (!set_err_sv(h, imp_xxh, err, errstr, state, method)) {
- /* set_err was canceled by HandleSetErr, */
- /* don't set "dbi_set_err_method", return an empty list */
- }
- else {
- /* store provided method name so handler code can find it */
- sem_svp = hv_fetch((HV*)SvRV(h), "dbi_set_err_method", 18, 1);
- if (SvOK(method)) {
- sv_setpv(*sem_svp, SvPV_nolen(method));
- }
- else
- (void)SvOK_off(*sem_svp);
- EXTEND(SP, 1);
- PUSHs( result ? result : &PL_sv_undef );
- }
- /* We don't check RaiseError and call die here because that must be */
- /* done by returning through dispatch and letting the DBI handle it */
- }
-
-
-int
-trace(h, level=&PL_sv_undef, file=Nullsv)
- SV *h
- SV *level
- SV *file
- ALIAS:
- debug = 1
- CODE:
- RETVAL = set_trace(h, level, file);
- (void)cv; /* Unused variables */
- (void)ix;
- OUTPUT:
- RETVAL
-
-
-void
-trace_msg(sv, msg, this_trace=1)
- SV *sv
- const char *msg
- int this_trace
- PREINIT:
- int current_trace;
- PerlIO *pio;
- CODE:
- {
- dMY_CXT;
- (void)cv;
- if (SvROK(sv)) {
- D_imp_xxh(sv);
- current_trace = DBIc_TRACE_LEVEL(imp_xxh);
- pio = DBIc_LOGPIO(imp_xxh);
- }
- else { /* called as a static method */
- current_trace = DBIS_TRACE_FLAGS;
- pio = DBILOGFP;
- }
- if (DBIc_TRACE_MATCHES(this_trace, current_trace)) {
- PerlIO_puts(pio, msg);
- ST(0) = &PL_sv_yes;
- }
- else {
- ST(0) = &PL_sv_no;
- }
- }
-
-
-void
-rows(h)
- SV * h
- CODE:
- /* fallback esp for $DBI::rows after $drh was last used */
- ST(0) = sv_2mortal(newSViv(-1));
- (void)h;
- (void)cv;
-
-
-void
-swap_inner_handle(rh1, rh2, allow_reparent=0)
- SV * rh1
- SV * rh2
- IV allow_reparent
- CODE:
- {
- D_impdata(imp_xxh1, imp_xxh_t, rh1);
- D_impdata(imp_xxh2, imp_xxh_t, rh2);
- SV *h1i = dbih_inner(aTHX_ rh1, "swap_inner_handle");
- SV *h2i = dbih_inner(aTHX_ rh2, "swap_inner_handle");
- SV *h1 = (rh1 == h1i) ? (SV*)DBIc_MY_H(imp_xxh1) : SvRV(rh1);
- SV *h2 = (rh2 == h2i) ? (SV*)DBIc_MY_H(imp_xxh2) : SvRV(rh2);
- (void)cv;
-
- if (DBIc_TYPE(imp_xxh1) != DBIc_TYPE(imp_xxh2)) {
- char buf[99];
- sprintf(buf, "Can't swap_inner_handle between %sh and %sh",
- dbih_htype_name(DBIc_TYPE(imp_xxh1)), dbih_htype_name(DBIc_TYPE(imp_xxh2)));
- DBIh_SET_ERR_CHAR(rh1, imp_xxh1, "1", 1, buf, Nullch, Nullch);
- XSRETURN_NO;
- }
- if (!allow_reparent && DBIc_PARENT_COM(imp_xxh1) != DBIc_PARENT_COM(imp_xxh2)) {
- DBIh_SET_ERR_CHAR(rh1, imp_xxh1, "1", 1,
- "Can't swap_inner_handle with handle from different parent",
- Nullch, Nullch);
- XSRETURN_NO;
- }
-
- (void)SvREFCNT_inc(h1i);
- (void)SvREFCNT_inc(h2i);
-
- sv_unmagic(h1, 'P'); /* untie(%$h1) */
- sv_unmagic(h2, 'P'); /* untie(%$h2) */
-
- sv_magic(h1, h2i, 'P', Nullch, 0); /* tie %$h1, $h2i */
- DBIc_MY_H(imp_xxh2) = (HV*)h1;
-
- sv_magic(h2, h1i, 'P', Nullch, 0); /* tie %$h2, $h1i */
- DBIc_MY_H(imp_xxh1) = (HV*)h2;
-
- SvREFCNT_dec(h1i);
- SvREFCNT_dec(h2i);
-
- ST(0) = &PL_sv_yes;
- }
-
-
-MODULE = DBI PACKAGE = DBD::_mem::common
-
-void
-DESTROY(imp_xxh_rv)
- SV * imp_xxh_rv
- CODE:
- /* ignore 'cast increases required alignment' warning */
- imp_xxh_t *imp_xxh = (imp_xxh_t*)SvPVX(SvRV(imp_xxh_rv));
- DBIc_DBISTATE(imp_xxh)->clearcom(imp_xxh);
- (void)cv;
-
-# end
+++ /dev/null
-/* vim: ts=8:sw=4:expandtab
- *
- * $Id$
- *
- * Copyright (c) 1994-2010 Tim Bunce Ireland
- *
- * See COPYRIGHT section in DBI.pm for usage and distribution rights.
- */
-
-/* DBI Interface Definitions for DBD Modules */
-
-#ifndef DBIXS_VERSION /* prevent multiple inclusion */
-
-#ifndef DBIS
-#define DBIS dbis /* default name for dbistate_t variable */
-#endif
-
-/* Here for backwards compat. PERL_POLLUTE was removed in perl 5.13.3 */
-#define PERL_POLLUTE
-
-/* first pull in the standard Perl header files for extensions */
-#include <EXTERN.h>
-#include <perl.h>
-#include <XSUB.h>
-
-#ifdef debug /* causes problems with DBIS->debug */
-#undef debug
-#endif
-
-#ifdef std /* causes problems with STLport <tscheresky@micron.com> */
-#undef std
-#endif
-
-/* define DBIXS_REVISION */
-#include "dbixs_rev.h"
-
-/* Perl backwards compatibility definitions */
-#include "dbipport.h"
-
-/* DBI SQL_* type definitions */
-#include "dbi_sql.h"
-
-
-#define DBIXS_VERSION 93 /* superseded by DBIXS_REVISION */
-
-#ifdef NEED_DBIXS_VERSION
-#if NEED_DBIXS_VERSION > DBIXS_VERSION
-error You_need_to_upgrade_your_DBI_module_before_building_this_driver
-#endif
-#else
-#define NEED_DBIXS_VERSION DBIXS_VERSION
-#endif
-
-
-#define DBI_LOCK
-#define DBI_UNLOCK
-
-#ifndef DBI_NO_THREADS
-#ifdef USE_ITHREADS
-#define DBI_USE_THREADS
-#endif /* USE_ITHREADS */
-#endif /* DBI_NO_THREADS */
-
-
-/* forward struct declarations */
-
-typedef struct dbistate_st dbistate_t;
-/* implementor needs to define actual struct { dbih_??c_t com; ... }*/
-typedef struct imp_drh_st imp_drh_t; /* driver */
-typedef struct imp_dbh_st imp_dbh_t; /* database */
-typedef struct imp_sth_st imp_sth_t; /* statement */
-typedef struct imp_fdh_st imp_fdh_t; /* field descriptor */
-typedef struct imp_xxh_st imp_xxh_t; /* any (defined below) */
-#define DBI_imp_data_ imp_xxh_t /* friendly for take_imp_data */
-
-
-
-/* --- DBI Handle Common Data Structure (all handles have one) --- */
-
-/* Handle types. Code currently assumes child = parent + 1. */
-#define DBIt_DR 1
-#define DBIt_DB 2
-#define DBIt_ST 3
-#define DBIt_FD 4
-
-/* component structures */
-
-typedef struct dbih_com_std_st {
- U32 flags;
- int call_depth; /* used by DBI to track nested calls (int) */
- U16 type; /* DBIt_DR, DBIt_DB, DBIt_ST */
- HV *my_h; /* copy of outer handle HV (not refcounted) */
- SV *parent_h; /* parent inner handle (ref to hv) (r.c.inc) */
- imp_xxh_t *parent_com; /* parent com struct shortcut */
- PerlInterpreter * thr_user; /* thread that owns the handle */
-
- HV *imp_stash; /* who is the implementor for this handle */
- SV *imp_data; /* optional implementors data (for perl imp's) */
-
- I32 kids; /* count of db's for dr's, st's for db's etc */
- I32 active_kids; /* kids which are currently DBIc_ACTIVE */
- U32 pid; /* pid of process that created handle */
- dbistate_t *dbistate;
-} dbih_com_std_t;
-
-typedef struct dbih_com_attr_st {
- /* These are copies of the Hash values (ref.cnt.inc'd) */
- /* Many of the hash values are themselves references */
- SV *TraceLevel;
- SV *State; /* Standard SQLSTATE, 5 char string */
- SV *Err; /* Native engine error code */
- SV *Errstr; /* Native engine error message */
- UV ErrCount;
- U32 LongReadLen; /* auto read length for long/blob types */
- SV *FetchHashKeyName; /* for fetchrow_hashref */
- /* (NEW FIELDS?... DON'T FORGET TO UPDATE dbih_clearcom()!) */
-} dbih_com_attr_t;
-
-
-struct dbih_com_st { /* complete core structure (typedef'd above) */
- dbih_com_std_t std;
- dbih_com_attr_t attr;
-};
-
-/* This 'implementors' type the DBI defines by default as a way to */
-/* refer to the imp_??h data of a handle without considering its type. */
-struct imp_xxh_st { struct dbih_com_st com; };
-
-/* Define handle-type specific structures for implementors to include */
-/* at the start of their private structures. */
-
-typedef struct { /* -- DRIVER -- */
- dbih_com_std_t std;
- dbih_com_attr_t attr;
- HV *_old_cached_kids; /* not used, here for binary compat */
-} dbih_drc_t;
-
-typedef struct { /* -- DATABASE -- */
- dbih_com_std_t std; /* \__ standard structure */
- dbih_com_attr_t attr; /* / plus... (nothing else right now) */
- HV *_old_cached_kids; /* not used, here for binary compat */
-} dbih_dbc_t;
-
-typedef struct { /* -- STATEMENT -- */
- dbih_com_std_t std; /* \__ standard structure */
- dbih_com_attr_t attr; /* / plus ... */
-
- int num_params; /* number of placeholders */
- int num_fields; /* NUM_OF_FIELDS, must be set */
- AV *fields_svav; /* special row buffer (inc bind_cols) */
- IV row_count; /* incremented by get_fbav() */
-
- AV *fields_fdav; /* not used yet, may change */
-
- I32 spare1;
- void *spare2;
-} dbih_stc_t;
-
-
-/* XXX THIS STRUCTURE SHOULD NOT BE USED */
-typedef struct { /* -- FIELD DESCRIPTOR -- */
- dbih_com_std_t std; /* standard structure (not fully setup) */
-
- /* core attributes (from DescribeCol in ODBC) */
- char *col_name; /* see dbih_make_fdsv */
- I16 col_name_len;
- I16 col_sql_type;
- I16 col_precision;
- I16 col_scale;
- I16 col_nullable;
-
- /* additional attributes (from ColAttributes in ODBC) */
- I32 col_length;
- I32 col_disp_size;
-
- I32 spare1;
- void *spare2;
-} dbih_fdc_t;
-
-
-#define _imp2com(p,f) ((p)->com.f) /* private */
-
-#define DBIc_FLAGS(imp) _imp2com(imp, std.flags)
-#define DBIc_TYPE(imp) _imp2com(imp, std.type)
-#define DBIc_CALL_DEPTH(imp) _imp2com(imp, std.call_depth)
-#define DBIc_MY_H(imp) _imp2com(imp, std.my_h)
-#define DBIc_PARENT_H(imp) _imp2com(imp, std.parent_h)
-#define DBIc_PARENT_COM(imp) _imp2com(imp, std.parent_com)
-#define DBIc_THR_COND(imp) _imp2com(imp, std.thr_cond)
-#define DBIc_THR_USER(imp) _imp2com(imp, std.thr_user)
-#define DBIc_THR_USER_NONE (0xFFFF)
-#define DBIc_IMP_STASH(imp) _imp2com(imp, std.imp_stash)
-#define DBIc_IMP_DATA(imp) _imp2com(imp, std.imp_data)
-#define DBIc_DBISTATE(imp) _imp2com(imp, std.dbistate)
-#define DBIc_LOGPIO(imp) DBIc_DBISTATE(imp)->logfp
-#define DBIc_KIDS(imp) _imp2com(imp, std.kids)
-#define DBIc_ACTIVE_KIDS(imp) _imp2com(imp, std.active_kids)
-#define DBIc_LAST_METHOD(imp) _imp2com(imp, std.last_method)
-
-/* d = DBD flags, l = DBD level (needs to be shifted down)
- * D - DBI flags, r = reserved, L = DBI trace level
- * Trace level bit allocation: 0xddlDDDrL */
-#define DBIc_TRACE_LEVEL_MASK 0x0000000F
-#define DBIc_TRACE_FLAGS_MASK 0xFF0FFF00 /* includes DBD flag bits for DBIc_TRACE */
-#define DBIc_TRACE_SETTINGS(imp) (DBIc_DBISTATE(imp)->debug)
-#define DBIc_TRACE_LEVEL(imp) (DBIc_TRACE_SETTINGS(imp) & DBIc_TRACE_LEVEL_MASK)
-#define DBIc_TRACE_FLAGS(imp) (DBIc_TRACE_SETTINGS(imp) & DBIc_TRACE_FLAGS_MASK)
-/* DBI defined trace flags */
-#define DBIf_TRACE_SQL 0x00000100
-#define DBIf_TRACE_CON 0x00000200
-#define DBIf_TRACE_ENC 0x00000400
-#define DBIf_TRACE_DBD 0x00000800
-#define DBIf_TRACE_TXN 0x00001000
-
-#define DBDc_TRACE_LEVEL_MASK 0x00F00000
-#define DBDc_TRACE_LEVEL_SHIFT 20
-#define DBDc_TRACE_LEVEL(imp) ( (DBIc_TRACE_SETTINGS(imp) & DBDc_TRACE_LEVEL_MASK) >> DBDc_TRACE_LEVEL_SHIFT )
-#define DBDc_TRACE_LEVEL_set(imp, l) ( DBIc_TRACE_SETTINGS(imp) |= (((l) << DBDc_TRACE_LEVEL_SHIFT) & DBDc_TRACE_LEVEL_MASK ))
-
-/* DBIc_TRACE_MATCHES(this, crnt): true if this 'matches' (is within) crnt
- DBIc_TRACE_MATCHES(foo, DBIc_TRACE_SETTINGS(imp))
-*/
-#define DBIc_TRACE_MATCHES(this, crnt) \
- ( ((crnt & DBIc_TRACE_LEVEL_MASK) >= (this & DBIc_TRACE_LEVEL_MASK)) \
- || ((crnt & DBIc_TRACE_FLAGS_MASK) & (this & DBIc_TRACE_FLAGS_MASK)) )
-
-/* DBIc_TRACE(imp, flags, flag_level, fallback_level)
- True if flags match the handle trace flags & handle trace level >= flag_level,
- OR if handle trace_level > fallback_level (typically > flag_level).
- This is the main trace testing macro to be used by drivers.
- (Drivers should define their own DBDf_TRACE_* macros for the top 8 bits: 0xFF000000)
- DBIc_TRACE(imp, 0, 0, 4) = if trace level >= 4
- DBIc_TRACE(imp, DBDf_TRACE_FOO, 2, 4) = if tracing DBDf_FOO & level>=2 or level>=4
- DBIc_TRACE(imp, DBDf_TRACE_FOO, 2, 0) = as above but never trace just due to level
- e.g.
- if (DBIc_TRACE(imp_xxh, DBIf_TRACE_SQL|DBIf_TRACE_xxx, 2, 0)) {
- PerlIO_printf(DBIc_LOGPIO(imp_sth), "\tThe %s wibbled the %s\n", ...);
- }
-*/
-#define DBIc_TRACE(imp, flags, flaglevel, level) \
- ( (flags && (DBIc_TRACE_FLAGS(imp) & flags) && (DBIc_TRACE_LEVEL(imp) >= flaglevel)) \
- || (level && DBIc_TRACE_LEVEL(imp) >= level) )
-
-#define DBIc_DEBUG(imp) (_imp2com(imp, attr.TraceLevel)) /* deprecated */
-#define DBIc_DEBUGIV(imp) SvIV(DBIc_DEBUG(imp)) /* deprecated */
-#define DBIc_STATE(imp) SvRV(_imp2com(imp, attr.State))
-#define DBIc_ERR(imp) SvRV(_imp2com(imp, attr.Err))
-#define DBIc_ERRSTR(imp) SvRV(_imp2com(imp, attr.Errstr))
-#define DBIc_ErrCount(imp) _imp2com(imp, attr.ErrCount)
-#define DBIc_LongReadLen(imp) _imp2com(imp, attr.LongReadLen)
-#define DBIc_LongReadLen_init 80 /* may change */
-#define DBIc_FetchHashKeyName(imp) (_imp2com(imp, attr.FetchHashKeyName))
-
-/* handle sub-type specific fields */
-/* dbh & drh */
-#define DBIc_CACHED_KIDS(imp) Nullhv /* no longer used, here for src compat */
-/* sth */
-#define DBIc_NUM_FIELDS(imp) _imp2com(imp, num_fields)
-#define DBIc_NUM_PARAMS(imp) _imp2com(imp, num_params)
-#define DBIc_NUM_PARAMS_AT_EXECUTE -9 /* see Driver.xst */
-#define DBIc_ROW_COUNT(imp) _imp2com(imp, row_count)
-#define DBIc_FIELDS_AV(imp) _imp2com(imp, fields_svav)
-#define DBIc_FDESC_AV(imp) _imp2com(imp, fields_fdav)
-#define DBIc_FDESC(imp, i) ((imp_fdh_t*)(void*)SvPVX(AvARRAY(DBIc_FDESC_AV(imp))[i]))
-
-/* XXX --- DO NOT CHANGE THESE VALUES AS THEY ARE COMPILED INTO DRIVERS --- XXX */
-#define DBIcf_COMSET 0x000001 /* needs to be clear'd before free'd */
-#define DBIcf_IMPSET 0x000002 /* has implementor data to be clear'd */
-#define DBIcf_ACTIVE 0x000004 /* needs finish/disconnect before clear */
-#define DBIcf_IADESTROY 0x000008 /* do DBIc_ACTIVE_off before DESTROY */
-#define DBIcf_WARN 0x000010 /* warn about poor practice etc */
-#define DBIcf_COMPAT 0x000020 /* compat/emulation mode (eg oraperl) */
-#define DBIcf_ChopBlanks 0x000040 /* rtrim spaces from fetch char columns */
-#define DBIcf_RaiseError 0x000080 /* throw exception (croak) on error */
-#define DBIcf_PrintError 0x000100 /* warn() on error */
-#define DBIcf_AutoCommit 0x000200 /* dbh only. used by drivers */
-#define DBIcf_LongTruncOk 0x000400 /* truncation to LongReadLen is okay */
-#define DBIcf_MultiThread 0x000800 /* allow multiple threads to enter */
-#define DBIcf_HandleSetErr 0x001000 /* has coderef HandleSetErr attribute */
-#define DBIcf_ShowErrorStatement 0x002000 /* include Statement in error */
-#define DBIcf_BegunWork 0x004000 /* between begin_work & commit/rollback */
-#define DBIcf_HandleError 0x008000 /* has coderef in HandleError attribute */
-#define DBIcf_Profile 0x010000 /* profile activity on this handle */
-#define DBIcf_TaintIn 0x020000 /* check inputs for taintedness */
-#define DBIcf_TaintOut 0x040000 /* taint outgoing data */
-#define DBIcf_Executed 0x080000 /* do/execute called since commit/rollb */
-#define DBIcf_PrintWarn 0x100000 /* warn() on warning (err="0") */
-#define DBIcf_Callbacks 0x200000 /* has Callbacks attribute hash */
-#define DBIcf_AIADESTROY 0x400000 /* auto DBIcf_IADESTROY if pid changes */
-/* NOTE: new flags may require clone() to be updated */
-
-#define DBIcf_INHERITMASK /* what NOT to pass on to children */ \
- (U32)( DBIcf_COMSET | DBIcf_IMPSET | DBIcf_ACTIVE | DBIcf_IADESTROY \
- | DBIcf_AutoCommit | DBIcf_BegunWork | DBIcf_Executed | DBIcf_Callbacks )
-
-/* general purpose bit setting and testing macros */
-#define DBIbf_is( bitset,flag) ((bitset) & (flag))
-#define DBIbf_has(bitset,flag) DBIbf_is(bitset, flag) /* alias for _is */
-#define DBIbf_on( bitset,flag) ((bitset) |= (flag))
-#define DBIbf_off(bitset,flag) ((bitset) &= ~(flag))
-#define DBIbf_set(bitset,flag,on) ((on) ? DBIbf_on(bitset, flag) : DBIbf_off(bitset,flag))
-
-/* as above, but specifically for DBIc_FLAGS imp flags (except ACTIVE) */
-#define DBIc_is(imp, flag) DBIbf_is( DBIc_FLAGS(imp), flag)
-#define DBIc_has(imp,flag) DBIc_is(imp, flag) /* alias for DBIc_is */
-#define DBIc_on(imp, flag) DBIbf_on( DBIc_FLAGS(imp), flag)
-#define DBIc_off(imp,flag) DBIbf_off(DBIc_FLAGS(imp), flag)
-#define DBIc_set(imp,flag,on) DBIbf_set(DBIc_FLAGS(imp), flag, on)
-
-#define DBIc_COMSET(imp) DBIc_is(imp, DBIcf_COMSET)
-#define DBIc_COMSET_on(imp) DBIc_on(imp, DBIcf_COMSET)
-#define DBIc_COMSET_off(imp) DBIc_off(imp,DBIcf_COMSET)
-
-#define DBIc_IMPSET(imp) DBIc_is(imp, DBIcf_IMPSET)
-#define DBIc_IMPSET_on(imp) DBIc_on(imp, DBIcf_IMPSET)
-#define DBIc_IMPSET_off(imp) DBIc_off(imp,DBIcf_IMPSET)
-
-#define DBIc_ACTIVE(imp) (DBIc_FLAGS(imp) & DBIcf_ACTIVE)
-#define DBIc_ACTIVE_on(imp) /* adjust parent's active kid count */ \
- do { \
- imp_xxh_t *ph_com = DBIc_PARENT_COM(imp); \
- if (!DBIc_ACTIVE(imp) && ph_com && !PL_dirty \
- && ++DBIc_ACTIVE_KIDS(ph_com) > DBIc_KIDS(ph_com)) \
- croak("panic: DBI active kids (%ld) > kids (%ld)", \
- (long)DBIc_ACTIVE_KIDS(ph_com), \
- (long)DBIc_KIDS(ph_com)); \
- DBIc_FLAGS(imp) |= DBIcf_ACTIVE; \
- } while(0)
-#define DBIc_ACTIVE_off(imp) /* adjust parent's active kid count */ \
- do { \
- imp_xxh_t *ph_com = DBIc_PARENT_COM(imp); \
- if (DBIc_ACTIVE(imp) && ph_com && !PL_dirty \
- && (--DBIc_ACTIVE_KIDS(ph_com) > DBIc_KIDS(ph_com) \
- || DBIc_ACTIVE_KIDS(ph_com) < 0) ) \
- croak("panic: DBI active kids (%ld) < 0 or > kids (%ld)", \
- (long)DBIc_ACTIVE_KIDS(ph_com), \
- (long)DBIc_KIDS(ph_com)); \
- DBIc_FLAGS(imp) &= ~DBIcf_ACTIVE; \
- } while(0)
-
-#define DBIc_IADESTROY(imp) (DBIc_FLAGS(imp) & DBIcf_IADESTROY)
-#define DBIc_IADESTROY_on(imp) (DBIc_FLAGS(imp) |= DBIcf_IADESTROY)
-#define DBIc_IADESTROY_off(imp) (DBIc_FLAGS(imp) &= ~DBIcf_IADESTROY)
-
-#define DBIc_AIADESTROY(imp) (DBIc_FLAGS(imp) & DBIcf_AIADESTROY)
-#define DBIc_AIADESTROY_on(imp) (DBIc_FLAGS(imp) |= DBIcf_AIADESTROY)
-#define DBIc_AIADESTROY_off(imp) (DBIc_FLAGS(imp) &= ~DBIcf_AIADESTROY)
-
-#define DBIc_WARN(imp) (DBIc_FLAGS(imp) & DBIcf_WARN)
-#define DBIc_WARN_on(imp) (DBIc_FLAGS(imp) |= DBIcf_WARN)
-#define DBIc_WARN_off(imp) (DBIc_FLAGS(imp) &= ~DBIcf_WARN)
-
-#define DBIc_COMPAT(imp) (DBIc_FLAGS(imp) & DBIcf_COMPAT)
-#define DBIc_COMPAT_on(imp) (DBIc_FLAGS(imp) |= DBIcf_COMPAT)
-#define DBIc_COMPAT_off(imp) (DBIc_FLAGS(imp) &= ~DBIcf_COMPAT)
-
-
-#ifdef IN_DBI_XS /* get Handle Common Data Structure */
-#define DBIh_COM(h) (dbih_getcom2(aTHX_ h, 0))
-#else
-#define DBIh_COM(h) (DBIS->getcom(h))
-#define neatsvpv(sv,len) (DBIS->neat_svpv(sv,len))
-#endif
-
-/* --- For sql_type_cast_svpv() --- */
-
-#define DBIstcf_DISCARD_STRING 0x0001
-#define DBIstcf_STRICT 0x0002
-
-/* --- Implementors Private Data Support --- */
-
-#define D_impdata(name,type,h) type *name = (type*)(DBIh_COM(h))
-#define D_imp_drh(h) D_impdata(imp_drh, imp_drh_t, h)
-#define D_imp_dbh(h) D_impdata(imp_dbh, imp_dbh_t, h)
-#define D_imp_sth(h) D_impdata(imp_sth, imp_sth_t, h)
-#define D_imp_xxh(h) D_impdata(imp_xxh, imp_xxh_t, h)
-
-#define D_imp_from_child(name,type,child) \
- type *name = (type*)(DBIc_PARENT_COM(child))
-#define D_imp_drh_from_dbh D_imp_from_child(imp_drh, imp_drh_t, imp_dbh)
-#define D_imp_dbh_from_sth D_imp_from_child(imp_dbh, imp_dbh_t, imp_sth)
-
-#define DBI_IMP_SIZE(n,s) sv_setiv(get_sv((n), GV_ADDMULTI), (s)) /* XXX */
-
-
-
-/* --- Event Support (VERY LIABLE TO CHANGE) --- */
-
-#define DBIh_EVENTx(h,t,a1,a2) /* deprecated XXX */ &PL_sv_no
-#define DBIh_EVENT0(h,t) DBIh_EVENTx((h), (t), &PL_sv_undef, &PL_sv_undef)
-#define DBIh_EVENT1(h,t, a1) DBIh_EVENTx((h), (t), (a1), &PL_sv_undef)
-#define DBIh_EVENT2(h,t, a1,a2) DBIh_EVENTx((h), (t), (a1), (a2))
-
-#define ERROR_event "ERROR"
-#define WARN_event "WARN"
-#define MSG_event "MESSAGE"
-#define DBEVENT_event "DBEVENT"
-#define UNKNOWN_event "UNKNOWN"
-
-#define DBIh_SET_ERR_SV(h,i, err, errstr, state, method) \
- (DBIc_DBISTATE(i)->set_err_sv(h,i, err, errstr, state, method))
-#define DBIh_SET_ERR_CHAR(h,i, err_c, err_i, errstr, state, method) \
- (DBIc_DBISTATE(i)->set_err_char(h,i, err_c, err_i, errstr, state, method))
-
-
-/* --- Handy Macros --- */
-
-#define DBIh_CLEAR_ERROR(imp_xxh) (void)( \
- (void)SvOK_off(DBIc_ERR(imp_xxh)), \
- (void)SvOK_off(DBIc_ERRSTR(imp_xxh)), \
- (void)SvOK_off(DBIc_STATE(imp_xxh)) \
- )
-
-
-/* --- DBI State Structure --- */
-
-struct dbistate_st {
-
-/* DBISTATE_VERSION is checked at runtime via DBISTATE_INIT and check_version.
- * It should be incremented on incompatible changes to dbistate_t structure.
- * Additional function pointers being assigned from spare padding, where the
- * size of the structure doesn't change, doesn't require an increment.
- * Incrementing forces all XS drivers to need to be recompiled.
- * (See also DBIXS_REVISION as a driver source compatibility tool.)
- */
-#define DBISTATE_VERSION 94 /* ++ on incompatible dbistate_t changes */
-
- /* this must be the first member in structure */
- void (*check_version) _((const char *name,
- int dbis_cv, int dbis_cs, int need_dbixs_cv,
- int drc_s, int dbc_s, int stc_s, int fdc_s));
-
- /* version and size are used to check for DBI/DBD version mis-match */
- U16 version; /* version of this structure */
- U16 size;
- U16 xs_version; /* version of the overall DBIXS / DBD interface */
- U16 spare_pad;
-
- I32 debug;
- PerlIO *logfp;
-
- /* pointers to DBI functions which the DBD's will want to use */
- char * (*neat_svpv) _((SV *sv, STRLEN maxlen));
- imp_xxh_t * (*getcom) _((SV *h)); /* see DBIh_COM macro */
- void (*clearcom) _((imp_xxh_t *imp_xxh));
- SV * (*event) _((SV *h, const char *name, SV*, SV*));
- int (*set_attr_k) _((SV *h, SV *keysv, int dbikey, SV *valuesv));
- SV * (*get_attr_k) _((SV *h, SV *keysv, int dbikey));
- AV * (*get_fbav) _((imp_sth_t *imp_sth));
- SV * (*make_fdsv) _((SV *sth, const char *imp_class, STRLEN imp_size, const char *col_name));
- int (*bind_as_num) _((int sql_type, int p, int s, int *t, void *v)); /* XXX deprecated */
- I32 (*hash) _((const char *string, long i));
- SV * (*preparse) _((SV *sth, char *statement, IV ps_return, IV ps_accept, void *foo));
-
- SV *neatsvpvlen; /* only show dbgpvlen chars when debugging pv's */
-
- PerlInterpreter * thr_owner; /* thread that owns this dbistate */
-
- int (*logmsg) _((imp_xxh_t *imp_xxh, const char *fmt, ...));
- int (*set_err_sv) _((SV *h, imp_xxh_t *imp_xxh, SV *err, SV *errstr, SV *state, SV *method));
- int (*set_err_char) _((SV *h, imp_xxh_t *imp_xxh, const char *err, IV err_i, const char *errstr, const char *state, const char *method));
- int (*bind_col) _((SV *sth, SV *col, SV *ref, SV *attribs));
-
- IO *logfp_ref; /* keep ptr to filehandle for refcounting */
-
- int (*sql_type_cast_svpv) _((pTHX_ SV *sv, int sql_type, U32 flags, void *v));
-
- /* WARNING: Only add new structure members here, and reduce pad2 to keep */
- /* the memory footprint exactly the same */
- void *pad2[3];
-};
-
-/* macros for backwards compatibility */
-#define set_attr(h, k, v) set_attr_k(h, k, 0, v)
-#define get_attr(h, k) get_attr_k(h, k, 0)
-
-#define DBILOGFP (DBIS->logfp)
-#ifdef IN_DBI_XS
-#define DBILOGMSG (dbih_logmsg)
-#else
-#define DBILOGMSG (DBIS->logmsg)
-#endif
-
-/* --- perl object (ActiveState) / multiplicity hooks and hoops --- */
-/* note that USE_ITHREADS implies MULTIPLICITY */
-
-typedef dbistate_t** (*_dbi_state_lval_t)(pTHX);
-
-# define _DBISTATE_DECLARE_COMMON \
- static _dbi_state_lval_t dbi_state_lval_p = 0; \
- static dbistate_t** dbi_get_state(pTHX) { \
- if (!dbi_state_lval_p) { \
- CV *cv = get_cv("DBI::_dbi_state_lval", 0); \
- if (!cv) \
- croak("Unable to get DBI state function. DBI not loaded."); \
- dbi_state_lval_p = (_dbi_state_lval_t)CvXSUB(cv); \
- } \
- return dbi_state_lval_p(aTHX); \
- } \
- typedef int dummy_dbistate /* keep semicolon from feeling lonely */
-
-#if defined(MULTIPLICITY) || defined(PERL_OBJECT) || defined(PERL_CAPI)
-
-# define DBISTATE_DECLARE _DBISTATE_DECLARE_COMMON
-# define _DBISTATE_INIT_DBIS
-# undef DBIS
-# define DBIS (*dbi_get_state(aTHX))
-# define dbis DBIS /* temp for old drivers using 'dbis' instead of 'DBIS' */
-
-#else /* plain and simple non perl object / multiplicity case */
-
-# define DBISTATE_DECLARE \
- static dbistate_t *DBIS; \
- _DBISTATE_DECLARE_COMMON
-
-# define _DBISTATE_INIT_DBIS DBIS = *dbi_get_state(aTHX);
-#endif
-
-# define DBISTATE_INIT { /* typically use in BOOT: of XS file */ \
- _DBISTATE_INIT_DBIS \
- if (DBIS == NULL) \
- croak("Unable to get DBI state. DBI not loaded."); \
- DBIS->check_version(__FILE__, DBISTATE_VERSION, sizeof(*DBIS), NEED_DBIXS_VERSION, \
- sizeof(dbih_drc_t), sizeof(dbih_dbc_t), sizeof(dbih_stc_t), sizeof(dbih_fdc_t) \
- ); \
-}
-
-
-/* --- Assorted Utility Macros --- */
-
-#define DBD_ATTRIB_OK(attribs) /* is this a usable attrib value */ \
- (attribs && SvROK(attribs) && SvTYPE(SvRV(attribs))==SVt_PVHV)
-
-/* If attribs value supplied then croak if it's not a hash ref. */
-/* Also map undef to Null. Should always be called to pre-process the */
-/* attribs value. One day we may add some extra magic in here. */
-#define DBD_ATTRIBS_CHECK(func, h, attribs) \
- if ((attribs) && SvOK(attribs)) { \
- if (!SvROK(attribs) || SvTYPE(SvRV(attribs))!=SVt_PVHV) \
- croak("%s->%s(...): attribute parameter '%s' is not a hash ref", \
- SvPV_nolen(h), func, SvPV_nolen(attribs)); \
- } else (attribs) = Nullsv
-
-#define DBD_ATTRIB_GET_SVP(attribs, key,klen) \
- (DBD_ATTRIB_OK(attribs) \
- ? hv_fetch((HV*)SvRV(attribs), key,klen, 0) \
- : (SV **)Nullsv)
-
-#define DBD_ATTRIB_GET_IV(attribs, key,klen, svp, var) \
- if ((svp=DBD_ATTRIB_GET_SVP(attribs, key,klen)) != NULL) \
- var = SvIV(*svp)
-
-#define DBD_ATTRIB_GET_UV(attribs, key,klen, svp, var) \
- if ((svp=DBD_ATTRIB_GET_SVP(attribs, key,klen)) != NULL) \
- var = SvUV(*svp)
-
-#define DBD_ATTRIB_GET_BOOL(attribs, key,klen, svp, var) \
- if ((svp=DBD_ATTRIB_GET_SVP(attribs, key,klen)) != NULL) \
- var = SvTRUE(*svp)
-
-#define DBD_ATTRIB_TRUE(attribs, key,klen, svp) \
- ( ((svp=DBD_ATTRIB_GET_SVP(attribs, key,klen)) != NULL) \
- ? SvTRUE(*svp) : 0 )
-
-#define DBD_ATTRIB_GET_PV(attribs, key,klen, svp, dflt) \
- (((svp=DBD_ATTRIB_GET_SVP(attribs, key,klen)) != NULL) \
- ? SvPV_nolen(*svp) : (dflt))
-
-#define DBD_ATTRIB_DELETE(attribs, key, klen) \
- hv_delete((HV*)SvRV(attribs), key, klen, G_DISCARD)
-
-#endif /* DBIXS_VERSION */
-/* end of DBIXS.h */
+++ /dev/null
-# $Id$
-# Copyright (c) 1997-2002 Tim Bunce Ireland
-# Copyright (c) 2002 Jonathan Leffler
-#
-# You may distribute under the terms of either the GNU General Public
-# License or the Artistic License, as specified in the Perl README file.
-
-
-#include "Driver_xst.h"
-
-# Historically dbd_db_do4, dbd_st_execute, and dbd_st_rows returned an 'int' type.
-# That's only 32 bits (31+sign) so isn't sufficient for very large row counts
-# So now instead of defining those macros, drivers can define dbd_db_do4_iv,
-# dbd_st_execute_iv, and dbd_st_rows_iv to be the names of functions that
-# return an 'IV' type. They could also set DBIc_ROW_COUNT(imp_sth).
-#
-# To save a mess of #ifdef's we arrange for dbd_st_execute (etc) to work
-# as dbd_st_execute_iv if that's defined
-#
-#if defined(dbd_st_execute_iv)
-#undef dbd_st_execute
-#define dbd_st_execute dbd_st_execute_iv
-#endif
-#if defined(dbd_st_rows_iv)
-#undef dbd_st_rows
-#define dbd_st_rows dbd_st_rows_iv
-#endif
-#if defined(dbd_db_do4_iv)
-#undef dbd_db_do4
-#define dbd_db_do4 dbd_db_do4_iv
-#endif
-
-MODULE = DBD::~DRIVER~ PACKAGE = DBD::~DRIVER~
-
-REQUIRE: 1.929
-PROTOTYPES: DISABLE
-
-BOOT:
- PERL_UNUSED_VAR(items);
- DBISTATE_INIT;
- /* XXX this interface will change: */
- DBI_IMP_SIZE("DBD::~DRIVER~::dr::imp_data_size", sizeof(imp_drh_t));
- DBI_IMP_SIZE("DBD::~DRIVER~::db::imp_data_size", sizeof(imp_dbh_t));
- DBI_IMP_SIZE("DBD::~DRIVER~::st::imp_data_size", sizeof(imp_sth_t));
- dbd_init(DBIS);
-
-
-# ------------------------------------------------------------
-# driver level interface
-# ------------------------------------------------------------
-MODULE = DBD::~DRIVER~ PACKAGE = DBD::~DRIVER~::dr
-
-
-void
-dbixs_revision(...)
- PPCODE:
- ST(0) = sv_2mortal(newSViv(DBIXS_REVISION));
-
-
-#ifdef dbd_discon_all
-
-# disconnect_all renamed and ALIAS'd to avoid length clash on VMS :-(
-void
-discon_all_(drh)
- SV * drh
- ALIAS:
- disconnect_all = 1
- CODE:
- D_imp_drh(drh);
- PERL_UNUSED_VAR(ix);
- ST(0) = dbd_discon_all(drh, imp_drh) ? &PL_sv_yes : &PL_sv_no;
-
-#endif /* dbd_discon_all */
-
-
-#ifdef dbd_dr_data_sources
-
-void
-data_sources(drh, attr = Nullsv)
- SV *drh
- SV *attr
- PPCODE:
- {
- D_imp_drh(drh);
- AV *av = dbd_dr_data_sources(drh, imp_drh, attr);
- if (av) {
- int i;
- int n = AvFILL(av)+1;
- EXTEND(sp, n);
- for (i = 0; i < n; ++i) {
- PUSHs(AvARRAY(av)[i]);
- }
- }
- }
-
-#endif
-
-
-# ------------------------------------------------------------
-# database level interface
-# ------------------------------------------------------------
-MODULE = DBD::~DRIVER~ PACKAGE = DBD::~DRIVER~::db
-
-
-void
-_login(dbh, dbname, username, password, attribs=Nullsv)
- SV * dbh
- SV * dbname
- SV * username
- SV * password
- SV * attribs
- CODE:
- {
- D_imp_dbh(dbh);
-#if !defined(dbd_db_login6_sv)
- STRLEN lna;
- char *u = (SvOK(username)) ? SvPV(username,lna) : (char*)"";
- char *p = (SvOK(password)) ? SvPV(password,lna) : (char*)"";
-#endif
-#ifdef dbd_db_login6_sv
- ST(0) = dbd_db_login6_sv(dbh, imp_dbh, dbname, username, password, attribs) ? &PL_sv_yes : &PL_sv_no;
-#elif defined(dbd_db_login6)
- ST(0) = dbd_db_login6(dbh, imp_dbh, SvPV_nolen(dbname), u, p, attribs) ? &PL_sv_yes : &PL_sv_no;
-#else
- PERL_UNUSED_ARG(attribs);
- ST(0) = dbd_db_login( dbh, imp_dbh, SvPV_nolen(dbname), u, p) ? &PL_sv_yes : &PL_sv_no;
-#endif
- }
-
-
-void
-selectall_arrayref(...)
- PREINIT:
- SV *sth;
- SV **maxrows_svp;
- SV **tmp_svp;
- SV *tmp_sv;
- SV *attr = &PL_sv_undef;
- imp_sth_t *imp_sth;
- CODE:
- if (items > 2) {
- attr = ST(2);
- if (SvROK(attr) &&
- (DBD_ATTRIB_TRUE(attr,"Slice",5,tmp_svp) || DBD_ATTRIB_TRUE(attr,"Columns",7,tmp_svp))
- ) {
- /* fallback to perl implementation */
- SV *tmp =dbixst_bounce_method("DBD::~DRIVER~::db::SUPER::selectall_arrayref", items);
- SPAGAIN;
- ST(0) = tmp;
- XSRETURN(1);
- }
- }
- /* --- prepare --- */
- if (SvROK(ST(1))) {
- MAGIC *mg;
- sth = ST(1);
- /* switch to inner handle if not already */
- if ( (mg = mg_find(SvRV(sth),'P')) )
- sth = mg->mg_obj;
- }
- else {
- sth = dbixst_bounce_method("prepare", 3);
- SPAGAIN; SP -= items; /* because stack might have been realloc'd */
- if (!SvROK(sth))
- XSRETURN_UNDEF;
- /* switch to inner handle */
- sth = mg_find(SvRV(sth),'P')->mg_obj;
- }
- imp_sth = (imp_sth_t*)(DBIh_COM(sth));
- /* --- bind_param --- */
- if (items > 3) { /* need to bind params before execute */
- if (!dbdxst_bind_params(sth, imp_sth, items-2, ax+2) ) {
- XSRETURN_UNDEF;
- }
- }
- /* --- execute --- */
- DBIc_ROW_COUNT(imp_sth) = 0;
- if ( dbd_st_execute(sth, imp_sth) <= -2 ) { /* -2 == error */
- XSRETURN_UNDEF;
- }
- /* --- fetchall --- */
- maxrows_svp = DBD_ATTRIB_GET_SVP(attr, "MaxRows", 7);
- tmp_sv = dbdxst_fetchall_arrayref(sth, &PL_sv_undef, (maxrows_svp) ? *maxrows_svp : &PL_sv_undef);
- SPAGAIN;
- ST(0) = tmp_sv;
-
-
-void
-selectrow_arrayref(...)
- ALIAS:
- selectrow_array = 1
- PREINIT:
- int is_selectrow_array = (ix == 1);
- imp_sth_t *imp_sth;
- SV *sth;
- AV *row_av;
- PPCODE:
- if (SvROK(ST(1))) {
- MAGIC *mg;
- sth = ST(1);
- /* switch to inner handle if not already */
- if ( (mg = mg_find(SvRV(sth),'P')) )
- sth = mg->mg_obj;
- }
- else {
- /* --- prepare --- */
- sth = dbixst_bounce_method("prepare", 3);
- SPAGAIN; SP -= items; /* because stack might have been realloc'd */
- if (!SvROK(sth)) {
- if (is_selectrow_array) { XSRETURN_EMPTY; } else { XSRETURN_UNDEF; }
- }
- /* switch to inner handle */
- sth = mg_find(SvRV(sth),'P')->mg_obj;
- }
- imp_sth = (imp_sth_t*)(DBIh_COM(sth));
- /* --- bind_param --- */
- if (items > 3) { /* need to bind params before execute */
- if (!dbdxst_bind_params(sth, imp_sth, items-2, ax+2) ) {
- if (is_selectrow_array) { XSRETURN_EMPTY; } else { XSRETURN_UNDEF; }
- }
- }
- /* --- execute --- */
- DBIc_ROW_COUNT(imp_sth) = 0;
- if ( dbd_st_execute(sth, imp_sth) <= -2 ) { /* -2 == error */
- if (is_selectrow_array) { XSRETURN_EMPTY; } else { XSRETURN_UNDEF; }
- }
- /* --- fetchrow_arrayref --- */
- row_av = dbd_st_fetch(sth, imp_sth);
- if (!row_av) {
- if (GIMME == G_SCALAR)
- PUSHs(&PL_sv_undef);
- }
- else if (is_selectrow_array) {
- int i;
- int num_fields = AvFILL(row_av)+1;
- if (GIMME == G_SCALAR)
- num_fields = 1; /* return just first field */
- EXTEND(sp, num_fields);
- for(i=0; i < num_fields; ++i) {
- PUSHs(AvARRAY(row_av)[i]);
- }
- }
- else {
- PUSHs( sv_2mortal(newRV((SV *)row_av)) );
- }
- /* --- finish --- */
-#ifdef dbd_st_finish3
- dbd_st_finish3(sth, imp_sth, 0);
-#else
- dbd_st_finish(sth, imp_sth);
-#endif
-
-
-#ifdef dbd_db_do4 /* deebeedee-deebee-doo, deebee-doobee-dah? */
-
-void
-do(dbh, statement, params = Nullsv)
- SV * dbh
- char * statement
- SV * params
- CODE:
- {
- D_imp_dbh(dbh);
- IV retval;
- retval = dbd_db_do4(dbh, imp_dbh, statement, params); /* might be dbd_db_do4_iv via macro */
- /* remember that dbd_db_do4 must return <= -2 for error */
- if (retval == 0) /* ok with no rows affected */
- XST_mPV(0, "0E0"); /* (true but zero) */
- else if (retval < -1) /* -1 == unknown number of rows */
- XST_mUNDEF(0); /* <= -2 means error */
- else
- XST_mIV(0, retval); /* typically 1, rowcount or -1 */
- }
-
-#endif
-
-
-#ifdef dbd_db_last_insert_id
-
-void
-last_insert_id(dbh, catalog, schema, table, field, attr=Nullsv)
- SV * dbh
- SV * catalog
- SV * schema
- SV * table
- SV * field
- SV * attr
- CODE:
- {
- D_imp_dbh(dbh);
- ST(0) = dbd_db_last_insert_id(dbh, imp_dbh, catalog, schema, table, field, attr);
- }
-
-#endif
-
-
-void
-commit(dbh)
- SV * dbh
- CODE:
- D_imp_dbh(dbh);
- if (DBIc_has(imp_dbh,DBIcf_AutoCommit) && DBIc_WARN(imp_dbh))
- warn("commit ineffective with AutoCommit enabled");
- ST(0) = dbd_db_commit(dbh, imp_dbh) ? &PL_sv_yes : &PL_sv_no;
-
-
-void
-rollback(dbh)
- SV * dbh
- CODE:
- D_imp_dbh(dbh);
- if (DBIc_has(imp_dbh,DBIcf_AutoCommit) && DBIc_WARN(imp_dbh))
- warn("rollback ineffective with AutoCommit enabled");
- ST(0) = dbd_db_rollback(dbh, imp_dbh) ? &PL_sv_yes : &PL_sv_no;
-
-
-void
-disconnect(dbh)
- SV * dbh
- CODE:
- D_imp_dbh(dbh);
- if ( !DBIc_ACTIVE(imp_dbh) ) {
- XSRETURN_YES;
- }
- /* Check for disconnect() being called whilst refs to cursors */
- /* still exists. This possibly needs some more thought. */
- if (DBIc_ACTIVE_KIDS(imp_dbh) && DBIc_WARN(imp_dbh) && !PL_dirty) {
- STRLEN lna;
- char *plural = (DBIc_ACTIVE_KIDS(imp_dbh)==1) ? (char*)"" : (char*)"s";
- warn("%s->disconnect invalidates %d active statement handle%s %s",
- SvPV(dbh,lna), (int)DBIc_ACTIVE_KIDS(imp_dbh), plural,
- "(either destroy statement handles or call finish on them before disconnecting)");
- }
- ST(0) = dbd_db_disconnect(dbh, imp_dbh) ? &PL_sv_yes : &PL_sv_no;
- DBIc_ACTIVE_off(imp_dbh); /* ensure it's off, regardless */
-
-
-void
-STORE(dbh, keysv, valuesv)
- SV * dbh
- SV * keysv
- SV * valuesv
- CODE:
- D_imp_dbh(dbh);
- if (SvGMAGICAL(valuesv))
- mg_get(valuesv);
- ST(0) = &PL_sv_yes;
- if (!dbd_db_STORE_attrib(dbh, imp_dbh, keysv, valuesv))
- if (!DBIc_DBISTATE(imp_dbh)->set_attr(dbh, keysv, valuesv))
- ST(0) = &PL_sv_no;
-
-
-void
-FETCH(dbh, keysv)
- SV * dbh
- SV * keysv
- CODE:
- D_imp_dbh(dbh);
- SV *valuesv = dbd_db_FETCH_attrib(dbh, imp_dbh, keysv);
- if (!valuesv)
- valuesv = DBIc_DBISTATE(imp_dbh)->get_attr(dbh, keysv);
- ST(0) = valuesv; /* dbd_db_FETCH_attrib did sv_2mortal */
-
-
-void
-DESTROY(dbh)
- SV * dbh
- PPCODE:
- /* keep in sync with default DESTROY in DBI.xs */
- D_imp_dbh(dbh);
- ST(0) = &PL_sv_yes;
- if (!DBIc_IMPSET(imp_dbh)) { /* was never fully set up */
- STRLEN lna;
- if (DBIc_WARN(imp_dbh) && !PL_dirty && DBIc_DBISTATE(imp_dbh)->debug >= 2)
- PerlIO_printf(DBIc_LOGPIO(imp_dbh),
- " DESTROY for %s ignored - handle not initialised\n",
- SvPV(dbh,lna));
- }
- else {
- if (DBIc_IADESTROY(imp_dbh)) { /* wants ineffective destroy */
- DBIc_ACTIVE_off(imp_dbh);
- if (DBIc_DBISTATE(imp_dbh)->debug)
- PerlIO_printf(DBIc_LOGPIO(imp_dbh), " DESTROY %s skipped due to InactiveDestroy\n", SvPV_nolen(dbh));
- }
- if (DBIc_ACTIVE(imp_dbh)) {
- if (!DBIc_has(imp_dbh,DBIcf_AutoCommit)) {
- /* Application is using transactions and hasn't explicitly disconnected.
- Some databases will automatically commit on graceful disconnect.
- Since we're about to gracefully disconnect as part of the DESTROY
- we want to be sure we're not about to implicitly commit changes
- that are incomplete and should be rolled back. (The DESTROY may
- be due to a RaiseError, for example.) So we rollback here.
- This will be harmless if the application has issued a commit,
- XXX Could add an attribute flag to indicate that the driver
- doesn't have this problem. Patches welcome.
- */
- if (DBIc_WARN(imp_dbh) /* only warn if likely to be useful... */
- && DBIc_is(imp_dbh, DBIcf_Executed) /* has not just called commit/rollback */
- /* && !DBIc_is(imp_dbh, DBIcf_ReadOnly) -- is not read only */
- && (!PL_dirty || DBIc_DBISTATE(imp_dbh)->debug >= 3)
- ) {
- warn("Issuing rollback() due to DESTROY without explicit disconnect() of %s handle %s",
- SvPV_nolen(*hv_fetch((HV*)SvRV(dbh), "ImplementorClass", 16, 1)),
- SvPV_nolen(*hv_fetch((HV*)SvRV(dbh), "Name", 4, 1))
- );
- }
- dbd_db_rollback(dbh, imp_dbh); /* ROLLBACK! */
- }
- dbd_db_disconnect(dbh, imp_dbh);
- DBIc_ACTIVE_off(imp_dbh); /* ensure it's off, regardless */
- }
- dbd_db_destroy(dbh, imp_dbh);
- }
-
-
-#ifdef dbd_take_imp_data
-
-void
-take_imp_data(h)
- SV * h
- CODE:
- D_imp_xxh(h);
- /* dbd_take_imp_data() returns &sv_no (or other defined but false value)
- * to indicate "preparations complete, now call SUPER::take_imp_data" for me.
- * Anything else is returned to the caller via sv_2mortal(sv), typically that
- * would be &sv_undef for error or an SV holding the imp_data.
- */
- SV *sv = dbd_take_imp_data(h, imp_xxh, NULL);
- if (SvOK(sv) && !SvTRUE(sv)) {
- SV *tmp = dbixst_bounce_method("DBD::~DRIVER~::db::SUPER::take_imp_data", items);
- SPAGAIN;
- ST(0) = tmp;
- } else {
- ST(0) = sv_2mortal(sv);
- }
-
-#endif
-
-#ifdef dbd_db_data_sources
-
-void
-data_sources(dbh, attr = Nullsv)
- SV *dbh
- SV *attr
- PPCODE:
- {
- D_imp_dbh(dbh);
- AV *av = dbd_db_data_sources(dbh, imp_dbh, attr);
- if (av) {
- int i;
- int n = AvFILL(av)+1;
- EXTEND(sp, n);
- for (i = 0; i < n; ++i) {
- PUSHs(AvARRAY(av)[i]);
- }
- }
- }
-
-#endif
-
-# -- end of DBD::~DRIVER~::db
-
-# ------------------------------------------------------------
-# statement interface
-# ------------------------------------------------------------
-MODULE = DBD::~DRIVER~ PACKAGE = DBD::~DRIVER~::st
-
-
-void
-_prepare(sth, statement, attribs=Nullsv)
- SV * sth
- SV * statement
- SV * attribs
- CODE:
- {
- D_imp_sth(sth);
- DBD_ATTRIBS_CHECK("_prepare", sth, attribs);
-#ifdef dbd_st_prepare_sv
- ST(0) = dbd_st_prepare_sv(sth, imp_sth, statement, attribs) ? &PL_sv_yes : &PL_sv_no;
-#else
- ST(0) = dbd_st_prepare(sth, imp_sth, SvPV_nolen(statement), attribs) ? &PL_sv_yes : &PL_sv_no;
-#endif
- }
-
-
-#ifdef dbd_st_rows
-
-void
-rows(sth)
- SV * sth
- CODE:
- D_imp_sth(sth);
- XST_mIV(0, dbd_st_rows(sth, imp_sth));
-
-#endif /* dbd_st_rows */
-
-
-#ifdef dbd_st_bind_col
-
-void
-bind_col(sth, col, ref, attribs=Nullsv)
- SV * sth
- SV * col
- SV * ref
- SV * attribs
- CODE:
- {
- IV sql_type = 0;
- D_imp_sth(sth);
- if (SvGMAGICAL(ref))
- mg_get(ref);
- if (attribs) {
- if (SvNIOK(attribs)) {
- sql_type = SvIV(attribs);
- attribs = Nullsv;
- }
- else {
- SV **svp;
- DBD_ATTRIBS_CHECK("bind_col", sth, attribs);
- /* XXX we should perhaps complain if TYPE is not SvNIOK */
- DBD_ATTRIB_GET_IV(attribs, "TYPE",4, svp, sql_type);
- }
- }
- switch(dbd_st_bind_col(sth, imp_sth, col, ref, sql_type, attribs)) {
- case 2: ST(0) = &PL_sv_yes; /* job done completely */
- break;
- case 1: /* fallback to DBI default */
- ST(0) = (DBIc_DBISTATE(imp_sth)->bind_col(sth, col, ref, attribs))
- ? &PL_sv_yes : &PL_sv_no;
- break;
- default: ST(0) = &PL_sv_no; /* dbd_st_bind_col has called set_err */
- break;
- }
- }
-
-#endif /* dbd_st_bind_col */
-
-void
-bind_param(sth, param, value, attribs=Nullsv)
- SV * sth
- SV * param
- SV * value
- SV * attribs
- CODE:
- {
- IV sql_type = 0;
- D_imp_sth(sth);
- if (SvGMAGICAL(value))
- mg_get(value);
- if (attribs) {
- if (SvNIOK(attribs)) {
- sql_type = SvIV(attribs);
- attribs = Nullsv;
- }
- else {
- SV **svp;
- DBD_ATTRIBS_CHECK("bind_param", sth, attribs);
- /* XXX we should perhaps complain if TYPE is not SvNIOK */
- DBD_ATTRIB_GET_IV(attribs, "TYPE",4, svp, sql_type);
- }
- }
- ST(0) = dbd_bind_ph(sth, imp_sth, param, value, sql_type, attribs, FALSE, 0)
- ? &PL_sv_yes : &PL_sv_no;
- }
-
-
-void
-bind_param_inout(sth, param, value_ref, maxlen, attribs=Nullsv)
- SV * sth
- SV * param
- SV * value_ref
- IV maxlen
- SV * attribs
- CODE:
- {
- IV sql_type = 0;
- D_imp_sth(sth);
- SV *value;
- if (!SvROK(value_ref) || SvTYPE(SvRV(value_ref)) > SVt_PVMG)
- croak("bind_param_inout needs a reference to a scalar value");
- value = SvRV(value_ref);
- if (SvREADONLY(value))
- croak("Modification of a read-only value attempted");
- if (SvGMAGICAL(value))
- mg_get(value);
- if (attribs) {
- if (SvNIOK(attribs)) {
- sql_type = SvIV(attribs);
- attribs = Nullsv;
- }
- else {
- SV **svp;
- DBD_ATTRIBS_CHECK("bind_param", sth, attribs);
- DBD_ATTRIB_GET_IV(attribs, "TYPE",4, svp, sql_type);
- }
- }
- ST(0) = dbd_bind_ph(sth, imp_sth, param, value, sql_type, attribs, TRUE, maxlen)
- ? &PL_sv_yes : &PL_sv_no;
- }
-
-
-void
-execute(sth, ...)
- SV * sth
- CODE:
- D_imp_sth(sth);
- IV retval;
- if (items > 1) { /* need to bind params */
- if (!dbdxst_bind_params(sth, imp_sth, items, ax) ) {
- XSRETURN_UNDEF;
- }
- }
- /* XXX this code is duplicated in selectrow_arrayref above */
- DBIc_ROW_COUNT(imp_sth) = 0;
- retval = dbd_st_execute(sth, imp_sth); /* might be dbd_st_execute_iv via macro */
- /* remember that dbd_st_execute must return <= -2 for error */
- if (retval == 0) /* ok with no rows affected */
- XST_mPV(0, "0E0"); /* (true but zero) */
- else if (retval < -1) /* -1 == unknown number of rows */
- XST_mUNDEF(0); /* <= -2 means error */
- else
- XST_mIV(0, retval); /* typically 1, rowcount or -1 */
-
-
-#ifdef dbd_st_execute_for_fetch
-
-void
-execute_for_fetch(sth, fetch_tuple_sub, tuple_status = Nullsv)
- SV * sth
- SV * fetch_tuple_sub
- SV * tuple_status
- CODE:
- {
- D_imp_sth(sth);
- ST(0) = dbd_st_execute_for_fetch(sth, imp_sth, fetch_tuple_sub, tuple_status);
- }
-
-#endif
-
-
-
-void
-fetchrow_arrayref(sth)
- SV * sth
- ALIAS:
- fetch = 1
- CODE:
- D_imp_sth(sth);
- AV *av;
- PERL_UNUSED_VAR(ix);
- av = dbd_st_fetch(sth, imp_sth);
- ST(0) = (av) ? sv_2mortal(newRV((SV *)av)) : &PL_sv_undef;
-
-
-void
-fetchrow_array(sth)
- SV * sth
- ALIAS:
- fetchrow = 1
- PPCODE:
- D_imp_sth(sth);
- AV *av;
- av = dbd_st_fetch(sth, imp_sth);
- if (av) {
- int i;
- int num_fields = AvFILL(av)+1;
- EXTEND(sp, num_fields);
- for(i=0; i < num_fields; ++i) {
- PUSHs(AvARRAY(av)[i]);
- }
- PERL_UNUSED_VAR(ix);
- }
-
-
-void
-fetchall_arrayref(sth, slice=&PL_sv_undef, batch_row_count=&PL_sv_undef)
- SV * sth
- SV * slice
- SV * batch_row_count
- CODE:
- if (SvOK(slice)) { /* fallback to perl implementation */
- SV *tmp = dbixst_bounce_method("DBD::~DRIVER~::st::SUPER::fetchall_arrayref", 3);
- SPAGAIN;
- ST(0) = tmp;
- }
- else {
- SV *tmp = dbdxst_fetchall_arrayref(sth, slice, batch_row_count);
- SPAGAIN;
- ST(0) = tmp;
- }
-
-
-void
-finish(sth)
- SV * sth
- CODE:
- D_imp_sth(sth);
- D_imp_dbh_from_sth;
- if (!DBIc_ACTIVE(imp_sth)) {
- /* No active statement to finish */
- XSRETURN_YES;
- }
- if (!DBIc_ACTIVE(imp_dbh)) {
- /* Either an explicit disconnect() or global destruction */
- /* has disconnected us from the database. Finish is meaningless */
- DBIc_ACTIVE_off(imp_sth);
- XSRETURN_YES;
- }
-#ifdef dbd_st_finish3
- ST(0) = dbd_st_finish3(sth, imp_sth, 0) ? &PL_sv_yes : &PL_sv_no;
-#else
- ST(0) = dbd_st_finish(sth, imp_sth) ? &PL_sv_yes : &PL_sv_no;
-#endif
-
-
-void
-blob_read(sth, field, offset, len, destrv=Nullsv, destoffset=0)
- SV * sth
- int field
- long offset
- long len
- SV * destrv
- long destoffset
- CODE:
- {
- D_imp_sth(sth);
- if (!destrv)
- destrv = sv_2mortal(newRV(sv_2mortal(newSV(0))));
- if (dbd_st_blob_read(sth, imp_sth, field, offset, len, destrv, destoffset))
- ST(0) = SvRV(destrv);
- else ST(0) = &PL_sv_undef;
- }
-
-
-void
-STORE(sth, keysv, valuesv)
- SV * sth
- SV * keysv
- SV * valuesv
- CODE:
- D_imp_sth(sth);
- if (SvGMAGICAL(valuesv))
- mg_get(valuesv);
- ST(0) = &PL_sv_yes;
- if (!dbd_st_STORE_attrib(sth, imp_sth, keysv, valuesv))
- if (!DBIc_DBISTATE(imp_sth)->set_attr(sth, keysv, valuesv))
- ST(0) = &PL_sv_no;
-
-
-# FETCH renamed and ALIAS'd to avoid case clash on VMS :-(
-void
-FETCH_attrib(sth, keysv)
- SV * sth
- SV * keysv
- ALIAS:
- FETCH = 1
- CODE:
- D_imp_sth(sth);
- SV *valuesv;
- PERL_UNUSED_VAR(ix);
- valuesv = dbd_st_FETCH_attrib(sth, imp_sth, keysv);
- if (!valuesv)
- valuesv = DBIc_DBISTATE(imp_sth)->get_attr(sth, keysv);
- ST(0) = valuesv; /* dbd_st_FETCH_attrib did sv_2mortal */
-
-
-void
-DESTROY(sth)
- SV * sth
- PPCODE:
- /* keep in sync with default DESTROY in DBI.xs */
- D_imp_sth(sth);
- ST(0) = &PL_sv_yes;
- if (!DBIc_IMPSET(imp_sth)) { /* was never fully set up */
- STRLEN lna;
- if (DBIc_WARN(imp_sth) && !PL_dirty && DBIc_DBISTATE(imp_sth)->debug >= 2)
- PerlIO_printf(DBIc_LOGPIO(imp_sth),
- " DESTROY for %s ignored - handle not initialised\n",
- SvPV(sth,lna));
- }
- else {
- if (DBIc_IADESTROY(imp_sth)) { /* wants ineffective destroy */
- DBIc_ACTIVE_off(imp_sth);
- if (DBIc_DBISTATE(imp_sth)->debug)
- PerlIO_printf(DBIc_LOGPIO(imp_sth), " DESTROY %s skipped due to InactiveDestroy\n", SvPV_nolen(sth));
- }
- if (DBIc_ACTIVE(imp_sth)) {
- D_imp_dbh_from_sth;
- if (!PL_dirty && DBIc_ACTIVE(imp_dbh)) {
-#ifdef dbd_st_finish3
- dbd_st_finish3(sth, imp_sth, 1);
-#else
- dbd_st_finish(sth, imp_sth);
-#endif
- }
- else {
- DBIc_ACTIVE_off(imp_sth);
- }
- }
- dbd_st_destroy(sth, imp_sth);
- }
-
-# end of ~DRIVER~.xst
-# vim:ts=8:sw=4:et
+++ /dev/null
-/*
-# $Id$
-# Copyright (c) 2002 Tim Bunce Ireland
-#
-# You may distribute under the terms of either the GNU General Public
-# License or the Artistic License, as specified in the Perl README file.
-*/
-
-
-/* This is really just a workaround for SUPER:: not working right for XS code.
- * It would be better if we setup perl's context so SUPER:: did the right thing
- * (borrowing the relevant magic from pp_entersub in perl pp_hot.c).
- * Then we could just use call_method("SUPER::foo") instead.
- * XXX remember to call SPAGAIN in the calling code after calling this!
- */
-static SV *
-dbixst_bounce_method(char *methname, int params)
-{
- dTHX;
- /* XXX this 'magic' undoes the dMARK embedded in the dXSARGS of our caller */
- /* so that the dXSARGS below can set things up as they were for our caller */
- void *xxx = PL_markstack_ptr++;
- dXSARGS; /* declares sp, ax, mark, items */
- int i;
- SV *sv;
- int debug = 0;
- D_imp_xxh(ST(0));
- if (debug >= 3) {
- PerlIO_printf(DBIc_LOGPIO(imp_xxh),
- " -> %s (trampoline call with %d (%ld) params)\n", methname, params, (long)items);
- PERL_UNUSED_VAR(xxx);
- }
- EXTEND(SP, params);
- PUSHMARK(SP);
- for (i=0; i < params; ++i) {
- sv = (i >= items) ? &PL_sv_undef : ST(i);
- PUSHs(sv);
- }
- PUTBACK;
- i = call_method(methname, G_SCALAR);
- SPAGAIN;
- sv = (i) ? POPs : &PL_sv_undef;
- PUTBACK;
- if (debug >= 3)
- PerlIO_printf(DBIc_LOGPIO(imp_xxh),
- " <- %s= %s (trampoline call return)\n", methname, neatsvpv(sv,0));
- return sv;
-}
-
-
-static int
-dbdxst_bind_params(SV *sth, imp_sth_t *imp_sth, I32 items, I32 ax)
-{
- /* Handle binding supplied values to placeholders. */
- /* items = one greater than the number of params */
- /* ax = ax from calling sub, maybe adjusted to match items */
- dTHX;
- int i;
- SV *idx;
- if (items-1 != DBIc_NUM_PARAMS(imp_sth)
- && DBIc_NUM_PARAMS(imp_sth) != DBIc_NUM_PARAMS_AT_EXECUTE
- ) {
- char errmsg[99];
- /* clear any previous ParamValues before error is generated */
- SV **svp = hv_fetch((HV*)DBIc_MY_H(imp_sth),"ParamValues",11,FALSE);
- if (svp && SvROK(*svp) && SvTYPE(SvRV(*svp)) == SVt_PVHV) {
- HV *hv = (HV*)SvRV(*svp);
- hv_clear(hv);
- }
- sprintf(errmsg,"called with %d bind variables when %d are needed",
- (int)items-1, DBIc_NUM_PARAMS(imp_sth));
- DBIh_SET_ERR_CHAR(sth, (imp_xxh_t*)imp_sth, "-1", -1, errmsg, Nullch, Nullch);
- return 0;
- }
- idx = sv_2mortal(newSViv(0));
- for(i=1; i < items ; ++i) {
- SV* value = ST(i);
- if (SvGMAGICAL(value))
- mg_get(value); /* trigger magic to FETCH the value */
- sv_setiv(idx, i);
- if (!dbd_bind_ph(sth, imp_sth, idx, value, 0, Nullsv, FALSE, 0)) {
- return 0; /* dbd_bind_ph already registered error */
- }
- }
- return 1;
-}
-
-#ifndef dbd_fetchall_arrayref
-static SV *
-dbdxst_fetchall_arrayref(SV *sth, SV *slice, SV *batch_row_count)
-{
- dTHX;
- D_imp_sth(sth);
- SV *rows_rvav;
- if (SvOK(slice)) { /* should never get here */
- char errmsg[99];
- sprintf(errmsg,"slice param not supported by XS version of fetchall_arrayref");
- DBIh_SET_ERR_CHAR(sth, (imp_xxh_t*)imp_sth, "-1", -1, errmsg, Nullch, Nullch);
- return &PL_sv_undef;
- }
- else {
- IV maxrows = SvOK(batch_row_count) ? SvIV(batch_row_count) : -1;
- AV *fetched_av;
- AV *rows_av = newAV();
- if ( !DBIc_ACTIVE(imp_sth) && maxrows>0 ) {
- /* to simplify application logic we return undef without an error */
- /* if we've fetched all the rows and called with a batch_row_count */
- return &PL_sv_undef;
- }
- av_extend(rows_av, (maxrows>0) ? maxrows : 31);
- while ( (maxrows < 0 || maxrows-- > 0)
- && (fetched_av = dbd_st_fetch(sth, imp_sth))
- ) {
- AV *copy_row_av = av_make(AvFILL(fetched_av)+1, AvARRAY(fetched_av));
- av_push(rows_av, newRV_noinc((SV*)copy_row_av));
- }
- rows_rvav = sv_2mortal(newRV_noinc((SV *)rows_av));
- }
- return rows_rvav;
-}
-#endif
-
+++ /dev/null
-BEFORE BUILDING, TESTING AND INSTALLING this you will need to:
-
- Build, test and install a recent version of Perl 5
- It is very important to test it and actually install it!
- (You can use "Configure -Dprefix=..." to build a private copy.)
-
-BUILDING
-
- perl Makefile.PL
- make
- make test
- make test TEST_VERBOSE=1 (if any of the t/* tests fail)
- make install (if the tests look okay)
-
-The perl you use to execute Makefile.PL should be the first one in your PATH.
-If you want to use some installed perl then modify your PATH to match.
-
-IF YOU HAVE PROBLEMS
-
----
-If you get an error like "gcc: command not found" or "cc: command not found"
-you need to either install a compiler, or you may be able to install a
-precompiled binary of DBI using a package manager (e.g., ppm for ActiveState,
-Synaptic for Ubuntu, port for FreeBSD etc)
-
----
-If you get compiler errors referring to Perl's own header files
-(.../CORE/...h) or the compiler complains about bad options etc then
-there is something wrong with your perl installation. If the compiler complains
-of missing files (.../perl.h: error: sys/types.h: No such file) then you may
-need to install extra packages for your operating system.
-
-Generally it's best to use a Perl that was built on the system you are trying
-to use and it's also important to use the same compiler that was used to build
-the Perl you are using.
-
-If you installed Perl using a binary distribution, such as ActiveState Perl,
-or if Perl came installed with the operating system you use, such as Debian or
-Ubuntu, then you may be able to install a precompiled binary of DBI using a
-package manager. Check the package manager for your distribution of Perl (e.g.
-ppm for ActiveState) or for your operating system (e.g Synaptic for Ubuntu).
-
----
-If you get compiler warnings like "value computed is not used" and
-"unused variable" you can ignore them.
-
+++ /dev/null
-DBI is Copyright (c) 1994-2015 by Tim Bunce and others.
-See LICENSE included with this distribution. All rights reserved.
-
-This is free software; you can redistribute it and/or modify it under the
-same terms as the Perl5 (v5.0.0 ~ v5.20.0) programming language system
-itself: under the terms of either:
-
-a) the "Artistic License 1.0" as published by The Perl Foundation
- http://www.perlfoundation.org/artistic_license_1_0
-
-b) the GNU General Public License as published by the Free Software Foundation;
- either version 1 http://www.gnu.org/licenses/gpl-1.0.html
- or (at your option) any later version
-
-PLEASE NOTE: It is the current maintainers intention to keep the dual
-licensing intact. Until this notice is removed, releases will continue to
-be available under both the standard GPL and the less restrictive Artistic
-licenses.
-
-Verbatim copies of both licenses are included below:
-
-
-
---- The Artistic License 1.0 ---
-
- The "Artistic License"
-
- Preamble
-
-The intent of this document is to state the conditions under which a
-Package may be copied, such that the Copyright Holder maintains some
-semblance of artistic control over the development of the package,
-while giving the users of the package the right to use and distribute
-the Package in a more-or-less customary fashion, plus the right to make
-reasonable modifications.
-
-Definitions:
-
- "Package" refers to the collection of files distributed by the
- Copyright Holder, and derivatives of that collection of files
- created through textual modification.
-
- "Standard Version" refers to such a Package if it has not been
- modified, or has been modified in accordance with the wishes
- of the Copyright Holder as specified below.
-
- "Copyright Holder" is whoever is named in the copyright or
- copyrights for the package.
-
- "You" is you, if you're thinking about copying or distributing
- this Package.
-
- "Reasonable copying fee" is whatever you can justify on the
- basis of media cost, duplication charges, time of people involved,
- and so on. (You will not be required to justify it to the
- Copyright Holder, but only to the computing community at large
- as a market that must bear the fee.)
-
- "Freely Available" means that no fee is charged for the item
- itself, though there may be fees involved in handling the item.
- It also means that recipients of the item may redistribute it
- under the same conditions they received it.
-
-1. You may make and give away verbatim copies of the source form of the
-Standard Version of this Package without restriction, provided that you
-duplicate all of the original copyright notices and associated disclaimers.
-
-2. You may apply bug fixes, portability fixes and other modifications
-derived from the Public Domain or from the Copyright Holder. A Package
-modified in such a way shall still be considered the Standard Version.
-
-3. You may otherwise modify your copy of this Package in any way, provided
-that you insert a prominent notice in each changed file stating how and
-when you changed that file, and provided that you do at least ONE of the
-following:
-
- a) place your modifications in the Public Domain or otherwise make them
- Freely Available, such as by posting said modifications to Usenet or
- an equivalent medium, or placing the modifications on a major archive
- site such as uunet.uu.net, or by allowing the Copyright Holder to include
- your modifications in the Standard Version of the Package.
-
- b) use the modified Package only within your corporation or organization.
-
- c) rename any non-standard executables so the names do not conflict
- with standard executables, which must also be provided, and provide
- a separate manual page for each non-standard executable that clearly
- documents how it differs from the Standard Version.
-
- d) make other distribution arrangements with the Copyright Holder.
-
-4. You may distribute the programs of this Package in object code or
-executable form, provided that you do at least ONE of the following:
-
- a) distribute a Standard Version of the executables and library files,
- together with instructions (in the manual page or equivalent) on where
- to get the Standard Version.
-
- b) accompany the distribution with the machine-readable source of
- the Package with your modifications.
-
- c) give non-standard executables non-standard names, and clearly
- document the differences in manual pages (or equivalent), together
- with instructions on where to get the Standard Version.
-
- d) make other distribution arrangements with the Copyright Holder.
-
-5. You may charge a reasonable copying fee for any distribution of this
-Package. You may charge any fee you choose for support of this
-Package. You may not charge a fee for this Package itself. However,
-you may distribute this Package in aggregate with other (possibly
-commercial) programs as part of a larger (possibly commercial) software
-distribution provided that you do not advertise this Package as a
-product of your own. You may embed this Package's interpreter within
-an executable of yours (by linking); this shall be construed as a mere
-form of aggregation, provided that the complete Standard Version of the
-interpreter is so embedded.
-
-6. The scripts and library files supplied as input to or produced as
-output from the programs of this Package do not automatically fall
-under the copyright of this Package, but belong to whoever generated
-them, and may be sold commercially, and may be aggregated with this
-Package. If such scripts or library files are aggregated with this
-Package via the so-called "undump" or "unexec" methods of producing a
-binary executable image, then distribution of such an image shall
-neither be construed as a distribution of this Package nor shall it
-fall under the restrictions of Paragraphs 3 and 4, provided that you do
-not represent such an executable image as a Standard Version of this
-Package.
-
-7. C subroutines (or comparably compiled subroutines in other
-languages) supplied by you and linked into this Package in order to
-emulate subroutines and variables of the language defined by this
-Package shall not be considered part of this Package, but are the
-equivalent of input as in Paragraph 6, provided these subroutines do
-not change the language in any way that would cause it to fail the
-regression tests for the language.
-
-8. Aggregation of this Package with a commercial distribution is always
-permitted provided that the use of this Package is embedded; that is,
-when no overt attempt is made to make this Package's interfaces visible
-to the end user of the commercial distribution. Such use shall not be
-construed as a distribution of this Package.
-
-9. The name of the Copyright Holder may not be used to endorse or promote
-products derived from this software without specific prior written permission.
-
-10. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR
-IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
-WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.
-
---- end of The Artistic License 1.0 ---
-
-
-
-
---- The GNU General Public License, Version 1, February 1989 ---
-
- GNU GENERAL PUBLIC LICENSE
- Version 1, February 1989
-
- Copyright (C) 1989 Free Software Foundation, Inc.
- 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
-
- Everyone is permitted to copy and distribute verbatim copies
- of this license document, but changing it is not allowed.
-
- Preamble
-
- The license agreements of most software companies try to keep users
-at the mercy of those companies. By contrast, our General Public
-License is intended to guarantee your freedom to share and change free
-software--to make sure the software is free for all its users. The
-General Public License applies to the Free Software Foundation's
-software and to any other program whose authors commit to using it.
-You can use it for your programs, too.
-
- When we speak of free software, we are referring to freedom, not
-price. Specifically, the General Public License is designed to make
-sure that you have the freedom to give away or sell copies of free
-software, that you receive source code or can get it if you want it,
-that you can change the software or use pieces of it in new free
-programs; and that you know you can do these things.
-
- To protect your rights, we need to make restrictions that forbid
-anyone to deny you these rights or to ask you to surrender the rights.
-These restrictions translate to certain responsibilities for you if you
-distribute copies of the software, or if you modify it.
-
- For example, if you distribute copies of a such a program, whether
-gratis or for a fee, you must give the recipients all the rights that
-you have. You must make sure that they, too, receive or can get the
-source code. And you must tell them their rights.
-
- We protect your rights with two steps: (1) copyright the software, and
-(2) offer you this license which gives you legal permission to copy,
-distribute and/or modify the software.
-
- Also, for each author's protection and ours, we want to make certain
-that everyone understands that there is no warranty for this free
-software. If the software is modified by someone else and passed on, we
-want its recipients to know that what they have is not the original, so
-that any problems introduced by others will not reflect on the original
-authors' reputations.
-
- The precise terms and conditions for copying, distribution and
-modification follow.
-
- GNU GENERAL PUBLIC LICENSE
- TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
-
- 0. This License Agreement applies to any program or other work which
-contains a notice placed by the copyright holder saying it may be
-distributed under the terms of this General Public License. The
-"Program", below, refers to any such program or work, and a "work based
-on the Program" means either the Program or any work containing the
-Program or a portion of it, either verbatim or with modifications. Each
-licensee is addressed as "you".
-
- 1. You may copy and distribute verbatim copies of the Program's source
-code as you receive it, in any medium, provided that you conspicuously and
-appropriately publish on each copy an appropriate copyright notice and
-disclaimer of warranty; keep intact all the notices that refer to this
-General Public License and to the absence of any warranty; and give any
-other recipients of the Program a copy of this General Public License
-along with the Program. You may charge a fee for the physical act of
-transferring a copy.
-
- 2. You may modify your copy or copies of the Program or any portion of
-it, and copy and distribute such modifications under the terms of Paragraph
-1 above, provided that you also do the following:
-
- a) cause the modified files to carry prominent notices stating that
- you changed the files and the date of any change; and
-
- b) cause the whole of any work that you distribute or publish, that
- in whole or in part contains the Program or any part thereof, either
- with or without modifications, to be licensed at no charge to all
- third parties under the terms of this General Public License (except
- that you may choose to grant warranty protection to some or all
- third parties, at your option).
-
- c) If the modified program normally reads commands interactively when
- run, you must cause it, when started running for such interactive use
- in the simplest and most usual way, to print or display an
- announcement including an appropriate copyright notice and a notice
- that there is no warranty (or else, saying that you provide a
- warranty) and that users may redistribute the program under these
- conditions, and telling the user how to view a copy of this General
- Public License.
-
- d) You may charge a fee for the physical act of transferring a
- copy, and you may at your option offer warranty protection in
- exchange for a fee.
-
-Mere aggregation of another independent work with the Program (or its
-derivative) on a volume of a storage or distribution medium does not bring
-the other work under the scope of these terms.
-
- 3. You may copy and distribute the Program (or a portion or derivative of
-it, under Paragraph 2) in object code or executable form under the terms of
-Paragraphs 1 and 2 above provided that you also do one of the following:
-
- a) accompany it with the complete corresponding machine-readable
- source code, which must be distributed under the terms of
- Paragraphs 1 and 2 above; or,
-
- b) accompany it with a written offer, valid for at least three
- years, to give any third party free (except for a nominal charge
- for the cost of distribution) a complete machine-readable copy of the
- corresponding source code, to be distributed under the terms of
- Paragraphs 1 and 2 above; or,
-
- c) accompany it with the information you received as to where the
- corresponding source code may be obtained. (This alternative is
- allowed only for noncommercial distribution and only if you
- received the program in object code or executable form alone.)
-
-Source code for a work means the preferred form of the work for making
-modifications to it. For an executable file, complete source code means
-all the source code for all modules it contains; but, as a special
-exception, it need not include source code for modules which are standard
-libraries that accompany the operating system on which the executable
-file runs, or for standard header files or definitions files that
-accompany that operating system.
-
- 4. You may not copy, modify, sublicense, distribute or transfer the
-Program except as expressly provided under this General Public License.
-Any attempt otherwise to copy, modify, sublicense, distribute or transfer
-the Program is void, and will automatically terminate your rights to use
-the Program under this License. However, parties who have received
-copies, or rights to use copies, from you under this General Public
-License will not have their licenses terminated so long as such parties
-remain in full compliance.
-
- 5. By copying, distributing or modifying the Program (or any work based
-on the Program) you indicate your acceptance of this license to do so,
-and all its terms and conditions.
-
- 6. Each time you redistribute the Program (or any work based on the
-Program), the recipient automatically receives a license from the original
-licensor to copy, distribute or modify the Program subject to these
-terms and conditions. You may not impose any further restrictions on the
-recipients' exercise of the rights granted herein.
-
- 7. The Free Software Foundation may publish revised and/or new versions
-of the General Public License from time to time. Such new versions will
-be similar in spirit to the present version, but may differ in detail to
-address new problems or concerns.
-
-Each version is given a distinguishing version number. If the Program
-specifies a version number of the license which applies to it and "any
-later version", you have the option of following the terms and conditions
-either of that version or of any later version published by the Free
-Software Foundation. If the Program does not specify a version number of
-the license, you may choose any version ever published by the Free Software
-Foundation.
-
- 8. If you wish to incorporate parts of the Program into other free
-programs whose distribution conditions are different, write to the author
-to ask for permission. For software which is copyrighted by the Free
-Software Foundation, write to the Free Software Foundation; we sometimes
-make exceptions for this. Our decision will be guided by the two goals
-of preserving the free status of all derivatives of our free software and
-of promoting the sharing and reuse of software generally.
-
- NO WARRANTY
-
- 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
-FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
-OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
-PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
-OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
-MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
-TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
-PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
-REPAIR OR CORRECTION.
-
- 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
-WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
-REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
-INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
-OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
-TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
-YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
-PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
-POSSIBILITY OF SUCH DAMAGES.
-
- END OF TERMS AND CONDITIONS
-
- Appendix: How to Apply These Terms to Your New Programs
-
- If you develop a new program, and you want it to be of the greatest
-possible use to humanity, the best way to achieve this is to make it
-free software which everyone can redistribute and change under these
-terms.
-
- To do so, attach the following notices to the program. It is safest to
-attach them to the start of each source file to most effectively convey
-the exclusion of warranty; and each file should have at least the
-"copyright" line and a pointer to where the full notice is found.
-
- <one line to give the program's name and a brief idea of what it does.>
- Copyright (C) 19yy <name of author>
-
- This program is free software; you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation; either version 1, or (at your option)
- any later version.
-
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
-
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA 02110-1301 USA
-
-
-Also add information on how to contact you by electronic and paper mail.
-
-If the program is interactive, make it output a short notice like this
-when it starts in an interactive mode:
-
- Gnomovision version 69, Copyright (C) 19xx name of author
- Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
- This is free software, and you are welcome to redistribute it
- under certain conditions; type `show c' for details.
-
-The hypothetical commands `show w' and `show c' should show the
-appropriate parts of the General Public License. Of course, the
-commands you use may be called something other than `show w' and `show
-c'; they could even be mouse-clicks or menu items--whatever suits your
-program.
-
-You should also get your employer (if you work as a programmer) or your
-school, if any, to sign a "copyright disclaimer" for the program, if
-necessary. Here a sample; alter the names:
-
- Yoyodyne, Inc., hereby disclaims all copyright interest in the
- program `Gnomovision' (a program to direct compilers to make passes
- at assemblers) written by James Hacker.
-
- <signature of Ty Coon>, 1 April 1989
- Ty Coon, President of Vice
-
-That's all there is to it!
-
---- end of The GNU General Public License, Version 1, February 1989 ---
-
-
+++ /dev/null
-Changes History of significant changes to the DBI
-DBI.pm The Database Interface Module Perl code
-DBI.xs The Database Interface Module XS code
-DBIXS.h The DBI XS public interface for Drivers (DBD::...)
-Driver.xst Template driver xs file
-Driver_xst.h Template driver xs support code
-INSTALL
-LICENSE
-MANIFEST
-Makefile.PL The Makefile generator
-Perl.xs Test harness (currently) for Driver.xst
-README.md
-dbd_xsh.h Prototypes for standard Driver.xst interface
-dbi_sql.h Definitions based on SQL CLI / ODBC (#inc'd by DBIXS.h)
-dbipport.h Perl portability macros (from Devel::PPort)
-dbilogstrip.PL Utility to normalise DBI logs so they can be compared with diff
-dbiprof.PL
-dbiproxy.PL Frontend for DBI::ProxyServer
-dbivport.h DBI version portability macros (for drivers to copy)
-dbixs_rev.h Defines DBIXS_REVISION macro holding DBIXS.h subversion revision number
-dbixs_rev.pl Utility to write dbixs_rev.h
-ex/perl_dbi_nulls_test.pl A test script for forms of IS NULL qualification in SQL
-ex/profile.pl A test script for DBI::Profile
-ex/corogofer.pl A test script for DBD::Gofer::Transport::corostream
-lib/Bundle/DBI.pm A bundle for automatic installation via CPAN.
-lib/DBD/DBM.pm A driver for DBM files (uses DBD::File)
-lib/DBD/ExampleP.pm A very simple example Driver module
-lib/DBD/File.pm A driver base class for simple drivers
-lib/DBD/File/Developers.pod Developer documentation for DBD::File
-lib/DBD/File/Roadmap.pod Roadmap for DBD::File and other Pure Perl DBD's
-lib/DBD/File/HowTo.pod Guide to write a DBD::File based DBI driver
-lib/DBD/Gofer.pm DBD::Gofer 'stateless proxy' driver
-lib/DBD/Gofer/Policy/Base.pm
-lib/DBD/Gofer/Policy/pedantic.pm Safest and most transparent, but also slowest
-lib/DBD/Gofer/Policy/classic.pm Reasonable policy for typical usage
-lib/DBD/Gofer/Policy/rush.pm Raw speed, fewest round trips, least transparent
-lib/DBD/Gofer/Transport/Base.pm Base class for DBD::Gofer driver transport classes
-lib/DBD/Gofer/Transport/corostream.pm Async Gofer transport using Coro and AnyEvent
-lib/DBD/Gofer/Transport/null.pm DBD::Gofer transport that executes in same process (for testing)
-lib/DBD/Gofer/Transport/pipeone.pm DBD::Gofer transport to new subprocess for each request
-lib/DBD/Gofer/Transport/stream.pm DBD::Gofer transport for ssh etc
-lib/DBD/Mem.pm A pure-perl in-memory driver using DBI::DBD::SqlEngine
-lib/DBD/NullP.pm An empty example Driver module
-lib/DBD/Proxy.pm Proxy driver
-lib/DBD/Sponge.pm A driver for fake cursors (precached data)
-lib/DBI/Const/GetInfo/ANSI.pm GetInfo data based on ANSI standard
-lib/DBI/Const/GetInfo/ODBC.pm GetInfo data based on ODBC standard
-lib/DBI/Const/GetInfoReturn.pm GetInfo return values plus tools based on standards
-lib/DBI/Const/GetInfoType.pm GetInfo type code data based on standards
-lib/DBI/DBD.pm Some basic help for people writing DBI drivers
-lib/DBI/DBD/Metadata.pm Metadata tools for people writing DBI drivers
-lib/DBI/DBD/SqlEngine.pm SQL Engine for drivers without an own
-lib/DBI/DBD/SqlEngine/Developers.pod DBI::DBD::SqlEngine API Documentation
-lib/DBI/DBD/SqlEngine/HowTo.pod HowTo ... write a DBI::DBD::SqlEngine based driver
-lib/DBI/Gofer/Execute.pm Execution logic for DBD::Gofer server
-lib/DBI/Gofer/Request.pm Request object from DBD::Gofer
-lib/DBI/Gofer/Response.pm Response object for DBD::Gofer
-lib/DBI/Gofer/Serializer/Base.pm
-lib/DBI/Gofer/Serializer/DataDumper.pm
-lib/DBI/Gofer/Serializer/Storable.pm
-lib/DBI/Gofer/Transport/Base.pm Base class for DBD::Gofer server transport classes
-lib/DBI/Gofer/Transport/pipeone.pm DBD::Gofer transport for single requests
-lib/DBI/Gofer/Transport/stream.pm DBI::Gofer transport for ssh etc
-lib/DBI/Profile.pm Manage DBI usage profile data
-lib/DBI/ProfileData.pm
-lib/DBI/ProfileDumper.pm
-lib/DBI/ProfileDumper/Apache.pm
-lib/DBI/ProfileSubs.pm
-lib/DBI/ProxyServer.pm The proxy drivers server
-lib/DBI/PurePerl.pm A DBI.xs emulation in Perl
-lib/DBI/SQL/Nano.pm A 'smaller than micro' SQL parser
-lib/DBI/Util/_accessor.pm A very¬cut-down version of Class::Accessor::Fast
-lib/DBI/Util/CacheMemory.pm A very cut-down version of Cache::Memory
-lib/DBI/W32ODBC.pm An experimental DBI emulation layer for Win32::ODBC
-lib/Win32/DBIODBC.pm An experimental Win32::ODBC emulation layer for DBI
-t/01basics.t
-t/02dbidrv.t
-t/03handle.t
-t/04mods.t
-t/05concathash.t
-t/06attrs.t
-t/07kids.t
-t/08keeperr.t
-t/09trace.t
-t/10examp.t
-t/11fetch.t
-t/12quote.t
-t/13taint.t
-t/14utf8.t
-t/15array.t
-t/16destroy.t
-t/19fhtrace.t
-t/20meta.t
-t/30subclass.t
-t/31methcache.t Test caching of inner methods
-t/35thrclone.t
-t/40profile.t
-t/41prof_dump.t
-t/42prof_data.t
-t/43prof_env.t
-t/48dbi_dbd_sqlengine.t Tests for DBI::DBD::SqlEngine
-t/49dbd_file.t DBD::File API and very basic tests
-t/50dbm_simple.t simple DBD::DBM tests
-t/51dbm_file.t extended DBD::File tests (through DBD::DBM)
-t/52dbm_complex.t Complex DBD::DBM tests with SQL::Statement
-t/53sqlengine_adv.t
-t/54_dbd_mem.t
-t/60preparse.t
-t/65transact.t
-t/70callbacks.t
-t/72childhandles.t
-t/73cachedkids.t
-t/80proxy.t
-t/85gofer.t
-t/86gofer_fail.t
-t/87gofer_cache.t
-t/90sql_type_cast.t
-t/91_store_warning.t
-t/lib.pl Utility functions for test scripts
-t/pod.t
-t/pod-coverage.t
-test.pl Assorted informal tests, including tests for memory leaks
-typemap
-META.yml Module YAML meta-data (added by MakeMaker)
-META.json Module JSON meta-data (added by MakeMaker)
+++ /dev/null
-{
- "abstract" : "Database independent interface for Perl",
- "author" : [
- "Tim Bunce (dbi-users@perl.org)"
- ],
- "dynamic_config" : 1,
- "generated_by" : "ExtUtils::MakeMaker version 7.1002, CPAN::Meta::Converter version 2.150005",
- "license" : [
- "perl_5"
- ],
- "meta-spec" : {
- "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
- "version" : "2"
- },
- "name" : "DBI",
- "no_index" : {
- "directory" : [
- "t",
- "inc"
- ]
- },
- "prereqs" : {
- "build" : {
- "requires" : {
- "ExtUtils::MakeMaker" : "6.48",
- "Test::Simple" : "0.90"
- }
- },
- "configure" : {
- "requires" : {
- "ExtUtils::MakeMaker" : "0"
- }
- },
- "runtime" : {
- "conflicts" : {
- "DBD::Amazon" : "0.10",
- "DBD::AnyData" : "0.110",
- "DBD::CSV" : "0.36",
- "DBD::Google" : "0.51",
- "DBD::PO" : "2.10",
- "DBD::RAM" : "0.072",
- "SQL::Statement" : "1.33"
- },
- "requires" : {
- "perl" : "5.008"
- }
- }
- },
- "release_status" : "stable",
- "resources" : {
- "homepage" : "http://dbi.perl.org/",
- "license" : [
- "http://dev.perl.org/licenses/"
- ],
- "repository" : {
- "url" : "https://github.com/perl5-dbi/dbi"
- },
- "x_IRC" : "irc://irc.perl.org/#dbi",
- "x_MailingList" : "mailto:dbi-dev@perl.org"
- },
- "version" : "1.641",
- "x_serialization_backend" : "JSON::PP version 2.27300_01",
- "x_suggests" : {
- "Clone" : 0.34,
- "DB_File" : 0,
- "MLDBM" : 0,
- "Net::Daemon" : 0,
- "RPC::PlServer" : 0.2001,
- "SQL::Statement" : 1.402
- }
-}
+++ /dev/null
----
-abstract: 'Database independent interface for Perl'
-author:
- - 'Tim Bunce (dbi-users@perl.org)'
-build_requires:
- ExtUtils::MakeMaker: '6.48'
- Test::Simple: '0.90'
-configure_requires:
- ExtUtils::MakeMaker: '0'
-conflicts:
- DBD::Amazon: '0.10'
- DBD::AnyData: '0.110'
- DBD::CSV: '0.36'
- DBD::Google: '0.51'
- DBD::PO: '2.10'
- DBD::RAM: '0.072'
- SQL::Statement: '1.33'
-dynamic_config: 1
-generated_by: 'ExtUtils::MakeMaker version 7.1002, CPAN::Meta::Converter version 2.150005'
-license: perl
-meta-spec:
- url: http://module-build.sourceforge.net/META-spec-v1.4.html
- version: '1.4'
-name: DBI
-no_index:
- directory:
- - t
- - inc
-requires:
- perl: '5.008'
-resources:
- IRC: irc://irc.perl.org/#dbi
- MailingList: mailto:dbi-dev@perl.org
- homepage: http://dbi.perl.org/
- license: http://dev.perl.org/licenses/
- repository: https://github.com/perl5-dbi/dbi
-version: '1.641'
-x_serialization_backend: 'CPAN::Meta::YAML version 0.018'
-x_suggests:
- Clone: 0.34
- DB_File: 0
- MLDBM: 0
- Net::Daemon: 0
- RPC::PlServer: 0.2001
- SQL::Statement: 1.402
+++ /dev/null
-{
- "abstract" : "Database independent interface for Perl",
- "author" : [
- "Tim Bunce (dbi-users@perl.org)"
- ],
- "dynamic_config" : 0,
- "generated_by" : "ExtUtils::MakeMaker version 7.1002, CPAN::Meta::Converter version 2.150005, CPAN::Meta::Converter version 2.150001",
- "license" : [
- "perl_5"
- ],
- "meta-spec" : {
- "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
- "version" : "2"
- },
- "name" : "DBI",
- "no_index" : {
- "directory" : [
- "t",
- "inc"
- ]
- },
- "prereqs" : {
- "build" : {
- "requires" : {
- "ExtUtils::MakeMaker" : "6.48",
- "Test::Simple" : "0.90"
- }
- },
- "configure" : {
- "requires" : {
- "ExtUtils::MakeMaker" : "0"
- }
- },
- "runtime" : {
- "conflicts" : {
- "DBD::Amazon" : "0.10",
- "DBD::AnyData" : "0.110",
- "DBD::CSV" : "0.36",
- "DBD::Google" : "0.51",
- "DBD::PO" : "2.10",
- "DBD::RAM" : "0.072",
- "SQL::Statement" : "1.33"
- },
- "requires" : {
- "perl" : "5.008"
- }
- }
- },
- "release_status" : "stable",
- "resources" : {
- "homepage" : "http://dbi.perl.org/",
- "license" : [
- "http://dev.perl.org/licenses/"
- ],
- "repository" : {
- "url" : "https://github.com/perl5-dbi/dbi"
- },
- "x_IRC" : "irc://irc.perl.org/#dbi",
- "x_MailingList" : "mailto:dbi-dev@perl.org"
- },
- "version" : "1.641",
- "x_serialization_backend" : "JSON::PP version 2.27300_01",
- "x_suggests" : {
- "Clone" : 0.34,
- "DB_File" : 0,
- "MLDBM" : 0,
- "Net::Daemon" : 0,
- "RPC::PlServer" : 0.2001,
- "SQL::Statement" : 1.402
- }
-}
+++ /dev/null
----
-abstract: 'Database independent interface for Perl'
-author:
- - 'Tim Bunce (dbi-users@perl.org)'
-build_requires:
- ExtUtils::MakeMaker: '6.48'
- Test::Simple: '0.90'
-configure_requires:
- ExtUtils::MakeMaker: '0'
-conflicts:
- DBD::Amazon: '0.10'
- DBD::AnyData: '0.110'
- DBD::CSV: '0.36'
- DBD::Google: '0.51'
- DBD::PO: '2.10'
- DBD::RAM: '0.072'
- SQL::Statement: '1.33'
-dynamic_config: 0
-generated_by: 'ExtUtils::MakeMaker version 7.1002, CPAN::Meta::Converter version 2.150005, CPAN::Meta::Converter version 2.150001'
-license: perl
-meta-spec:
- url: http://module-build.sourceforge.net/META-spec-v1.4.html
- version: '1.4'
-name: DBI
-no_index:
- directory:
- - t
- - inc
-requires:
- perl: '5.008'
-resources:
- IRC: irc://irc.perl.org/#dbi
- MailingList: mailto:dbi-dev@perl.org
- homepage: http://dbi.perl.org/
- license: http://dev.perl.org/licenses/
- repository: https://github.com/perl5-dbi/dbi
-version: '1.641'
-x_serialization_backend: 'JSON::PP version 2.27300_01'
-x_suggests:
- Clone: 0.34
- DB_File: 0
- MLDBM: 0
- Net::Daemon: 0
- RPC::PlServer: 0.2001
- SQL::Statement: 1.402
+++ /dev/null
-# This Makefile is for the DBI extension to perl.
-#
-# It was generated automatically by MakeMaker version
-# 7.0401 (Revision: 70401) 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[DBI.pm]
-# AUTHOR => [q[Tim Bunce (dbi-users@perl.org)]]
-# BUILD_REQUIRES => { ExtUtils::MakeMaker=>q[6.48], Test::Simple=>q[0.90] }
-# CONFIGURE_REQUIRES => { }
-# DEFINE => q[ -W -Wall -Wpointer-arith -Wbad-function-cast -Wno-comment -Wno-sign-compare -Wno-cast-qual -Wmissing-noreturn -Wno-unused-parameter]
-# DIR => []
-# EXE_FILES => [q[dbiproxy], q[dbiprof], q[dbilogstrip]]
-# LICENSE => q[perl]
-# META_MERGE => { conflicts=>{ DBD::Amazon=>q[0.10], DBD::AnyData=>q[0.110], DBD::CSV=>q[0.36], DBD::Google=>q[0.51], DBD::PO=>q[2.10], DBD::RAM=>q[0.072], SQL::Statement=>q[1.33] }, resources=>{ IRC=>q[irc://irc.perl.org/#dbi], MailingList=>q[mailto:dbi-dev@perl.org], homepage=>q[http://dbi.perl.org/], license=>q[http://dev.perl.org/licenses/], repository=>q[https://github.com/perl5-dbi/dbi] }, suggests=>{ Clone=>q[0.34], DB_File=>q[0], MLDBM=>q[0], Net::Daemon=>q[0], RPC::PlServer=>q[0.2001], SQL::Statement=>q[1.402] } }
-# MIN_PERL_VERSION => q[5.008]
-# NAME => q[DBI]
-# PREREQ_PM => { ExtUtils::MakeMaker=>q[6.48], Test::Simple=>q[0.90] }
-# TEST_REQUIRES => { }
-# VERSION_FROM => q[DBI.pm]
-# clean => { FILES=>q[$(DISTVNAME) Perl.xsi t/zv*_*.t dbi__null_test_tmp* test_output_* dbiproxy dbiprof dbilogstrip dbiproxy.*log dbitrace.log dbi*.prof ndtest.prt] }
-# dist => { COMPRESS=>q[gzip -v9], DIST_DEFAULT=>q[clean distcheck disttest tardist], PREOP=>q[$(MAKE) -f Makefile.old distdir], SUFFIX=>q[gz] }
-# dynamic_lib => { OTHERLDFLAGS=>q[0] }
-
-# --- MakeMaker post_initialize section:
-
-
-# --- MakeMaker const_config section:
-
-# These definitions are from config.sh (via /usr/lib/x86_64-linux-gnu/perl/5.22/Config.pm).
-# They may have been overridden via Makefile.PL or on the command line.
-AR = ar
-CC = x86_64-linux-gnu-gcc
-CCCDLFLAGS = -fPIC
-CCDLFLAGS = -Wl,-E
-DLEXT = so
-DLSRC = dl_dlopen.xs
-EXE_EXT =
-FULL_AR = /usr/bin/ar
-LD = x86_64-linux-gnu-gcc
-LDDLFLAGS = -shared -L/usr/local/lib -fstack-protector-strong
-LDFLAGS = -fstack-protector-strong -L/usr/local/lib
-LIBC = libc-2.23.so
-LIB_EXT = .a
-OBJ_EXT = .o
-OSNAME = linux
-OSVERS = 3.16.0
-RANLIB = :
-SITELIBEXP = /usr/local/share/perl/5.22.1
-SITEARCHEXP = /usr/local/lib/x86_64-linux-gnu/perl/5.22.1
-SO = so
-VENDORARCHEXP = /usr/lib/x86_64-linux-gnu/perl5/5.22
-VENDORLIBEXP = /usr/share/perl5
-
-
-# --- MakeMaker constants section:
-AR_STATIC_ARGS = cr
-DIRFILESEP = /
-DFSEP = $(DIRFILESEP)
-NAME = DBI
-NAME_SYM = DBI
-VERSION = 1.641
-VERSION_MACRO = VERSION
-VERSION_SYM = 1_641
-DEFINE_VERSION = -D$(VERSION_MACRO)=\"$(VERSION)\"
-XS_VERSION = 1.641
-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 = 1p
-MAN3EXT = 3pm
-INSTALLDIRS = site
-DESTDIR =
-PREFIX = $(SITEPREFIX)
-PERLPREFIX = /usr
-SITEPREFIX = /usr/local
-VENDORPREFIX = /usr
-INSTALLPRIVLIB = /usr/share/perl/5.22
-DESTINSTALLPRIVLIB = $(DESTDIR)$(INSTALLPRIVLIB)
-INSTALLSITELIB = /usr/local/share/perl/5.22.1
-DESTINSTALLSITELIB = $(DESTDIR)$(INSTALLSITELIB)
-INSTALLVENDORLIB = /usr/share/perl5
-DESTINSTALLVENDORLIB = $(DESTDIR)$(INSTALLVENDORLIB)
-INSTALLARCHLIB = /usr/lib/x86_64-linux-gnu/perl/5.22
-DESTINSTALLARCHLIB = $(DESTDIR)$(INSTALLARCHLIB)
-INSTALLSITEARCH = /usr/local/lib/x86_64-linux-gnu/perl/5.22.1
-DESTINSTALLSITEARCH = $(DESTDIR)$(INSTALLSITEARCH)
-INSTALLVENDORARCH = /usr/lib/x86_64-linux-gnu/perl5/5.22
-DESTINSTALLVENDORARCH = $(DESTDIR)$(INSTALLVENDORARCH)
-INSTALLBIN = /usr/bin
-DESTINSTALLBIN = $(DESTDIR)$(INSTALLBIN)
-INSTALLSITEBIN = /usr/local/bin
-DESTINSTALLSITEBIN = $(DESTDIR)$(INSTALLSITEBIN)
-INSTALLVENDORBIN = /usr/bin
-DESTINSTALLVENDORBIN = $(DESTDIR)$(INSTALLVENDORBIN)
-INSTALLSCRIPT = /usr/bin
-DESTINSTALLSCRIPT = $(DESTDIR)$(INSTALLSCRIPT)
-INSTALLSITESCRIPT = /usr/local/bin
-DESTINSTALLSITESCRIPT = $(DESTDIR)$(INSTALLSITESCRIPT)
-INSTALLVENDORSCRIPT = /usr/bin
-DESTINSTALLVENDORSCRIPT = $(DESTDIR)$(INSTALLVENDORSCRIPT)
-INSTALLMAN1DIR = /usr/share/man/man1
-DESTINSTALLMAN1DIR = $(DESTDIR)$(INSTALLMAN1DIR)
-INSTALLSITEMAN1DIR = /usr/local/man/man1
-DESTINSTALLSITEMAN1DIR = $(DESTDIR)$(INSTALLSITEMAN1DIR)
-INSTALLVENDORMAN1DIR = /usr/share/man/man1
-DESTINSTALLVENDORMAN1DIR = $(DESTDIR)$(INSTALLVENDORMAN1DIR)
-INSTALLMAN3DIR = /usr/share/man/man3
-DESTINSTALLMAN3DIR = $(DESTDIR)$(INSTALLMAN3DIR)
-INSTALLSITEMAN3DIR = /usr/local/man/man3
-DESTINSTALLSITEMAN3DIR = $(DESTDIR)$(INSTALLSITEMAN3DIR)
-INSTALLVENDORMAN3DIR = /usr/share/man/man3
-DESTINSTALLVENDORMAN3DIR = $(DESTDIR)$(INSTALLVENDORMAN3DIR)
-PERL_LIB = /usr/share/perl/5.22
-PERL_ARCHLIB = /usr/lib/x86_64-linux-gnu/perl/5.22
-PERL_ARCHLIBDEP = /usr/lib/x86_64-linux-gnu/perl/5.22
-LIBPERL_A = libperl.a
-FIRST_MAKEFILE = Makefile
-MAKEFILE_OLD = Makefile.old
-MAKE_APERL_FILE = Makefile.aperl
-PERLMAINCC = $(CC)
-PERL_INC = /usr/lib/x86_64-linux-gnu/perl/5.22/CORE
-PERL_INCDEP = /usr/lib/x86_64-linux-gnu/perl/5.22/CORE
-PERL = "/usr/bin/perl"
-FULLPERL = "/usr/bin/perl"
-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_DIR = 755
-PERM_RW = 644
-PERM_RWX = 755
-
-MAKEMAKER = /usr/share/perl/5.22/ExtUtils/MakeMaker.pm
-MM_VERSION = 7.0401
-MM_REVISION = 70401
-
-# 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 = make
-FULLEXT = DBI
-BASEEXT = DBI
-PARENT_NAME =
-DLBASE = $(BASEEXT)
-VERSION_FROM = DBI.pm
-DEFINE = -W -Wall -Wpointer-arith -Wbad-function-cast -Wno-comment -Wno-sign-compare -Wno-cast-qual -Wmissing-noreturn -Wno-unused-parameter
-OBJECT = $(BASEEXT)$(OBJ_EXT)
-LDFROM = $(OBJECT)
-LINKTYPE = dynamic
-BOOTDEP =
-
-# Handy lists of source code files:
-XS_FILES = DBI.xs \
- Perl.xs
-C_FILES = DBI.c \
- Perl.c
-O_FILES = DBI.o \
- Perl.o
-H_FILES = DBIXS.h \
- Driver_xst.h \
- dbd_xsh.h \
- dbi_sql.h \
- dbipport.h \
- dbivport.h \
- dbixs_rev.h
-MAN1PODS = dbilogstrip \
- dbiprof \
- dbiproxy
-MAN3PODS = DBI.pm \
- lib/Bundle/DBI.pm \
- lib/DBD/DBM.pm \
- lib/DBD/File.pm \
- lib/DBD/File/Developers.pod \
- lib/DBD/File/HowTo.pod \
- lib/DBD/File/Roadmap.pod \
- lib/DBD/Gofer.pm \
- lib/DBD/Gofer/Policy/Base.pm \
- lib/DBD/Gofer/Policy/classic.pm \
- lib/DBD/Gofer/Policy/pedantic.pm \
- lib/DBD/Gofer/Policy/rush.pm \
- lib/DBD/Gofer/Transport/Base.pm \
- lib/DBD/Gofer/Transport/corostream.pm \
- lib/DBD/Gofer/Transport/null.pm \
- lib/DBD/Gofer/Transport/pipeone.pm \
- lib/DBD/Gofer/Transport/stream.pm \
- lib/DBD/Mem.pm \
- lib/DBD/Proxy.pm \
- lib/DBD/Sponge.pm \
- lib/DBI/Const/GetInfo/ANSI.pm \
- lib/DBI/Const/GetInfo/ODBC.pm \
- lib/DBI/Const/GetInfoReturn.pm \
- lib/DBI/Const/GetInfoType.pm \
- lib/DBI/DBD.pm \
- lib/DBI/DBD/Metadata.pm \
- lib/DBI/DBD/SqlEngine.pm \
- lib/DBI/DBD/SqlEngine/Developers.pod \
- lib/DBI/DBD/SqlEngine/HowTo.pod \
- lib/DBI/Gofer/Execute.pm \
- lib/DBI/Gofer/Request.pm \
- lib/DBI/Gofer/Response.pm \
- lib/DBI/Gofer/Serializer/Base.pm \
- lib/DBI/Gofer/Serializer/DataDumper.pm \
- lib/DBI/Gofer/Serializer/Storable.pm \
- lib/DBI/Gofer/Transport/Base.pm \
- lib/DBI/Gofer/Transport/pipeone.pm \
- lib/DBI/Gofer/Transport/stream.pm \
- lib/DBI/Profile.pm \
- lib/DBI/ProfileData.pm \
- lib/DBI/ProfileDumper.pm \
- lib/DBI/ProfileDumper/Apache.pm \
- lib/DBI/ProfileSubs.pm \
- lib/DBI/ProxyServer.pm \
- lib/DBI/PurePerl.pm \
- lib/DBI/SQL/Nano.pm \
- lib/DBI/Util/CacheMemory.pm \
- lib/DBI/W32ODBC.pm \
- lib/Win32/DBIODBC.pm
-
-# Where is the Config information that we are using/depend on
-CONFIGDEP = $(PERL_ARCHLIBDEP)$(DFSEP)Config.pm $(PERL_INCDEP)$(DFSEP)config.h
-
-# Where to build things
-INST_LIBDIR = $(INST_LIB)
-INST_ARCHLIBDIR = $(INST_ARCHLIB)
-
-INST_AUTODIR = $(INST_LIB)/auto/$(FULLEXT)
-INST_ARCHAUTODIR = $(INST_ARCHLIB)/auto/$(FULLEXT)
-
-INST_STATIC = $(INST_ARCHAUTODIR)/$(BASEEXT)$(LIB_EXT)
-INST_DYNAMIC = $(INST_ARCHAUTODIR)/$(DLBASE).$(DLEXT)
-INST_BOOT = $(INST_ARCHAUTODIR)/$(BASEEXT).bs
-
-# Extra linker info
-EXPORT_LIST =
-PERL_ARCHIVE =
-PERL_ARCHIVEDEP =
-PERL_ARCHIVE_AFTER =
-
-
-TO_INST_PM = DBI.pm \
- DBIXS.h \
- Driver.xst \
- Driver_xst.h \
- dbd_xsh.h \
- dbi_sql.h \
- dbipport.h \
- dbivport.h \
- dbixs_rev.h \
- dbixs_rev.pl \
- lib/Bundle/DBI.pm \
- lib/DBD/DBM.pm \
- lib/DBD/ExampleP.pm \
- lib/DBD/File.pm \
- lib/DBD/File/Developers.pod \
- lib/DBD/File/HowTo.pod \
- lib/DBD/File/Roadmap.pod \
- lib/DBD/Gofer.pm \
- lib/DBD/Gofer/Policy/Base.pm \
- lib/DBD/Gofer/Policy/classic.pm \
- lib/DBD/Gofer/Policy/pedantic.pm \
- lib/DBD/Gofer/Policy/rush.pm \
- lib/DBD/Gofer/Transport/Base.pm \
- lib/DBD/Gofer/Transport/corostream.pm \
- lib/DBD/Gofer/Transport/null.pm \
- lib/DBD/Gofer/Transport/pipeone.pm \
- lib/DBD/Gofer/Transport/stream.pm \
- lib/DBD/Mem.pm \
- lib/DBD/NullP.pm \
- lib/DBD/Proxy.pm \
- lib/DBD/Sponge.pm \
- lib/DBI/Const/GetInfo/ANSI.pm \
- lib/DBI/Const/GetInfo/ODBC.pm \
- lib/DBI/Const/GetInfoReturn.pm \
- lib/DBI/Const/GetInfoType.pm \
- lib/DBI/DBD.pm \
- lib/DBI/DBD/Metadata.pm \
- lib/DBI/DBD/SqlEngine.pm \
- lib/DBI/DBD/SqlEngine/Developers.pod \
- lib/DBI/DBD/SqlEngine/HowTo.pod \
- lib/DBI/Gofer/Execute.pm \
- lib/DBI/Gofer/Request.pm \
- lib/DBI/Gofer/Response.pm \
- lib/DBI/Gofer/Serializer/Base.pm \
- lib/DBI/Gofer/Serializer/DataDumper.pm \
- lib/DBI/Gofer/Serializer/Storable.pm \
- lib/DBI/Gofer/Transport/Base.pm \
- lib/DBI/Gofer/Transport/pipeone.pm \
- lib/DBI/Gofer/Transport/stream.pm \
- lib/DBI/Profile.pm \
- lib/DBI/ProfileData.pm \
- lib/DBI/ProfileDumper.pm \
- lib/DBI/ProfileDumper/Apache.pm \
- lib/DBI/ProfileSubs.pm \
- lib/DBI/ProxyServer.pm \
- lib/DBI/PurePerl.pm \
- lib/DBI/SQL/Nano.pm \
- lib/DBI/Util/CacheMemory.pm \
- lib/DBI/Util/_accessor.pm \
- lib/DBI/W32ODBC.pm \
- lib/Win32/DBIODBC.pm
-
-PM_TO_BLIB = DBI.pm \
- $(INST_LIB)/DBI.pm \
- DBIXS.h \
- $(INST_ARCHLIB)/auto/$(FULLEXT)/DBIXS.h \
- Driver.xst \
- $(INST_ARCHLIB)/auto/$(FULLEXT)/Driver.xst \
- Driver_xst.h \
- $(INST_ARCHLIB)/auto/$(FULLEXT)/Driver_xst.h \
- dbd_xsh.h \
- $(INST_ARCHLIB)/auto/$(FULLEXT)/dbd_xsh.h \
- dbi_sql.h \
- $(INST_ARCHLIB)/auto/$(FULLEXT)/dbi_sql.h \
- dbipport.h \
- $(INST_ARCHLIB)/auto/$(FULLEXT)/dbipport.h \
- dbivport.h \
- $(INST_ARCHLIB)/auto/$(FULLEXT)/dbivport.h \
- dbixs_rev.h \
- $(INST_ARCHLIB)/auto/$(FULLEXT)/dbixs_rev.h \
- dbixs_rev.pl \
- $(INST_LIB)/dbixs_rev.pl \
- lib/Bundle/DBI.pm \
- blib/lib/Bundle/DBI.pm \
- lib/DBD/DBM.pm \
- blib/lib/DBD/DBM.pm \
- lib/DBD/ExampleP.pm \
- blib/lib/DBD/ExampleP.pm \
- lib/DBD/File.pm \
- blib/lib/DBD/File.pm \
- lib/DBD/File/Developers.pod \
- blib/lib/DBD/File/Developers.pod \
- lib/DBD/File/HowTo.pod \
- blib/lib/DBD/File/HowTo.pod \
- lib/DBD/File/Roadmap.pod \
- blib/lib/DBD/File/Roadmap.pod \
- lib/DBD/Gofer.pm \
- blib/lib/DBD/Gofer.pm \
- lib/DBD/Gofer/Policy/Base.pm \
- blib/lib/DBD/Gofer/Policy/Base.pm \
- lib/DBD/Gofer/Policy/classic.pm \
- blib/lib/DBD/Gofer/Policy/classic.pm \
- lib/DBD/Gofer/Policy/pedantic.pm \
- blib/lib/DBD/Gofer/Policy/pedantic.pm \
- lib/DBD/Gofer/Policy/rush.pm \
- blib/lib/DBD/Gofer/Policy/rush.pm \
- lib/DBD/Gofer/Transport/Base.pm \
- blib/lib/DBD/Gofer/Transport/Base.pm \
- lib/DBD/Gofer/Transport/corostream.pm \
- blib/lib/DBD/Gofer/Transport/corostream.pm \
- lib/DBD/Gofer/Transport/null.pm \
- blib/lib/DBD/Gofer/Transport/null.pm \
- lib/DBD/Gofer/Transport/pipeone.pm \
- blib/lib/DBD/Gofer/Transport/pipeone.pm \
- lib/DBD/Gofer/Transport/stream.pm \
- blib/lib/DBD/Gofer/Transport/stream.pm \
- lib/DBD/Mem.pm \
- blib/lib/DBD/Mem.pm \
- lib/DBD/NullP.pm \
- blib/lib/DBD/NullP.pm \
- lib/DBD/Proxy.pm \
- blib/lib/DBD/Proxy.pm \
- lib/DBD/Sponge.pm \
- blib/lib/DBD/Sponge.pm \
- lib/DBI/Const/GetInfo/ANSI.pm \
- blib/lib/DBI/Const/GetInfo/ANSI.pm \
- lib/DBI/Const/GetInfo/ODBC.pm \
- blib/lib/DBI/Const/GetInfo/ODBC.pm \
- lib/DBI/Const/GetInfoReturn.pm \
- blib/lib/DBI/Const/GetInfoReturn.pm \
- lib/DBI/Const/GetInfoType.pm \
- blib/lib/DBI/Const/GetInfoType.pm \
- lib/DBI/DBD.pm \
- blib/lib/DBI/DBD.pm \
- lib/DBI/DBD/Metadata.pm \
- blib/lib/DBI/DBD/Metadata.pm \
- lib/DBI/DBD/SqlEngine.pm \
- blib/lib/DBI/DBD/SqlEngine.pm \
- lib/DBI/DBD/SqlEngine/Developers.pod \
- blib/lib/DBI/DBD/SqlEngine/Developers.pod \
- lib/DBI/DBD/SqlEngine/HowTo.pod \
- blib/lib/DBI/DBD/SqlEngine/HowTo.pod \
- lib/DBI/Gofer/Execute.pm \
- blib/lib/DBI/Gofer/Execute.pm \
- lib/DBI/Gofer/Request.pm \
- blib/lib/DBI/Gofer/Request.pm \
- lib/DBI/Gofer/Response.pm \
- blib/lib/DBI/Gofer/Response.pm \
- lib/DBI/Gofer/Serializer/Base.pm \
- blib/lib/DBI/Gofer/Serializer/Base.pm \
- lib/DBI/Gofer/Serializer/DataDumper.pm \
- blib/lib/DBI/Gofer/Serializer/DataDumper.pm \
- lib/DBI/Gofer/Serializer/Storable.pm \
- blib/lib/DBI/Gofer/Serializer/Storable.pm \
- lib/DBI/Gofer/Transport/Base.pm \
- blib/lib/DBI/Gofer/Transport/Base.pm \
- lib/DBI/Gofer/Transport/pipeone.pm \
- blib/lib/DBI/Gofer/Transport/pipeone.pm \
- lib/DBI/Gofer/Transport/stream.pm \
- blib/lib/DBI/Gofer/Transport/stream.pm \
- lib/DBI/Profile.pm \
- blib/lib/DBI/Profile.pm \
- lib/DBI/ProfileData.pm \
- blib/lib/DBI/ProfileData.pm \
- lib/DBI/ProfileDumper.pm \
- blib/lib/DBI/ProfileDumper.pm \
- lib/DBI/ProfileDumper/Apache.pm \
- blib/lib/DBI/ProfileDumper/Apache.pm \
- lib/DBI/ProfileSubs.pm \
- blib/lib/DBI/ProfileSubs.pm \
- lib/DBI/ProxyServer.pm \
- blib/lib/DBI/ProxyServer.pm \
- lib/DBI/PurePerl.pm \
- blib/lib/DBI/PurePerl.pm \
- lib/DBI/SQL/Nano.pm \
- blib/lib/DBI/SQL/Nano.pm \
- lib/DBI/Util/CacheMemory.pm \
- blib/lib/DBI/Util/CacheMemory.pm \
- lib/DBI/Util/_accessor.pm \
- blib/lib/DBI/Util/_accessor.pm \
- lib/DBI/W32ODBC.pm \
- blib/lib/DBI/W32ODBC.pm \
- lib/Win32/DBIODBC.pm \
- blib/lib/Win32/DBIODBC.pm
-
-
-# --- MakeMaker platform_constants section:
-MM_Unix_VERSION = 7.0401
-PERL_MALLOC_DEF = -DPERL_EXTMALLOC_DEF -Dmalloc=Perl_malloc -Dfree=Perl_mfree -Drealloc=Perl_realloc -Dcalloc=Perl_calloc
-
-
-# --- 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:
-
-XSUBPPDIR = /usr/share/perl/5.22/ExtUtils
-XSUBPP = "$(XSUBPPDIR)$(DFSEP)xsubpp"
-XSUBPPRUN = $(PERLRUN) $(XSUBPP)
-XSPROTOARG =
-XSUBPPDEPS = /usr/share/perl/5.22/ExtUtils/typemap typemap /usr/share/perl/5.22/ExtUtils$(DFSEP)xsubpp
-XSUBPPARGS = -typemap "/usr/share/perl/5.22/ExtUtils/typemap" -typemap "typemap"
-XSUBPP_EXTRA_ARGS =
-
-
-# --- MakeMaker tools_other section:
-SHELL = /bin/sh
-CHMOD = chmod
-CP = cp
-MV = mv
-NOOP = $(TRUE)
-NOECHO = @
-RM_F = rm -f
-RM_RF = rm -rf
-TEST_F = test -f
-TOUCH = touch
-UMASK_NULL = umask 0
-DEV_NULL = > /dev/null 2>&1
-MKPATH = $(ABSPERLRUN) -MExtUtils::Command -e 'mkpath' --
-EQUALIZE_TIMESTAMP = $(ABSPERLRUN) -MExtUtils::Command -e 'eqtime' --
-FALSE = false
-TRUE = true
-ECHO = echo
-ECHO_N = echo -n
-UNINST = 0
-VERBINST = 0
-MOD_INSTALL = $(ABSPERLRUN) -MExtUtils::Install -e 'install([ from_to => {@ARGV}, verbose => '\''$(VERBINST)'\'', uninstall_shadows => '\''$(UNINST)'\'', dir_mode => '\''$(PERM_DIR)'\'' ]);' --
-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 = $(ABSPERLRUN) -MExtUtils::MY -e 'MY->fixin(shift)' --
-CP_NONEMPTY = $(ABSPERLRUN) -MExtUtils::Command::MM -e 'cp_nonempty' --
-
-
-# --- MakeMaker makemakerdflt section:
-makemakerdflt : all
- $(NOECHO) $(NOOP)
-
-
-# --- MakeMaker dist section:
-TAR = tar
-TARFLAGS = cvf
-ZIP = zip
-ZIPFLAGS = -r
-COMPRESS = gzip -v9
-SUFFIX = .gz
-SHAR = shar
-PREOP = $(MAKE) -f Makefile.old distdir
-POSTOP = $(NOECHO) $(NOOP)
-TO_UNIX = $(NOECHO) $(NOOP)
-CI = ci -u
-RCS_LABEL = rcs -Nv$(VERSION_SYM): -q
-DIST_CP = best
-DIST_DEFAULT = clean distcheck disttest tardist
-DISTNAME = DBI
-DISTVNAME = DBI-1.641
-
-
-# --- MakeMaker macro section:
-
-
-# --- MakeMaker depend section:
-
-
-# --- MakeMaker cflags section:
-
-CCFLAGS = -D_REENTRANT -D_GNU_SOURCE -DDEBIAN -fwrapv -fno-strict-aliasing -pipe -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64
-OPTIMIZE = -O2 -g
-PERLTYPE =
-MPOLLUTE =
-
-
-# --- MakeMaker const_loadlibs section:
-
-# DBI might depend on some other libraries:
-# See ExtUtils::Liblist for details
-#
-
-
-# --- MakeMaker const_cccmd section:
-CCCMD = $(CC) -c $(PASTHRU_INC) $(INC) \
- $(CCFLAGS) $(OPTIMIZE) \
- $(PERLTYPE) $(MPOLLUTE) $(DEFINE_VERSION) \
- $(XS_DEFINE_VERSION)
-
-# --- MakeMaker post_constants section:
-
-# --- This section was generated by DBI::DBD::dbd_postamble()
-DBI_INSTARCH_DIR=.
-DBI_DRIVER_XST=./Driver.xst
-
-# The main dependency (technically correct but probably not used)
-Perl.c: Perl.xsi
-
-# This dependency is needed since MakeMaker uses the .xs.o rule
-Perl$(OBJ_EXT): Perl.xsi
-
-Perl.xsi: $(DBI_DRIVER_XST) ./Driver_xst.h
- $(PERL) -p -e "s/~DRIVER~/Perl/g" $(DBI_DRIVER_XST) > Perl.xsi
-
-# ---
-
-dbixs_rev.h: DBIXS.h Driver_xst.h dbipport.h dbivport.h dbixs_rev.pl
- $(PERL) dbixs_rev.pl
-
-DBI.c: Perl$(OBJ_EXT)
-
-# make Changes file available as installed pod docs "perldoc DBI::Changes"
-inst_libdbi = blib/lib/DBI
-changes_pm = blib/lib/DBI/Changes.pm
-
-
-config :: $(changes_pm)
- $(NOECHO) $(NOOP)
-
-$(changes_pm): Changes
- $(MKPATH) $(inst_libdbi)
- $(RM_F) $(changes_pm)
- $(CP) Changes $(changes_pm)
-
-ptest: all
- prove --blib --jobs 8 --shuffle
-
-faq:
- : checkin any local changes not already checked in before overwriting
- svn commit --message "dbi.tiddlyspot.com FAQ update" dbi.tiddlyspot.com.html
- wget --ignore-length --output-document=dbi.tiddlyspot.com.html --timestamping http://dbi.tiddlyspot.com/download
- svn commit --message "dbi.tiddlyspot.com FAQ update" dbi.tiddlyspot.com.html
-
-checkkeywords:
- $(RM_RF) blib
- find . -type f \( -name .svn -prune -o -name \*.pm -o -name \*.PL -o -name \*.pl \) \
- -exec bash -c '[ -z "$$(svn pg svn:keywords {})" ] && echo svn propset svn:keywords \"Id Revision\" {}' \;
-
-checkpod:
- $(RM_RF) blib
- find . -type f \( -name .svn -prune -o -name \*.pm -o -name \*.PL -o -name \*.pl \) \
- -exec podchecker {} \; 2>&1 | grep -v 'pod syntax OK'
-
-
-# --- MakeMaker pasthru section:
-
-PASTHRU = LIBPERL_A="$(LIBPERL_A)"\
- LINKTYPE="$(LINKTYPE)"\
- OPTIMIZE="$(OPTIMIZE)"\
- LD="$(LD)"\
- PREFIX="$(PREFIX)"\
- PASTHRU_DEFINE="$(PASTHRU_DEFINE)"
-
-
-# --- 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:
-
-.c.i:
- x86_64-linux-gnu-gcc -E -c $(PASTHRU_INC) $(INC) \
- $(CCFLAGS) $(OPTIMIZE) \
- $(PERLTYPE) $(MPOLLUTE) $(DEFINE_VERSION) \
- $(XS_DEFINE_VERSION) $(CCCDLFLAGS) "-I$(PERL_INC)" $(PASTHRU_DEFINE) $(DEFINE) $*.c > $*.i
-
-.c.s:
- $(CCCMD) -S $(CCCDLFLAGS) "-I$(PERL_INC)" $(PASTHRU_DEFINE) $(DEFINE) $*.c
-
-.c$(OBJ_EXT):
- $(CCCMD) $(CCCDLFLAGS) "-I$(PERL_INC)" $(PASTHRU_DEFINE) $(DEFINE) $*.c
-
-.cpp$(OBJ_EXT):
- $(CCCMD) $(CCCDLFLAGS) "-I$(PERL_INC)" $(PASTHRU_DEFINE) $(DEFINE) $*.cpp
-
-.cxx$(OBJ_EXT):
- $(CCCMD) $(CCCDLFLAGS) "-I$(PERL_INC)" $(PASTHRU_DEFINE) $(DEFINE) $*.cxx
-
-.cc$(OBJ_EXT):
- $(CCCMD) $(CCCDLFLAGS) "-I$(PERL_INC)" $(PASTHRU_DEFINE) $(DEFINE) $*.cc
-
-.C$(OBJ_EXT):
- $(CCCMD) $(CCCDLFLAGS) "-I$(PERL_INC)" $(PASTHRU_DEFINE) $(DEFINE) $*.C
-
-
-# --- MakeMaker xs_c section:
-
-.xs.c:
- $(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $(XSUBPP_EXTRA_ARGS) $*.xs > $*.xsc && $(MV) $*.xsc $*.c
-
-
-# --- MakeMaker xs_o section:
-
-.xs$(OBJ_EXT):
- $(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $*.xs > $*.xsc && $(MV) $*.xsc $*.c
- $(CCCMD) $(CCCDLFLAGS) "-I$(PERL_INC)" $(PASTHRU_DEFINE) $(DEFINE) $*.c
-
-
-# --- MakeMaker top_targets section:
-all :: pure_all manifypods
- $(NOECHO) $(NOOP)
-
-
-pure_all :: config pm_to_blib subdirs linkext
- $(NOECHO) $(NOOP)
-
-subdirs :: $(MYEXTLIB)
- $(NOECHO) $(NOOP)
-
-config :: $(FIRST_MAKEFILE) blibdirs
- $(NOECHO) $(NOOP)
-
-$(O_FILES): $(H_FILES)
-
-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) $(PERM_DIR) $(INST_LIBDIR)
- $(NOECHO) $(TOUCH) $(INST_LIBDIR)$(DFSEP).exists
-
-$(INST_ARCHLIB)$(DFSEP).exists :: Makefile.PL
- $(NOECHO) $(MKPATH) $(INST_ARCHLIB)
- $(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_ARCHLIB)
- $(NOECHO) $(TOUCH) $(INST_ARCHLIB)$(DFSEP).exists
-
-$(INST_AUTODIR)$(DFSEP).exists :: Makefile.PL
- $(NOECHO) $(MKPATH) $(INST_AUTODIR)
- $(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_AUTODIR)
- $(NOECHO) $(TOUCH) $(INST_AUTODIR)$(DFSEP).exists
-
-$(INST_ARCHAUTODIR)$(DFSEP).exists :: Makefile.PL
- $(NOECHO) $(MKPATH) $(INST_ARCHAUTODIR)
- $(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_ARCHAUTODIR)
- $(NOECHO) $(TOUCH) $(INST_ARCHAUTODIR)$(DFSEP).exists
-
-$(INST_BIN)$(DFSEP).exists :: Makefile.PL
- $(NOECHO) $(MKPATH) $(INST_BIN)
- $(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_BIN)
- $(NOECHO) $(TOUCH) $(INST_BIN)$(DFSEP).exists
-
-$(INST_SCRIPT)$(DFSEP).exists :: Makefile.PL
- $(NOECHO) $(MKPATH) $(INST_SCRIPT)
- $(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_SCRIPT)
- $(NOECHO) $(TOUCH) $(INST_SCRIPT)$(DFSEP).exists
-
-$(INST_MAN1DIR)$(DFSEP).exists :: Makefile.PL
- $(NOECHO) $(MKPATH) $(INST_MAN1DIR)
- $(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_MAN1DIR)
- $(NOECHO) $(TOUCH) $(INST_MAN1DIR)$(DFSEP).exists
-
-$(INST_MAN3DIR)$(DFSEP).exists :: Makefile.PL
- $(NOECHO) $(MKPATH) $(INST_MAN3DIR)
- $(NOECHO) $(CHMOD) $(PERM_DIR) $(INST_MAN3DIR)
- $(NOECHO) $(TOUCH) $(INST_MAN3DIR)$(DFSEP).exists
-
-
-
-# --- MakeMaker linkext section:
-
-linkext :: $(LINKTYPE)
- $(NOECHO) $(NOOP)
-
-
-# --- MakeMaker dlsyms section:
-
-
-# --- MakeMaker dynamic_bs section:
-BOOTSTRAP = $(BASEEXT).bs
-
-# As Mkbootstrap might not write a file (if none is required)
-# we use touch to prevent make continually trying to remake it.
-# The DynaLoader only reads a non-empty file.
-$(BOOTSTRAP) : $(FIRST_MAKEFILE) $(BOOTDEP) $(INST_ARCHAUTODIR)$(DFSEP).exists
- $(NOECHO) $(ECHO) "Running Mkbootstrap for $(NAME) ($(BSLOADLIBS))"
- $(NOECHO) $(PERLRUN) \
- "-MExtUtils::Mkbootstrap" \
- -e "Mkbootstrap('$(BASEEXT)','$(BSLOADLIBS)');"
- $(NOECHO) $(TOUCH) "$@"
- $(CHMOD) $(PERM_RW) "$@"
-
-
-# --- MakeMaker dynamic section:
-
-dynamic :: $(FIRST_MAKEFILE) $(BOOTSTRAP) $(INST_DYNAMIC)
- $(NOECHO) $(NOOP)
-
-
-# --- MakeMaker dynamic_lib section:
-
-# This section creates the dynamically loadable $(INST_DYNAMIC)
-# from $(OBJECT) and possibly $(MYEXTLIB).
-ARMAYBE = :
-OTHERLDFLAGS =
-INST_DYNAMIC_DEP =
-INST_DYNAMIC_FIX =
-
-$(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(INST_ARCHAUTODIR)$(DFSEP).exists $(EXPORT_LIST) $(PERL_ARCHIVEDEP) $(PERL_ARCHIVE_AFTER) $(INST_DYNAMIC_DEP)
- $(RM_F) $@
- $(LD) $(LDDLFLAGS) $(LDFROM) $(OTHERLDFLAGS) -o $@ $(MYEXTLIB) \
- $(PERL_ARCHIVE) $(LDLOADLIBS) $(PERL_ARCHIVE_AFTER) $(EXPORT_LIST) \
- $(INST_DYNAMIC_FIX)
- $(CHMOD) $(PERM_RWX) $@
- $(NOECHO) $(RM_RF) $(BOOTSTRAP)
- - $(CP_NONEMPTY) $(BOOTSTRAP) $(INST_BOOT) $(PERM_RW)
-
-
-# --- 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:
-
-$(INST_STATIC) : $(OBJECT) $(MYEXTLIB) $(INST_ARCHAUTODIR)$(DFSEP).exists
- $(RM_RF) $@
- $(FULL_AR) $(AR_STATIC_ARGS) $@ $(OBJECT) && $(RANLIB) $@
- $(CHMOD) $(PERM_RWX) $@
- $(NOECHO) $(ECHO) "$(EXTRALIBS)" > "$(INST_ARCHAUTODIR)/extralibs.ld"
-
-
-# --- MakeMaker manifypods section:
-
-POD2MAN_EXE = $(PERLRUN) "-MExtUtils::Command::MM" -e pod2man "--"
-POD2MAN = $(POD2MAN_EXE)
-
-
-manifypods : pure_all \
- DBI.pm \
- dbilogstrip \
- dbiprof \
- dbiproxy \
- lib/Bundle/DBI.pm \
- lib/DBD/DBM.pm \
- lib/DBD/File.pm \
- lib/DBD/File/Developers.pod \
- lib/DBD/File/HowTo.pod \
- lib/DBD/File/Roadmap.pod \
- lib/DBD/Gofer.pm \
- lib/DBD/Gofer/Policy/Base.pm \
- lib/DBD/Gofer/Policy/classic.pm \
- lib/DBD/Gofer/Policy/pedantic.pm \
- lib/DBD/Gofer/Policy/rush.pm \
- lib/DBD/Gofer/Transport/Base.pm \
- lib/DBD/Gofer/Transport/corostream.pm \
- lib/DBD/Gofer/Transport/null.pm \
- lib/DBD/Gofer/Transport/pipeone.pm \
- lib/DBD/Gofer/Transport/stream.pm \
- lib/DBD/Mem.pm \
- lib/DBD/Proxy.pm \
- lib/DBD/Sponge.pm \
- lib/DBI/Const/GetInfo/ANSI.pm \
- lib/DBI/Const/GetInfo/ODBC.pm \
- lib/DBI/Const/GetInfoReturn.pm \
- lib/DBI/Const/GetInfoType.pm \
- lib/DBI/DBD.pm \
- lib/DBI/DBD/Metadata.pm \
- lib/DBI/DBD/SqlEngine.pm \
- lib/DBI/DBD/SqlEngine/Developers.pod \
- lib/DBI/DBD/SqlEngine/HowTo.pod \
- lib/DBI/Gofer/Execute.pm \
- lib/DBI/Gofer/Request.pm \
- lib/DBI/Gofer/Response.pm \
- lib/DBI/Gofer/Serializer/Base.pm \
- lib/DBI/Gofer/Serializer/DataDumper.pm \
- lib/DBI/Gofer/Serializer/Storable.pm \
- lib/DBI/Gofer/Transport/Base.pm \
- lib/DBI/Gofer/Transport/pipeone.pm \
- lib/DBI/Gofer/Transport/stream.pm \
- lib/DBI/Profile.pm \
- lib/DBI/ProfileData.pm \
- lib/DBI/ProfileDumper.pm \
- lib/DBI/ProfileDumper/Apache.pm \
- lib/DBI/ProfileSubs.pm \
- lib/DBI/ProxyServer.pm \
- lib/DBI/PurePerl.pm \
- lib/DBI/SQL/Nano.pm \
- lib/DBI/Util/CacheMemory.pm \
- lib/DBI/W32ODBC.pm \
- lib/Win32/DBIODBC.pm
- $(NOECHO) $(POD2MAN) --section=$(MAN1EXT) --perm_rw=$(PERM_RW) -u \
- dbilogstrip $(INST_MAN1DIR)/dbilogstrip.$(MAN1EXT) \
- dbiprof $(INST_MAN1DIR)/dbiprof.$(MAN1EXT) \
- dbiproxy $(INST_MAN1DIR)/dbiproxy.$(MAN1EXT)
- $(NOECHO) $(POD2MAN) --section=$(MAN3EXT) --perm_rw=$(PERM_RW) -u \
- DBI.pm $(INST_MAN3DIR)/DBI.$(MAN3EXT) \
- lib/Bundle/DBI.pm $(INST_MAN3DIR)/Bundle::DBI.$(MAN3EXT) \
- lib/DBD/DBM.pm $(INST_MAN3DIR)/DBD::DBM.$(MAN3EXT) \
- lib/DBD/File.pm $(INST_MAN3DIR)/DBD::File.$(MAN3EXT) \
- lib/DBD/File/Developers.pod $(INST_MAN3DIR)/DBD::File::Developers.$(MAN3EXT) \
- lib/DBD/File/HowTo.pod $(INST_MAN3DIR)/DBD::File::HowTo.$(MAN3EXT) \
- lib/DBD/File/Roadmap.pod $(INST_MAN3DIR)/DBD::File::Roadmap.$(MAN3EXT) \
- lib/DBD/Gofer.pm $(INST_MAN3DIR)/DBD::Gofer.$(MAN3EXT) \
- lib/DBD/Gofer/Policy/Base.pm $(INST_MAN3DIR)/DBD::Gofer::Policy::Base.$(MAN3EXT) \
- lib/DBD/Gofer/Policy/classic.pm $(INST_MAN3DIR)/DBD::Gofer::Policy::classic.$(MAN3EXT) \
- lib/DBD/Gofer/Policy/pedantic.pm $(INST_MAN3DIR)/DBD::Gofer::Policy::pedantic.$(MAN3EXT) \
- lib/DBD/Gofer/Policy/rush.pm $(INST_MAN3DIR)/DBD::Gofer::Policy::rush.$(MAN3EXT) \
- lib/DBD/Gofer/Transport/Base.pm $(INST_MAN3DIR)/DBD::Gofer::Transport::Base.$(MAN3EXT) \
- lib/DBD/Gofer/Transport/corostream.pm $(INST_MAN3DIR)/DBD::Gofer::Transport::corostream.$(MAN3EXT) \
- lib/DBD/Gofer/Transport/null.pm $(INST_MAN3DIR)/DBD::Gofer::Transport::null.$(MAN3EXT) \
- lib/DBD/Gofer/Transport/pipeone.pm $(INST_MAN3DIR)/DBD::Gofer::Transport::pipeone.$(MAN3EXT) \
- lib/DBD/Gofer/Transport/stream.pm $(INST_MAN3DIR)/DBD::Gofer::Transport::stream.$(MAN3EXT) \
- lib/DBD/Mem.pm $(INST_MAN3DIR)/DBD::Mem.$(MAN3EXT) \
- lib/DBD/Proxy.pm $(INST_MAN3DIR)/DBD::Proxy.$(MAN3EXT) \
- lib/DBD/Sponge.pm $(INST_MAN3DIR)/DBD::Sponge.$(MAN3EXT) \
- lib/DBI/Const/GetInfo/ANSI.pm $(INST_MAN3DIR)/DBI::Const::GetInfo::ANSI.$(MAN3EXT) \
- lib/DBI/Const/GetInfo/ODBC.pm $(INST_MAN3DIR)/DBI::Const::GetInfo::ODBC.$(MAN3EXT) \
- lib/DBI/Const/GetInfoReturn.pm $(INST_MAN3DIR)/DBI::Const::GetInfoReturn.$(MAN3EXT) \
- lib/DBI/Const/GetInfoType.pm $(INST_MAN3DIR)/DBI::Const::GetInfoType.$(MAN3EXT) \
- lib/DBI/DBD.pm $(INST_MAN3DIR)/DBI::DBD.$(MAN3EXT) \
- lib/DBI/DBD/Metadata.pm $(INST_MAN3DIR)/DBI::DBD::Metadata.$(MAN3EXT) \
- lib/DBI/DBD/SqlEngine.pm $(INST_MAN3DIR)/DBI::DBD::SqlEngine.$(MAN3EXT) \
- lib/DBI/DBD/SqlEngine/Developers.pod $(INST_MAN3DIR)/DBI::DBD::SqlEngine::Developers.$(MAN3EXT) \
- lib/DBI/DBD/SqlEngine/HowTo.pod $(INST_MAN3DIR)/DBI::DBD::SqlEngine::HowTo.$(MAN3EXT) \
- lib/DBI/Gofer/Execute.pm $(INST_MAN3DIR)/DBI::Gofer::Execute.$(MAN3EXT) \
- lib/DBI/Gofer/Request.pm $(INST_MAN3DIR)/DBI::Gofer::Request.$(MAN3EXT) \
- lib/DBI/Gofer/Response.pm $(INST_MAN3DIR)/DBI::Gofer::Response.$(MAN3EXT) \
- lib/DBI/Gofer/Serializer/Base.pm $(INST_MAN3DIR)/DBI::Gofer::Serializer::Base.$(MAN3EXT) \
- lib/DBI/Gofer/Serializer/DataDumper.pm $(INST_MAN3DIR)/DBI::Gofer::Serializer::DataDumper.$(MAN3EXT) \
- lib/DBI/Gofer/Serializer/Storable.pm $(INST_MAN3DIR)/DBI::Gofer::Serializer::Storable.$(MAN3EXT)
- $(NOECHO) $(POD2MAN) --section=$(MAN3EXT) --perm_rw=$(PERM_RW) -u \
- lib/DBI/Gofer/Transport/Base.pm $(INST_MAN3DIR)/DBI::Gofer::Transport::Base.$(MAN3EXT) \
- lib/DBI/Gofer/Transport/pipeone.pm $(INST_MAN3DIR)/DBI::Gofer::Transport::pipeone.$(MAN3EXT) \
- lib/DBI/Gofer/Transport/stream.pm $(INST_MAN3DIR)/DBI::Gofer::Transport::stream.$(MAN3EXT) \
- lib/DBI/Profile.pm $(INST_MAN3DIR)/DBI::Profile.$(MAN3EXT) \
- lib/DBI/ProfileData.pm $(INST_MAN3DIR)/DBI::ProfileData.$(MAN3EXT) \
- lib/DBI/ProfileDumper.pm $(INST_MAN3DIR)/DBI::ProfileDumper.$(MAN3EXT) \
- lib/DBI/ProfileDumper/Apache.pm $(INST_MAN3DIR)/DBI::ProfileDumper::Apache.$(MAN3EXT) \
- lib/DBI/ProfileSubs.pm $(INST_MAN3DIR)/DBI::ProfileSubs.$(MAN3EXT) \
- lib/DBI/ProxyServer.pm $(INST_MAN3DIR)/DBI::ProxyServer.$(MAN3EXT) \
- lib/DBI/PurePerl.pm $(INST_MAN3DIR)/DBI::PurePerl.$(MAN3EXT) \
- lib/DBI/SQL/Nano.pm $(INST_MAN3DIR)/DBI::SQL::Nano.$(MAN3EXT) \
- lib/DBI/Util/CacheMemory.pm $(INST_MAN3DIR)/DBI::Util::CacheMemory.$(MAN3EXT) \
- lib/DBI/W32ODBC.pm $(INST_MAN3DIR)/DBI::W32ODBC.$(MAN3EXT) \
- lib/Win32/DBIODBC.pm $(INST_MAN3DIR)/Win32::DBIODBC.$(MAN3EXT)
-
-
-
-
-# --- MakeMaker processPL section:
-
-all :: dbilogstrip
- $(NOECHO) $(NOOP)
-
-dbilogstrip :: dbilogstrip.PL pm_to_blib
- $(PERLRUNINST) dbilogstrip.PL dbilogstrip
-
-all :: dbiprof
- $(NOECHO) $(NOOP)
-
-dbiprof :: dbiprof.PL pm_to_blib
- $(PERLRUNINST) dbiprof.PL dbiprof
-
-all :: dbiproxy
- $(NOECHO) $(NOOP)
-
-dbiproxy :: dbiproxy.PL pm_to_blib
- $(PERLRUNINST) dbiproxy.PL dbiproxy
-
-
-# --- MakeMaker installbin section:
-
-EXE_FILES = dbiproxy dbiprof dbilogstrip
-
-pure_all :: $(INST_SCRIPT)/dbilogstrip $(INST_SCRIPT)/dbiproxy $(INST_SCRIPT)/dbiprof
- $(NOECHO) $(NOOP)
-
-realclean ::
- $(RM_F) \
- $(INST_SCRIPT)/dbilogstrip $(INST_SCRIPT)/dbiproxy \
- $(INST_SCRIPT)/dbiprof
-
-$(INST_SCRIPT)/dbilogstrip : dbilogstrip $(FIRST_MAKEFILE) $(INST_SCRIPT)$(DFSEP).exists $(INST_BIN)$(DFSEP).exists
- $(NOECHO) $(RM_F) $(INST_SCRIPT)/dbilogstrip
- $(CP) dbilogstrip $(INST_SCRIPT)/dbilogstrip
- $(FIXIN) $(INST_SCRIPT)/dbilogstrip
- -$(NOECHO) $(CHMOD) $(PERM_RWX) $(INST_SCRIPT)/dbilogstrip
-
-$(INST_SCRIPT)/dbiproxy : dbiproxy $(FIRST_MAKEFILE) $(INST_SCRIPT)$(DFSEP).exists $(INST_BIN)$(DFSEP).exists
- $(NOECHO) $(RM_F) $(INST_SCRIPT)/dbiproxy
- $(CP) dbiproxy $(INST_SCRIPT)/dbiproxy
- $(FIXIN) $(INST_SCRIPT)/dbiproxy
- -$(NOECHO) $(CHMOD) $(PERM_RWX) $(INST_SCRIPT)/dbiproxy
-
-$(INST_SCRIPT)/dbiprof : dbiprof $(FIRST_MAKEFILE) $(INST_SCRIPT)$(DFSEP).exists $(INST_BIN)$(DFSEP).exists
- $(NOECHO) $(RM_F) $(INST_SCRIPT)/dbiprof
- $(CP) dbiprof $(INST_SCRIPT)/dbiprof
- $(FIXIN) $(INST_SCRIPT)/dbiprof
- -$(NOECHO) $(CHMOD) $(PERM_RWX) $(INST_SCRIPT)/dbiprof
-
-
-
-# --- 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) \
- $(BASEEXT).bso $(BASEEXT).def \
- $(BASEEXT).exp $(BASEEXT).x \
- $(BOOTSTRAP) $(INST_ARCHAUTODIR)/extralibs.all \
- $(INST_ARCHAUTODIR)/extralibs.ld $(MAKE_APERL_FILE) \
- *$(LIB_EXT) *$(OBJ_EXT) \
- *perl.core DBI.c \
- MYMETA.json MYMETA.yml \
- Perl.c blibdirs.ts \
- core core.*perl.*.? \
- core.[0-9] core.[0-9][0-9] \
- core.[0-9][0-9][0-9] core.[0-9][0-9][0-9][0-9] \
- core.[0-9][0-9][0-9][0-9][0-9] lib$(BASEEXT).def \
- mon.out perl \
- perl$(EXE_EXT) perl.exe \
- perlmain.c pm_to_blib \
- pm_to_blib.ts so_locations \
- tmon.out
- - $(RM_RF) \
- $(DISTVNAME) Perl.xsi \
- blib dbi*.prof \
- dbi__null_test_tmp* dbilogstrip \
- dbiprof dbiproxy \
- dbiproxy.*log dbitrace.log \
- ndtest.prt t/zv*_*.t \
- test_output_*
- $(NOECHO) $(RM_F) $(MAKEFILE_OLD)
- - $(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) \
- $(FIRST_MAKEFILE) $(OBJECT) \
- $(MAKEFILE_OLD)
- - $(RM_RF) \
- $(DISTVNAME)
-
-
-# --- MakeMaker metafile section:
-metafile : create_distdir
- $(NOECHO) $(ECHO) Generating META.yml
- $(NOECHO) $(ECHO) '---' > META_new.yml
- $(NOECHO) $(ECHO) 'abstract: '\''Database independent interface for Perl'\''' >> META_new.yml
- $(NOECHO) $(ECHO) 'author:' >> META_new.yml
- $(NOECHO) $(ECHO) ' - '\''Tim Bunce (dbi-users@perl.org)'\''' >> META_new.yml
- $(NOECHO) $(ECHO) 'build_requires:' >> META_new.yml
- $(NOECHO) $(ECHO) ' ExtUtils::MakeMaker: '\''6.48'\''' >> META_new.yml
- $(NOECHO) $(ECHO) ' Test::Simple: '\''0.90'\''' >> META_new.yml
- $(NOECHO) $(ECHO) 'configure_requires:' >> META_new.yml
- $(NOECHO) $(ECHO) ' ExtUtils::MakeMaker: '\''0'\''' >> META_new.yml
- $(NOECHO) $(ECHO) 'conflicts:' >> META_new.yml
- $(NOECHO) $(ECHO) ' DBD::Amazon: '\''0.10'\''' >> META_new.yml
- $(NOECHO) $(ECHO) ' DBD::AnyData: '\''0.110'\''' >> META_new.yml
- $(NOECHO) $(ECHO) ' DBD::CSV: '\''0.36'\''' >> META_new.yml
- $(NOECHO) $(ECHO) ' DBD::Google: '\''0.51'\''' >> META_new.yml
- $(NOECHO) $(ECHO) ' DBD::PO: '\''2.10'\''' >> META_new.yml
- $(NOECHO) $(ECHO) ' DBD::RAM: '\''0.072'\''' >> META_new.yml
- $(NOECHO) $(ECHO) ' SQL::Statement: '\''1.33'\''' >> META_new.yml
- $(NOECHO) $(ECHO) 'dynamic_config: 1' >> META_new.yml
- $(NOECHO) $(ECHO) 'generated_by: '\''ExtUtils::MakeMaker version 7.0401, CPAN::Meta::Converter version 2.150001'\''' >> META_new.yml
- $(NOECHO) $(ECHO) 'license: perl' >> META_new.yml
- $(NOECHO) $(ECHO) 'meta-spec:' >> META_new.yml
- $(NOECHO) $(ECHO) ' url: http://module-build.sourceforge.net/META-spec-v1.4.html' >> META_new.yml
- $(NOECHO) $(ECHO) ' version: '\''1.4'\''' >> META_new.yml
- $(NOECHO) $(ECHO) 'name: DBI' >> META_new.yml
- $(NOECHO) $(ECHO) 'no_index:' >> META_new.yml
- $(NOECHO) $(ECHO) ' directory:' >> META_new.yml
- $(NOECHO) $(ECHO) ' - t' >> META_new.yml
- $(NOECHO) $(ECHO) ' - inc' >> META_new.yml
- $(NOECHO) $(ECHO) 'requires:' >> META_new.yml
- $(NOECHO) $(ECHO) ' perl: '\''5.008'\''' >> META_new.yml
- $(NOECHO) $(ECHO) 'resources:' >> META_new.yml
- $(NOECHO) $(ECHO) ' IRC: irc://irc.perl.org/#dbi' >> META_new.yml
- $(NOECHO) $(ECHO) ' MailingList: mailto:dbi-dev@perl.org' >> META_new.yml
- $(NOECHO) $(ECHO) ' homepage: http://dbi.perl.org/' >> META_new.yml
- $(NOECHO) $(ECHO) ' license: http://dev.perl.org/licenses/' >> META_new.yml
- $(NOECHO) $(ECHO) ' repository: https://github.com/perl5-dbi/dbi' >> META_new.yml
- $(NOECHO) $(ECHO) 'version: '\''1.641'\''' >> META_new.yml
- $(NOECHO) $(ECHO) 'x_suggests:' >> META_new.yml
- $(NOECHO) $(ECHO) ' Clone: 0.34' >> META_new.yml
- $(NOECHO) $(ECHO) ' DB_File: 0' >> META_new.yml
- $(NOECHO) $(ECHO) ' MLDBM: 0' >> META_new.yml
- $(NOECHO) $(ECHO) ' Net::Daemon: 0' >> META_new.yml
- $(NOECHO) $(ECHO) ' RPC::PlServer: 0.2001' >> META_new.yml
- $(NOECHO) $(ECHO) ' SQL::Statement: 1.402' >> META_new.yml
- -$(NOECHO) $(MV) META_new.yml $(DISTVNAME)/META.yml
- $(NOECHO) $(ECHO) Generating META.json
- $(NOECHO) $(ECHO) '{' > META_new.json
- $(NOECHO) $(ECHO) ' "abstract" : "Database independent interface for Perl",' >> META_new.json
- $(NOECHO) $(ECHO) ' "author" : [' >> META_new.json
- $(NOECHO) $(ECHO) ' "Tim Bunce (dbi-users@perl.org)"' >> META_new.json
- $(NOECHO) $(ECHO) ' ],' >> META_new.json
- $(NOECHO) $(ECHO) ' "dynamic_config" : 1,' >> META_new.json
- $(NOECHO) $(ECHO) ' "generated_by" : "ExtUtils::MakeMaker version 7.0401, CPAN::Meta::Converter version 2.150001",' >> META_new.json
- $(NOECHO) $(ECHO) ' "license" : [' >> META_new.json
- $(NOECHO) $(ECHO) ' "perl_5"' >> META_new.json
- $(NOECHO) $(ECHO) ' ],' >> META_new.json
- $(NOECHO) $(ECHO) ' "meta-spec" : {' >> META_new.json
- $(NOECHO) $(ECHO) ' "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",' >> META_new.json
- $(NOECHO) $(ECHO) ' "version" : "2"' >> META_new.json
- $(NOECHO) $(ECHO) ' },' >> META_new.json
- $(NOECHO) $(ECHO) ' "name" : "DBI",' >> META_new.json
- $(NOECHO) $(ECHO) ' "no_index" : {' >> META_new.json
- $(NOECHO) $(ECHO) ' "directory" : [' >> META_new.json
- $(NOECHO) $(ECHO) ' "t",' >> META_new.json
- $(NOECHO) $(ECHO) ' "inc"' >> META_new.json
- $(NOECHO) $(ECHO) ' ]' >> META_new.json
- $(NOECHO) $(ECHO) ' },' >> META_new.json
- $(NOECHO) $(ECHO) ' "prereqs" : {' >> META_new.json
- $(NOECHO) $(ECHO) ' "build" : {' >> META_new.json
- $(NOECHO) $(ECHO) ' "requires" : {' >> META_new.json
- $(NOECHO) $(ECHO) ' "ExtUtils::MakeMaker" : "6.48",' >> META_new.json
- $(NOECHO) $(ECHO) ' "Test::Simple" : "0.90"' >> META_new.json
- $(NOECHO) $(ECHO) ' }' >> META_new.json
- $(NOECHO) $(ECHO) ' },' >> META_new.json
- $(NOECHO) $(ECHO) ' "configure" : {' >> META_new.json
- $(NOECHO) $(ECHO) ' "requires" : {' >> META_new.json
- $(NOECHO) $(ECHO) ' "ExtUtils::MakeMaker" : "0"' >> META_new.json
- $(NOECHO) $(ECHO) ' }' >> META_new.json
- $(NOECHO) $(ECHO) ' },' >> META_new.json
- $(NOECHO) $(ECHO) ' "runtime" : {' >> META_new.json
- $(NOECHO) $(ECHO) ' "conflicts" : {' >> META_new.json
- $(NOECHO) $(ECHO) ' "DBD::Amazon" : "0.10",' >> META_new.json
- $(NOECHO) $(ECHO) ' "DBD::AnyData" : "0.110",' >> META_new.json
- $(NOECHO) $(ECHO) ' "DBD::CSV" : "0.36",' >> META_new.json
- $(NOECHO) $(ECHO) ' "DBD::Google" : "0.51",' >> META_new.json
- $(NOECHO) $(ECHO) ' "DBD::PO" : "2.10",' >> META_new.json
- $(NOECHO) $(ECHO) ' "DBD::RAM" : "0.072",' >> META_new.json
- $(NOECHO) $(ECHO) ' "SQL::Statement" : "1.33"' >> META_new.json
- $(NOECHO) $(ECHO) ' },' >> META_new.json
- $(NOECHO) $(ECHO) ' "requires" : {' >> META_new.json
- $(NOECHO) $(ECHO) ' "perl" : "5.008"' >> META_new.json
- $(NOECHO) $(ECHO) ' }' >> META_new.json
- $(NOECHO) $(ECHO) ' }' >> META_new.json
- $(NOECHO) $(ECHO) ' },' >> META_new.json
- $(NOECHO) $(ECHO) ' "release_status" : "stable",' >> META_new.json
- $(NOECHO) $(ECHO) ' "resources" : {' >> META_new.json
- $(NOECHO) $(ECHO) ' "homepage" : "http://dbi.perl.org/",' >> META_new.json
- $(NOECHO) $(ECHO) ' "license" : [' >> META_new.json
- $(NOECHO) $(ECHO) ' "http://dev.perl.org/licenses/"' >> META_new.json
- $(NOECHO) $(ECHO) ' ],' >> META_new.json
- $(NOECHO) $(ECHO) ' "repository" : {' >> META_new.json
- $(NOECHO) $(ECHO) ' "url" : "https://github.com/perl5-dbi/dbi"' >> META_new.json
- $(NOECHO) $(ECHO) ' },' >> META_new.json
- $(NOECHO) $(ECHO) ' "x_IRC" : "irc://irc.perl.org/#dbi",' >> META_new.json
- $(NOECHO) $(ECHO) ' "x_MailingList" : "mailto:dbi-dev@perl.org"' >> META_new.json
- $(NOECHO) $(ECHO) ' },' >> META_new.json
- $(NOECHO) $(ECHO) ' "version" : "1.641",' >> META_new.json
- $(NOECHO) $(ECHO) ' "x_suggests" : {' >> META_new.json
- $(NOECHO) $(ECHO) ' "Clone" : 0.34,' >> META_new.json
- $(NOECHO) $(ECHO) ' "DB_File" : 0,' >> META_new.json
- $(NOECHO) $(ECHO) ' "MLDBM" : 0,' >> META_new.json
- $(NOECHO) $(ECHO) ' "Net::Daemon" : 0,' >> META_new.json
- $(NOECHO) $(ECHO) ' "RPC::PlServer" : 0.2001,' >> META_new.json
- $(NOECHO) $(ECHO) ' "SQL::Statement" : 1.402' >> META_new.json
- $(NOECHO) $(ECHO) ' }' >> META_new.json
- $(NOECHO) $(ECHO) '}' >> META_new.json
- -$(NOECHO) $(MV) META_new.json $(DISTVNAME)/META.json
-
-
-# --- 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)'\''' \
- -e ' 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
- $(NOECHO) $(ECHO) 'Created $(DISTVNAME).tar$(SUFFIX)_uu'
-
-$(DISTVNAME).tar$(SUFFIX) : distdir
- $(PREOP)
- $(TO_UNIX)
- $(TAR) $(TARFLAGS) $(DISTVNAME).tar $(DISTVNAME)
- $(RM_RF) $(DISTVNAME)
- $(COMPRESS) $(DISTVNAME).tar
- $(NOECHO) $(ECHO) 'Created $(DISTVNAME).tar$(SUFFIX)'
- $(POSTOP)
-
-zipdist : $(DISTVNAME).zip
- $(NOECHO) $(NOOP)
-
-$(DISTVNAME).zip : distdir
- $(PREOP)
- $(ZIP) $(ZIPFLAGS) $(DISTVNAME).zip $(DISTVNAME)
- $(RM_RF) $(DISTVNAME)
- $(NOECHO) $(ECHO) 'Created $(DISTVNAME).zip'
- $(POSTOP)
-
-shdist : distdir
- $(PREOP)
- $(SHAR) $(DISTVNAME) > $(DISTVNAME).shar
- $(RM_RF) $(DISTVNAME)
- $(NOECHO) $(ECHO) 'Created $(DISTVNAME).shar'
- $(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
- cd $(DISTVNAME) && $(MAKE) $(PASTHRU)
- cd $(DISTVNAME) && $(MAKE) test $(PASTHRU)
-
-
-
-# --- 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 'exit unless -e q{META.yml};' \
- -e 'eval { maniadd({q{META.yml} => q{Module YAML meta-data (added by MakeMaker)}}) }' \
- -e ' or print "Could not add META.yml to MANIFEST: $$$${'\''@'\''}\n"' --
- $(NOECHO) cd $(DISTVNAME) && $(ABSPERLRUN) -MExtUtils::Manifest=maniadd -e 'exit unless -f q{META.json};' \
- -e 'eval { maniadd({q{META.json} => q{Module JSON meta-data (added by MakeMaker)}}) }' \
- -e ' or print "Could not add META.json to MANIFEST: $$$${'\''@'\''}\n"' --
-
-
-
-# --- 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)}}) }' \
- -e ' or print "Could not add SIGNATURE to MANIFEST: $$$${'\''@'\''}\n"' --
- $(NOECHO) cd $(DISTVNAME) && $(TOUCH) SIGNATURE
- cd $(DISTVNAME) && cpansign -s
-
-
-
-# --- MakeMaker install section:
-
-install :: pure_install doc_install
- $(NOECHO) $(NOOP)
-
-install_perl :: pure_perl_install doc_perl_install
- $(NOECHO) $(NOOP)
-
-install_site :: pure_site_install doc_site_install
- $(NOECHO) $(NOOP)
-
-install_vendor :: 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 :: all
- $(NOECHO) umask 022; $(MOD_INSTALL) \
- "$(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 :: all
- $(NOECHO) umask 02; $(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 :: all
- $(NOECHO) umask 022; $(MOD_INSTALL) \
- "$(INST_LIB)" "$(DESTINSTALLVENDORLIB)" \
- "$(INST_ARCHLIB)" "$(DESTINSTALLVENDORARCH)" \
- "$(INST_BIN)" "$(DESTINSTALLVENDORBIN)" \
- "$(INST_SCRIPT)" "$(DESTINSTALLVENDORSCRIPT)" \
- "$(INST_MAN1DIR)" "$(DESTINSTALLVENDORMAN1DIR)" \
- "$(INST_MAN3DIR)" "$(DESTINSTALLVENDORMAN3DIR)"
-
-
-doc_perl_install :: all
-
-doc_site_install :: all
- $(NOECHO) $(ECHO) Appending installation info to "$(DESTINSTALLSITEARCH)/perllocal.pod"
- -$(NOECHO) umask 02; $(MKPATH) "$(DESTINSTALLSITEARCH)"
- -$(NOECHO) umask 02; $(DOC_INSTALL) \
- "Module" "$(NAME)" \
- "installed into" $(INSTALLSITELIB) \
- LINKTYPE "$(LINKTYPE)" \
- VERSION "$(VERSION)" \
- EXE_FILES "$(EXE_FILES)" \
- >> "$(DESTINSTALLSITEARCH)/perllocal.pod"
-
-doc_vendor_install :: all
-
-
-uninstall :: uninstall_from_$(INSTALLDIRS)dirs
- $(NOECHO) $(NOOP)
-
-uninstall_from_perldirs ::
-
-uninstall_from_sitedirs ::
- $(NOECHO) $(UNINSTALL) "$(SITEARCHEXP)/auto/$(FULLEXT)/.packlist"
-
-uninstall_from_vendordirs ::
-
-
-# --- MakeMaker force section:
-# Phony target to force checking subdirectories.
-FORCE :
- $(NOECHO) $(NOOP)
-
-
-# --- MakeMaker perldepend section:
-PERL_HDRS = \
- $(PERL_INCDEP)/EXTERN.h \
- $(PERL_INCDEP)/INTERN.h \
- $(PERL_INCDEP)/XSUB.h \
- $(PERL_INCDEP)/av.h \
- $(PERL_INCDEP)/bitcount.h \
- $(PERL_INCDEP)/charclass_invlists.h \
- $(PERL_INCDEP)/config.h \
- $(PERL_INCDEP)/cop.h \
- $(PERL_INCDEP)/cv.h \
- $(PERL_INCDEP)/dosish.h \
- $(PERL_INCDEP)/ebcdic_tables.h \
- $(PERL_INCDEP)/embed.h \
- $(PERL_INCDEP)/embedvar.h \
- $(PERL_INCDEP)/fakesdio.h \
- $(PERL_INCDEP)/feature.h \
- $(PERL_INCDEP)/form.h \
- $(PERL_INCDEP)/git_version.h \
- $(PERL_INCDEP)/gv.h \
- $(PERL_INCDEP)/handy.h \
- $(PERL_INCDEP)/hv.h \
- $(PERL_INCDEP)/hv_func.h \
- $(PERL_INCDEP)/inline.h \
- $(PERL_INCDEP)/intrpvar.h \
- $(PERL_INCDEP)/iperlsys.h \
- $(PERL_INCDEP)/keywords.h \
- $(PERL_INCDEP)/l1_char_class_tab.h \
- $(PERL_INCDEP)/malloc_ctl.h \
- $(PERL_INCDEP)/metaconfig.h \
- $(PERL_INCDEP)/mg.h \
- $(PERL_INCDEP)/mg_data.h \
- $(PERL_INCDEP)/mg_raw.h \
- $(PERL_INCDEP)/mg_vtable.h \
- $(PERL_INCDEP)/mydtrace.h \
- $(PERL_INCDEP)/nostdio.h \
- $(PERL_INCDEP)/op.h \
- $(PERL_INCDEP)/op_reg_common.h \
- $(PERL_INCDEP)/opcode.h \
- $(PERL_INCDEP)/opnames.h \
- $(PERL_INCDEP)/overload.h \
- $(PERL_INCDEP)/pad.h \
- $(PERL_INCDEP)/parser.h \
- $(PERL_INCDEP)/patchlevel-debian.h \
- $(PERL_INCDEP)/patchlevel.h \
- $(PERL_INCDEP)/perl.h \
- $(PERL_INCDEP)/perlapi.h \
- $(PERL_INCDEP)/perlio.h \
- $(PERL_INCDEP)/perliol.h \
- $(PERL_INCDEP)/perlsdio.h \
- $(PERL_INCDEP)/perlvars.h \
- $(PERL_INCDEP)/perly.h \
- $(PERL_INCDEP)/pp.h \
- $(PERL_INCDEP)/pp_proto.h \
- $(PERL_INCDEP)/proto.h \
- $(PERL_INCDEP)/reentr.h \
- $(PERL_INCDEP)/regcharclass.h \
- $(PERL_INCDEP)/regcomp.h \
- $(PERL_INCDEP)/regexp.h \
- $(PERL_INCDEP)/regnodes.h \
- $(PERL_INCDEP)/scope.h \
- $(PERL_INCDEP)/sv.h \
- $(PERL_INCDEP)/thread.h \
- $(PERL_INCDEP)/time64.h \
- $(PERL_INCDEP)/time64_config.h \
- $(PERL_INCDEP)/uconfig.h \
- $(PERL_INCDEP)/unicode_constants.h \
- $(PERL_INCDEP)/unixish.h \
- $(PERL_INCDEP)/utf8.h \
- $(PERL_INCDEP)/utfebcdic.h \
- $(PERL_INCDEP)/util.h \
- $(PERL_INCDEP)/uudmap.h \
- $(PERL_INCDEP)/vutil.h \
- $(PERL_INCDEP)/warnings.h
-
-$(OBJECT) : $(PERL_HDRS)
-
-DBI.c Perl.c : $(XSUBPPDEPS)
-
-
-# --- MakeMaker makefile section:
-
-$(OBJECT) : $(FIRST_MAKEFILE)
-
-# 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 = "/usr/bin/perl"
-
-$(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
- PERL_DL_NONLAZY=1 $(FULLPERLRUN) "-MExtUtils::Command::MM" "-MTest::Harness" "-e" "undef *Test::Harness::Switches; test_harness($(TEST_VERBOSE), '$(INST_LIB)', '$(INST_ARCHLIB)')" $(TEST_FILES)
- PERL_DL_NONLAZY=1 $(FULLPERLRUN) "-I$(INST_LIB)" "-I$(INST_ARCHLIB)" $(TEST_FILE)
-
-testdb_dynamic :: pure_all
- PERL_DL_NONLAZY=1 $(FULLPERLRUN) $(TESTDB_SW) "-I$(INST_LIB)" "-I$(INST_ARCHLIB)" $(TEST_FILE)
-
-test_ : test_dynamic
-
-test_static :: pure_all $(MAP_TARGET)
- PERL_DL_NONLAZY=1 ./$(MAP_TARGET) "-MExtUtils::Command::MM" "-MTest::Harness" "-e" "undef *Test::Harness::Switches; test_harness($(TEST_VERBOSE), '$(INST_LIB)', '$(INST_ARCHLIB)')" $(TEST_FILES)
- PERL_DL_NONLAZY=1 ./$(MAP_TARGET) "-I$(INST_LIB)" "-I$(INST_ARCHLIB)" $(TEST_FILE)
-
-testdb_static :: pure_all $(MAP_TARGET)
- PERL_DL_NONLAZY=1 ./$(MAP_TARGET) $(TESTDB_SW) "-I$(INST_LIB)" "-I$(INST_ARCHLIB)" $(TEST_FILE)
-
-
-
-# --- MakeMaker ppd section:
-# Creates a PPD (Perl Package Description) for a binary distribution.
-ppd :
- $(NOECHO) $(ECHO) '<SOFTPKG NAME="$(DISTNAME)" VERSION="$(VERSION)">' > $(DISTNAME).ppd
- $(NOECHO) $(ECHO) ' <ABSTRACT>Database independent interface for Perl</ABSTRACT>' >> $(DISTNAME).ppd
- $(NOECHO) $(ECHO) ' <AUTHOR>Tim Bunce (dbi-users@perl.org)</AUTHOR>' >> $(DISTNAME).ppd
- $(NOECHO) $(ECHO) ' <IMPLEMENTATION>' >> $(DISTNAME).ppd
- $(NOECHO) $(ECHO) ' <PERLCORE VERSION="5,008,0,0" />' >> $(DISTNAME).ppd
- $(NOECHO) $(ECHO) ' <ARCHITECTURE NAME="x86_64-linux-gnu-thread-multi-5.22" />' >> $(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 : $(FIRST_MAKEFILE) $(TO_INST_PM)
- $(NOECHO) $(ABSPERLRUN) -MExtUtils::Install -e 'pm_to_blib({@ARGV}, '\''$(INST_LIB)/auto'\'', q[$(PM_FILTER)], '\''$(PERM_DIR)'\'')' -- \
- DBI.pm $(INST_LIB)/DBI.pm \
- DBIXS.h $(INST_ARCHLIB)/auto/$(FULLEXT)/DBIXS.h \
- Driver.xst $(INST_ARCHLIB)/auto/$(FULLEXT)/Driver.xst \
- Driver_xst.h $(INST_ARCHLIB)/auto/$(FULLEXT)/Driver_xst.h \
- dbd_xsh.h $(INST_ARCHLIB)/auto/$(FULLEXT)/dbd_xsh.h \
- dbi_sql.h $(INST_ARCHLIB)/auto/$(FULLEXT)/dbi_sql.h \
- dbipport.h $(INST_ARCHLIB)/auto/$(FULLEXT)/dbipport.h \
- dbivport.h $(INST_ARCHLIB)/auto/$(FULLEXT)/dbivport.h \
- dbixs_rev.h $(INST_ARCHLIB)/auto/$(FULLEXT)/dbixs_rev.h \
- dbixs_rev.pl $(INST_LIB)/dbixs_rev.pl \
- lib/Bundle/DBI.pm blib/lib/Bundle/DBI.pm \
- lib/DBD/DBM.pm blib/lib/DBD/DBM.pm \
- lib/DBD/ExampleP.pm blib/lib/DBD/ExampleP.pm \
- lib/DBD/File.pm blib/lib/DBD/File.pm \
- lib/DBD/File/Developers.pod blib/lib/DBD/File/Developers.pod \
- lib/DBD/File/HowTo.pod blib/lib/DBD/File/HowTo.pod \
- lib/DBD/File/Roadmap.pod blib/lib/DBD/File/Roadmap.pod \
- lib/DBD/Gofer.pm blib/lib/DBD/Gofer.pm \
- lib/DBD/Gofer/Policy/Base.pm blib/lib/DBD/Gofer/Policy/Base.pm \
- lib/DBD/Gofer/Policy/classic.pm blib/lib/DBD/Gofer/Policy/classic.pm \
- lib/DBD/Gofer/Policy/pedantic.pm blib/lib/DBD/Gofer/Policy/pedantic.pm \
- lib/DBD/Gofer/Policy/rush.pm blib/lib/DBD/Gofer/Policy/rush.pm \
- lib/DBD/Gofer/Transport/Base.pm blib/lib/DBD/Gofer/Transport/Base.pm \
- lib/DBD/Gofer/Transport/corostream.pm blib/lib/DBD/Gofer/Transport/corostream.pm \
- lib/DBD/Gofer/Transport/null.pm blib/lib/DBD/Gofer/Transport/null.pm \
- lib/DBD/Gofer/Transport/pipeone.pm blib/lib/DBD/Gofer/Transport/pipeone.pm \
- lib/DBD/Gofer/Transport/stream.pm blib/lib/DBD/Gofer/Transport/stream.pm \
- lib/DBD/Mem.pm blib/lib/DBD/Mem.pm \
- lib/DBD/NullP.pm blib/lib/DBD/NullP.pm \
- lib/DBD/Proxy.pm blib/lib/DBD/Proxy.pm \
- lib/DBD/Sponge.pm blib/lib/DBD/Sponge.pm \
- lib/DBI/Const/GetInfo/ANSI.pm blib/lib/DBI/Const/GetInfo/ANSI.pm \
- lib/DBI/Const/GetInfo/ODBC.pm blib/lib/DBI/Const/GetInfo/ODBC.pm \
- lib/DBI/Const/GetInfoReturn.pm blib/lib/DBI/Const/GetInfoReturn.pm \
- lib/DBI/Const/GetInfoType.pm blib/lib/DBI/Const/GetInfoType.pm \
- lib/DBI/DBD.pm blib/lib/DBI/DBD.pm \
- lib/DBI/DBD/Metadata.pm blib/lib/DBI/DBD/Metadata.pm \
- lib/DBI/DBD/SqlEngine.pm blib/lib/DBI/DBD/SqlEngine.pm \
- lib/DBI/DBD/SqlEngine/Developers.pod blib/lib/DBI/DBD/SqlEngine/Developers.pod \
- lib/DBI/DBD/SqlEngine/HowTo.pod blib/lib/DBI/DBD/SqlEngine/HowTo.pod \
- lib/DBI/Gofer/Execute.pm blib/lib/DBI/Gofer/Execute.pm \
- lib/DBI/Gofer/Request.pm blib/lib/DBI/Gofer/Request.pm \
- lib/DBI/Gofer/Response.pm blib/lib/DBI/Gofer/Response.pm \
- lib/DBI/Gofer/Serializer/Base.pm blib/lib/DBI/Gofer/Serializer/Base.pm \
- lib/DBI/Gofer/Serializer/DataDumper.pm blib/lib/DBI/Gofer/Serializer/DataDumper.pm
- $(NOECHO) $(ABSPERLRUN) -MExtUtils::Install -e 'pm_to_blib({@ARGV}, '\''$(INST_LIB)/auto'\'', q[$(PM_FILTER)], '\''$(PERM_DIR)'\'')' -- \
- lib/DBI/Gofer/Serializer/Storable.pm blib/lib/DBI/Gofer/Serializer/Storable.pm \
- lib/DBI/Gofer/Transport/Base.pm blib/lib/DBI/Gofer/Transport/Base.pm \
- lib/DBI/Gofer/Transport/pipeone.pm blib/lib/DBI/Gofer/Transport/pipeone.pm \
- lib/DBI/Gofer/Transport/stream.pm blib/lib/DBI/Gofer/Transport/stream.pm \
- lib/DBI/Profile.pm blib/lib/DBI/Profile.pm \
- lib/DBI/ProfileData.pm blib/lib/DBI/ProfileData.pm \
- lib/DBI/ProfileDumper.pm blib/lib/DBI/ProfileDumper.pm \
- lib/DBI/ProfileDumper/Apache.pm blib/lib/DBI/ProfileDumper/Apache.pm \
- lib/DBI/ProfileSubs.pm blib/lib/DBI/ProfileSubs.pm \
- lib/DBI/ProxyServer.pm blib/lib/DBI/ProxyServer.pm \
- lib/DBI/PurePerl.pm blib/lib/DBI/PurePerl.pm \
- lib/DBI/SQL/Nano.pm blib/lib/DBI/SQL/Nano.pm \
- lib/DBI/Util/CacheMemory.pm blib/lib/DBI/Util/CacheMemory.pm \
- lib/DBI/Util/_accessor.pm blib/lib/DBI/Util/_accessor.pm \
- lib/DBI/W32ODBC.pm blib/lib/DBI/W32ODBC.pm \
- lib/Win32/DBIODBC.pm blib/lib/Win32/DBIODBC.pm
- $(NOECHO) $(TOUCH) pm_to_blib
-
-
-# --- MakeMaker selfdocument section:
-
-
-# --- MakeMaker postamble section:
-
-
-# End.
+++ /dev/null
-# -*- perl -*-
-#
-# $Id$
-#
-# Copyright (c) 1994-2010 Tim Bunce Ireland
-#
-# See COPYRIGHT section in DBI.pm for usage and distribution rights.
-
-use 5.008_001;
-
-use ExtUtils::MakeMaker 5.16, qw(WriteMakefile $Verbose prompt);
-use Getopt::Long;
-use Config;
-use File::Find;
-use File::Spec;
-use strict;
-
-use lib 'lib'; # for use DBI::DBD
-use DBI::DBD;
-
-$| = 1;
-$^W = 1;
-my $os = $^O;
-my $osvers = $Config{osvers};
-$osvers =~ s/^\s*(\d+\.\d+).*/$1/; # drop sub-sub-version: 2.5.1 -> 2.5
-my $ext_pl = $^O eq 'VMS' ? '.pl' : '';
-my $is_developer = ((-d ".svn" || -d ".git") && -f "MANIFEST.SKIP");
-
-$::opt_v = 0;
-$::opt_thread = $Config{useithreads}; # thread if we can, use "-nothread" to disable
-$::opt_g = 0;
-$::opt_g = 1 if $is_developer && $ENV{LOGNAME} && $ENV{LOGNAME} eq 'timbo'; # it's me! (probably)
-
-GetOptions(qw(v! g! thread!))
- or die "Invalid arguments\n";
-
-$::opt_g &&= '-g'; # convert to actual string
-
-
-if (($ENV{LANG}||'') =~ m/utf-?8/i) {
- print "\n";
- print "*** Your LANG environment variable is set to '$ENV{LANG}'\n";
- print "*** This may cause problems for some perl installations.\n";
- print "*** If you get test failures, please try again with LANG unset.\n";
- print "*** If that then works, please email dbi-dev\@perl.org with details\n";
- print "*** including the output of 'perl -V'\n";
- print "\n";
- sleep 1;
-}
-
-my %opts = (
- NAME => 'DBI',
- AUTHOR => 'Tim Bunce (dbi-users@perl.org)',
- VERSION_FROM => 'DBI.pm',
- ABSTRACT_FROM => 'DBI.pm',
- MIN_PERL_VERSION => '5.008',
- BUILD_REQUIRES => {
- 'ExtUtils::MakeMaker' => '6.48',
- 'Test::Simple' => '0.90',
- },
- META_MERGE => {
- resources => {
- repository => 'https://github.com/perl5-dbi/dbi',
- MailingList => 'mailto:dbi-dev@perl.org',
- license => 'http://dev.perl.org/licenses/',
- homepage => 'http://dbi.perl.org/',
- IRC => 'irc://irc.perl.org/#dbi',
- },
- suggests => {
- 'RPC::PlServer' => 0.2001,
- 'Net::Daemon' => 0,
- 'SQL::Statement' => 1.402,
- 'Clone' => 0.34,
- 'MLDBM' => 0,
- 'DB_File' => 0,
- },
- },
- PREREQ_PM => {
- ( $^O eq 'MSWin32' ? ( 'File::Spec' => 3.31, ) : () ),
- },
- CONFLICTS => {
- 'SQL::Statement' => '1.33',
- 'DBD::AnyData' => '0.110',
- 'DBD::CSV' => '0.36',
- 'DBD::RAM' => '0.072',
- 'DBD::PO' => '2.10',
- 'DBD::Google' => '0.51',
- 'DBD::Amazon' => '0.10',
- },
- LICENSE => 'perl',
- EXE_FILES => [ "dbiproxy$ext_pl", "dbiprof$ext_pl", "dbilogstrip$ext_pl" ],
- DIR => [ ],
- dynamic_lib => { OTHERLDFLAGS => "$::opt_g" },
- clean => { FILES=> "\$(DISTVNAME) Perl.xsi t/zv*_*.t dbi__null_test_tmp* test_output_*"
- ." dbiproxy$ext_pl dbiprof$ext_pl dbilogstrip$ext_pl dbiproxy.*log dbitrace.log dbi*.prof ndtest.prt" },
- dist => {
- DIST_DEFAULT=> 'clean distcheck disttest tardist',
- PREOP => '$(MAKE) -f Makefile.old distdir',
- COMPRESS => 'gzip -v9', SUFFIX => 'gz',
- },
-);
-$opts{CAPI} = 'TRUE' if $Config{archname} =~ /-object\b/i;
-
-if (my $gccversion = $Config{gccversion}) { # ask gcc to be more pedantic
- warn "WARNING: Your GNU C $gccversion compiler is very old. Please upgrade it and rebuild perl.\n"
- if $gccversion =~ m/^\D*(1|2\.[1-8])/;
- print "Your perl was compiled with gcc (version $Config{gccversion}), okay.\n";
- $gccversion =~ s/[^\d\.]//g; # just a number please
- $opts{DEFINE} .= ' -W -Wall -Wpointer-arith -Wbad-function-cast';
- $opts{DEFINE} .= ' -Wno-comment -Wno-sign-compare -Wno-cast-qual';
- $opts{DEFINE} .= ' -Wmissing-noreturn -Wno-unused-parameter' if $gccversion ge "3.0";
- if ($is_developer && $::opt_g) {
- $opts{DEFINE} .= ' -DPERL_GCC_PEDANTIC -ansi -pedantic' if $gccversion ge "3.0";
- $opts{DEFINE} .= ' -Wdisabled-optimization -Wformat' if $gccversion ge "3.0";
- $opts{DEFINE} .= ' -Wmissing-prototypes';
- }
-}
-
-$opts{DEFINE} .= ' -DDBI_NO_THREADS' unless $::opt_thread;
-
-# HP-UX 9 cannot link a non-PIC object file into a shared library.
-# Since the # .a libs that Oracle supplies contain non-PIC object
-# files, we sadly have to build static on HP-UX 9 :(
-if ($os eq 'hpux' and $osvers < 10) {
- $opts{LINKTYPE} = 'static';
- print "Warning: Forced to build static not dynamic on $os $osvers.\a\n";
- print "** Note: DBI will be built *into* a NEW perl binary. You MUST use that new perl.\n";
- print " See README and Makefile.PL for more information.\a\n";
-}
-
-if ($os eq 'MSWin32' && $Config{libs} =~ /\bPerlCRT.lib\b/
- && -f "$Config{archlib}/CORE/PerlCRT.lib") {
- # ActiveState Perl needs this; should better be done in MakeMaker, but
- # as a temporary workaround it seems ok.
- $opts{LIBS} = "-L$Config{archlib}/CORE";
-}
-
-# Set aside some values for post_initialize() in package MY
-my ( $cfg_privlibexp, $cfg_archlibexp, $cfg_sitelibexp, $cfg_sitearchexp,
- $cfg_man3direxp ) =
- @Config{qw( privlibexp archlibexp sitelibexp sitearchexp man3direxp ) };
-for ( $cfg_privlibexp, $cfg_archlibexp, $cfg_sitelibexp, $cfg_sitearchexp,
- $cfg_man3direxp ) {
- $_ = '' unless defined $_;
-}
-
-my $conflictMsg = <<EOCM;
-***
- This version of DBI conflicts with the version of
- module %s (%s) you have installed.
-
- It's strongly recommended that you update it after
- installing this version of DBI.
-***
-EOCM
-
-sub CheckConflicts {
- my %params = @_;
- my %conflicts = %{ $params{CONFLICTS} };
- my $found = 0;
-
- while ( my ( $module, $version ) = each(%conflicts) ) {
- undef $@;
- eval "require $module";
- next if $@;
- my $installed = eval "\$" . $module . "::VERSION";
- if ( $installed le $version ) {
- ++$found;
- my $msg = $conflictMsg;
- my $warning = sprintf( $msg, $module, $installed );
- warn $warning;
- }
- }
-
- return !$found;
-}
-
-sub WriteMakefile1 {
- #Written by Alexandr Ciornii, version 0.21. Added by eumm-upgrade.
- my %params = @_;
- my $eumm_version = $ExtUtils::MakeMaker::VERSION;
- $eumm_version = eval $eumm_version;
- die "EXTRA_META is deprecated" if ( exists( $params{EXTRA_META} ) );
- die "License not specified" if ( !exists( $params{LICENSE} ) );
- if ( $params{BUILD_REQUIRES} and ( $eumm_version < 6.5503 ) ) {
- #EUMM 6.5502 has problems with BUILD_REQUIRES
- $params{PREREQ_PM} = { %{ $params{PREREQ_PM} || {} }, %{ $params{BUILD_REQUIRES} } };
- delete $params{BUILD_REQUIRES};
- }
-
- # more or less taken from Moose' Makefile.PL
- if ( $params{CONFLICTS} ) {
- my $ok = CheckConflicts(%params);
- exit(0) if ( $params{PREREQ_FATAL} and not $ok );
- my $cpan_smoker = grep { $_ =~ m/(?:CR_SMOKER|CPAN_REPORTER|AUTOMATED_TESTING)/ } keys %ENV;
- unless ( $cpan_smoker || $ENV{PERL_MM_USE_DEFAULT} ) {
- sleep 4 unless ($ok);
- }
- %{$params{META_MERGE}{conflicts}} = %{$params{CONFLICTS}};
- delete $params{CONFLICTS};
- }
-
- delete $params{CONFIGURE_REQUIRES} if ( $eumm_version < 6.52 );
- delete $params{MIN_PERL_VERSION} if ( $eumm_version < 6.48 );
- delete $params{META_MERGE} if ( $eumm_version < 6.46 );
- delete $params{META_ADD} if ( $eumm_version < 6.46 );
- delete $params{LICENSE} if ( $eumm_version < 6.31 );
-
- WriteMakefile(%params);
-}
-
-$Verbose = $::opt_v;
-WriteMakefile1(
- dbd_edit_mm_attribs(\%opts, {
- create_pp_tests => 1,
- create_nano_tests => 1,
- create_gap_tests => 1,
- })
-);
-# WriteMakefile call is last thing executed
-# so return value is propagated
-
-
-# =====================================================================
-
-package MY;
-
-sub postamble {
-warn <<EOT;
-
- I see you're using perl $] on $Config::Config{archname}, okay.
- Remember to actually *read* the README file!
- Use 'make' to build the software (dmake or nmake on Windows).
- Then 'make test' to execute self tests.
- Then 'make install' to install the DBI and then delete this working
- directory before unpacking and building any DBD::* drivers.
-
-EOT
-warn <<EOT if $os eq 'MSWin32';
- Windows users need to use the correct make command.
- That may be nmake or dmake depending on which Perl you are using.
- If using the Win32 ActiveState build then it is recommended that you
- use the ppm utility to fetch and install a prebuilt DBI instead.
-
-EOT
- return "";
-}
-
-sub libscan {
- my($self, $path) = @_;
- ($path =~ /\~$|\B\.(svn|git)\b/) ? undef : $path;
-}
-
-sub const_cccmd {
- my $self = shift;
- local($_) = $self->SUPER::const_cccmd(@_);
- # If perl Makefile.PL *-g* then switch on debugging
- if ($::opt_g) {
- s/\s-O\d?\b//; # delete optimise option
- s/\s-/ -g -/; # add -g option
- }
- $_;
-}
-
-
-sub post_initialize {
- my($self) = shift;
-
- if ($cfg_privlibexp ne $cfg_sitelibexp) {
- # this block could probably be removed now
- my %old;
- File::Find::find( sub {
- local $_ = $File::Find::name;
- s:\\:/:g if $os eq 'MSWin32';
- $File::Find::prune = 1, return
- if -d $_ && ( $_ eq $cfg_sitelibexp ||
- $_ eq $cfg_sitearchexp ||
- $_ eq $cfg_man3direxp );
- ++$old{$_} if m:\bDB(I|D$):; # DBI files, but just DBD dirs
- }, $cfg_privlibexp, $cfg_archlibexp );
- if ( %old ) {
- warn "
-Warning: By default new modules are installed into your 'site_lib'
- directories. Since site_lib directories come after the normal library
- directories you must delete old DBI files and directories from your
- 'privlib' and 'archlib' directories and their auto subdirectories.
-
-Reinstall DBI and your DBD::* drivers after deleting the old directories.
-
-Here's a list of probable old files and directories:
-
- " . join( "\n ", ( sort keys %old ), "\n" );
- }
- }
-
- # install files that DBD's may need
- File::Find::find( sub {
-
- # may be '.' or '[]' depending on File::Find version
- $_ = '.' if $^O eq 'VMS' && $_ eq File::Spec->curdir;
-
- $File::Find::prune = 1, return if -d $_ && '.' ne $_;
- $self->{PM}->{$_} = File::Spec->catfile($self->{INST_ARCHAUTODIR}, $_)
- if '.h' eq substr( $_, -2 ) || '.xst' eq substr( $_, -4 );
- }, '.' );
-
- delete $self->{$_}{"git-svn-vsn.pl"} for qw( PM MAN3PODS );
-
- return '';
-}
-
-
-sub post_constants {
- my($self) = shift;
-
- # ensure that Driver.xst and related code gets tested
- my $xst = main::dbd_postamble();
- $xst =~ s/\$\(BASEEXT\)/Perl/g;
- $xst .= '
-dbixs_rev.h: DBIXS.h Driver_xst.h dbipport.h dbivport.h dbixs_rev.pl
- $(PERL) dbixs_rev.pl
-
-DBI.c: Perl$(OBJ_EXT)
-
-# make Changes file available as installed pod docs "perldoc DBI::Changes"
-inst_libdbi = ' . File::Spec->catdir($self->{INST_LIB}, 'DBI') . '
-changes_pm = ' . File::Spec->catfile($self->{INST_LIB}, 'DBI', 'Changes.pm') . '
-'.q{
-
-config :: $(changes_pm)
- $(NOECHO) $(NOOP)
-
-$(changes_pm): Changes
- $(MKPATH) $(inst_libdbi)
- $(RM_F) $(changes_pm)
- $(CP) Changes $(changes_pm)
-
-ptest: all
- prove --blib --jobs 8 --shuffle
-
-faq:
- : checkin any local changes not already checked in before overwriting
- svn commit --message "dbi.tiddlyspot.com FAQ update" dbi.tiddlyspot.com.html
- wget --ignore-length --output-document=dbi.tiddlyspot.com.html --timestamping http://dbi.tiddlyspot.com/download
- svn commit --message "dbi.tiddlyspot.com FAQ update" dbi.tiddlyspot.com.html
-
-checkkeywords:
- $(RM_RF) blib
- find . -type f \( -name .svn -prune -o -name \*.pm -o -name \*.PL -o -name \*.pl \) \
- -exec bash -c '[ -z "$$(svn pg svn:keywords {})" ] && echo svn propset svn:keywords \"Id Revision\" {}' \;
-
-checkpod:
- $(RM_RF) blib
- find . -type f \( -name .svn -prune -o -name \*.pm -o -name \*.PL -o -name \*.pl \) \
- -exec podchecker {} \; 2>&1 | grep -v 'pod syntax OK'
-};
-
- return $xst;
-}
-
-# end.
+++ /dev/null
-/*
- * This file was generated automatically by ExtUtils::ParseXS version 3.28 from the
- * contents of Perl.xs. Do not edit this file, edit Perl.xs instead.
- *
- * ANY CHANGES MADE HERE WILL BE LOST!
- *
- */
-
-#line 1 "Perl.xs"
-/* This is a skeleton driver that only serves as a basic sanity check
- that the Driver.xst mechansim doesn't have compile-time errors in it.
- vim: ts=8:sw=4:expandtab
-*/
-
-#define PERL_NO_GET_CONTEXT
-#include "DBIXS.h"
-#include "dbd_xsh.h"
-
-#undef DBIh_SET_ERR_CHAR /* to syntax check emulation */
-#include "dbivport.h"
-
-DBISTATE_DECLARE;
-
-
-struct imp_drh_st {
- dbih_drc_t com; /* MUST be first element in structure */
-};
-struct imp_dbh_st {
- dbih_dbc_t com; /* MUST be first element in structure */
-};
-struct imp_sth_st {
- dbih_stc_t com; /* MUST be first element in structure */
-};
-
-
-
-#define dbd_discon_all(drh, imp_drh) (drh=drh,imp_drh=imp_drh,1)
-#define dbd_dr_data_sources(drh, imp_drh, attr) (drh=drh,imp_drh=imp_drh,attr=attr,Nullav)
-#define dbd_db_do4_iv(dbh,imp_dbh,p3,p4) (dbh=dbh,imp_dbh=imp_dbh,p3=p3,p4=p4,-2)
-#define dbd_db_last_insert_id(dbh, imp_dbh, p3,p4,p5,p6, attr) \
- (dbh=dbh,imp_dbh=imp_dbh,p3=p3,p4=p4,p5=p5,p6=p6,attr=attr,&PL_sv_undef)
-#define dbd_take_imp_data(h, imp_xxh, p3) (h=h,imp_xxh=imp_xxh,&PL_sv_undef)
-#define dbd_st_execute_for_fetch(sth, imp_sth, p3, p4) \
- (sth=sth,imp_sth=imp_sth,p3=p3,p4=p4,&PL_sv_undef)
-
-#define dbd_st_bind_col(sth, imp_sth, param, ref, sql_type, attribs) \
- (sth=sth,imp_sth=imp_sth,param=param,ref=ref,sql_type=sql_type,attribs=attribs,1)
-
-int /* just to test syntax of macros etc */
-dbd_st_rows(SV *h, imp_sth_t *imp_sth)
-{
- dTHX;
- PERL_UNUSED_VAR(h);
- DBIh_SET_ERR_CHAR(h, imp_sth, 0, 1, "err msg", "12345", Nullch);
- return -1;
-}
-
-
-#line 60 "Perl.c"
-#ifndef PERL_UNUSED_VAR
-# define PERL_UNUSED_VAR(var) if (0) var = var
-#endif
-
-#ifndef dVAR
-# define dVAR dNOOP
-#endif
-
-
-/* This stuff is not part of the API! You have been warned. */
-#ifndef PERL_VERSION_DECIMAL
-# define PERL_VERSION_DECIMAL(r,v,s) (r*1000000 + v*1000 + s)
-#endif
-#ifndef PERL_DECIMAL_VERSION
-# define PERL_DECIMAL_VERSION \
- PERL_VERSION_DECIMAL(PERL_REVISION,PERL_VERSION,PERL_SUBVERSION)
-#endif
-#ifndef PERL_VERSION_GE
-# define PERL_VERSION_GE(r,v,s) \
- (PERL_DECIMAL_VERSION >= PERL_VERSION_DECIMAL(r,v,s))
-#endif
-#ifndef PERL_VERSION_LE
-# define PERL_VERSION_LE(r,v,s) \
- (PERL_DECIMAL_VERSION <= PERL_VERSION_DECIMAL(r,v,s))
-#endif
-
-/* XS_INTERNAL is the explicit static-linkage variant of the default
- * XS macro.
- *
- * XS_EXTERNAL is the same as XS_INTERNAL except it does not include
- * "STATIC", ie. it exports XSUB symbols. You probably don't want that
- * for anything but the BOOT XSUB.
- *
- * See XSUB.h in core!
- */
-
-
-/* TODO: This might be compatible further back than 5.10.0. */
-#if PERL_VERSION_GE(5, 10, 0) && PERL_VERSION_LE(5, 15, 1)
-# undef XS_EXTERNAL
-# undef XS_INTERNAL
-# if defined(__CYGWIN__) && defined(USE_DYNAMIC_LOADING)
-# define XS_EXTERNAL(name) __declspec(dllexport) XSPROTO(name)
-# define XS_INTERNAL(name) STATIC XSPROTO(name)
-# endif
-# if defined(__SYMBIAN32__)
-# define XS_EXTERNAL(name) EXPORT_C XSPROTO(name)
-# define XS_INTERNAL(name) EXPORT_C STATIC XSPROTO(name)
-# endif
-# ifndef XS_EXTERNAL
-# if defined(HASATTRIBUTE_UNUSED) && !defined(__cplusplus)
-# define XS_EXTERNAL(name) void name(pTHX_ CV* cv __attribute__unused__)
-# define XS_INTERNAL(name) STATIC void name(pTHX_ CV* cv __attribute__unused__)
-# else
-# ifdef __cplusplus
-# define XS_EXTERNAL(name) extern "C" XSPROTO(name)
-# define XS_INTERNAL(name) static XSPROTO(name)
-# else
-# define XS_EXTERNAL(name) XSPROTO(name)
-# define XS_INTERNAL(name) STATIC XSPROTO(name)
-# endif
-# endif
-# endif
-#endif
-
-/* perl >= 5.10.0 && perl <= 5.15.1 */
-
-
-/* The XS_EXTERNAL macro is used for functions that must not be static
- * like the boot XSUB of a module. If perl didn't have an XS_EXTERNAL
- * macro defined, the best we can do is assume XS is the same.
- * Dito for XS_INTERNAL.
- */
-#ifndef XS_EXTERNAL
-# define XS_EXTERNAL(name) XS(name)
-#endif
-#ifndef XS_INTERNAL
-# define XS_INTERNAL(name) XS(name)
-#endif
-
-/* Now, finally, after all this mess, we want an ExtUtils::ParseXS
- * internal macro that we're free to redefine for varying linkage due
- * to the EXPORT_XSUB_SYMBOLS XS keyword. This is internal, use
- * XS_EXTERNAL(name) or XS_INTERNAL(name) in your code if you need to!
- */
-
-#undef XS_EUPXS
-#if defined(PERL_EUPXS_ALWAYS_EXPORT)
-# define XS_EUPXS(name) XS_EXTERNAL(name)
-#else
- /* default to internal */
-# define XS_EUPXS(name) XS_INTERNAL(name)
-#endif
-
-#ifndef PERL_ARGS_ASSERT_CROAK_XS_USAGE
-#define PERL_ARGS_ASSERT_CROAK_XS_USAGE assert(cv); assert(params)
-
-/* prototype to pass -Wmissing-prototypes */
-STATIC void
-S_croak_xs_usage(const CV *const cv, const char *const params);
-
-STATIC void
-S_croak_xs_usage(const CV *const cv, const char *const params)
-{
- const GV *const gv = CvGV(cv);
-
- PERL_ARGS_ASSERT_CROAK_XS_USAGE;
-
- if (gv) {
- const char *const gvname = GvNAME(gv);
- const HV *const stash = GvSTASH(gv);
- const char *const hvname = stash ? HvNAME(stash) : NULL;
-
- if (hvname)
- Perl_croak_nocontext("Usage: %s::%s(%s)", hvname, gvname, params);
- else
- Perl_croak_nocontext("Usage: %s(%s)", gvname, params);
- } else {
- /* Pants. I don't think that it should be possible to get here. */
- Perl_croak_nocontext("Usage: CODE(0x%"UVxf")(%s)", PTR2UV(cv), params);
- }
-}
-#undef PERL_ARGS_ASSERT_CROAK_XS_USAGE
-
-#define croak_xs_usage S_croak_xs_usage
-
-#endif
-
-/* NOTE: the prototype of newXSproto() is different in versions of perls,
- * so we define a portable version of newXSproto()
- */
-#ifdef newXS_flags
-#define newXSproto_portable(name, c_impl, file, proto) newXS_flags(name, c_impl, file, proto, 0)
-#else
-#define newXSproto_portable(name, c_impl, file, proto) (PL_Sv=(SV*)newXS(name, c_impl, file), sv_setpv(PL_Sv, proto), (CV*)PL_Sv)
-#endif /* !defined(newXS_flags) */
-
-#if PERL_VERSION_LE(5, 21, 5)
-# define newXS_deffile(a,b) Perl_newXS(aTHX_ a,b,file)
-#else
-# define newXS_deffile(a,b) Perl_newXS_deffile(aTHX_ a,b)
-#endif
-
-#line 204 "Perl.c"
-
-/* INCLUDE: Including 'Perl.xsi' from 'Perl.xs' */
-
-#include "Driver_xst.h"
-#if defined(dbd_st_execute_iv)
-#undef dbd_st_execute
-#define dbd_st_execute dbd_st_execute_iv
-#endif
-#if defined(dbd_st_rows_iv)
-#undef dbd_st_rows
-#define dbd_st_rows dbd_st_rows_iv
-#endif
-#if defined(dbd_db_do4_iv)
-#undef dbd_db_do4
-#define dbd_db_do4 dbd_db_do4_iv
-#endif
-
-XS_EUPXS(XS_DBD__Perl__dr_dbixs_revision); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD__Perl__dr_dbixs_revision)
-{
- dVAR; dXSARGS;
- PERL_UNUSED_VAR(cv); /* -W */
- PERL_UNUSED_VAR(ax); /* -Wall */
- SP -= items;
- {
-#line 57 "./Perl.xsi"
- ST(0) = sv_2mortal(newSViv(DBIXS_REVISION));
-#line 232 "Perl.c"
- PUTBACK;
- return;
- }
-}
-
-#ifdef dbd_discon_all
-#define XSubPPtmpAAAA 1
-
-
-XS_EUPXS(XS_DBD__Perl__dr_discon_all_); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD__Perl__dr_discon_all_)
-{
- dVAR; dXSARGS;
- dXSI32;
- if (items != 1)
- croak_xs_usage(cv, "drh");
- {
- SV * drh = ST(0)
-;
-#line 69 "./Perl.xsi"
- D_imp_drh(drh);
- PERL_UNUSED_VAR(ix);
- ST(0) = dbd_discon_all(drh, imp_drh) ? &PL_sv_yes : &PL_sv_no;
-#line 256 "Perl.c"
- }
- XSRETURN(1);
-}
-
-#endif /* dbd_discon_all */
-#ifdef dbd_dr_data_sources
-#define XSubPPtmpAAAB 1
-
-
-XS_EUPXS(XS_DBD__Perl__dr_data_sources); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD__Perl__dr_data_sources)
-{
- dVAR; dXSARGS;
- if (items < 1 || items > 2)
- croak_xs_usage(cv, "drh, attr = Nullsv");
- PERL_UNUSED_VAR(ax); /* -Wall */
- SP -= items;
- {
- SV * drh = ST(0)
-;
- SV * attr;
-
- if (items < 2)
- attr = Nullsv;
- else {
- attr = ST(1)
-;
- }
-#line 83 "./Perl.xsi"
- {
- D_imp_drh(drh);
- AV *av = dbd_dr_data_sources(drh, imp_drh, attr);
- if (av) {
- int i;
- int n = AvFILL(av)+1;
- EXTEND(sp, n);
- for (i = 0; i < n; ++i) {
- PUSHs(AvARRAY(av)[i]);
- }
- }
- }
-#line 298 "Perl.c"
- PUTBACK;
- return;
- }
-}
-
-#endif
-
-XS_EUPXS(XS_DBD__Perl__db__login); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD__Perl__db__login)
-{
- dVAR; dXSARGS;
- if (items < 4 || items > 5)
- croak_xs_usage(cv, "dbh, dbname, username, password, attribs=Nullsv");
- {
- SV * dbh = ST(0)
-;
- SV * dbname = ST(1)
-;
- SV * username = ST(2)
-;
- SV * password = ST(3)
-;
- SV * attribs;
-
- if (items < 5)
- attribs = Nullsv;
- else {
- attribs = ST(4)
-;
- }
-#line 113 "./Perl.xsi"
- {
- D_imp_dbh(dbh);
-#if !defined(dbd_db_login6_sv)
- STRLEN lna;
- char *u = (SvOK(username)) ? SvPV(username,lna) : (char*)"";
- char *p = (SvOK(password)) ? SvPV(password,lna) : (char*)"";
-#endif
-#ifdef dbd_db_login6_sv
- ST(0) = dbd_db_login6_sv(dbh, imp_dbh, dbname, username, password, attribs) ? &PL_sv_yes : &PL_sv_no;
-#elif defined(dbd_db_login6)
- ST(0) = dbd_db_login6(dbh, imp_dbh, SvPV_nolen(dbname), u, p, attribs) ? &PL_sv_yes : &PL_sv_no;
-#else
- PERL_UNUSED_ARG(attribs);
- ST(0) = dbd_db_login( dbh, imp_dbh, SvPV_nolen(dbname), u, p) ? &PL_sv_yes : &PL_sv_no;
-#endif
- }
-#line 346 "Perl.c"
- }
- XSRETURN(1);
-}
-
-
-XS_EUPXS(XS_DBD__Perl__db_selectall_arrayref); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD__Perl__db_selectall_arrayref)
-{
- dVAR; dXSARGS;
- PERL_UNUSED_VAR(cv); /* -W */
- {
-#line 134 "./Perl.xsi"
- SV *sth;
- SV **maxrows_svp;
- SV **tmp_svp;
- SV *tmp_sv;
- SV *attr = &PL_sv_undef;
- imp_sth_t *imp_sth;
-#line 365 "Perl.c"
-#line 141 "./Perl.xsi"
- if (items > 2) {
- attr = ST(2);
- if (SvROK(attr) &&
- (DBD_ATTRIB_TRUE(attr,"Slice",5,tmp_svp) || DBD_ATTRIB_TRUE(attr,"Columns",7,tmp_svp))
- ) {
- /* fallback to perl implementation */
- SV *tmp =dbixst_bounce_method("DBD::Perl::db::SUPER::selectall_arrayref", items);
- SPAGAIN;
- ST(0) = tmp;
- XSRETURN(1);
- }
- }
- /* --- prepare --- */
- if (SvROK(ST(1))) {
- MAGIC *mg;
- sth = ST(1);
- /* switch to inner handle if not already */
- if ( (mg = mg_find(SvRV(sth),'P')) )
- sth = mg->mg_obj;
- }
- else {
- sth = dbixst_bounce_method("prepare", 3);
- SPAGAIN; SP -= items; /* because stack might have been realloc'd */
- if (!SvROK(sth))
- XSRETURN_UNDEF;
- /* switch to inner handle */
- sth = mg_find(SvRV(sth),'P')->mg_obj;
- }
- imp_sth = (imp_sth_t*)(DBIh_COM(sth));
- /* --- bind_param --- */
- if (items > 3) { /* need to bind params before execute */
- if (!dbdxst_bind_params(sth, imp_sth, items-2, ax+2) ) {
- XSRETURN_UNDEF;
- }
- }
- /* --- execute --- */
- DBIc_ROW_COUNT(imp_sth) = 0;
- if ( dbd_st_execute(sth, imp_sth) <= -2 ) { /* -2 == error */
- XSRETURN_UNDEF;
- }
- /* --- fetchall --- */
- maxrows_svp = DBD_ATTRIB_GET_SVP(attr, "MaxRows", 7);
- tmp_sv = dbdxst_fetchall_arrayref(sth, &PL_sv_undef, (maxrows_svp) ? *maxrows_svp : &PL_sv_undef);
- SPAGAIN;
- ST(0) = tmp_sv;
-#line 412 "Perl.c"
- }
- XSRETURN(1);
-}
-
-
-XS_EUPXS(XS_DBD__Perl__db_selectrow_arrayref); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD__Perl__db_selectrow_arrayref)
-{
- dVAR; dXSARGS;
- dXSI32;
- PERL_UNUSED_VAR(cv); /* -W */
- PERL_UNUSED_VAR(ax); /* -Wall */
- SP -= items;
- {
-#line 193 "./Perl.xsi"
- int is_selectrow_array = (ix == 1);
- imp_sth_t *imp_sth;
- SV *sth;
- AV *row_av;
-#line 432 "Perl.c"
-#line 198 "./Perl.xsi"
- if (SvROK(ST(1))) {
- MAGIC *mg;
- sth = ST(1);
- /* switch to inner handle if not already */
- if ( (mg = mg_find(SvRV(sth),'P')) )
- sth = mg->mg_obj;
- }
- else {
- /* --- prepare --- */
- sth = dbixst_bounce_method("prepare", 3);
- SPAGAIN; SP -= items; /* because stack might have been realloc'd */
- if (!SvROK(sth)) {
- if (is_selectrow_array) { XSRETURN_EMPTY; } else { XSRETURN_UNDEF; }
- }
- /* switch to inner handle */
- sth = mg_find(SvRV(sth),'P')->mg_obj;
- }
- imp_sth = (imp_sth_t*)(DBIh_COM(sth));
- /* --- bind_param --- */
- if (items > 3) { /* need to bind params before execute */
- if (!dbdxst_bind_params(sth, imp_sth, items-2, ax+2) ) {
- if (is_selectrow_array) { XSRETURN_EMPTY; } else { XSRETURN_UNDEF; }
- }
- }
- /* --- execute --- */
- DBIc_ROW_COUNT(imp_sth) = 0;
- if ( dbd_st_execute(sth, imp_sth) <= -2 ) { /* -2 == error */
- if (is_selectrow_array) { XSRETURN_EMPTY; } else { XSRETURN_UNDEF; }
- }
- /* --- fetchrow_arrayref --- */
- row_av = dbd_st_fetch(sth, imp_sth);
- if (!row_av) {
- if (GIMME == G_SCALAR)
- PUSHs(&PL_sv_undef);
- }
- else if (is_selectrow_array) {
- int i;
- int num_fields = AvFILL(row_av)+1;
- if (GIMME == G_SCALAR)
- num_fields = 1; /* return just first field */
- EXTEND(sp, num_fields);
- for(i=0; i < num_fields; ++i) {
- PUSHs(AvARRAY(row_av)[i]);
- }
- }
- else {
- PUSHs( sv_2mortal(newRV((SV *)row_av)) );
- }
- /* --- finish --- */
-#ifdef dbd_st_finish3
- dbd_st_finish3(sth, imp_sth, 0);
-#else
- dbd_st_finish(sth, imp_sth);
-#endif
-#line 488 "Perl.c"
- PUTBACK;
- return;
- }
-}
-
-#ifdef dbd_db_do4 /* deebeedee-deebee-doo, deebee-doobee-dah? */
-#define XSubPPtmpAAAC 1
-
-
-XS_EUPXS(XS_DBD__Perl__db_do); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD__Perl__db_do)
-{
- dVAR; dXSARGS;
- if (items < 2 || items > 3)
- croak_xs_usage(cv, "dbh, statement, params = Nullsv");
- {
- SV * dbh = ST(0)
-;
- char * statement = (char *)SvPV_nolen(ST(1))
-;
- SV * params;
-
- if (items < 3)
- params = Nullsv;
- else {
- params = ST(2)
-;
- }
-#line 262 "./Perl.xsi"
- {
- D_imp_dbh(dbh);
- IV retval;
- retval = dbd_db_do4(dbh, imp_dbh, statement, params); /* might be dbd_db_do4_iv via macro */
- /* remember that dbd_db_do4 must return <= -2 for error */
- if (retval == 0) /* ok with no rows affected */
- XST_mPV(0, "0E0"); /* (true but zero) */
- else if (retval < -1) /* -1 == unknown number of rows */
- XST_mUNDEF(0); /* <= -2 means error */
- else
- XST_mIV(0, retval); /* typically 1, rowcount or -1 */
- }
-#line 530 "Perl.c"
- }
- XSRETURN(1);
-}
-
-#endif
-#ifdef dbd_db_last_insert_id
-#define XSubPPtmpAAAD 1
-
-
-XS_EUPXS(XS_DBD__Perl__db_last_insert_id); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD__Perl__db_last_insert_id)
-{
- dVAR; dXSARGS;
- if (items < 5 || items > 6)
- croak_xs_usage(cv, "dbh, catalog, schema, table, field, attr=Nullsv");
- {
- SV * dbh = ST(0)
-;
- SV * catalog = ST(1)
-;
- SV * schema = ST(2)
-;
- SV * table = ST(3)
-;
- SV * field = ST(4)
-;
- SV * attr;
-
- if (items < 6)
- attr = Nullsv;
- else {
- attr = ST(5)
-;
- }
-#line 289 "./Perl.xsi"
- {
- D_imp_dbh(dbh);
- ST(0) = dbd_db_last_insert_id(dbh, imp_dbh, catalog, schema, table, field, attr);
- }
-#line 570 "Perl.c"
- }
- XSRETURN(1);
-}
-
-#endif
-
-XS_EUPXS(XS_DBD__Perl__db_commit); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD__Perl__db_commit)
-{
- dVAR; dXSARGS;
- if (items != 1)
- croak_xs_usage(cv, "dbh");
- {
- SV * dbh = ST(0)
-;
-#line 301 "./Perl.xsi"
- D_imp_dbh(dbh);
- if (DBIc_has(imp_dbh,DBIcf_AutoCommit) && DBIc_WARN(imp_dbh))
- warn("commit ineffective with AutoCommit enabled");
- ST(0) = dbd_db_commit(dbh, imp_dbh) ? &PL_sv_yes : &PL_sv_no;
-#line 591 "Perl.c"
- }
- XSRETURN(1);
-}
-
-
-XS_EUPXS(XS_DBD__Perl__db_rollback); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD__Perl__db_rollback)
-{
- dVAR; dXSARGS;
- if (items != 1)
- croak_xs_usage(cv, "dbh");
- {
- SV * dbh = ST(0)
-;
-#line 311 "./Perl.xsi"
- D_imp_dbh(dbh);
- if (DBIc_has(imp_dbh,DBIcf_AutoCommit) && DBIc_WARN(imp_dbh))
- warn("rollback ineffective with AutoCommit enabled");
- ST(0) = dbd_db_rollback(dbh, imp_dbh) ? &PL_sv_yes : &PL_sv_no;
-#line 611 "Perl.c"
- }
- XSRETURN(1);
-}
-
-
-XS_EUPXS(XS_DBD__Perl__db_disconnect); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD__Perl__db_disconnect)
-{
- dVAR; dXSARGS;
- if (items != 1)
- croak_xs_usage(cv, "dbh");
- {
- SV * dbh = ST(0)
-;
-#line 321 "./Perl.xsi"
- D_imp_dbh(dbh);
- if ( !DBIc_ACTIVE(imp_dbh) ) {
- XSRETURN_YES;
- }
- /* Check for disconnect() being called whilst refs to cursors */
- /* still exists. This possibly needs some more thought. */
- if (DBIc_ACTIVE_KIDS(imp_dbh) && DBIc_WARN(imp_dbh) && !PL_dirty) {
- STRLEN lna;
- char *plural = (DBIc_ACTIVE_KIDS(imp_dbh)==1) ? (char*)"" : (char*)"s";
- warn("%s->disconnect invalidates %d active statement handle%s %s",
- SvPV(dbh,lna), (int)DBIc_ACTIVE_KIDS(imp_dbh), plural,
- "(either destroy statement handles or call finish on them before disconnecting)");
- }
- ST(0) = dbd_db_disconnect(dbh, imp_dbh) ? &PL_sv_yes : &PL_sv_no;
- DBIc_ACTIVE_off(imp_dbh); /* ensure it's off, regardless */
-#line 642 "Perl.c"
- }
- XSRETURN(1);
-}
-
-
-XS_EUPXS(XS_DBD__Perl__db_STORE); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD__Perl__db_STORE)
-{
- dVAR; dXSARGS;
- if (items != 3)
- croak_xs_usage(cv, "dbh, keysv, valuesv");
- {
- SV * dbh = ST(0)
-;
- SV * keysv = ST(1)
-;
- SV * valuesv = ST(2)
-;
-#line 344 "./Perl.xsi"
- D_imp_dbh(dbh);
- if (SvGMAGICAL(valuesv))
- mg_get(valuesv);
- ST(0) = &PL_sv_yes;
- if (!dbd_db_STORE_attrib(dbh, imp_dbh, keysv, valuesv))
- if (!DBIc_DBISTATE(imp_dbh)->set_attr(dbh, keysv, valuesv))
- ST(0) = &PL_sv_no;
-#line 669 "Perl.c"
- }
- XSRETURN(1);
-}
-
-
-XS_EUPXS(XS_DBD__Perl__db_FETCH); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD__Perl__db_FETCH)
-{
- dVAR; dXSARGS;
- if (items != 2)
- croak_xs_usage(cv, "dbh, keysv");
- {
- SV * dbh = ST(0)
-;
- SV * keysv = ST(1)
-;
-#line 358 "./Perl.xsi"
- D_imp_dbh(dbh);
- SV *valuesv = dbd_db_FETCH_attrib(dbh, imp_dbh, keysv);
- if (!valuesv)
- valuesv = DBIc_DBISTATE(imp_dbh)->get_attr(dbh, keysv);
- ST(0) = valuesv; /* dbd_db_FETCH_attrib did sv_2mortal */
-#line 692 "Perl.c"
- }
- XSRETURN(1);
-}
-
-
-XS_EUPXS(XS_DBD__Perl__db_DESTROY); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD__Perl__db_DESTROY)
-{
- dVAR; dXSARGS;
- if (items != 1)
- croak_xs_usage(cv, "dbh");
- PERL_UNUSED_VAR(ax); /* -Wall */
- SP -= items;
- {
- SV * dbh = ST(0)
-;
-#line 369 "./Perl.xsi"
- /* keep in sync with default DESTROY in DBI.xs */
- D_imp_dbh(dbh);
- ST(0) = &PL_sv_yes;
- if (!DBIc_IMPSET(imp_dbh)) { /* was never fully set up */
- STRLEN lna;
- if (DBIc_WARN(imp_dbh) && !PL_dirty && DBIc_DBISTATE(imp_dbh)->debug >= 2)
- PerlIO_printf(DBIc_LOGPIO(imp_dbh),
- " DESTROY for %s ignored - handle not initialised\n",
- SvPV(dbh,lna));
- }
- else {
- if (DBIc_IADESTROY(imp_dbh)) { /* wants ineffective destroy */
- DBIc_ACTIVE_off(imp_dbh);
- if (DBIc_DBISTATE(imp_dbh)->debug)
- PerlIO_printf(DBIc_LOGPIO(imp_dbh), " DESTROY %s skipped due to InactiveDestroy\n", SvPV_nolen(dbh));
- }
- if (DBIc_ACTIVE(imp_dbh)) {
- if (!DBIc_has(imp_dbh,DBIcf_AutoCommit)) {
- /* Application is using transactions and hasn't explicitly disconnected.
- Some databases will automatically commit on graceful disconnect.
- Since we're about to gracefully disconnect as part of the DESTROY
- we want to be sure we're not about to implicitly commit changes
- that are incomplete and should be rolled back. (The DESTROY may
- be due to a RaiseError, for example.) So we rollback here.
- This will be harmless if the application has issued a commit,
- XXX Could add an attribute flag to indicate that the driver
- doesn't have this problem. Patches welcome.
- */
- if (DBIc_WARN(imp_dbh) /* only warn if likely to be useful... */
- && DBIc_is(imp_dbh, DBIcf_Executed) /* has not just called commit/rollback */
- /* && !DBIc_is(imp_dbh, DBIcf_ReadOnly) -- is not read only */
- && (!PL_dirty || DBIc_DBISTATE(imp_dbh)->debug >= 3)
- ) {
- warn("Issuing rollback() due to DESTROY without explicit disconnect() of %s handle %s",
- SvPV_nolen(*hv_fetch((HV*)SvRV(dbh), "ImplementorClass", 16, 1)),
- SvPV_nolen(*hv_fetch((HV*)SvRV(dbh), "Name", 4, 1))
- );
- }
- dbd_db_rollback(dbh, imp_dbh); /* ROLLBACK! */
- }
- dbd_db_disconnect(dbh, imp_dbh);
- DBIc_ACTIVE_off(imp_dbh); /* ensure it's off, regardless */
- }
- dbd_db_destroy(dbh, imp_dbh);
- }
-#line 755 "Perl.c"
- PUTBACK;
- return;
- }
-}
-
-#ifdef dbd_take_imp_data
-#define XSubPPtmpAAAE 1
-
-
-XS_EUPXS(XS_DBD__Perl__db_take_imp_data); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD__Perl__db_take_imp_data)
-{
- dVAR; dXSARGS;
- if (items != 1)
- croak_xs_usage(cv, "h");
- {
- SV * h = ST(0)
-;
-#line 422 "./Perl.xsi"
- D_imp_xxh(h);
- /* dbd_take_imp_data() returns &sv_no (or other defined but false value)
- * to indicate "preparations complete, now call SUPER::take_imp_data" for me.
- * Anything else is returned to the caller via sv_2mortal(sv), typically that
- * would be &sv_undef for error or an SV holding the imp_data.
- */
- SV *sv = dbd_take_imp_data(h, imp_xxh, NULL);
- if (SvOK(sv) && !SvTRUE(sv)) {
- SV *tmp = dbixst_bounce_method("DBD::Perl::db::SUPER::take_imp_data", items);
- SPAGAIN;
- ST(0) = tmp;
- } else {
- ST(0) = sv_2mortal(sv);
- }
-#line 789 "Perl.c"
- }
- XSRETURN(1);
-}
-
-#endif
-#ifdef dbd_db_data_sources
-#define XSubPPtmpAAAF 1
-
-
-XS_EUPXS(XS_DBD__Perl__db_data_sources); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD__Perl__db_data_sources)
-{
- dVAR; dXSARGS;
- if (items < 1 || items > 2)
- croak_xs_usage(cv, "dbh, attr = Nullsv");
- PERL_UNUSED_VAR(ax); /* -Wall */
- SP -= items;
- {
- SV * dbh = ST(0)
-;
- SV * attr;
-
- if (items < 2)
- attr = Nullsv;
- else {
- attr = ST(1)
-;
- }
-#line 446 "./Perl.xsi"
- {
- D_imp_dbh(dbh);
- AV *av = dbd_db_data_sources(dbh, imp_dbh, attr);
- if (av) {
- int i;
- int n = AvFILL(av)+1;
- EXTEND(sp, n);
- for (i = 0; i < n; ++i) {
- PUSHs(AvARRAY(av)[i]);
- }
- }
- }
-#line 831 "Perl.c"
- PUTBACK;
- return;
- }
-}
-
-#endif
-
-XS_EUPXS(XS_DBD__Perl__st__prepare); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD__Perl__st__prepare)
-{
- dVAR; dXSARGS;
- if (items < 2 || items > 3)
- croak_xs_usage(cv, "sth, statement, attribs=Nullsv");
- {
- SV * sth = ST(0)
-;
- SV * statement = ST(1)
-;
- SV * attribs;
-
- if (items < 3)
- attribs = Nullsv;
- else {
- attribs = ST(2)
-;
- }
-#line 475 "./Perl.xsi"
- {
- D_imp_sth(sth);
- DBD_ATTRIBS_CHECK("_prepare", sth, attribs);
-#ifdef dbd_st_prepare_sv
- ST(0) = dbd_st_prepare_sv(sth, imp_sth, statement, attribs) ? &PL_sv_yes : &PL_sv_no;
-#else
- ST(0) = dbd_st_prepare(sth, imp_sth, SvPV_nolen(statement), attribs) ? &PL_sv_yes : &PL_sv_no;
-#endif
- }
-#line 868 "Perl.c"
- }
- XSRETURN(1);
-}
-
-#ifdef dbd_st_rows
-#define XSubPPtmpAAAG 1
-
-
-XS_EUPXS(XS_DBD__Perl__st_rows); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD__Perl__st_rows)
-{
- dVAR; dXSARGS;
- if (items != 1)
- croak_xs_usage(cv, "sth");
- {
- SV * sth = ST(0)
-;
-#line 492 "./Perl.xsi"
- D_imp_sth(sth);
- XST_mIV(0, dbd_st_rows(sth, imp_sth));
-#line 889 "Perl.c"
- }
- XSRETURN(1);
-}
-
-#endif /* dbd_st_rows */
-#ifdef dbd_st_bind_col
-#define XSubPPtmpAAAH 1
-
-
-XS_EUPXS(XS_DBD__Perl__st_bind_col); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD__Perl__st_bind_col)
-{
- dVAR; dXSARGS;
- if (items < 3 || items > 4)
- croak_xs_usage(cv, "sth, col, ref, attribs=Nullsv");
- {
- SV * sth = ST(0)
-;
- SV * col = ST(1)
-;
- SV * ref = ST(2)
-;
- SV * attribs;
-
- if (items < 4)
- attribs = Nullsv;
- else {
- attribs = ST(3)
-;
- }
-#line 507 "./Perl.xsi"
- {
- IV sql_type = 0;
- D_imp_sth(sth);
- if (SvGMAGICAL(ref))
- mg_get(ref);
- if (attribs) {
- if (SvNIOK(attribs)) {
- sql_type = SvIV(attribs);
- attribs = Nullsv;
- }
- else {
- SV **svp;
- DBD_ATTRIBS_CHECK("bind_col", sth, attribs);
- /* XXX we should perhaps complain if TYPE is not SvNIOK */
- DBD_ATTRIB_GET_IV(attribs, "TYPE",4, svp, sql_type);
- }
- }
- switch(dbd_st_bind_col(sth, imp_sth, col, ref, sql_type, attribs)) {
- case 2: ST(0) = &PL_sv_yes; /* job done completely */
- break;
- case 1: /* fallback to DBI default */
- ST(0) = (DBIc_DBISTATE(imp_sth)->bind_col(sth, col, ref, attribs))
- ? &PL_sv_yes : &PL_sv_no;
- break;
- default: ST(0) = &PL_sv_no; /* dbd_st_bind_col has called set_err */
- break;
- }
- }
-#line 949 "Perl.c"
- }
- XSRETURN(1);
-}
-
-#endif /* dbd_st_bind_col */
-
-XS_EUPXS(XS_DBD__Perl__st_bind_param); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD__Perl__st_bind_param)
-{
- dVAR; dXSARGS;
- if (items < 3 || items > 4)
- croak_xs_usage(cv, "sth, param, value, attribs=Nullsv");
- {
- SV * sth = ST(0)
-;
- SV * param = ST(1)
-;
- SV * value = ST(2)
-;
- SV * attribs;
-
- if (items < 4)
- attribs = Nullsv;
- else {
- attribs = ST(3)
-;
- }
-#line 545 "./Perl.xsi"
- {
- IV sql_type = 0;
- D_imp_sth(sth);
- if (SvGMAGICAL(value))
- mg_get(value);
- if (attribs) {
- if (SvNIOK(attribs)) {
- sql_type = SvIV(attribs);
- attribs = Nullsv;
- }
- else {
- SV **svp;
- DBD_ATTRIBS_CHECK("bind_param", sth, attribs);
- /* XXX we should perhaps complain if TYPE is not SvNIOK */
- DBD_ATTRIB_GET_IV(attribs, "TYPE",4, svp, sql_type);
- }
- }
- ST(0) = dbd_bind_ph(sth, imp_sth, param, value, sql_type, attribs, FALSE, 0)
- ? &PL_sv_yes : &PL_sv_no;
- }
-#line 998 "Perl.c"
- }
- XSRETURN(1);
-}
-
-
-XS_EUPXS(XS_DBD__Perl__st_bind_param_inout); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD__Perl__st_bind_param_inout)
-{
- dVAR; dXSARGS;
- if (items < 4 || items > 5)
- croak_xs_usage(cv, "sth, param, value_ref, maxlen, attribs=Nullsv");
- {
- SV * sth = ST(0)
-;
- SV * param = ST(1)
-;
- SV * value_ref = ST(2)
-;
- IV maxlen = (IV)SvIV(ST(3))
-;
- SV * attribs;
-
- if (items < 5)
- attribs = Nullsv;
- else {
- attribs = ST(4)
-;
- }
-#line 575 "./Perl.xsi"
- {
- IV sql_type = 0;
- D_imp_sth(sth);
- SV *value;
- if (!SvROK(value_ref) || SvTYPE(SvRV(value_ref)) > SVt_PVMG)
- croak("bind_param_inout needs a reference to a scalar value");
- value = SvRV(value_ref);
- if (SvREADONLY(value))
- croak("Modification of a read-only value attempted");
- if (SvGMAGICAL(value))
- mg_get(value);
- if (attribs) {
- if (SvNIOK(attribs)) {
- sql_type = SvIV(attribs);
- attribs = Nullsv;
- }
- else {
- SV **svp;
- DBD_ATTRIBS_CHECK("bind_param", sth, attribs);
- DBD_ATTRIB_GET_IV(attribs, "TYPE",4, svp, sql_type);
- }
- }
- ST(0) = dbd_bind_ph(sth, imp_sth, param, value, sql_type, attribs, TRUE, maxlen)
- ? &PL_sv_yes : &PL_sv_no;
- }
-#line 1053 "Perl.c"
- }
- XSRETURN(1);
-}
-
-
-XS_EUPXS(XS_DBD__Perl__st_execute); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD__Perl__st_execute)
-{
- dVAR; dXSARGS;
- if (items < 1)
- croak_xs_usage(cv, "sth, ...");
- {
- SV * sth = ST(0)
-;
-#line 606 "./Perl.xsi"
- D_imp_sth(sth);
- IV retval;
- if (items > 1) { /* need to bind params */
- if (!dbdxst_bind_params(sth, imp_sth, items, ax) ) {
- XSRETURN_UNDEF;
- }
- }
- /* XXX this code is duplicated in selectrow_arrayref above */
- DBIc_ROW_COUNT(imp_sth) = 0;
- retval = dbd_st_execute(sth, imp_sth); /* might be dbd_st_execute_iv via macro */
- /* remember that dbd_st_execute must return <= -2 for error */
- if (retval == 0) /* ok with no rows affected */
- XST_mPV(0, "0E0"); /* (true but zero) */
- else if (retval < -1) /* -1 == unknown number of rows */
- XST_mUNDEF(0); /* <= -2 means error */
- else
- XST_mIV(0, retval); /* typically 1, rowcount or -1 */
-#line 1086 "Perl.c"
- }
- XSRETURN(1);
-}
-
-#ifdef dbd_st_execute_for_fetch
-#define XSubPPtmpAAAI 1
-
-
-XS_EUPXS(XS_DBD__Perl__st_execute_for_fetch); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD__Perl__st_execute_for_fetch)
-{
- dVAR; dXSARGS;
- if (items < 2 || items > 3)
- croak_xs_usage(cv, "sth, fetch_tuple_sub, tuple_status = Nullsv");
- {
- SV * sth = ST(0)
-;
- SV * fetch_tuple_sub = ST(1)
-;
- SV * tuple_status;
-
- if (items < 3)
- tuple_status = Nullsv;
- else {
- tuple_status = ST(2)
-;
- }
-#line 633 "./Perl.xsi"
- {
- D_imp_sth(sth);
- ST(0) = dbd_st_execute_for_fetch(sth, imp_sth, fetch_tuple_sub, tuple_status);
- }
-#line 1119 "Perl.c"
- }
- XSRETURN(1);
-}
-
-#endif
-
-XS_EUPXS(XS_DBD__Perl__st_fetchrow_arrayref); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD__Perl__st_fetchrow_arrayref)
-{
- dVAR; dXSARGS;
- dXSI32;
- if (items != 1)
- croak_xs_usage(cv, "sth");
- {
- SV * sth = ST(0)
-;
-#line 648 "./Perl.xsi"
- D_imp_sth(sth);
- AV *av;
- PERL_UNUSED_VAR(ix);
- av = dbd_st_fetch(sth, imp_sth);
- ST(0) = (av) ? sv_2mortal(newRV((SV *)av)) : &PL_sv_undef;
-#line 1142 "Perl.c"
- }
- XSRETURN(1);
-}
-
-
-XS_EUPXS(XS_DBD__Perl__st_fetchrow_array); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD__Perl__st_fetchrow_array)
-{
- dVAR; dXSARGS;
- dXSI32;
- if (items != 1)
- croak_xs_usage(cv, "sth");
- PERL_UNUSED_VAR(ax); /* -Wall */
- SP -= items;
- {
- SV * sth = ST(0)
-;
-#line 661 "./Perl.xsi"
- D_imp_sth(sth);
- AV *av;
- av = dbd_st_fetch(sth, imp_sth);
- if (av) {
- int i;
- int num_fields = AvFILL(av)+1;
- EXTEND(sp, num_fields);
- for(i=0; i < num_fields; ++i) {
- PUSHs(AvARRAY(av)[i]);
- }
- PERL_UNUSED_VAR(ix);
- }
-#line 1173 "Perl.c"
- PUTBACK;
- return;
- }
-}
-
-
-XS_EUPXS(XS_DBD__Perl__st_fetchall_arrayref); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD__Perl__st_fetchall_arrayref)
-{
- dVAR; dXSARGS;
- if (items < 1 || items > 3)
- croak_xs_usage(cv, "sth, slice=&PL_sv_undef, batch_row_count=&PL_sv_undef");
- {
- SV * sth = ST(0)
-;
- SV * slice;
- SV * batch_row_count;
-
- if (items < 2)
- slice = &PL_sv_undef;
- else {
- slice = ST(1)
-;
- }
-
- if (items < 3)
- batch_row_count = &PL_sv_undef;
- else {
- batch_row_count = ST(2)
-;
- }
-#line 681 "./Perl.xsi"
- if (SvOK(slice)) { /* fallback to perl implementation */
- SV *tmp = dbixst_bounce_method("DBD::Perl::st::SUPER::fetchall_arrayref", 3);
- SPAGAIN;
- ST(0) = tmp;
- }
- else {
- SV *tmp = dbdxst_fetchall_arrayref(sth, slice, batch_row_count);
- SPAGAIN;
- ST(0) = tmp;
- }
-#line 1216 "Perl.c"
- }
- XSRETURN(1);
-}
-
-
-XS_EUPXS(XS_DBD__Perl__st_finish); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD__Perl__st_finish)
-{
- dVAR; dXSARGS;
- if (items != 1)
- croak_xs_usage(cv, "sth");
- {
- SV * sth = ST(0)
-;
-#line 697 "./Perl.xsi"
- D_imp_sth(sth);
- D_imp_dbh_from_sth;
- if (!DBIc_ACTIVE(imp_sth)) {
- /* No active statement to finish */
- XSRETURN_YES;
- }
- if (!DBIc_ACTIVE(imp_dbh)) {
- /* Either an explicit disconnect() or global destruction */
- /* has disconnected us from the database. Finish is meaningless */
- DBIc_ACTIVE_off(imp_sth);
- XSRETURN_YES;
- }
-#ifdef dbd_st_finish3
- ST(0) = dbd_st_finish3(sth, imp_sth, 0) ? &PL_sv_yes : &PL_sv_no;
-#else
- ST(0) = dbd_st_finish(sth, imp_sth) ? &PL_sv_yes : &PL_sv_no;
-#endif
-#line 1249 "Perl.c"
- }
- XSRETURN(1);
-}
-
-
-XS_EUPXS(XS_DBD__Perl__st_blob_read); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD__Perl__st_blob_read)
-{
- dVAR; dXSARGS;
- if (items < 4 || items > 6)
- croak_xs_usage(cv, "sth, field, offset, len, destrv=Nullsv, destoffset=0");
- {
- SV * sth = ST(0)
-;
- int field = (int)SvIV(ST(1))
-;
- long offset = (long)SvIV(ST(2))
-;
- long len = (long)SvIV(ST(3))
-;
- SV * destrv;
- long destoffset;
-
- if (items < 5)
- destrv = Nullsv;
- else {
- destrv = ST(4)
-;
- }
-
- if (items < 6)
- destoffset = 0;
- else {
- destoffset = (long)SvIV(ST(5))
-;
- }
-#line 725 "./Perl.xsi"
- {
- D_imp_sth(sth);
- if (!destrv)
- destrv = sv_2mortal(newRV(sv_2mortal(newSV(0))));
- if (dbd_st_blob_read(sth, imp_sth, field, offset, len, destrv, destoffset))
- ST(0) = SvRV(destrv);
- else ST(0) = &PL_sv_undef;
- }
-#line 1295 "Perl.c"
- }
- XSRETURN(1);
-}
-
-
-XS_EUPXS(XS_DBD__Perl__st_STORE); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD__Perl__st_STORE)
-{
- dVAR; dXSARGS;
- if (items != 3)
- croak_xs_usage(cv, "sth, keysv, valuesv");
- {
- SV * sth = ST(0)
-;
- SV * keysv = ST(1)
-;
- SV * valuesv = ST(2)
-;
-#line 741 "./Perl.xsi"
- D_imp_sth(sth);
- if (SvGMAGICAL(valuesv))
- mg_get(valuesv);
- ST(0) = &PL_sv_yes;
- if (!dbd_st_STORE_attrib(sth, imp_sth, keysv, valuesv))
- if (!DBIc_DBISTATE(imp_sth)->set_attr(sth, keysv, valuesv))
- ST(0) = &PL_sv_no;
-#line 1322 "Perl.c"
- }
- XSRETURN(1);
-}
-
-
-XS_EUPXS(XS_DBD__Perl__st_FETCH_attrib); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD__Perl__st_FETCH_attrib)
-{
- dVAR; dXSARGS;
- dXSI32;
- if (items != 2)
- croak_xs_usage(cv, "sth, keysv");
- {
- SV * sth = ST(0)
-;
- SV * keysv = ST(1)
-;
-#line 758 "./Perl.xsi"
- D_imp_sth(sth);
- SV *valuesv;
- PERL_UNUSED_VAR(ix);
- valuesv = dbd_st_FETCH_attrib(sth, imp_sth, keysv);
- if (!valuesv)
- valuesv = DBIc_DBISTATE(imp_sth)->get_attr(sth, keysv);
- ST(0) = valuesv; /* dbd_st_FETCH_attrib did sv_2mortal */
-#line 1348 "Perl.c"
- }
- XSRETURN(1);
-}
-
-
-XS_EUPXS(XS_DBD__Perl__st_DESTROY); /* prototype to pass -Wmissing-prototypes */
-XS_EUPXS(XS_DBD__Perl__st_DESTROY)
-{
- dVAR; dXSARGS;
- if (items != 1)
- croak_xs_usage(cv, "sth");
- PERL_UNUSED_VAR(ax); /* -Wall */
- SP -= items;
- {
- SV * sth = ST(0)
-;
-#line 771 "./Perl.xsi"
- /* keep in sync with default DESTROY in DBI.xs */
- D_imp_sth(sth);
- ST(0) = &PL_sv_yes;
- if (!DBIc_IMPSET(imp_sth)) { /* was never fully set up */
- STRLEN lna;
- if (DBIc_WARN(imp_sth) && !PL_dirty && DBIc_DBISTATE(imp_sth)->debug >= 2)
- PerlIO_printf(DBIc_LOGPIO(imp_sth),
- " DESTROY for %s ignored - handle not initialised\n",
- SvPV(sth,lna));
- }
- else {
- if (DBIc_IADESTROY(imp_sth)) { /* wants ineffective destroy */
- DBIc_ACTIVE_off(imp_sth);
- if (DBIc_DBISTATE(imp_sth)->debug)
- PerlIO_printf(DBIc_LOGPIO(imp_sth), " DESTROY %s skipped due to InactiveDestroy\n", SvPV_nolen(sth));
- }
- if (DBIc_ACTIVE(imp_sth)) {
- D_imp_dbh_from_sth;
- if (!PL_dirty && DBIc_ACTIVE(imp_dbh)) {
-#ifdef dbd_st_finish3
- dbd_st_finish3(sth, imp_sth, 1);
-#else
- dbd_st_finish(sth, imp_sth);
-#endif
- }
- else {
- DBIc_ACTIVE_off(imp_sth);
- }
- }
- dbd_st_destroy(sth, imp_sth);
- }
-#line 1397 "Perl.c"
- PUTBACK;
- return;
- }
-}
-
-
-/* INCLUDE: Returning to 'Perl.xs' from 'Perl.xsi' */
-
-#ifdef __cplusplus
-extern "C"
-#endif
-XS_EXTERNAL(boot_DBD__Perl); /* prototype to pass -Wmissing-prototypes */
-XS_EXTERNAL(boot_DBD__Perl)
-{
-#if PERL_VERSION_LE(5, 21, 5)
- dVAR; dXSARGS;
-#else
- dVAR; dXSBOOTARGSXSAPIVERCHK;
-#endif
-#if (PERL_REVISION == 5 && PERL_VERSION < 9)
- char* file = __FILE__;
-#else
- const char* file = __FILE__;
-#endif
-
- PERL_UNUSED_VAR(file);
-
- PERL_UNUSED_VAR(cv); /* -W */
- PERL_UNUSED_VAR(items); /* -W */
-#if PERL_VERSION_LE(5, 21, 5)
- XS_VERSION_BOOTCHECK;
-# ifdef XS_APIVERSION_BOOTCHECK
- XS_APIVERSION_BOOTCHECK;
-# endif
-#endif
-
- newXS_deffile("DBD::Perl::dr::dbixs_revision", XS_DBD__Perl__dr_dbixs_revision);
-#if XSubPPtmpAAAA
- cv = newXS_deffile("DBD::Perl::dr::discon_all_", XS_DBD__Perl__dr_discon_all_);
- XSANY.any_i32 = 0;
- cv = newXS_deffile("DBD::Perl::dr::disconnect_all", XS_DBD__Perl__dr_discon_all_);
- XSANY.any_i32 = 1;
-#endif
-#if XSubPPtmpAAAB
- newXS_deffile("DBD::Perl::dr::data_sources", XS_DBD__Perl__dr_data_sources);
-#endif
- newXS_deffile("DBD::Perl::db::_login", XS_DBD__Perl__db__login);
- newXS_deffile("DBD::Perl::db::selectall_arrayref", XS_DBD__Perl__db_selectall_arrayref);
- cv = newXS_deffile("DBD::Perl::db::selectrow_array", XS_DBD__Perl__db_selectrow_arrayref);
- XSANY.any_i32 = 1;
- cv = newXS_deffile("DBD::Perl::db::selectrow_arrayref", XS_DBD__Perl__db_selectrow_arrayref);
- XSANY.any_i32 = 0;
-#if XSubPPtmpAAAC
- newXS_deffile("DBD::Perl::db::do", XS_DBD__Perl__db_do);
-#endif
-#if XSubPPtmpAAAD
- newXS_deffile("DBD::Perl::db::last_insert_id", XS_DBD__Perl__db_last_insert_id);
-#endif
- newXS_deffile("DBD::Perl::db::commit", XS_DBD__Perl__db_commit);
- newXS_deffile("DBD::Perl::db::rollback", XS_DBD__Perl__db_rollback);
- newXS_deffile("DBD::Perl::db::disconnect", XS_DBD__Perl__db_disconnect);
- newXS_deffile("DBD::Perl::db::STORE", XS_DBD__Perl__db_STORE);
- newXS_deffile("DBD::Perl::db::FETCH", XS_DBD__Perl__db_FETCH);
- newXS_deffile("DBD::Perl::db::DESTROY", XS_DBD__Perl__db_DESTROY);
-#if XSubPPtmpAAAE
- newXS_deffile("DBD::Perl::db::take_imp_data", XS_DBD__Perl__db_take_imp_data);
-#endif
-#if XSubPPtmpAAAF
- newXS_deffile("DBD::Perl::db::data_sources", XS_DBD__Perl__db_data_sources);
-#endif
- newXS_deffile("DBD::Perl::st::_prepare", XS_DBD__Perl__st__prepare);
-#if XSubPPtmpAAAG
- newXS_deffile("DBD::Perl::st::rows", XS_DBD__Perl__st_rows);
-#endif
-#if XSubPPtmpAAAH
- newXS_deffile("DBD::Perl::st::bind_col", XS_DBD__Perl__st_bind_col);
-#endif
- newXS_deffile("DBD::Perl::st::bind_param", XS_DBD__Perl__st_bind_param);
- newXS_deffile("DBD::Perl::st::bind_param_inout", XS_DBD__Perl__st_bind_param_inout);
- newXS_deffile("DBD::Perl::st::execute", XS_DBD__Perl__st_execute);
-#if XSubPPtmpAAAI
- newXS_deffile("DBD::Perl::st::execute_for_fetch", XS_DBD__Perl__st_execute_for_fetch);
-#endif
- cv = newXS_deffile("DBD::Perl::st::fetch", XS_DBD__Perl__st_fetchrow_arrayref);
- XSANY.any_i32 = 1;
- cv = newXS_deffile("DBD::Perl::st::fetchrow_arrayref", XS_DBD__Perl__st_fetchrow_arrayref);
- XSANY.any_i32 = 0;
- cv = newXS_deffile("DBD::Perl::st::fetchrow", XS_DBD__Perl__st_fetchrow_array);
- XSANY.any_i32 = 1;
- cv = newXS_deffile("DBD::Perl::st::fetchrow_array", XS_DBD__Perl__st_fetchrow_array);
- XSANY.any_i32 = 0;
- newXS_deffile("DBD::Perl::st::fetchall_arrayref", XS_DBD__Perl__st_fetchall_arrayref);
- newXS_deffile("DBD::Perl::st::finish", XS_DBD__Perl__st_finish);
- newXS_deffile("DBD::Perl::st::blob_read", XS_DBD__Perl__st_blob_read);
- newXS_deffile("DBD::Perl::st::STORE", XS_DBD__Perl__st_STORE);
- cv = newXS_deffile("DBD::Perl::st::FETCH", XS_DBD__Perl__st_FETCH_attrib);
- XSANY.any_i32 = 1;
- cv = newXS_deffile("DBD::Perl::st::FETCH_attrib", XS_DBD__Perl__st_FETCH_attrib);
- XSANY.any_i32 = 0;
- newXS_deffile("DBD::Perl::st::DESTROY", XS_DBD__Perl__st_DESTROY);
-
- /* Initialisation Section */
-
-#line 39 "./Perl.xsi"
- PERL_UNUSED_VAR(items);
- DBISTATE_INIT;
- /* XXX this interface will change: */
- DBI_IMP_SIZE("DBD::Perl::dr::imp_data_size", sizeof(imp_drh_t));
- DBI_IMP_SIZE("DBD::Perl::db::imp_data_size", sizeof(imp_dbh_t));
- DBI_IMP_SIZE("DBD::Perl::st::imp_data_size", sizeof(imp_sth_t));
- dbd_init(DBIS);
-
-#if XSubPPtmpAAAA
-#endif
-#if XSubPPtmpAAAB
-#endif
-#if XSubPPtmpAAAC
-#endif
-#if XSubPPtmpAAAD
-#endif
-#if XSubPPtmpAAAE
-#endif
-#if XSubPPtmpAAAF
-#endif
-#if XSubPPtmpAAAG
-#endif
-#if XSubPPtmpAAAH
-#endif
-#if XSubPPtmpAAAI
-#endif
-#line 1528 "Perl.c"
-
- /* End of Initialisation Section */
-
-#if PERL_VERSION_LE(5, 21, 5)
-# if PERL_VERSION_GE(5, 9, 0)
- if (PL_unitcheckav)
- call_list(PL_scopestack_ix, PL_unitcheckav);
-# endif
- XSRETURN_YES;
-#else
- Perl_xs_boot_epilog(aTHX_ ax);
-#endif
-}
-
+++ /dev/null
-/* This is a skeleton driver that only serves as a basic sanity check
- that the Driver.xst mechansim doesn't have compile-time errors in it.
- vim: ts=8:sw=4:expandtab
-*/
-
-#define PERL_NO_GET_CONTEXT
-#include "DBIXS.h"
-#include "dbd_xsh.h"
-
-#undef DBIh_SET_ERR_CHAR /* to syntax check emulation */
-#include "dbivport.h"
-
-DBISTATE_DECLARE;
-
-
-struct imp_drh_st {
- dbih_drc_t com; /* MUST be first element in structure */
-};
-struct imp_dbh_st {
- dbih_dbc_t com; /* MUST be first element in structure */
-};
-struct imp_sth_st {
- dbih_stc_t com; /* MUST be first element in structure */
-};
-
-
-
-#define dbd_discon_all(drh, imp_drh) (drh=drh,imp_drh=imp_drh,1)
-#define dbd_dr_data_sources(drh, imp_drh, attr) (drh=drh,imp_drh=imp_drh,attr=attr,Nullav)
-#define dbd_db_do4_iv(dbh,imp_dbh,p3,p4) (dbh=dbh,imp_dbh=imp_dbh,p3=p3,p4=p4,-2)
-#define dbd_db_last_insert_id(dbh, imp_dbh, p3,p4,p5,p6, attr) \
- (dbh=dbh,imp_dbh=imp_dbh,p3=p3,p4=p4,p5=p5,p6=p6,attr=attr,&PL_sv_undef)
-#define dbd_take_imp_data(h, imp_xxh, p3) (h=h,imp_xxh=imp_xxh,&PL_sv_undef)
-#define dbd_st_execute_for_fetch(sth, imp_sth, p3, p4) \
- (sth=sth,imp_sth=imp_sth,p3=p3,p4=p4,&PL_sv_undef)
-
-#define dbd_st_bind_col(sth, imp_sth, param, ref, sql_type, attribs) \
- (sth=sth,imp_sth=imp_sth,param=param,ref=ref,sql_type=sql_type,attribs=attribs,1)
-
-int /* just to test syntax of macros etc */
-dbd_st_rows(SV *h, imp_sth_t *imp_sth)
-{
- dTHX;
- PERL_UNUSED_VAR(h);
- DBIh_SET_ERR_CHAR(h, imp_sth, 0, 1, "err msg", "12345", Nullch);
- return -1;
-}
-
-
-MODULE = DBD::Perl PACKAGE = DBD::Perl
-
-INCLUDE: Perl.xsi
-
-# vim:sw=4:ts=8
+++ /dev/null
-# $Id$
-# Copyright (c) 1997-2002 Tim Bunce Ireland
-# Copyright (c) 2002 Jonathan Leffler
-#
-# You may distribute under the terms of either the GNU General Public
-# License or the Artistic License, as specified in the Perl README file.
-
-
-#include "Driver_xst.h"
-
-# Historically dbd_db_do4, dbd_st_execute, and dbd_st_rows returned an 'int' type.
-# That's only 32 bits (31+sign) so isn't sufficient for very large row counts
-# So now instead of defining those macros, drivers can define dbd_db_do4_iv,
-# dbd_st_execute_iv, and dbd_st_rows_iv to be the names of functions that
-# return an 'IV' type. They could also set DBIc_ROW_COUNT(imp_sth).
-#
-# To save a mess of #ifdef's we arrange for dbd_st_execute (etc) to work
-# as dbd_st_execute_iv if that's defined
-#
-#if defined(dbd_st_execute_iv)
-#undef dbd_st_execute
-#define dbd_st_execute dbd_st_execute_iv
-#endif
-#if defined(dbd_st_rows_iv)
-#undef dbd_st_rows
-#define dbd_st_rows dbd_st_rows_iv
-#endif
-#if defined(dbd_db_do4_iv)
-#undef dbd_db_do4
-#define dbd_db_do4 dbd_db_do4_iv
-#endif
-
-MODULE = DBD::Perl PACKAGE = DBD::Perl
-
-REQUIRE: 1.929
-PROTOTYPES: DISABLE
-
-BOOT:
- PERL_UNUSED_VAR(items);
- DBISTATE_INIT;
- /* XXX this interface will change: */
- DBI_IMP_SIZE("DBD::Perl::dr::imp_data_size", sizeof(imp_drh_t));
- DBI_IMP_SIZE("DBD::Perl::db::imp_data_size", sizeof(imp_dbh_t));
- DBI_IMP_SIZE("DBD::Perl::st::imp_data_size", sizeof(imp_sth_t));
- dbd_init(DBIS);
-
-
-# ------------------------------------------------------------
-# driver level interface
-# ------------------------------------------------------------
-MODULE = DBD::Perl PACKAGE = DBD::Perl::dr
-
-
-void
-dbixs_revision(...)
- PPCODE:
- ST(0) = sv_2mortal(newSViv(DBIXS_REVISION));
-
-
-#ifdef dbd_discon_all
-
-# disconnect_all renamed and ALIAS'd to avoid length clash on VMS :-(
-void
-discon_all_(drh)
- SV * drh
- ALIAS:
- disconnect_all = 1
- CODE:
- D_imp_drh(drh);
- PERL_UNUSED_VAR(ix);
- ST(0) = dbd_discon_all(drh, imp_drh) ? &PL_sv_yes : &PL_sv_no;
-
-#endif /* dbd_discon_all */
-
-
-#ifdef dbd_dr_data_sources
-
-void
-data_sources(drh, attr = Nullsv)
- SV *drh
- SV *attr
- PPCODE:
- {
- D_imp_drh(drh);
- AV *av = dbd_dr_data_sources(drh, imp_drh, attr);
- if (av) {
- int i;
- int n = AvFILL(av)+1;
- EXTEND(sp, n);
- for (i = 0; i < n; ++i) {
- PUSHs(AvARRAY(av)[i]);
- }
- }
- }
-
-#endif
-
-
-# ------------------------------------------------------------
-# database level interface
-# ------------------------------------------------------------
-MODULE = DBD::Perl PACKAGE = DBD::Perl::db
-
-
-void
-_login(dbh, dbname, username, password, attribs=Nullsv)
- SV * dbh
- SV * dbname
- SV * username
- SV * password
- SV * attribs
- CODE:
- {
- D_imp_dbh(dbh);
-#if !defined(dbd_db_login6_sv)
- STRLEN lna;
- char *u = (SvOK(username)) ? SvPV(username,lna) : (char*)"";
- char *p = (SvOK(password)) ? SvPV(password,lna) : (char*)"";
-#endif
-#ifdef dbd_db_login6_sv
- ST(0) = dbd_db_login6_sv(dbh, imp_dbh, dbname, username, password, attribs) ? &PL_sv_yes : &PL_sv_no;
-#elif defined(dbd_db_login6)
- ST(0) = dbd_db_login6(dbh, imp_dbh, SvPV_nolen(dbname), u, p, attribs) ? &PL_sv_yes : &PL_sv_no;
-#else
- PERL_UNUSED_ARG(attribs);
- ST(0) = dbd_db_login( dbh, imp_dbh, SvPV_nolen(dbname), u, p) ? &PL_sv_yes : &PL_sv_no;
-#endif
- }
-
-
-void
-selectall_arrayref(...)
- PREINIT:
- SV *sth;
- SV **maxrows_svp;
- SV **tmp_svp;
- SV *tmp_sv;
- SV *attr = &PL_sv_undef;
- imp_sth_t *imp_sth;
- CODE:
- if (items > 2) {
- attr = ST(2);
- if (SvROK(attr) &&
- (DBD_ATTRIB_TRUE(attr,"Slice",5,tmp_svp) || DBD_ATTRIB_TRUE(attr,"Columns",7,tmp_svp))
- ) {
- /* fallback to perl implementation */
- SV *tmp =dbixst_bounce_method("DBD::Perl::db::SUPER::selectall_arrayref", items);
- SPAGAIN;
- ST(0) = tmp;
- XSRETURN(1);
- }
- }
- /* --- prepare --- */
- if (SvROK(ST(1))) {
- MAGIC *mg;
- sth = ST(1);
- /* switch to inner handle if not already */
- if ( (mg = mg_find(SvRV(sth),'P')) )
- sth = mg->mg_obj;
- }
- else {
- sth = dbixst_bounce_method("prepare", 3);
- SPAGAIN; SP -= items; /* because stack might have been realloc'd */
- if (!SvROK(sth))
- XSRETURN_UNDEF;
- /* switch to inner handle */
- sth = mg_find(SvRV(sth),'P')->mg_obj;
- }
- imp_sth = (imp_sth_t*)(DBIh_COM(sth));
- /* --- bind_param --- */
- if (items > 3) { /* need to bind params before execute */
- if (!dbdxst_bind_params(sth, imp_sth, items-2, ax+2) ) {
- XSRETURN_UNDEF;
- }
- }
- /* --- execute --- */
- DBIc_ROW_COUNT(imp_sth) = 0;
- if ( dbd_st_execute(sth, imp_sth) <= -2 ) { /* -2 == error */
- XSRETURN_UNDEF;
- }
- /* --- fetchall --- */
- maxrows_svp = DBD_ATTRIB_GET_SVP(attr, "MaxRows", 7);
- tmp_sv = dbdxst_fetchall_arrayref(sth, &PL_sv_undef, (maxrows_svp) ? *maxrows_svp : &PL_sv_undef);
- SPAGAIN;
- ST(0) = tmp_sv;
-
-
-void
-selectrow_arrayref(...)
- ALIAS:
- selectrow_array = 1
- PREINIT:
- int is_selectrow_array = (ix == 1);
- imp_sth_t *imp_sth;
- SV *sth;
- AV *row_av;
- PPCODE:
- if (SvROK(ST(1))) {
- MAGIC *mg;
- sth = ST(1);
- /* switch to inner handle if not already */
- if ( (mg = mg_find(SvRV(sth),'P')) )
- sth = mg->mg_obj;
- }
- else {
- /* --- prepare --- */
- sth = dbixst_bounce_method("prepare", 3);
- SPAGAIN; SP -= items; /* because stack might have been realloc'd */
- if (!SvROK(sth)) {
- if (is_selectrow_array) { XSRETURN_EMPTY; } else { XSRETURN_UNDEF; }
- }
- /* switch to inner handle */
- sth = mg_find(SvRV(sth),'P')->mg_obj;
- }
- imp_sth = (imp_sth_t*)(DBIh_COM(sth));
- /* --- bind_param --- */
- if (items > 3) { /* need to bind params before execute */
- if (!dbdxst_bind_params(sth, imp_sth, items-2, ax+2) ) {
- if (is_selectrow_array) { XSRETURN_EMPTY; } else { XSRETURN_UNDEF; }
- }
- }
- /* --- execute --- */
- DBIc_ROW_COUNT(imp_sth) = 0;
- if ( dbd_st_execute(sth, imp_sth) <= -2 ) { /* -2 == error */
- if (is_selectrow_array) { XSRETURN_EMPTY; } else { XSRETURN_UNDEF; }
- }
- /* --- fetchrow_arrayref --- */
- row_av = dbd_st_fetch(sth, imp_sth);
- if (!row_av) {
- if (GIMME == G_SCALAR)
- PUSHs(&PL_sv_undef);
- }
- else if (is_selectrow_array) {
- int i;
- int num_fields = AvFILL(row_av)+1;
- if (GIMME == G_SCALAR)
- num_fields = 1; /* return just first field */
- EXTEND(sp, num_fields);
- for(i=0; i < num_fields; ++i) {
- PUSHs(AvARRAY(row_av)[i]);
- }
- }
- else {
- PUSHs( sv_2mortal(newRV((SV *)row_av)) );
- }
- /* --- finish --- */
-#ifdef dbd_st_finish3
- dbd_st_finish3(sth, imp_sth, 0);
-#else
- dbd_st_finish(sth, imp_sth);
-#endif
-
-
-#ifdef dbd_db_do4 /* deebeedee-deebee-doo, deebee-doobee-dah? */
-
-void
-do(dbh, statement, params = Nullsv)
- SV * dbh
- char * statement
- SV * params
- CODE:
- {
- D_imp_dbh(dbh);
- IV retval;
- retval = dbd_db_do4(dbh, imp_dbh, statement, params); /* might be dbd_db_do4_iv via macro */
- /* remember that dbd_db_do4 must return <= -2 for error */
- if (retval == 0) /* ok with no rows affected */
- XST_mPV(0, "0E0"); /* (true but zero) */
- else if (retval < -1) /* -1 == unknown number of rows */
- XST_mUNDEF(0); /* <= -2 means error */
- else
- XST_mIV(0, retval); /* typically 1, rowcount or -1 */
- }
-
-#endif
-
-
-#ifdef dbd_db_last_insert_id
-
-void
-last_insert_id(dbh, catalog, schema, table, field, attr=Nullsv)
- SV * dbh
- SV * catalog
- SV * schema
- SV * table
- SV * field
- SV * attr
- CODE:
- {
- D_imp_dbh(dbh);
- ST(0) = dbd_db_last_insert_id(dbh, imp_dbh, catalog, schema, table, field, attr);
- }
-
-#endif
-
-
-void
-commit(dbh)
- SV * dbh
- CODE:
- D_imp_dbh(dbh);
- if (DBIc_has(imp_dbh,DBIcf_AutoCommit) && DBIc_WARN(imp_dbh))
- warn("commit ineffective with AutoCommit enabled");
- ST(0) = dbd_db_commit(dbh, imp_dbh) ? &PL_sv_yes : &PL_sv_no;
-
-
-void
-rollback(dbh)
- SV * dbh
- CODE:
- D_imp_dbh(dbh);
- if (DBIc_has(imp_dbh,DBIcf_AutoCommit) && DBIc_WARN(imp_dbh))
- warn("rollback ineffective with AutoCommit enabled");
- ST(0) = dbd_db_rollback(dbh, imp_dbh) ? &PL_sv_yes : &PL_sv_no;
-
-
-void
-disconnect(dbh)
- SV * dbh
- CODE:
- D_imp_dbh(dbh);
- if ( !DBIc_ACTIVE(imp_dbh) ) {
- XSRETURN_YES;
- }
- /* Check for disconnect() being called whilst refs to cursors */
- /* still exists. This possibly needs some more thought. */
- if (DBIc_ACTIVE_KIDS(imp_dbh) && DBIc_WARN(imp_dbh) && !PL_dirty) {
- STRLEN lna;
- char *plural = (DBIc_ACTIVE_KIDS(imp_dbh)==1) ? (char*)"" : (char*)"s";
- warn("%s->disconnect invalidates %d active statement handle%s %s",
- SvPV(dbh,lna), (int)DBIc_ACTIVE_KIDS(imp_dbh), plural,
- "(either destroy statement handles or call finish on them before disconnecting)");
- }
- ST(0) = dbd_db_disconnect(dbh, imp_dbh) ? &PL_sv_yes : &PL_sv_no;
- DBIc_ACTIVE_off(imp_dbh); /* ensure it's off, regardless */
-
-
-void
-STORE(dbh, keysv, valuesv)
- SV * dbh
- SV * keysv
- SV * valuesv
- CODE:
- D_imp_dbh(dbh);
- if (SvGMAGICAL(valuesv))
- mg_get(valuesv);
- ST(0) = &PL_sv_yes;
- if (!dbd_db_STORE_attrib(dbh, imp_dbh, keysv, valuesv))
- if (!DBIc_DBISTATE(imp_dbh)->set_attr(dbh, keysv, valuesv))
- ST(0) = &PL_sv_no;
-
-
-void
-FETCH(dbh, keysv)
- SV * dbh
- SV * keysv
- CODE:
- D_imp_dbh(dbh);
- SV *valuesv = dbd_db_FETCH_attrib(dbh, imp_dbh, keysv);
- if (!valuesv)
- valuesv = DBIc_DBISTATE(imp_dbh)->get_attr(dbh, keysv);
- ST(0) = valuesv; /* dbd_db_FETCH_attrib did sv_2mortal */
-
-
-void
-DESTROY(dbh)
- SV * dbh
- PPCODE:
- /* keep in sync with default DESTROY in DBI.xs */
- D_imp_dbh(dbh);
- ST(0) = &PL_sv_yes;
- if (!DBIc_IMPSET(imp_dbh)) { /* was never fully set up */
- STRLEN lna;
- if (DBIc_WARN(imp_dbh) && !PL_dirty && DBIc_DBISTATE(imp_dbh)->debug >= 2)
- PerlIO_printf(DBIc_LOGPIO(imp_dbh),
- " DESTROY for %s ignored - handle not initialised\n",
- SvPV(dbh,lna));
- }
- else {
- if (DBIc_IADESTROY(imp_dbh)) { /* wants ineffective destroy */
- DBIc_ACTIVE_off(imp_dbh);
- if (DBIc_DBISTATE(imp_dbh)->debug)
- PerlIO_printf(DBIc_LOGPIO(imp_dbh), " DESTROY %s skipped due to InactiveDestroy\n", SvPV_nolen(dbh));
- }
- if (DBIc_ACTIVE(imp_dbh)) {
- if (!DBIc_has(imp_dbh,DBIcf_AutoCommit)) {
- /* Application is using transactions and hasn't explicitly disconnected.
- Some databases will automatically commit on graceful disconnect.
- Since we're about to gracefully disconnect as part of the DESTROY
- we want to be sure we're not about to implicitly commit changes
- that are incomplete and should be rolled back. (The DESTROY may
- be due to a RaiseError, for example.) So we rollback here.
- This will be harmless if the application has issued a commit,
- XXX Could add an attribute flag to indicate that the driver
- doesn't have this problem. Patches welcome.
- */
- if (DBIc_WARN(imp_dbh) /* only warn if likely to be useful... */
- && DBIc_is(imp_dbh, DBIcf_Executed) /* has not just called commit/rollback */
- /* && !DBIc_is(imp_dbh, DBIcf_ReadOnly) -- is not read only */
- && (!PL_dirty || DBIc_DBISTATE(imp_dbh)->debug >= 3)
- ) {
- warn("Issuing rollback() due to DESTROY without explicit disconnect() of %s handle %s",
- SvPV_nolen(*hv_fetch((HV*)SvRV(dbh), "ImplementorClass", 16, 1)),
- SvPV_nolen(*hv_fetch((HV*)SvRV(dbh), "Name", 4, 1))
- );
- }
- dbd_db_rollback(dbh, imp_dbh); /* ROLLBACK! */
- }
- dbd_db_disconnect(dbh, imp_dbh);
- DBIc_ACTIVE_off(imp_dbh); /* ensure it's off, regardless */
- }
- dbd_db_destroy(dbh, imp_dbh);
- }
-
-
-#ifdef dbd_take_imp_data
-
-void
-take_imp_data(h)
- SV * h
- CODE:
- D_imp_xxh(h);
- /* dbd_take_imp_data() returns &sv_no (or other defined but false value)
- * to indicate "preparations complete, now call SUPER::take_imp_data" for me.
- * Anything else is returned to the caller via sv_2mortal(sv), typically that
- * would be &sv_undef for error or an SV holding the imp_data.
- */
- SV *sv = dbd_take_imp_data(h, imp_xxh, NULL);
- if (SvOK(sv) && !SvTRUE(sv)) {
- SV *tmp = dbixst_bounce_method("DBD::Perl::db::SUPER::take_imp_data", items);
- SPAGAIN;
- ST(0) = tmp;
- } else {
- ST(0) = sv_2mortal(sv);
- }
-
-#endif
-
-#ifdef dbd_db_data_sources
-
-void
-data_sources(dbh, attr = Nullsv)
- SV *dbh
- SV *attr
- PPCODE:
- {
- D_imp_dbh(dbh);
- AV *av = dbd_db_data_sources(dbh, imp_dbh, attr);
- if (av) {
- int i;
- int n = AvFILL(av)+1;
- EXTEND(sp, n);
- for (i = 0; i < n; ++i) {
- PUSHs(AvARRAY(av)[i]);
- }
- }
- }
-
-#endif
-
-# -- end of DBD::Perl::db
-
-# ------------------------------------------------------------
-# statement interface
-# ------------------------------------------------------------
-MODULE = DBD::Perl PACKAGE = DBD::Perl::st
-
-
-void
-_prepare(sth, statement, attribs=Nullsv)
- SV * sth
- SV * statement
- SV * attribs
- CODE:
- {
- D_imp_sth(sth);
- DBD_ATTRIBS_CHECK("_prepare", sth, attribs);
-#ifdef dbd_st_prepare_sv
- ST(0) = dbd_st_prepare_sv(sth, imp_sth, statement, attribs) ? &PL_sv_yes : &PL_sv_no;
-#else
- ST(0) = dbd_st_prepare(sth, imp_sth, SvPV_nolen(statement), attribs) ? &PL_sv_yes : &PL_sv_no;
-#endif
- }
-
-
-#ifdef dbd_st_rows
-
-void
-rows(sth)
- SV * sth
- CODE:
- D_imp_sth(sth);
- XST_mIV(0, dbd_st_rows(sth, imp_sth));
-
-#endif /* dbd_st_rows */
-
-
-#ifdef dbd_st_bind_col
-
-void
-bind_col(sth, col, ref, attribs=Nullsv)
- SV * sth
- SV * col
- SV * ref
- SV * attribs
- CODE:
- {
- IV sql_type = 0;
- D_imp_sth(sth);
- if (SvGMAGICAL(ref))
- mg_get(ref);
- if (attribs) {
- if (SvNIOK(attribs)) {
- sql_type = SvIV(attribs);
- attribs = Nullsv;
- }
- else {
- SV **svp;
- DBD_ATTRIBS_CHECK("bind_col", sth, attribs);
- /* XXX we should perhaps complain if TYPE is not SvNIOK */
- DBD_ATTRIB_GET_IV(attribs, "TYPE",4, svp, sql_type);
- }
- }
- switch(dbd_st_bind_col(sth, imp_sth, col, ref, sql_type, attribs)) {
- case 2: ST(0) = &PL_sv_yes; /* job done completely */
- break;
- case 1: /* fallback to DBI default */
- ST(0) = (DBIc_DBISTATE(imp_sth)->bind_col(sth, col, ref, attribs))
- ? &PL_sv_yes : &PL_sv_no;
- break;
- default: ST(0) = &PL_sv_no; /* dbd_st_bind_col has called set_err */
- break;
- }
- }
-
-#endif /* dbd_st_bind_col */
-
-void
-bind_param(sth, param, value, attribs=Nullsv)
- SV * sth
- SV * param
- SV * value
- SV * attribs
- CODE:
- {
- IV sql_type = 0;
- D_imp_sth(sth);
- if (SvGMAGICAL(value))
- mg_get(value);
- if (attribs) {
- if (SvNIOK(attribs)) {
- sql_type = SvIV(attribs);
- attribs = Nullsv;
- }
- else {
- SV **svp;
- DBD_ATTRIBS_CHECK("bind_param", sth, attribs);
- /* XXX we should perhaps complain if TYPE is not SvNIOK */
- DBD_ATTRIB_GET_IV(attribs, "TYPE",4, svp, sql_type);
- }
- }
- ST(0) = dbd_bind_ph(sth, imp_sth, param, value, sql_type, attribs, FALSE, 0)
- ? &PL_sv_yes : &PL_sv_no;
- }
-
-
-void
-bind_param_inout(sth, param, value_ref, maxlen, attribs=Nullsv)
- SV * sth
- SV * param
- SV * value_ref
- IV maxlen
- SV * attribs
- CODE:
- {
- IV sql_type = 0;
- D_imp_sth(sth);
- SV *value;
- if (!SvROK(value_ref) || SvTYPE(SvRV(value_ref)) > SVt_PVMG)
- croak("bind_param_inout needs a reference to a scalar value");
- value = SvRV(value_ref);
- if (SvREADONLY(value))
- croak("Modification of a read-only value attempted");
- if (SvGMAGICAL(value))
- mg_get(value);
- if (attribs) {
- if (SvNIOK(attribs)) {
- sql_type = SvIV(attribs);
- attribs = Nullsv;
- }
- else {
- SV **svp;
- DBD_ATTRIBS_CHECK("bind_param", sth, attribs);
- DBD_ATTRIB_GET_IV(attribs, "TYPE",4, svp, sql_type);
- }
- }
- ST(0) = dbd_bind_ph(sth, imp_sth, param, value, sql_type, attribs, TRUE, maxlen)
- ? &PL_sv_yes : &PL_sv_no;
- }
-
-
-void
-execute(sth, ...)
- SV * sth
- CODE:
- D_imp_sth(sth);
- IV retval;
- if (items > 1) { /* need to bind params */
- if (!dbdxst_bind_params(sth, imp_sth, items, ax) ) {
- XSRETURN_UNDEF;
- }
- }
- /* XXX this code is duplicated in selectrow_arrayref above */
- DBIc_ROW_COUNT(imp_sth) = 0;
- retval = dbd_st_execute(sth, imp_sth); /* might be dbd_st_execute_iv via macro */
- /* remember that dbd_st_execute must return <= -2 for error */
- if (retval == 0) /* ok with no rows affected */
- XST_mPV(0, "0E0"); /* (true but zero) */
- else if (retval < -1) /* -1 == unknown number of rows */
- XST_mUNDEF(0); /* <= -2 means error */
- else
- XST_mIV(0, retval); /* typically 1, rowcount or -1 */
-
-
-#ifdef dbd_st_execute_for_fetch
-
-void
-execute_for_fetch(sth, fetch_tuple_sub, tuple_status = Nullsv)
- SV * sth
- SV * fetch_tuple_sub
- SV * tuple_status
- CODE:
- {
- D_imp_sth(sth);
- ST(0) = dbd_st_execute_for_fetch(sth, imp_sth, fetch_tuple_sub, tuple_status);
- }
-
-#endif
-
-
-
-void
-fetchrow_arrayref(sth)
- SV * sth
- ALIAS:
- fetch = 1
- CODE:
- D_imp_sth(sth);
- AV *av;
- PERL_UNUSED_VAR(ix);
- av = dbd_st_fetch(sth, imp_sth);
- ST(0) = (av) ? sv_2mortal(newRV((SV *)av)) : &PL_sv_undef;
-
-
-void
-fetchrow_array(sth)
- SV * sth
- ALIAS:
- fetchrow = 1
- PPCODE:
- D_imp_sth(sth);
- AV *av;
- av = dbd_st_fetch(sth, imp_sth);
- if (av) {
- int i;
- int num_fields = AvFILL(av)+1;
- EXTEND(sp, num_fields);
- for(i=0; i < num_fields; ++i) {
- PUSHs(AvARRAY(av)[i]);
- }
- PERL_UNUSED_VAR(ix);
- }
-
-
-void
-fetchall_arrayref(sth, slice=&PL_sv_undef, batch_row_count=&PL_sv_undef)
- SV * sth
- SV * slice
- SV * batch_row_count
- CODE:
- if (SvOK(slice)) { /* fallback to perl implementation */
- SV *tmp = dbixst_bounce_method("DBD::Perl::st::SUPER::fetchall_arrayref", 3);
- SPAGAIN;
- ST(0) = tmp;
- }
- else {
- SV *tmp = dbdxst_fetchall_arrayref(sth, slice, batch_row_count);
- SPAGAIN;
- ST(0) = tmp;
- }
-
-
-void
-finish(sth)
- SV * sth
- CODE:
- D_imp_sth(sth);
- D_imp_dbh_from_sth;
- if (!DBIc_ACTIVE(imp_sth)) {
- /* No active statement to finish */
- XSRETURN_YES;
- }
- if (!DBIc_ACTIVE(imp_dbh)) {
- /* Either an explicit disconnect() or global destruction */
- /* has disconnected us from the database. Finish is meaningless */
- DBIc_ACTIVE_off(imp_sth);
- XSRETURN_YES;
- }
-#ifdef dbd_st_finish3
- ST(0) = dbd_st_finish3(sth, imp_sth, 0) ? &PL_sv_yes : &PL_sv_no;
-#else
- ST(0) = dbd_st_finish(sth, imp_sth) ? &PL_sv_yes : &PL_sv_no;
-#endif
-
-
-void
-blob_read(sth, field, offset, len, destrv=Nullsv, destoffset=0)
- SV * sth
- int field
- long offset
- long len
- SV * destrv
- long destoffset
- CODE:
- {
- D_imp_sth(sth);
- if (!destrv)
- destrv = sv_2mortal(newRV(sv_2mortal(newSV(0))));
- if (dbd_st_blob_read(sth, imp_sth, field, offset, len, destrv, destoffset))
- ST(0) = SvRV(destrv);
- else ST(0) = &PL_sv_undef;
- }
-
-
-void
-STORE(sth, keysv, valuesv)
- SV * sth
- SV * keysv
- SV * valuesv
- CODE:
- D_imp_sth(sth);
- if (SvGMAGICAL(valuesv))
- mg_get(valuesv);
- ST(0) = &PL_sv_yes;
- if (!dbd_st_STORE_attrib(sth, imp_sth, keysv, valuesv))
- if (!DBIc_DBISTATE(imp_sth)->set_attr(sth, keysv, valuesv))
- ST(0) = &PL_sv_no;
-
-
-# FETCH renamed and ALIAS'd to avoid case clash on VMS :-(
-void
-FETCH_attrib(sth, keysv)
- SV * sth
- SV * keysv
- ALIAS:
- FETCH = 1
- CODE:
- D_imp_sth(sth);
- SV *valuesv;
- PERL_UNUSED_VAR(ix);
- valuesv = dbd_st_FETCH_attrib(sth, imp_sth, keysv);
- if (!valuesv)
- valuesv = DBIc_DBISTATE(imp_sth)->get_attr(sth, keysv);
- ST(0) = valuesv; /* dbd_st_FETCH_attrib did sv_2mortal */
-
-
-void
-DESTROY(sth)
- SV * sth
- PPCODE:
- /* keep in sync with default DESTROY in DBI.xs */
- D_imp_sth(sth);
- ST(0) = &PL_sv_yes;
- if (!DBIc_IMPSET(imp_sth)) { /* was never fully set up */
- STRLEN lna;
- if (DBIc_WARN(imp_sth) && !PL_dirty && DBIc_DBISTATE(imp_sth)->debug >= 2)
- PerlIO_printf(DBIc_LOGPIO(imp_sth),
- " DESTROY for %s ignored - handle not initialised\n",
- SvPV(sth,lna));
- }
- else {
- if (DBIc_IADESTROY(imp_sth)) { /* wants ineffective destroy */
- DBIc_ACTIVE_off(imp_sth);
- if (DBIc_DBISTATE(imp_sth)->debug)
- PerlIO_printf(DBIc_LOGPIO(imp_sth), " DESTROY %s skipped due to InactiveDestroy\n", SvPV_nolen(sth));
- }
- if (DBIc_ACTIVE(imp_sth)) {
- D_imp_dbh_from_sth;
- if (!PL_dirty && DBIc_ACTIVE(imp_dbh)) {
-#ifdef dbd_st_finish3
- dbd_st_finish3(sth, imp_sth, 1);
-#else
- dbd_st_finish(sth, imp_sth);
-#endif
- }
- else {
- DBIc_ACTIVE_off(imp_sth);
- }
- }
- dbd_st_destroy(sth, imp_sth);
- }
-
-# end of Perl.xst
-# vim:ts=8:sw=4:et
+++ /dev/null
-# DBI - The Perl Database Interface.
-
-[](http://travis-ci.org/perl5-dbi/dbi/)
-
-See [COPYRIGHT](https://metacpan.org/module/DBI#COPYRIGHT)
-section in DBI.pm for usage and distribution rights.
-
-See [GETTING HELP](https://metacpan.org/module/DBI#GETTING-HELP)
-section in DBI.pm for how to get help.
-
-# QUICK START GUIDE:
-
- The DBI requires one or more 'driver' modules to talk to databases,
- but they are not needed to build or install the DBI.
-
- Check that a DBD::* module exists for the database you wish to use.
-
- Install the DBI using a installer like cpanm, cpanplus, cpan,
- or whatever is recommened by the perl distribution you're using.
- Make sure the DBI tests run successfully before installing.
-
- Use the 'perldoc DBI' command to read the DBI documentation.
-
- Install the DBD::* driver module you wish to use in the same way.
- It is often important to read the driver README file carefully.
- Make sure the driver tests run successfully before installing.
-
-The DBI.pm file contains the DBI specification and other documentation.
-PLEASE READ IT. It'll save you asking questions on the mailing list
-which you will be told are already answered in the documentation.
-
-For more information and to keep informed about progress you can join
-the a mailing list via mailto:dbi-users-help@perl.org
-You can post to the mailing list without subscribing. (Your first post may be
-delayed a day or so while it's being moderated.)
-
-To help you make the best use of the dbi-users mailing list,
-and any other lists or forums you may use, I strongly
-recommend that you read "How To Ask Questions The Smart Way"
-by Eric Raymond:
-
- http://www.catb.org/~esr/faqs/smart-questions.html
-
-Much useful information and online archives of the mailing lists can be
-found at http://dbi.perl.org/
-
-See also http://metacpan.org/
-
-
-# IF YOU HAVE PROBLEMS:
-
-First, read the notes in the INSTALL file.
-
-If you can't fix it your self please post details to dbi-users@perl.org.
-Please include:
-
-1. A complete log of a complete build, e.g.:
-
- perl Makefile.PL (do a make realclean first)
- make
- make test
- make test TEST_VERBOSE=1 (if any of the t/* tests fail)
-
-2. The output of perl -V
-
-3. If you get a core dump, try to include a stack trace from it.
-
- Try installing the Devel::CoreStack module to get a stack trace.
- If the stack trace mentions XS_DynaLoader_dl_load_file then rerun
- make test after setting the environment variable PERL_DL_DEBUG to 2.
-
-4. If your installation succeeds, but your script does not behave
- as you expect, the problem is possibly in your script.
-
- Before sending to dbi-users, try writing a small, easy to use test case to
- reproduce your problem. Also, use the DBI->trace method to trace your
- database calls.
-
-Please don't post problems to usenet, google groups or perl5-porters.
-This software is supported via the dbi-users mailing list. For more
-information and to keep informed about progress you can join the
-mailing list via mailto:dbi-users-help@perl.org
-(please note that I do not run or manage the mailing list).
-
-It is important to check that you are using the latest version before
-posting. If you're not then we're very likely to simply say "upgrade to
-the latest". You would do yourself a favour by upgrading beforehand.
-
-Please remember that we're all busy. Try to help yourself first,
-then try to help us help you by following these guidelines carefully.
-
-Regards,
-Tim Bunce and the perl5-dbi team.
+++ /dev/null
-/* vim: ts=8:sw=4:expandtab
- *
- * $Id$
- *
- * Copyright (c) 1994-2010 Tim Bunce Ireland
- *
- * See COPYRIGHT section in DBI.pm for usage and distribution rights.
- */
-
-/* DBI Interface Definitions for DBD Modules */
-
-#ifndef DBIXS_VERSION /* prevent multiple inclusion */
-
-#ifndef DBIS
-#define DBIS dbis /* default name for dbistate_t variable */
-#endif
-
-/* Here for backwards compat. PERL_POLLUTE was removed in perl 5.13.3 */
-#define PERL_POLLUTE
-
-/* first pull in the standard Perl header files for extensions */
-#include <EXTERN.h>
-#include <perl.h>
-#include <XSUB.h>
-
-#ifdef debug /* causes problems with DBIS->debug */
-#undef debug
-#endif
-
-#ifdef std /* causes problems with STLport <tscheresky@micron.com> */
-#undef std
-#endif
-
-/* define DBIXS_REVISION */
-#include "dbixs_rev.h"
-
-/* Perl backwards compatibility definitions */
-#include "dbipport.h"
-
-/* DBI SQL_* type definitions */
-#include "dbi_sql.h"
-
-
-#define DBIXS_VERSION 93 /* superseded by DBIXS_REVISION */
-
-#ifdef NEED_DBIXS_VERSION
-#if NEED_DBIXS_VERSION > DBIXS_VERSION
-error You_need_to_upgrade_your_DBI_module_before_building_this_driver
-#endif
-#else
-#define NEED_DBIXS_VERSION DBIXS_VERSION
-#endif
-
-
-#define DBI_LOCK
-#define DBI_UNLOCK
-
-#ifndef DBI_NO_THREADS
-#ifdef USE_ITHREADS
-#define DBI_USE_THREADS
-#endif /* USE_ITHREADS */
-#endif /* DBI_NO_THREADS */
-
-
-/* forward struct declarations */
-
-typedef struct dbistate_st dbistate_t;
-/* implementor needs to define actual struct { dbih_??c_t com; ... }*/
-typedef struct imp_drh_st imp_drh_t; /* driver */
-typedef struct imp_dbh_st imp_dbh_t; /* database */
-typedef struct imp_sth_st imp_sth_t; /* statement */
-typedef struct imp_fdh_st imp_fdh_t; /* field descriptor */
-typedef struct imp_xxh_st imp_xxh_t; /* any (defined below) */
-#define DBI_imp_data_ imp_xxh_t /* friendly for take_imp_data */
-
-
-
-/* --- DBI Handle Common Data Structure (all handles have one) --- */
-
-/* Handle types. Code currently assumes child = parent + 1. */
-#define DBIt_DR 1
-#define DBIt_DB 2
-#define DBIt_ST 3
-#define DBIt_FD 4
-
-/* component structures */
-
-typedef struct dbih_com_std_st {
- U32 flags;
- int call_depth; /* used by DBI to track nested calls (int) */
- U16 type; /* DBIt_DR, DBIt_DB, DBIt_ST */
- HV *my_h; /* copy of outer handle HV (not refcounted) */
- SV *parent_h; /* parent inner handle (ref to hv) (r.c.inc) */
- imp_xxh_t *parent_com; /* parent com struct shortcut */
- PerlInterpreter * thr_user; /* thread that owns the handle */
-
- HV *imp_stash; /* who is the implementor for this handle */
- SV *imp_data; /* optional implementors data (for perl imp's) */
-
- I32 kids; /* count of db's for dr's, st's for db's etc */
- I32 active_kids; /* kids which are currently DBIc_ACTIVE */
- U32 pid; /* pid of process that created handle */
- dbistate_t *dbistate;
-} dbih_com_std_t;
-
-typedef struct dbih_com_attr_st {
- /* These are copies of the Hash values (ref.cnt.inc'd) */
- /* Many of the hash values are themselves references */
- SV *TraceLevel;
- SV *State; /* Standard SQLSTATE, 5 char string */
- SV *Err; /* Native engine error code */
- SV *Errstr; /* Native engine error message */
- UV ErrCount;
- U32 LongReadLen; /* auto read length for long/blob types */
- SV *FetchHashKeyName; /* for fetchrow_hashref */
- /* (NEW FIELDS?... DON'T FORGET TO UPDATE dbih_clearcom()!) */
-} dbih_com_attr_t;
-
-
-struct dbih_com_st { /* complete core structure (typedef'd above) */
- dbih_com_std_t std;
- dbih_com_attr_t attr;
-};
-
-/* This 'implementors' type the DBI defines by default as a way to */
-/* refer to the imp_??h data of a handle without considering its type. */
-struct imp_xxh_st { struct dbih_com_st com; };
-
-/* Define handle-type specific structures for implementors to include */
-/* at the start of their private structures. */
-
-typedef struct { /* -- DRIVER -- */
- dbih_com_std_t std;
- dbih_com_attr_t attr;
- HV *_old_cached_kids; /* not used, here for binary compat */
-} dbih_drc_t;
-
-typedef struct { /* -- DATABASE -- */
- dbih_com_std_t std; /* \__ standard structure */
- dbih_com_attr_t attr; /* / plus... (nothing else right now) */
- HV *_old_cached_kids; /* not used, here for binary compat */
-} dbih_dbc_t;
-
-typedef struct { /* -- STATEMENT -- */
- dbih_com_std_t std; /* \__ standard structure */
- dbih_com_attr_t attr; /* / plus ... */
-
- int num_params; /* number of placeholders */
- int num_fields; /* NUM_OF_FIELDS, must be set */
- AV *fields_svav; /* special row buffer (inc bind_cols) */
- IV row_count; /* incremented by get_fbav() */
-
- AV *fields_fdav; /* not used yet, may change */
-
- I32 spare1;
- void *spare2;
-} dbih_stc_t;
-
-
-/* XXX THIS STRUCTURE SHOULD NOT BE USED */
-typedef struct { /* -- FIELD DESCRIPTOR -- */
- dbih_com_std_t std; /* standard structure (not fully setup) */
-
- /* core attributes (from DescribeCol in ODBC) */
- char *col_name; /* see dbih_make_fdsv */
- I16 col_name_len;
- I16 col_sql_type;
- I16 col_precision;
- I16 col_scale;
- I16 col_nullable;
-
- /* additional attributes (from ColAttributes in ODBC) */
- I32 col_length;
- I32 col_disp_size;
-
- I32 spare1;
- void *spare2;
-} dbih_fdc_t;
-
-
-#define _imp2com(p,f) ((p)->com.f) /* private */
-
-#define DBIc_FLAGS(imp) _imp2com(imp, std.flags)
-#define DBIc_TYPE(imp) _imp2com(imp, std.type)
-#define DBIc_CALL_DEPTH(imp) _imp2com(imp, std.call_depth)
-#define DBIc_MY_H(imp) _imp2com(imp, std.my_h)
-#define DBIc_PARENT_H(imp) _imp2com(imp, std.parent_h)
-#define DBIc_PARENT_COM(imp) _imp2com(imp, std.parent_com)
-#define DBIc_THR_COND(imp) _imp2com(imp, std.thr_cond)
-#define DBIc_THR_USER(imp) _imp2com(imp, std.thr_user)
-#define DBIc_THR_USER_NONE (0xFFFF)
-#define DBIc_IMP_STASH(imp) _imp2com(imp, std.imp_stash)
-#define DBIc_IMP_DATA(imp) _imp2com(imp, std.imp_data)
-#define DBIc_DBISTATE(imp) _imp2com(imp, std.dbistate)
-#define DBIc_LOGPIO(imp) DBIc_DBISTATE(imp)->logfp
-#define DBIc_KIDS(imp) _imp2com(imp, std.kids)
-#define DBIc_ACTIVE_KIDS(imp) _imp2com(imp, std.active_kids)
-#define DBIc_LAST_METHOD(imp) _imp2com(imp, std.last_method)
-
-/* d = DBD flags, l = DBD level (needs to be shifted down)
- * D - DBI flags, r = reserved, L = DBI trace level
- * Trace level bit allocation: 0xddlDDDrL */
-#define DBIc_TRACE_LEVEL_MASK 0x0000000F
-#define DBIc_TRACE_FLAGS_MASK 0xFF0FFF00 /* includes DBD flag bits for DBIc_TRACE */
-#define DBIc_TRACE_SETTINGS(imp) (DBIc_DBISTATE(imp)->debug)
-#define DBIc_TRACE_LEVEL(imp) (DBIc_TRACE_SETTINGS(imp) & DBIc_TRACE_LEVEL_MASK)
-#define DBIc_TRACE_FLAGS(imp) (DBIc_TRACE_SETTINGS(imp) & DBIc_TRACE_FLAGS_MASK)
-/* DBI defined trace flags */
-#define DBIf_TRACE_SQL 0x00000100
-#define DBIf_TRACE_CON 0x00000200
-#define DBIf_TRACE_ENC 0x00000400
-#define DBIf_TRACE_DBD 0x00000800
-#define DBIf_TRACE_TXN 0x00001000
-
-#define DBDc_TRACE_LEVEL_MASK 0x00F00000
-#define DBDc_TRACE_LEVEL_SHIFT 20
-#define DBDc_TRACE_LEVEL(imp) ( (DBIc_TRACE_SETTINGS(imp) & DBDc_TRACE_LEVEL_MASK) >> DBDc_TRACE_LEVEL_SHIFT )
-#define DBDc_TRACE_LEVEL_set(imp, l) ( DBIc_TRACE_SETTINGS(imp) |= (((l) << DBDc_TRACE_LEVEL_SHIFT) & DBDc_TRACE_LEVEL_MASK ))
-
-/* DBIc_TRACE_MATCHES(this, crnt): true if this 'matches' (is within) crnt
- DBIc_TRACE_MATCHES(foo, DBIc_TRACE_SETTINGS(imp))
-*/
-#define DBIc_TRACE_MATCHES(this, crnt) \
- ( ((crnt & DBIc_TRACE_LEVEL_MASK) >= (this & DBIc_TRACE_LEVEL_MASK)) \
- || ((crnt & DBIc_TRACE_FLAGS_MASK) & (this & DBIc_TRACE_FLAGS_MASK)) )
-
-/* DBIc_TRACE(imp, flags, flag_level, fallback_level)
- True if flags match the handle trace flags & handle trace level >= flag_level,
- OR if handle trace_level > fallback_level (typically > flag_level).
- This is the main trace testing macro to be used by drivers.
- (Drivers should define their own DBDf_TRACE_* macros for the top 8 bits: 0xFF000000)
- DBIc_TRACE(imp, 0, 0, 4) = if trace level >= 4
- DBIc_TRACE(imp, DBDf_TRACE_FOO, 2, 4) = if tracing DBDf_FOO & level>=2 or level>=4
- DBIc_TRACE(imp, DBDf_TRACE_FOO, 2, 0) = as above but never trace just due to level
- e.g.
- if (DBIc_TRACE(imp_xxh, DBIf_TRACE_SQL|DBIf_TRACE_xxx, 2, 0)) {
- PerlIO_printf(DBIc_LOGPIO(imp_sth), "\tThe %s wibbled the %s\n", ...);
- }
-*/
-#define DBIc_TRACE(imp, flags, flaglevel, level) \
- ( (flags && (DBIc_TRACE_FLAGS(imp) & flags) && (DBIc_TRACE_LEVEL(imp) >= flaglevel)) \
- || (level && DBIc_TRACE_LEVEL(imp) >= level) )
-
-#define DBIc_DEBUG(imp) (_imp2com(imp, attr.TraceLevel)) /* deprecated */
-#define DBIc_DEBUGIV(imp) SvIV(DBIc_DEBUG(imp)) /* deprecated */
-#define DBIc_STATE(imp) SvRV(_imp2com(imp, attr.State))
-#define DBIc_ERR(imp) SvRV(_imp2com(imp, attr.Err))
-#define DBIc_ERRSTR(imp) SvRV(_imp2com(imp, attr.Errstr))
-#define DBIc_ErrCount(imp) _imp2com(imp, attr.ErrCount)
-#define DBIc_LongReadLen(imp) _imp2com(imp, attr.LongReadLen)
-#define DBIc_LongReadLen_init 80 /* may change */
-#define DBIc_FetchHashKeyName(imp) (_imp2com(imp, attr.FetchHashKeyName))
-
-/* handle sub-type specific fields */
-/* dbh & drh */
-#define DBIc_CACHED_KIDS(imp) Nullhv /* no longer used, here for src compat */
-/* sth */
-#define DBIc_NUM_FIELDS(imp) _imp2com(imp, num_fields)
-#define DBIc_NUM_PARAMS(imp) _imp2com(imp, num_params)
-#define DBIc_NUM_PARAMS_AT_EXECUTE -9 /* see Driver.xst */
-#define DBIc_ROW_COUNT(imp) _imp2com(imp, row_count)
-#define DBIc_FIELDS_AV(imp) _imp2com(imp, fields_svav)
-#define DBIc_FDESC_AV(imp) _imp2com(imp, fields_fdav)
-#define DBIc_FDESC(imp, i) ((imp_fdh_t*)(void*)SvPVX(AvARRAY(DBIc_FDESC_AV(imp))[i]))
-
-/* XXX --- DO NOT CHANGE THESE VALUES AS THEY ARE COMPILED INTO DRIVERS --- XXX */
-#define DBIcf_COMSET 0x000001 /* needs to be clear'd before free'd */
-#define DBIcf_IMPSET 0x000002 /* has implementor data to be clear'd */
-#define DBIcf_ACTIVE 0x000004 /* needs finish/disconnect before clear */
-#define DBIcf_IADESTROY 0x000008 /* do DBIc_ACTIVE_off before DESTROY */
-#define DBIcf_WARN 0x000010 /* warn about poor practice etc */
-#define DBIcf_COMPAT 0x000020 /* compat/emulation mode (eg oraperl) */
-#define DBIcf_ChopBlanks 0x000040 /* rtrim spaces from fetch char columns */
-#define DBIcf_RaiseError 0x000080 /* throw exception (croak) on error */
-#define DBIcf_PrintError 0x000100 /* warn() on error */
-#define DBIcf_AutoCommit 0x000200 /* dbh only. used by drivers */
-#define DBIcf_LongTruncOk 0x000400 /* truncation to LongReadLen is okay */
-#define DBIcf_MultiThread 0x000800 /* allow multiple threads to enter */
-#define DBIcf_HandleSetErr 0x001000 /* has coderef HandleSetErr attribute */
-#define DBIcf_ShowErrorStatement 0x002000 /* include Statement in error */
-#define DBIcf_BegunWork 0x004000 /* between begin_work & commit/rollback */
-#define DBIcf_HandleError 0x008000 /* has coderef in HandleError attribute */
-#define DBIcf_Profile 0x010000 /* profile activity on this handle */
-#define DBIcf_TaintIn 0x020000 /* check inputs for taintedness */
-#define DBIcf_TaintOut 0x040000 /* taint outgoing data */
-#define DBIcf_Executed 0x080000 /* do/execute called since commit/rollb */
-#define DBIcf_PrintWarn 0x100000 /* warn() on warning (err="0") */
-#define DBIcf_Callbacks 0x200000 /* has Callbacks attribute hash */
-#define DBIcf_AIADESTROY 0x400000 /* auto DBIcf_IADESTROY if pid changes */
-/* NOTE: new flags may require clone() to be updated */
-
-#define DBIcf_INHERITMASK /* what NOT to pass on to children */ \
- (U32)( DBIcf_COMSET | DBIcf_IMPSET | DBIcf_ACTIVE | DBIcf_IADESTROY \
- | DBIcf_AutoCommit | DBIcf_BegunWork | DBIcf_Executed | DBIcf_Callbacks )
-
-/* general purpose bit setting and testing macros */
-#define DBIbf_is( bitset,flag) ((bitset) & (flag))
-#define DBIbf_has(bitset,flag) DBIbf_is(bitset, flag) /* alias for _is */
-#define DBIbf_on( bitset,flag) ((bitset) |= (flag))
-#define DBIbf_off(bitset,flag) ((bitset) &= ~(flag))
-#define DBIbf_set(bitset,flag,on) ((on) ? DBIbf_on(bitset, flag) : DBIbf_off(bitset,flag))
-
-/* as above, but specifically for DBIc_FLAGS imp flags (except ACTIVE) */
-#define DBIc_is(imp, flag) DBIbf_is( DBIc_FLAGS(imp), flag)
-#define DBIc_has(imp,flag) DBIc_is(imp, flag) /* alias for DBIc_is */
-#define DBIc_on(imp, flag) DBIbf_on( DBIc_FLAGS(imp), flag)
-#define DBIc_off(imp,flag) DBIbf_off(DBIc_FLAGS(imp), flag)
-#define DBIc_set(imp,flag,on) DBIbf_set(DBIc_FLAGS(imp), flag, on)
-
-#define DBIc_COMSET(imp) DBIc_is(imp, DBIcf_COMSET)
-#define DBIc_COMSET_on(imp) DBIc_on(imp, DBIcf_COMSET)
-#define DBIc_COMSET_off(imp) DBIc_off(imp,DBIcf_COMSET)
-
-#define DBIc_IMPSET(imp) DBIc_is(imp, DBIcf_IMPSET)
-#define DBIc_IMPSET_on(imp) DBIc_on(imp, DBIcf_IMPSET)
-#define DBIc_IMPSET_off(imp) DBIc_off(imp,DBIcf_IMPSET)
-
-#define DBIc_ACTIVE(imp) (DBIc_FLAGS(imp) & DBIcf_ACTIVE)
-#define DBIc_ACTIVE_on(imp) /* adjust parent's active kid count */ \
- do { \
- imp_xxh_t *ph_com = DBIc_PARENT_COM(imp); \
- if (!DBIc_ACTIVE(imp) && ph_com && !PL_dirty \
- && ++DBIc_ACTIVE_KIDS(ph_com) > DBIc_KIDS(ph_com)) \
- croak("panic: DBI active kids (%ld) > kids (%ld)", \
- (long)DBIc_ACTIVE_KIDS(ph_com), \
- (long)DBIc_KIDS(ph_com)); \
- DBIc_FLAGS(imp) |= DBIcf_ACTIVE; \
- } while(0)
-#define DBIc_ACTIVE_off(imp) /* adjust parent's active kid count */ \
- do { \
- imp_xxh_t *ph_com = DBIc_PARENT_COM(imp); \
- if (DBIc_ACTIVE(imp) && ph_com && !PL_dirty \
- && (--DBIc_ACTIVE_KIDS(ph_com) > DBIc_KIDS(ph_com) \
- || DBIc_ACTIVE_KIDS(ph_com) < 0) ) \
- croak("panic: DBI active kids (%ld) < 0 or > kids (%ld)", \
- (long)DBIc_ACTIVE_KIDS(ph_com), \
- (long)DBIc_KIDS(ph_com)); \
- DBIc_FLAGS(imp) &= ~DBIcf_ACTIVE; \
- } while(0)
-
-#define DBIc_IADESTROY(imp) (DBIc_FLAGS(imp) & DBIcf_IADESTROY)
-#define DBIc_IADESTROY_on(imp) (DBIc_FLAGS(imp) |= DBIcf_IADESTROY)
-#define DBIc_IADESTROY_off(imp) (DBIc_FLAGS(imp) &= ~DBIcf_IADESTROY)
-
-#define DBIc_AIADESTROY(imp) (DBIc_FLAGS(imp) & DBIcf_AIADESTROY)
-#define DBIc_AIADESTROY_on(imp) (DBIc_FLAGS(imp) |= DBIcf_AIADESTROY)
-#define DBIc_AIADESTROY_off(imp) (DBIc_FLAGS(imp) &= ~DBIcf_AIADESTROY)
-
-#define DBIc_WARN(imp) (DBIc_FLAGS(imp) & DBIcf_WARN)
-#define DBIc_WARN_on(imp) (DBIc_FLAGS(imp) |= DBIcf_WARN)
-#define DBIc_WARN_off(imp) (DBIc_FLAGS(imp) &= ~DBIcf_WARN)
-
-#define DBIc_COMPAT(imp) (DBIc_FLAGS(imp) & DBIcf_COMPAT)
-#define DBIc_COMPAT_on(imp) (DBIc_FLAGS(imp) |= DBIcf_COMPAT)
-#define DBIc_COMPAT_off(imp) (DBIc_FLAGS(imp) &= ~DBIcf_COMPAT)
-
-
-#ifdef IN_DBI_XS /* get Handle Common Data Structure */
-#define DBIh_COM(h) (dbih_getcom2(aTHX_ h, 0))
-#else
-#define DBIh_COM(h) (DBIS->getcom(h))
-#define neatsvpv(sv,len) (DBIS->neat_svpv(sv,len))
-#endif
-
-/* --- For sql_type_cast_svpv() --- */
-
-#define DBIstcf_DISCARD_STRING 0x0001
-#define DBIstcf_STRICT 0x0002
-
-/* --- Implementors Private Data Support --- */
-
-#define D_impdata(name,type,h) type *name = (type*)(DBIh_COM(h))
-#define D_imp_drh(h) D_impdata(imp_drh, imp_drh_t, h)
-#define D_imp_dbh(h) D_impdata(imp_dbh, imp_dbh_t, h)
-#define D_imp_sth(h) D_impdata(imp_sth, imp_sth_t, h)
-#define D_imp_xxh(h) D_impdata(imp_xxh, imp_xxh_t, h)
-
-#define D_imp_from_child(name,type,child) \
- type *name = (type*)(DBIc_PARENT_COM(child))
-#define D_imp_drh_from_dbh D_imp_from_child(imp_drh, imp_drh_t, imp_dbh)
-#define D_imp_dbh_from_sth D_imp_from_child(imp_dbh, imp_dbh_t, imp_sth)
-
-#define DBI_IMP_SIZE(n,s) sv_setiv(get_sv((n), GV_ADDMULTI), (s)) /* XXX */
-
-
-
-/* --- Event Support (VERY LIABLE TO CHANGE) --- */
-
-#define DBIh_EVENTx(h,t,a1,a2) /* deprecated XXX */ &PL_sv_no
-#define DBIh_EVENT0(h,t) DBIh_EVENTx((h), (t), &PL_sv_undef, &PL_sv_undef)
-#define DBIh_EVENT1(h,t, a1) DBIh_EVENTx((h), (t), (a1), &PL_sv_undef)
-#define DBIh_EVENT2(h,t, a1,a2) DBIh_EVENTx((h), (t), (a1), (a2))
-
-#define ERROR_event "ERROR"
-#define WARN_event "WARN"
-#define MSG_event "MESSAGE"
-#define DBEVENT_event "DBEVENT"
-#define UNKNOWN_event "UNKNOWN"
-
-#define DBIh_SET_ERR_SV(h,i, err, errstr, state, method) \
- (DBIc_DBISTATE(i)->set_err_sv(h,i, err, errstr, state, method))
-#define DBIh_SET_ERR_CHAR(h,i, err_c, err_i, errstr, state, method) \
- (DBIc_DBISTATE(i)->set_err_char(h,i, err_c, err_i, errstr, state, method))
-
-
-/* --- Handy Macros --- */
-
-#define DBIh_CLEAR_ERROR(imp_xxh) (void)( \
- (void)SvOK_off(DBIc_ERR(imp_xxh)), \
- (void)SvOK_off(DBIc_ERRSTR(imp_xxh)), \
- (void)SvOK_off(DBIc_STATE(imp_xxh)) \
- )
-
-
-/* --- DBI State Structure --- */
-
-struct dbistate_st {
-
-/* DBISTATE_VERSION is checked at runtime via DBISTATE_INIT and check_version.
- * It should be incremented on incompatible changes to dbistate_t structure.
- * Additional function pointers being assigned from spare padding, where the
- * size of the structure doesn't change, doesn't require an increment.
- * Incrementing forces all XS drivers to need to be recompiled.
- * (See also DBIXS_REVISION as a driver source compatibility tool.)
- */
-#define DBISTATE_VERSION 94 /* ++ on incompatible dbistate_t changes */
-
- /* this must be the first member in structure */
- void (*check_version) _((const char *name,
- int dbis_cv, int dbis_cs, int need_dbixs_cv,
- int drc_s, int dbc_s, int stc_s, int fdc_s));
-
- /* version and size are used to check for DBI/DBD version mis-match */
- U16 version; /* version of this structure */
- U16 size;
- U16 xs_version; /* version of the overall DBIXS / DBD interface */
- U16 spare_pad;
-
- I32 debug;
- PerlIO *logfp;
-
- /* pointers to DBI functions which the DBD's will want to use */
- char * (*neat_svpv) _((SV *sv, STRLEN maxlen));
- imp_xxh_t * (*getcom) _((SV *h)); /* see DBIh_COM macro */
- void (*clearcom) _((imp_xxh_t *imp_xxh));
- SV * (*event) _((SV *h, const char *name, SV*, SV*));
- int (*set_attr_k) _((SV *h, SV *keysv, int dbikey, SV *valuesv));
- SV * (*get_attr_k) _((SV *h, SV *keysv, int dbikey));
- AV * (*get_fbav) _((imp_sth_t *imp_sth));
- SV * (*make_fdsv) _((SV *sth, const char *imp_class, STRLEN imp_size, const char *col_name));
- int (*bind_as_num) _((int sql_type, int p, int s, int *t, void *v)); /* XXX deprecated */
- I32 (*hash) _((const char *string, long i));
- SV * (*preparse) _((SV *sth, char *statement, IV ps_return, IV ps_accept, void *foo));
-
- SV *neatsvpvlen; /* only show dbgpvlen chars when debugging pv's */
-
- PerlInterpreter * thr_owner; /* thread that owns this dbistate */
-
- int (*logmsg) _((imp_xxh_t *imp_xxh, const char *fmt, ...));
- int (*set_err_sv) _((SV *h, imp_xxh_t *imp_xxh, SV *err, SV *errstr, SV *state, SV *method));
- int (*set_err_char) _((SV *h, imp_xxh_t *imp_xxh, const char *err, IV err_i, const char *errstr, const char *state, const char *method));
- int (*bind_col) _((SV *sth, SV *col, SV *ref, SV *attribs));
-
- IO *logfp_ref; /* keep ptr to filehandle for refcounting */
-
- int (*sql_type_cast_svpv) _((pTHX_ SV *sv, int sql_type, U32 flags, void *v));
-
- /* WARNING: Only add new structure members here, and reduce pad2 to keep */
- /* the memory footprint exactly the same */
- void *pad2[3];
-};
-
-/* macros for backwards compatibility */
-#define set_attr(h, k, v) set_attr_k(h, k, 0, v)
-#define get_attr(h, k) get_attr_k(h, k, 0)
-
-#define DBILOGFP (DBIS->logfp)
-#ifdef IN_DBI_XS
-#define DBILOGMSG (dbih_logmsg)
-#else
-#define DBILOGMSG (DBIS->logmsg)
-#endif
-
-/* --- perl object (ActiveState) / multiplicity hooks and hoops --- */
-/* note that USE_ITHREADS implies MULTIPLICITY */
-
-typedef dbistate_t** (*_dbi_state_lval_t)(pTHX);
-
-# define _DBISTATE_DECLARE_COMMON \
- static _dbi_state_lval_t dbi_state_lval_p = 0; \
- static dbistate_t** dbi_get_state(pTHX) { \
- if (!dbi_state_lval_p) { \
- CV *cv = get_cv("DBI::_dbi_state_lval", 0); \
- if (!cv) \
- croak("Unable to get DBI state function. DBI not loaded."); \
- dbi_state_lval_p = (_dbi_state_lval_t)CvXSUB(cv); \
- } \
- return dbi_state_lval_p(aTHX); \
- } \
- typedef int dummy_dbistate /* keep semicolon from feeling lonely */
-
-#if defined(MULTIPLICITY) || defined(PERL_OBJECT) || defined(PERL_CAPI)
-
-# define DBISTATE_DECLARE _DBISTATE_DECLARE_COMMON
-# define _DBISTATE_INIT_DBIS
-# undef DBIS
-# define DBIS (*dbi_get_state(aTHX))
-# define dbis DBIS /* temp for old drivers using 'dbis' instead of 'DBIS' */
-
-#else /* plain and simple non perl object / multiplicity case */
-
-# define DBISTATE_DECLARE \
- static dbistate_t *DBIS; \
- _DBISTATE_DECLARE_COMMON
-
-# define _DBISTATE_INIT_DBIS DBIS = *dbi_get_state(aTHX);
-#endif
-
-# define DBISTATE_INIT { /* typically use in BOOT: of XS file */ \
- _DBISTATE_INIT_DBIS \
- if (DBIS == NULL) \
- croak("Unable to get DBI state. DBI not loaded."); \
- DBIS->check_version(__FILE__, DBISTATE_VERSION, sizeof(*DBIS), NEED_DBIXS_VERSION, \
- sizeof(dbih_drc_t), sizeof(dbih_dbc_t), sizeof(dbih_stc_t), sizeof(dbih_fdc_t) \
- ); \
-}
-
-
-/* --- Assorted Utility Macros --- */
-
-#define DBD_ATTRIB_OK(attribs) /* is this a usable attrib value */ \
- (attribs && SvROK(attribs) && SvTYPE(SvRV(attribs))==SVt_PVHV)
-
-/* If attribs value supplied then croak if it's not a hash ref. */
-/* Also map undef to Null. Should always be called to pre-process the */
-/* attribs value. One day we may add some extra magic in here. */
-#define DBD_ATTRIBS_CHECK(func, h, attribs) \
- if ((attribs) && SvOK(attribs)) { \
- if (!SvROK(attribs) || SvTYPE(SvRV(attribs))!=SVt_PVHV) \
- croak("%s->%s(...): attribute parameter '%s' is not a hash ref", \
- SvPV_nolen(h), func, SvPV_nolen(attribs)); \
- } else (attribs) = Nullsv
-
-#define DBD_ATTRIB_GET_SVP(attribs, key,klen) \
- (DBD_ATTRIB_OK(attribs) \
- ? hv_fetch((HV*)SvRV(attribs), key,klen, 0) \
- : (SV **)Nullsv)
-
-#define DBD_ATTRIB_GET_IV(attribs, key,klen, svp, var) \
- if ((svp=DBD_ATTRIB_GET_SVP(attribs, key,klen)) != NULL) \
- var = SvIV(*svp)
-
-#define DBD_ATTRIB_GET_UV(attribs, key,klen, svp, var) \
- if ((svp=DBD_ATTRIB_GET_SVP(attribs, key,klen)) != NULL) \
- var = SvUV(*svp)
-
-#define DBD_ATTRIB_GET_BOOL(attribs, key,klen, svp, var) \
- if ((svp=DBD_ATTRIB_GET_SVP(attribs, key,klen)) != NULL) \
- var = SvTRUE(*svp)
-
-#define DBD_ATTRIB_TRUE(attribs, key,klen, svp) \
- ( ((svp=DBD_ATTRIB_GET_SVP(attribs, key,klen)) != NULL) \
- ? SvTRUE(*svp) : 0 )
-
-#define DBD_ATTRIB_GET_PV(attribs, key,klen, svp, dflt) \
- (((svp=DBD_ATTRIB_GET_SVP(attribs, key,klen)) != NULL) \
- ? SvPV_nolen(*svp) : (dflt))
-
-#define DBD_ATTRIB_DELETE(attribs, key, klen) \
- hv_delete((HV*)SvRV(attribs), key, klen, G_DISCARD)
-
-#endif /* DBIXS_VERSION */
-/* end of DBIXS.h */
+++ /dev/null
-# $Id$
-# Copyright (c) 1997-2002 Tim Bunce Ireland
-# Copyright (c) 2002 Jonathan Leffler
-#
-# You may distribute under the terms of either the GNU General Public
-# License or the Artistic License, as specified in the Perl README file.
-
-
-#include "Driver_xst.h"
-
-# Historically dbd_db_do4, dbd_st_execute, and dbd_st_rows returned an 'int' type.
-# That's only 32 bits (31+sign) so isn't sufficient for very large row counts
-# So now instead of defining those macros, drivers can define dbd_db_do4_iv,
-# dbd_st_execute_iv, and dbd_st_rows_iv to be the names of functions that
-# return an 'IV' type. They could also set DBIc_ROW_COUNT(imp_sth).
-#
-# To save a mess of #ifdef's we arrange for dbd_st_execute (etc) to work
-# as dbd_st_execute_iv if that's defined
-#
-#if defined(dbd_st_execute_iv)
-#undef dbd_st_execute
-#define dbd_st_execute dbd_st_execute_iv
-#endif
-#if defined(dbd_st_rows_iv)
-#undef dbd_st_rows
-#define dbd_st_rows dbd_st_rows_iv
-#endif
-#if defined(dbd_db_do4_iv)
-#undef dbd_db_do4
-#define dbd_db_do4 dbd_db_do4_iv
-#endif
-
-MODULE = DBD::~DRIVER~ PACKAGE = DBD::~DRIVER~
-
-REQUIRE: 1.929
-PROTOTYPES: DISABLE
-
-BOOT:
- PERL_UNUSED_VAR(items);
- DBISTATE_INIT;
- /* XXX this interface will change: */
- DBI_IMP_SIZE("DBD::~DRIVER~::dr::imp_data_size", sizeof(imp_drh_t));
- DBI_IMP_SIZE("DBD::~DRIVER~::db::imp_data_size", sizeof(imp_dbh_t));
- DBI_IMP_SIZE("DBD::~DRIVER~::st::imp_data_size", sizeof(imp_sth_t));
- dbd_init(DBIS);
-
-
-# ------------------------------------------------------------
-# driver level interface
-# ------------------------------------------------------------
-MODULE = DBD::~DRIVER~ PACKAGE = DBD::~DRIVER~::dr
-
-
-void
-dbixs_revision(...)
- PPCODE:
- ST(0) = sv_2mortal(newSViv(DBIXS_REVISION));
-
-
-#ifdef dbd_discon_all
-
-# disconnect_all renamed and ALIAS'd to avoid length clash on VMS :-(
-void
-discon_all_(drh)
- SV * drh
- ALIAS:
- disconnect_all = 1
- CODE:
- D_imp_drh(drh);
- PERL_UNUSED_VAR(ix);
- ST(0) = dbd_discon_all(drh, imp_drh) ? &PL_sv_yes : &PL_sv_no;
-
-#endif /* dbd_discon_all */
-
-
-#ifdef dbd_dr_data_sources
-
-void
-data_sources(drh, attr = Nullsv)
- SV *drh
- SV *attr
- PPCODE:
- {
- D_imp_drh(drh);
- AV *av = dbd_dr_data_sources(drh, imp_drh, attr);
- if (av) {
- int i;
- int n = AvFILL(av)+1;
- EXTEND(sp, n);
- for (i = 0; i < n; ++i) {
- PUSHs(AvARRAY(av)[i]);
- }
- }
- }
-
-#endif
-
-
-# ------------------------------------------------------------
-# database level interface
-# ------------------------------------------------------------
-MODULE = DBD::~DRIVER~ PACKAGE = DBD::~DRIVER~::db
-
-
-void
-_login(dbh, dbname, username, password, attribs=Nullsv)
- SV * dbh
- SV * dbname
- SV * username
- SV * password
- SV * attribs
- CODE:
- {
- D_imp_dbh(dbh);
-#if !defined(dbd_db_login6_sv)
- STRLEN lna;
- char *u = (SvOK(username)) ? SvPV(username,lna) : (char*)"";
- char *p = (SvOK(password)) ? SvPV(password,lna) : (char*)"";
-#endif
-#ifdef dbd_db_login6_sv
- ST(0) = dbd_db_login6_sv(dbh, imp_dbh, dbname, username, password, attribs) ? &PL_sv_yes : &PL_sv_no;
-#elif defined(dbd_db_login6)
- ST(0) = dbd_db_login6(dbh, imp_dbh, SvPV_nolen(dbname), u, p, attribs) ? &PL_sv_yes : &PL_sv_no;
-#else
- PERL_UNUSED_ARG(attribs);
- ST(0) = dbd_db_login( dbh, imp_dbh, SvPV_nolen(dbname), u, p) ? &PL_sv_yes : &PL_sv_no;
-#endif
- }
-
-
-void
-selectall_arrayref(...)
- PREINIT:
- SV *sth;
- SV **maxrows_svp;
- SV **tmp_svp;
- SV *tmp_sv;
- SV *attr = &PL_sv_undef;
- imp_sth_t *imp_sth;
- CODE:
- if (items > 2) {
- attr = ST(2);
- if (SvROK(attr) &&
- (DBD_ATTRIB_TRUE(attr,"Slice",5,tmp_svp) || DBD_ATTRIB_TRUE(attr,"Columns",7,tmp_svp))
- ) {
- /* fallback to perl implementation */
- SV *tmp =dbixst_bounce_method("DBD::~DRIVER~::db::SUPER::selectall_arrayref", items);
- SPAGAIN;
- ST(0) = tmp;
- XSRETURN(1);
- }
- }
- /* --- prepare --- */
- if (SvROK(ST(1))) {
- MAGIC *mg;
- sth = ST(1);
- /* switch to inner handle if not already */
- if ( (mg = mg_find(SvRV(sth),'P')) )
- sth = mg->mg_obj;
- }
- else {
- sth = dbixst_bounce_method("prepare", 3);
- SPAGAIN; SP -= items; /* because stack might have been realloc'd */
- if (!SvROK(sth))
- XSRETURN_UNDEF;
- /* switch to inner handle */
- sth = mg_find(SvRV(sth),'P')->mg_obj;
- }
- imp_sth = (imp_sth_t*)(DBIh_COM(sth));
- /* --- bind_param --- */
- if (items > 3) { /* need to bind params before execute */
- if (!dbdxst_bind_params(sth, imp_sth, items-2, ax+2) ) {
- XSRETURN_UNDEF;
- }
- }
- /* --- execute --- */
- DBIc_ROW_COUNT(imp_sth) = 0;
- if ( dbd_st_execute(sth, imp_sth) <= -2 ) { /* -2 == error */
- XSRETURN_UNDEF;
- }
- /* --- fetchall --- */
- maxrows_svp = DBD_ATTRIB_GET_SVP(attr, "MaxRows", 7);
- tmp_sv = dbdxst_fetchall_arrayref(sth, &PL_sv_undef, (maxrows_svp) ? *maxrows_svp : &PL_sv_undef);
- SPAGAIN;
- ST(0) = tmp_sv;
-
-
-void
-selectrow_arrayref(...)
- ALIAS:
- selectrow_array = 1
- PREINIT:
- int is_selectrow_array = (ix == 1);
- imp_sth_t *imp_sth;
- SV *sth;
- AV *row_av;
- PPCODE:
- if (SvROK(ST(1))) {
- MAGIC *mg;
- sth = ST(1);
- /* switch to inner handle if not already */
- if ( (mg = mg_find(SvRV(sth),'P')) )
- sth = mg->mg_obj;
- }
- else {
- /* --- prepare --- */
- sth = dbixst_bounce_method("prepare", 3);
- SPAGAIN; SP -= items; /* because stack might have been realloc'd */
- if (!SvROK(sth)) {
- if (is_selectrow_array) { XSRETURN_EMPTY; } else { XSRETURN_UNDEF; }
- }
- /* switch to inner handle */
- sth = mg_find(SvRV(sth),'P')->mg_obj;
- }
- imp_sth = (imp_sth_t*)(DBIh_COM(sth));
- /* --- bind_param --- */
- if (items > 3) { /* need to bind params before execute */
- if (!dbdxst_bind_params(sth, imp_sth, items-2, ax+2) ) {
- if (is_selectrow_array) { XSRETURN_EMPTY; } else { XSRETURN_UNDEF; }
- }
- }
- /* --- execute --- */
- DBIc_ROW_COUNT(imp_sth) = 0;
- if ( dbd_st_execute(sth, imp_sth) <= -2 ) { /* -2 == error */
- if (is_selectrow_array) { XSRETURN_EMPTY; } else { XSRETURN_UNDEF; }
- }
- /* --- fetchrow_arrayref --- */
- row_av = dbd_st_fetch(sth, imp_sth);
- if (!row_av) {
- if (GIMME == G_SCALAR)
- PUSHs(&PL_sv_undef);
- }
- else if (is_selectrow_array) {
- int i;
- int num_fields = AvFILL(row_av)+1;
- if (GIMME == G_SCALAR)
- num_fields = 1; /* return just first field */
- EXTEND(sp, num_fields);
- for(i=0; i < num_fields; ++i) {
- PUSHs(AvARRAY(row_av)[i]);
- }
- }
- else {
- PUSHs( sv_2mortal(newRV((SV *)row_av)) );
- }
- /* --- finish --- */
-#ifdef dbd_st_finish3
- dbd_st_finish3(sth, imp_sth, 0);
-#else
- dbd_st_finish(sth, imp_sth);
-#endif
-
-
-#ifdef dbd_db_do4 /* deebeedee-deebee-doo, deebee-doobee-dah? */
-
-void
-do(dbh, statement, params = Nullsv)
- SV * dbh
- char * statement
- SV * params
- CODE:
- {
- D_imp_dbh(dbh);
- IV retval;
- retval = dbd_db_do4(dbh, imp_dbh, statement, params); /* might be dbd_db_do4_iv via macro */
- /* remember that dbd_db_do4 must return <= -2 for error */
- if (retval == 0) /* ok with no rows affected */
- XST_mPV(0, "0E0"); /* (true but zero) */
- else if (retval < -1) /* -1 == unknown number of rows */
- XST_mUNDEF(0); /* <= -2 means error */
- else
- XST_mIV(0, retval); /* typically 1, rowcount or -1 */
- }
-
-#endif
-
-
-#ifdef dbd_db_last_insert_id
-
-void
-last_insert_id(dbh, catalog, schema, table, field, attr=Nullsv)
- SV * dbh
- SV * catalog
- SV * schema
- SV * table
- SV * field
- SV * attr
- CODE:
- {
- D_imp_dbh(dbh);
- ST(0) = dbd_db_last_insert_id(dbh, imp_dbh, catalog, schema, table, field, attr);
- }
-
-#endif
-
-
-void
-commit(dbh)
- SV * dbh
- CODE:
- D_imp_dbh(dbh);
- if (DBIc_has(imp_dbh,DBIcf_AutoCommit) && DBIc_WARN(imp_dbh))
- warn("commit ineffective with AutoCommit enabled");
- ST(0) = dbd_db_commit(dbh, imp_dbh) ? &PL_sv_yes : &PL_sv_no;
-
-
-void
-rollback(dbh)
- SV * dbh
- CODE:
- D_imp_dbh(dbh);
- if (DBIc_has(imp_dbh,DBIcf_AutoCommit) && DBIc_WARN(imp_dbh))
- warn("rollback ineffective with AutoCommit enabled");
- ST(0) = dbd_db_rollback(dbh, imp_dbh) ? &PL_sv_yes : &PL_sv_no;
-
-
-void
-disconnect(dbh)
- SV * dbh
- CODE:
- D_imp_dbh(dbh);
- if ( !DBIc_ACTIVE(imp_dbh) ) {
- XSRETURN_YES;
- }
- /* Check for disconnect() being called whilst refs to cursors */
- /* still exists. This possibly needs some more thought. */
- if (DBIc_ACTIVE_KIDS(imp_dbh) && DBIc_WARN(imp_dbh) && !PL_dirty) {
- STRLEN lna;
- char *plural = (DBIc_ACTIVE_KIDS(imp_dbh)==1) ? (char*)"" : (char*)"s";
- warn("%s->disconnect invalidates %d active statement handle%s %s",
- SvPV(dbh,lna), (int)DBIc_ACTIVE_KIDS(imp_dbh), plural,
- "(either destroy statement handles or call finish on them before disconnecting)");
- }
- ST(0) = dbd_db_disconnect(dbh, imp_dbh) ? &PL_sv_yes : &PL_sv_no;
- DBIc_ACTIVE_off(imp_dbh); /* ensure it's off, regardless */
-
-
-void
-STORE(dbh, keysv, valuesv)
- SV * dbh
- SV * keysv
- SV * valuesv
- CODE:
- D_imp_dbh(dbh);
- if (SvGMAGICAL(valuesv))
- mg_get(valuesv);
- ST(0) = &PL_sv_yes;
- if (!dbd_db_STORE_attrib(dbh, imp_dbh, keysv, valuesv))
- if (!DBIc_DBISTATE(imp_dbh)->set_attr(dbh, keysv, valuesv))
- ST(0) = &PL_sv_no;
-
-
-void
-FETCH(dbh, keysv)
- SV * dbh
- SV * keysv
- CODE:
- D_imp_dbh(dbh);
- SV *valuesv = dbd_db_FETCH_attrib(dbh, imp_dbh, keysv);
- if (!valuesv)
- valuesv = DBIc_DBISTATE(imp_dbh)->get_attr(dbh, keysv);
- ST(0) = valuesv; /* dbd_db_FETCH_attrib did sv_2mortal */
-
-
-void
-DESTROY(dbh)
- SV * dbh
- PPCODE:
- /* keep in sync with default DESTROY in DBI.xs */
- D_imp_dbh(dbh);
- ST(0) = &PL_sv_yes;
- if (!DBIc_IMPSET(imp_dbh)) { /* was never fully set up */
- STRLEN lna;
- if (DBIc_WARN(imp_dbh) && !PL_dirty && DBIc_DBISTATE(imp_dbh)->debug >= 2)
- PerlIO_printf(DBIc_LOGPIO(imp_dbh),
- " DESTROY for %s ignored - handle not initialised\n",
- SvPV(dbh,lna));
- }
- else {
- if (DBIc_IADESTROY(imp_dbh)) { /* wants ineffective destroy */
- DBIc_ACTIVE_off(imp_dbh);
- if (DBIc_DBISTATE(imp_dbh)->debug)
- PerlIO_printf(DBIc_LOGPIO(imp_dbh), " DESTROY %s skipped due to InactiveDestroy\n", SvPV_nolen(dbh));
- }
- if (DBIc_ACTIVE(imp_dbh)) {
- if (!DBIc_has(imp_dbh,DBIcf_AutoCommit)) {
- /* Application is using transactions and hasn't explicitly disconnected.
- Some databases will automatically commit on graceful disconnect.
- Since we're about to gracefully disconnect as part of the DESTROY
- we want to be sure we're not about to implicitly commit changes
- that are incomplete and should be rolled back. (The DESTROY may
- be due to a RaiseError, for example.) So we rollback here.
- This will be harmless if the application has issued a commit,
- XXX Could add an attribute flag to indicate that the driver
- doesn't have this problem. Patches welcome.
- */
- if (DBIc_WARN(imp_dbh) /* only warn if likely to be useful... */
- && DBIc_is(imp_dbh, DBIcf_Executed) /* has not just called commit/rollback */
- /* && !DBIc_is(imp_dbh, DBIcf_ReadOnly) -- is not read only */
- && (!PL_dirty || DBIc_DBISTATE(imp_dbh)->debug >= 3)
- ) {
- warn("Issuing rollback() due to DESTROY without explicit disconnect() of %s handle %s",
- SvPV_nolen(*hv_fetch((HV*)SvRV(dbh), "ImplementorClass", 16, 1)),
- SvPV_nolen(*hv_fetch((HV*)SvRV(dbh), "Name", 4, 1))
- );
- }
- dbd_db_rollback(dbh, imp_dbh); /* ROLLBACK! */
- }
- dbd_db_disconnect(dbh, imp_dbh);
- DBIc_ACTIVE_off(imp_dbh); /* ensure it's off, regardless */
- }
- dbd_db_destroy(dbh, imp_dbh);
- }
-
-
-#ifdef dbd_take_imp_data
-
-void
-take_imp_data(h)
- SV * h
- CODE:
- D_imp_xxh(h);
- /* dbd_take_imp_data() returns &sv_no (or other defined but false value)
- * to indicate "preparations complete, now call SUPER::take_imp_data" for me.
- * Anything else is returned to the caller via sv_2mortal(sv), typically that
- * would be &sv_undef for error or an SV holding the imp_data.
- */
- SV *sv = dbd_take_imp_data(h, imp_xxh, NULL);
- if (SvOK(sv) && !SvTRUE(sv)) {
- SV *tmp = dbixst_bounce_method("DBD::~DRIVER~::db::SUPER::take_imp_data", items);
- SPAGAIN;
- ST(0) = tmp;
- } else {
- ST(0) = sv_2mortal(sv);
- }
-
-#endif
-
-#ifdef dbd_db_data_sources
-
-void
-data_sources(dbh, attr = Nullsv)
- SV *dbh
- SV *attr
- PPCODE:
- {
- D_imp_dbh(dbh);
- AV *av = dbd_db_data_sources(dbh, imp_dbh, attr);
- if (av) {
- int i;
- int n = AvFILL(av)+1;
- EXTEND(sp, n);
- for (i = 0; i < n; ++i) {
- PUSHs(AvARRAY(av)[i]);
- }
- }
- }
-
-#endif
-
-# -- end of DBD::~DRIVER~::db
-
-# ------------------------------------------------------------
-# statement interface
-# ------------------------------------------------------------
-MODULE = DBD::~DRIVER~ PACKAGE = DBD::~DRIVER~::st
-
-
-void
-_prepare(sth, statement, attribs=Nullsv)
- SV * sth
- SV * statement
- SV * attribs
- CODE:
- {
- D_imp_sth(sth);
- DBD_ATTRIBS_CHECK("_prepare", sth, attribs);
-#ifdef dbd_st_prepare_sv
- ST(0) = dbd_st_prepare_sv(sth, imp_sth, statement, attribs) ? &PL_sv_yes : &PL_sv_no;
-#else
- ST(0) = dbd_st_prepare(sth, imp_sth, SvPV_nolen(statement), attribs) ? &PL_sv_yes : &PL_sv_no;
-#endif
- }
-
-
-#ifdef dbd_st_rows
-
-void
-rows(sth)
- SV * sth
- CODE:
- D_imp_sth(sth);
- XST_mIV(0, dbd_st_rows(sth, imp_sth));
-
-#endif /* dbd_st_rows */
-
-
-#ifdef dbd_st_bind_col
-
-void
-bind_col(sth, col, ref, attribs=Nullsv)
- SV * sth
- SV * col
- SV * ref
- SV * attribs
- CODE:
- {
- IV sql_type = 0;
- D_imp_sth(sth);
- if (SvGMAGICAL(ref))
- mg_get(ref);
- if (attribs) {
- if (SvNIOK(attribs)) {
- sql_type = SvIV(attribs);
- attribs = Nullsv;
- }
- else {
- SV **svp;
- DBD_ATTRIBS_CHECK("bind_col", sth, attribs);
- /* XXX we should perhaps complain if TYPE is not SvNIOK */
- DBD_ATTRIB_GET_IV(attribs, "TYPE",4, svp, sql_type);
- }
- }
- switch(dbd_st_bind_col(sth, imp_sth, col, ref, sql_type, attribs)) {
- case 2: ST(0) = &PL_sv_yes; /* job done completely */
- break;
- case 1: /* fallback to DBI default */
- ST(0) = (DBIc_DBISTATE(imp_sth)->bind_col(sth, col, ref, attribs))
- ? &PL_sv_yes : &PL_sv_no;
- break;
- default: ST(0) = &PL_sv_no; /* dbd_st_bind_col has called set_err */
- break;
- }
- }
-
-#endif /* dbd_st_bind_col */
-
-void
-bind_param(sth, param, value, attribs=Nullsv)
- SV * sth
- SV * param
- SV * value
- SV * attribs
- CODE:
- {
- IV sql_type = 0;
- D_imp_sth(sth);
- if (SvGMAGICAL(value))
- mg_get(value);
- if (attribs) {
- if (SvNIOK(attribs)) {
- sql_type = SvIV(attribs);
- attribs = Nullsv;
- }
- else {
- SV **svp;
- DBD_ATTRIBS_CHECK("bind_param", sth, attribs);
- /* XXX we should perhaps complain if TYPE is not SvNIOK */
- DBD_ATTRIB_GET_IV(attribs, "TYPE",4, svp, sql_type);
- }
- }
- ST(0) = dbd_bind_ph(sth, imp_sth, param, value, sql_type, attribs, FALSE, 0)
- ? &PL_sv_yes : &PL_sv_no;
- }
-
-
-void
-bind_param_inout(sth, param, value_ref, maxlen, attribs=Nullsv)
- SV * sth
- SV * param
- SV * value_ref
- IV maxlen
- SV * attribs
- CODE:
- {
- IV sql_type = 0;
- D_imp_sth(sth);
- SV *value;
- if (!SvROK(value_ref) || SvTYPE(SvRV(value_ref)) > SVt_PVMG)
- croak("bind_param_inout needs a reference to a scalar value");
- value = SvRV(value_ref);
- if (SvREADONLY(value))
- croak("Modification of a read-only value attempted");
- if (SvGMAGICAL(value))
- mg_get(value);
- if (attribs) {
- if (SvNIOK(attribs)) {
- sql_type = SvIV(attribs);
- attribs = Nullsv;
- }
- else {
- SV **svp;
- DBD_ATTRIBS_CHECK("bind_param", sth, attribs);
- DBD_ATTRIB_GET_IV(attribs, "TYPE",4, svp, sql_type);
- }
- }
- ST(0) = dbd_bind_ph(sth, imp_sth, param, value, sql_type, attribs, TRUE, maxlen)
- ? &PL_sv_yes : &PL_sv_no;
- }
-
-
-void
-execute(sth, ...)
- SV * sth
- CODE:
- D_imp_sth(sth);
- IV retval;
- if (items > 1) { /* need to bind params */
- if (!dbdxst_bind_params(sth, imp_sth, items, ax) ) {
- XSRETURN_UNDEF;
- }
- }
- /* XXX this code is duplicated in selectrow_arrayref above */
- DBIc_ROW_COUNT(imp_sth) = 0;
- retval = dbd_st_execute(sth, imp_sth); /* might be dbd_st_execute_iv via macro */
- /* remember that dbd_st_execute must return <= -2 for error */
- if (retval == 0) /* ok with no rows affected */
- XST_mPV(0, "0E0"); /* (true but zero) */
- else if (retval < -1) /* -1 == unknown number of rows */
- XST_mUNDEF(0); /* <= -2 means error */
- else
- XST_mIV(0, retval); /* typically 1, rowcount or -1 */
-
-
-#ifdef dbd_st_execute_for_fetch
-
-void
-execute_for_fetch(sth, fetch_tuple_sub, tuple_status = Nullsv)
- SV * sth
- SV * fetch_tuple_sub
- SV * tuple_status
- CODE:
- {
- D_imp_sth(sth);
- ST(0) = dbd_st_execute_for_fetch(sth, imp_sth, fetch_tuple_sub, tuple_status);
- }
-
-#endif
-
-
-
-void
-fetchrow_arrayref(sth)
- SV * sth
- ALIAS:
- fetch = 1
- CODE:
- D_imp_sth(sth);
- AV *av;
- PERL_UNUSED_VAR(ix);
- av = dbd_st_fetch(sth, imp_sth);
- ST(0) = (av) ? sv_2mortal(newRV((SV *)av)) : &PL_sv_undef;
-
-
-void
-fetchrow_array(sth)
- SV * sth
- ALIAS:
- fetchrow = 1
- PPCODE:
- D_imp_sth(sth);
- AV *av;
- av = dbd_st_fetch(sth, imp_sth);
- if (av) {
- int i;
- int num_fields = AvFILL(av)+1;
- EXTEND(sp, num_fields);
- for(i=0; i < num_fields; ++i) {
- PUSHs(AvARRAY(av)[i]);
- }
- PERL_UNUSED_VAR(ix);
- }
-
-
-void
-fetchall_arrayref(sth, slice=&PL_sv_undef, batch_row_count=&PL_sv_undef)
- SV * sth
- SV * slice
- SV * batch_row_count
- CODE:
- if (SvOK(slice)) { /* fallback to perl implementation */
- SV *tmp = dbixst_bounce_method("DBD::~DRIVER~::st::SUPER::fetchall_arrayref", 3);
- SPAGAIN;
- ST(0) = tmp;
- }
- else {
- SV *tmp = dbdxst_fetchall_arrayref(sth, slice, batch_row_count);
- SPAGAIN;
- ST(0) = tmp;
- }
-
-
-void
-finish(sth)
- SV * sth
- CODE:
- D_imp_sth(sth);
- D_imp_dbh_from_sth;
- if (!DBIc_ACTIVE(imp_sth)) {
- /* No active statement to finish */
- XSRETURN_YES;
- }
- if (!DBIc_ACTIVE(imp_dbh)) {
- /* Either an explicit disconnect() or global destruction */
- /* has disconnected us from the database. Finish is meaningless */
- DBIc_ACTIVE_off(imp_sth);
- XSRETURN_YES;
- }
-#ifdef dbd_st_finish3
- ST(0) = dbd_st_finish3(sth, imp_sth, 0) ? &PL_sv_yes : &PL_sv_no;
-#else
- ST(0) = dbd_st_finish(sth, imp_sth) ? &PL_sv_yes : &PL_sv_no;
-#endif
-
-
-void
-blob_read(sth, field, offset, len, destrv=Nullsv, destoffset=0)
- SV * sth
- int field
- long offset
- long len
- SV * destrv
- long destoffset
- CODE:
- {
- D_imp_sth(sth);
- if (!destrv)
- destrv = sv_2mortal(newRV(sv_2mortal(newSV(0))));
- if (dbd_st_blob_read(sth, imp_sth, field, offset, len, destrv, destoffset))
- ST(0) = SvRV(destrv);
- else ST(0) = &PL_sv_undef;
- }
-
-
-void
-STORE(sth, keysv, valuesv)
- SV * sth
- SV * keysv
- SV * valuesv
- CODE:
- D_imp_sth(sth);
- if (SvGMAGICAL(valuesv))
- mg_get(valuesv);
- ST(0) = &PL_sv_yes;
- if (!dbd_st_STORE_attrib(sth, imp_sth, keysv, valuesv))
- if (!DBIc_DBISTATE(imp_sth)->set_attr(sth, keysv, valuesv))
- ST(0) = &PL_sv_no;
-
-
-# FETCH renamed and ALIAS'd to avoid case clash on VMS :-(
-void
-FETCH_attrib(sth, keysv)
- SV * sth
- SV * keysv
- ALIAS:
- FETCH = 1
- CODE:
- D_imp_sth(sth);
- SV *valuesv;
- PERL_UNUSED_VAR(ix);
- valuesv = dbd_st_FETCH_attrib(sth, imp_sth, keysv);
- if (!valuesv)
- valuesv = DBIc_DBISTATE(imp_sth)->get_attr(sth, keysv);
- ST(0) = valuesv; /* dbd_st_FETCH_attrib did sv_2mortal */
-
-
-void
-DESTROY(sth)
- SV * sth
- PPCODE:
- /* keep in sync with default DESTROY in DBI.xs */
- D_imp_sth(sth);
- ST(0) = &PL_sv_yes;
- if (!DBIc_IMPSET(imp_sth)) { /* was never fully set up */
- STRLEN lna;
- if (DBIc_WARN(imp_sth) && !PL_dirty && DBIc_DBISTATE(imp_sth)->debug >= 2)
- PerlIO_printf(DBIc_LOGPIO(imp_sth),
- " DESTROY for %s ignored - handle not initialised\n",
- SvPV(sth,lna));
- }
- else {
- if (DBIc_IADESTROY(imp_sth)) { /* wants ineffective destroy */
- DBIc_ACTIVE_off(imp_sth);
- if (DBIc_DBISTATE(imp_sth)->debug)
- PerlIO_printf(DBIc_LOGPIO(imp_sth), " DESTROY %s skipped due to InactiveDestroy\n", SvPV_nolen(sth));
- }
- if (DBIc_ACTIVE(imp_sth)) {
- D_imp_dbh_from_sth;
- if (!PL_dirty && DBIc_ACTIVE(imp_dbh)) {
-#ifdef dbd_st_finish3
- dbd_st_finish3(sth, imp_sth, 1);
-#else
- dbd_st_finish(sth, imp_sth);
-#endif
- }
- else {
- DBIc_ACTIVE_off(imp_sth);
- }
- }
- dbd_st_destroy(sth, imp_sth);
- }
-
-# end of ~DRIVER~.xst
-# vim:ts=8:sw=4:et
+++ /dev/null
-/*
-# $Id$
-# Copyright (c) 2002 Tim Bunce Ireland
-#
-# You may distribute under the terms of either the GNU General Public
-# License or the Artistic License, as specified in the Perl README file.
-*/
-
-
-/* This is really just a workaround for SUPER:: not working right for XS code.
- * It would be better if we setup perl's context so SUPER:: did the right thing
- * (borrowing the relevant magic from pp_entersub in perl pp_hot.c).
- * Then we could just use call_method("SUPER::foo") instead.
- * XXX remember to call SPAGAIN in the calling code after calling this!
- */
-static SV *
-dbixst_bounce_method(char *methname, int params)
-{
- dTHX;
- /* XXX this 'magic' undoes the dMARK embedded in the dXSARGS of our caller */
- /* so that the dXSARGS below can set things up as they were for our caller */
- void *xxx = PL_markstack_ptr++;
- dXSARGS; /* declares sp, ax, mark, items */
- int i;
- SV *sv;
- int debug = 0;
- D_imp_xxh(ST(0));
- if (debug >= 3) {
- PerlIO_printf(DBIc_LOGPIO(imp_xxh),
- " -> %s (trampoline call with %d (%ld) params)\n", methname, params, (long)items);
- PERL_UNUSED_VAR(xxx);
- }
- EXTEND(SP, params);
- PUSHMARK(SP);
- for (i=0; i < params; ++i) {
- sv = (i >= items) ? &PL_sv_undef : ST(i);
- PUSHs(sv);
- }
- PUTBACK;
- i = call_method(methname, G_SCALAR);
- SPAGAIN;
- sv = (i) ? POPs : &PL_sv_undef;
- PUTBACK;
- if (debug >= 3)
- PerlIO_printf(DBIc_LOGPIO(imp_xxh),
- " <- %s= %s (trampoline call return)\n", methname, neatsvpv(sv,0));
- return sv;
-}
-
-
-static int
-dbdxst_bind_params(SV *sth, imp_sth_t *imp_sth, I32 items, I32 ax)
-{
- /* Handle binding supplied values to placeholders. */
- /* items = one greater than the number of params */
- /* ax = ax from calling sub, maybe adjusted to match items */
- dTHX;
- int i;
- SV *idx;
- if (items-1 != DBIc_NUM_PARAMS(imp_sth)
- && DBIc_NUM_PARAMS(imp_sth) != DBIc_NUM_PARAMS_AT_EXECUTE
- ) {
- char errmsg[99];
- /* clear any previous ParamValues before error is generated */
- SV **svp = hv_fetch((HV*)DBIc_MY_H(imp_sth),"ParamValues",11,FALSE);
- if (svp && SvROK(*svp) && SvTYPE(SvRV(*svp)) == SVt_PVHV) {
- HV *hv = (HV*)SvRV(*svp);
- hv_clear(hv);
- }
- sprintf(errmsg,"called with %d bind variables when %d are needed",
- (int)items-1, DBIc_NUM_PARAMS(imp_sth));
- DBIh_SET_ERR_CHAR(sth, (imp_xxh_t*)imp_sth, "-1", -1, errmsg, Nullch, Nullch);
- return 0;
- }
- idx = sv_2mortal(newSViv(0));
- for(i=1; i < items ; ++i) {
- SV* value = ST(i);
- if (SvGMAGICAL(value))
- mg_get(value); /* trigger magic to FETCH the value */
- sv_setiv(idx, i);
- if (!dbd_bind_ph(sth, imp_sth, idx, value, 0, Nullsv, FALSE, 0)) {
- return 0; /* dbd_bind_ph already registered error */
- }
- }
- return 1;
-}
-
-#ifndef dbd_fetchall_arrayref
-static SV *
-dbdxst_fetchall_arrayref(SV *sth, SV *slice, SV *batch_row_count)
-{
- dTHX;
- D_imp_sth(sth);
- SV *rows_rvav;
- if (SvOK(slice)) { /* should never get here */
- char errmsg[99];
- sprintf(errmsg,"slice param not supported by XS version of fetchall_arrayref");
- DBIh_SET_ERR_CHAR(sth, (imp_xxh_t*)imp_sth, "-1", -1, errmsg, Nullch, Nullch);
- return &PL_sv_undef;
- }
- else {
- IV maxrows = SvOK(batch_row_count) ? SvIV(batch_row_count) : -1;
- AV *fetched_av;
- AV *rows_av = newAV();
- if ( !DBIc_ACTIVE(imp_sth) && maxrows>0 ) {
- /* to simplify application logic we return undef without an error */
- /* if we've fetched all the rows and called with a batch_row_count */
- return &PL_sv_undef;
- }
- av_extend(rows_av, (maxrows>0) ? maxrows : 31);
- while ( (maxrows < 0 || maxrows-- > 0)
- && (fetched_av = dbd_st_fetch(sth, imp_sth))
- ) {
- AV *copy_row_av = av_make(AvFILL(fetched_av)+1, AvARRAY(fetched_av));
- av_push(rows_av, newRV_noinc((SV*)copy_row_av));
- }
- rows_rvav = sv_2mortal(newRV_noinc((SV *)rows_av));
- }
- return rows_rvav;
-}
-#endif
-
+++ /dev/null
-/* @(#)$Id$
- *
- * Copyright 2000-2002 Tim Bunce
- * Copyright 2002 Jonathan Leffler
- *
- * These prototypes are for dbdimp.c funcs used in the XS file.
- * These names are #defined to driver specific names by the
- * dbdimp.h file in the driver source.
- */
-
-#ifndef DBI_DBD_XSH_H
-#define DBI_DBD_XSH_H
-
-void dbd_init _((dbistate_t *dbistate));
-
-int dbd_discon_all _((SV *drh, imp_drh_t *imp_drh));
-SV *dbd_take_imp_data _((SV *h, imp_xxh_t *imp_xxh, void *foo));
-
-/* Support for dbd_dr_data_sources and dbd_db_do added to Driver.xst in DBI v1.33 */
-/* dbd_dr_data_sources: optional: defined by a driver that calls a C */
-/* function to get the list of data sources */
-AV *dbd_dr_data_sources(SV *drh, imp_drh_t *imp_drh, SV *attrs);
-
-int dbd_db_login6_sv _((SV *dbh, imp_dbh_t *imp_dbh, SV *dbname, SV *uid, SV *pwd, SV*attribs));
-int dbd_db_login6 _((SV *dbh, imp_dbh_t *imp_dbh, char *dbname, char *uid, char *pwd, SV*attribs));
-int dbd_db_login _((SV *dbh, imp_dbh_t *imp_dbh, char *dbname, char *uid, char *pwd)); /* deprecated */
-/* Note: interface of dbd_db_do changed in v1.33 */
-/* Old prototype: dbd_db_do _((SV *sv, char *statement)); */
-/* dbd_db_do: optional: defined by a driver if the DBI default version is too slow */
-int dbd_db_do4 _((SV *dbh, imp_dbh_t *imp_dbh, char *statement, SV *params));
-IV dbd_db_do4_iv _((SV *dbh, imp_dbh_t *imp_dbh, char *statement, SV *params));
-int dbd_db_commit _((SV *dbh, imp_dbh_t *imp_dbh));
-int dbd_db_rollback _((SV *dbh, imp_dbh_t *imp_dbh));
-int dbd_db_disconnect _((SV *dbh, imp_dbh_t *imp_dbh));
-void dbd_db_destroy _((SV *dbh, imp_dbh_t *imp_dbh));
-int dbd_db_STORE_attrib _((SV *dbh, imp_dbh_t *imp_dbh, SV *keysv, SV *valuesv));
-SV *dbd_db_FETCH_attrib _((SV *dbh, imp_dbh_t *imp_dbh, SV *keysv));
-SV *dbd_db_last_insert_id _((SV *dbh, imp_dbh_t *imp_dbh, SV *catalog, SV *schema, SV *table, SV *field, SV *attr));
-AV *dbd_db_data_sources _((SV *dbh, imp_dbh_t *imp_dbh, SV *attr));
-
-int dbd_st_prepare _((SV *sth, imp_sth_t *imp_sth, char *statement, SV *attribs));
-int dbd_st_prepare_sv _((SV *sth, imp_sth_t *imp_sth, SV *statement, SV *attribs));
-int dbd_st_rows _((SV *sth, imp_sth_t *imp_sth));
-IV dbd_st_rows_iv _((SV *sth, imp_sth_t *imp_sth));
-int dbd_st_execute _((SV *sth, imp_sth_t *imp_sth));
-IV dbd_st_execute_iv _((SV *sth, imp_sth_t *imp_sth));
-AV *dbd_st_fetch _((SV *sth, imp_sth_t *imp_sth));
-int dbd_st_finish3 _((SV *sth, imp_sth_t *imp_sth, int from_destroy));
-int dbd_st_finish _((SV *sth, imp_sth_t *imp_sth)); /* deprecated */
-void dbd_st_destroy _((SV *sth, imp_sth_t *imp_sth));
-int dbd_st_blob_read _((SV *sth, imp_sth_t *imp_sth,
- int field, long offset, long len, SV *destrv, long destoffset));
-int dbd_st_STORE_attrib _((SV *sth, imp_sth_t *imp_sth, SV *keysv, SV *valuesv));
-SV *dbd_st_FETCH_attrib _((SV *sth, imp_sth_t *imp_sth, SV *keysv));
-SV *dbd_st_execute_for_fetch _((SV *sth, imp_sth_t *imp_sth, SV *fetch_tuple_sub, SV *tuple_status));
-
-int dbd_bind_ph _((SV *sth, imp_sth_t *imp_sth,
- SV *param, SV *value, IV sql_type, SV *attribs,
- int is_inout, IV maxlen));
-
-#endif /* end of dbd_xsh.h */
+++ /dev/null
-/* $Id$
- *
- * Copyright (c) 1997,1998,1999 Tim Bunce England
- *
- * See COPYRIGHT section in DBI.pm for usage and distribution rights.
- */
-
-
-/* Some core SQL CLI standard (ODBC) declarations */
-#ifndef SQL_SUCCESS /* don't clash with ODBC based drivers */
-
-/* SQL datatype codes */
-#define SQL_GUID (-11)
-#define SQL_WLONGVARCHAR (-10)
-#define SQL_WVARCHAR (-9)
-#define SQL_WCHAR (-8)
-#define SQL_BIT (-7)
-#define SQL_TINYINT (-6)
-#define SQL_BIGINT (-5)
-#define SQL_LONGVARBINARY (-4)
-#define SQL_VARBINARY (-3)
-#define SQL_BINARY (-2)
-#define SQL_LONGVARCHAR (-1)
-#define SQL_UNKNOWN_TYPE 0
-#define SQL_ALL_TYPES 0
-#define SQL_CHAR 1
-#define SQL_NUMERIC 2
-#define SQL_DECIMAL 3
-#define SQL_INTEGER 4
-#define SQL_SMALLINT 5
-#define SQL_FLOAT 6
-#define SQL_REAL 7
-#define SQL_DOUBLE 8
-#define SQL_DATETIME 9
-#define SQL_DATE 9
-#define SQL_INTERVAL 10
-#define SQL_TIME 10
-#define SQL_TIMESTAMP 11
-#define SQL_VARCHAR 12
-#define SQL_BOOLEAN 16
-#define SQL_UDT 17
-#define SQL_UDT_LOCATOR 18
-#define SQL_ROW 19
-#define SQL_REF 20
-#define SQL_BLOB 30
-#define SQL_BLOB_LOCATOR 31
-#define SQL_CLOB 40
-#define SQL_CLOB_LOCATOR 41
-#define SQL_ARRAY 50
-#define SQL_ARRAY_LOCATOR 51
-#define SQL_MULTISET 55
-#define SQL_MULTISET_LOCATOR 56
-#define SQL_TYPE_DATE 91
-#define SQL_TYPE_TIME 92
-#define SQL_TYPE_TIMESTAMP 93
-#define SQL_TYPE_TIME_WITH_TIMEZONE 94
-#define SQL_TYPE_TIMESTAMP_WITH_TIMEZONE 95
-#define SQL_INTERVAL_YEAR 101
-#define SQL_INTERVAL_MONTH 102
-#define SQL_INTERVAL_DAY 103
-#define SQL_INTERVAL_HOUR 104
-#define SQL_INTERVAL_MINUTE 105
-#define SQL_INTERVAL_SECOND 106
-#define SQL_INTERVAL_YEAR_TO_MONTH 107
-#define SQL_INTERVAL_DAY_TO_HOUR 108
-#define SQL_INTERVAL_DAY_TO_MINUTE 109
-#define SQL_INTERVAL_DAY_TO_SECOND 110
-#define SQL_INTERVAL_HOUR_TO_MINUTE 111
-#define SQL_INTERVAL_HOUR_TO_SECOND 112
-#define SQL_INTERVAL_MINUTE_TO_SECOND 113
-
-
-/* Main return codes */
-#define SQL_ERROR (-1)
-#define SQL_SUCCESS 0
-#define SQL_SUCCESS_WITH_INFO 1
-#define SQL_NO_DATA_FOUND 100
-
-/*
- * for ODBC SQL Cursor Types
- */
-#define SQL_CURSOR_FORWARD_ONLY 0UL
-#define SQL_CURSOR_KEYSET_DRIVEN 1UL
-#define SQL_CURSOR_DYNAMIC 2UL
-#define SQL_CURSOR_STATIC 3UL
-#define SQL_CURSOR_TYPE_DEFAULT SQL_CURSOR_FORWARD_ONLY
-
-#endif /* SQL_SUCCESS */
-
-/* Handy macro for testing for success and success with info. */
-/* BEWARE that this macro can have side effects since rc appears twice! */
-/* So DONT use it as if(SQL_ok(func(...))) { ... } */
-#define SQL_ok(rc) ((rc)==SQL_SUCCESS || (rc)==SQL_SUCCESS_WITH_INFO)
-
-
-/* end of dbi_sql.h */
+++ /dev/null
-#if 0
-<<'SKIP';
-#endif
-/*
-----------------------------------------------------------------------
-
- ppport.h -- Perl/Pollution/Portability Version 3.32
-
- Automatically created by Devel::PPPort running under perl 5.018002.
-
- Do NOT edit this file directly! -- Edit PPPort_pm.PL and the
- includes in parts/inc/ instead.
-
- Use 'perldoc ppport.h' to view the documentation below.
-
-----------------------------------------------------------------------
-
-SKIP
-
-=pod
-
-=head1 NAME
-
-ppport.h - Perl/Pollution/Portability version 3.32
-
-=head1 SYNOPSIS
-
- perl ppport.h [options] [source files]
-
- Searches current directory for files if no [source files] are given
-
- --help show short help
-
- --version show version
-
- --patch=file write one patch file with changes
- --copy=suffix write changed copies with suffix
- --diff=program use diff program and options
-
- --compat-version=version provide compatibility with Perl version
- --cplusplus accept C++ comments
-
- --quiet don't output anything except fatal errors
- --nodiag don't show diagnostics
- --nohints don't show hints
- --nochanges don't suggest changes
- --nofilter don't filter input files
-
- --strip strip all script and doc functionality from
- ppport.h
-
- --list-provided list provided API
- --list-unsupported list unsupported API
- --api-info=name show Perl API portability information
-
-=head1 COMPATIBILITY
-
-This version of F<ppport.h> is designed to support operation with Perl
-installations back to 5.003, and has been tested up to 5.20.
-
-=head1 OPTIONS
-
-=head2 --help
-
-Display a brief usage summary.
-
-=head2 --version
-
-Display the version of F<ppport.h>.
-
-=head2 --patch=I<file>
-
-If this option is given, a single patch file will be created if
-any changes are suggested. This requires a working diff program
-to be installed on your system.
-
-=head2 --copy=I<suffix>
-
-If this option is given, a copy of each file will be saved with
-the given suffix that contains the suggested changes. This does
-not require any external programs. Note that this does not
-automagically add a dot between the original filename and the
-suffix. If you want the dot, you have to include it in the option
-argument.
-
-If neither C<--patch> or C<--copy> are given, the default is to
-simply print the diffs for each file. This requires either
-C<Text::Diff> or a C<diff> program to be installed.
-
-=head2 --diff=I<program>
-
-Manually set the diff program and options to use. The default
-is to use C<Text::Diff>, when installed, and output unified
-context diffs.
-
-=head2 --compat-version=I<version>
-
-Tell F<ppport.h> to check for compatibility with the given
-Perl version. The default is to check for compatibility with Perl
-version 5.003. You can use this option to reduce the output
-of F<ppport.h> if you intend to be backward compatible only
-down to a certain Perl version.
-
-=head2 --cplusplus
-
-Usually, F<ppport.h> will detect C++ style comments and
-replace them with C style comments for portability reasons.
-Using this option instructs F<ppport.h> to leave C++
-comments untouched.
-
-=head2 --quiet
-
-Be quiet. Don't print anything except fatal errors.
-
-=head2 --nodiag
-
-Don't output any diagnostic messages. Only portability
-alerts will be printed.
-
-=head2 --nohints
-
-Don't output any hints. Hints often contain useful portability
-notes. Warnings will still be displayed.
-
-=head2 --nochanges
-
-Don't suggest any changes. Only give diagnostic output and hints
-unless these are also deactivated.
-
-=head2 --nofilter
-
-Don't filter the list of input files. By default, files not looking
-like source code (i.e. not *.xs, *.c, *.cc, *.cpp or *.h) are skipped.
-
-=head2 --strip
-
-Strip all script and documentation functionality from F<ppport.h>.
-This reduces the size of F<ppport.h> dramatically and may be useful
-if you want to include F<ppport.h> in smaller modules without
-increasing their distribution size too much.
-
-The stripped F<ppport.h> will have a C<--unstrip> option that allows
-you to undo the stripping, but only if an appropriate C<Devel::PPPort>
-module is installed.
-
-=head2 --list-provided
-
-Lists the API elements for which compatibility is provided by
-F<ppport.h>. Also lists if it must be explicitly requested,
-if it has dependencies, and if there are hints or warnings for it.
-
-=head2 --list-unsupported
-
-Lists the API elements that are known not to be supported by
-F<ppport.h> and below which version of Perl they probably
-won't be available or work.
-
-=head2 --api-info=I<name>
-
-Show portability information for API elements matching I<name>.
-If I<name> is surrounded by slashes, it is interpreted as a regular
-expression.
-
-=head1 DESCRIPTION
-
-In order for a Perl extension (XS) module to be as portable as possible
-across differing versions of Perl itself, certain steps need to be taken.
-
-=over 4
-
-=item *
-
-Including this header is the first major one. This alone will give you
-access to a large part of the Perl API that hasn't been available in
-earlier Perl releases. Use
-
- perl ppport.h --list-provided
-
-to see which API elements are provided by ppport.h.
-
-=item *
-
-You should avoid using deprecated parts of the API. For example, using
-global Perl variables without the C<PL_> prefix is deprecated. Also,
-some API functions used to have a C<perl_> prefix. Using this form is
-also deprecated. You can safely use the supported API, as F<ppport.h>
-will provide wrappers for older Perl versions.
-
-=item *
-
-If you use one of a few functions or variables that were not present in
-earlier versions of Perl, and that can't be provided using a macro, you
-have to explicitly request support for these functions by adding one or
-more C<#define>s in your source code before the inclusion of F<ppport.h>.
-
-These functions or variables will be marked C<explicit> in the list shown
-by C<--list-provided>.
-
-Depending on whether you module has a single or multiple files that
-use such functions or variables, you want either C<static> or global
-variants.
-
-For a C<static> function or variable (used only in a single source
-file), use:
-
- #define NEED_function
- #define NEED_variable
-
-For a global function or variable (used in multiple source files),
-use:
-
- #define NEED_function_GLOBAL
- #define NEED_variable_GLOBAL
-
-Note that you mustn't have more than one global request for the
-same function or variable in your project.
-
- Function / Variable Static Request Global Request
- -----------------------------------------------------------------------------------------
- PL_parser NEED_PL_parser NEED_PL_parser_GLOBAL
- PL_signals NEED_PL_signals NEED_PL_signals_GLOBAL
- caller_cx() NEED_caller_cx NEED_caller_cx_GLOBAL
- eval_pv() NEED_eval_pv NEED_eval_pv_GLOBAL
- grok_bin() NEED_grok_bin NEED_grok_bin_GLOBAL
- grok_hex() NEED_grok_hex NEED_grok_hex_GLOBAL
- grok_number() NEED_grok_number NEED_grok_number_GLOBAL
- grok_numeric_radix() NEED_grok_numeric_radix NEED_grok_numeric_radix_GLOBAL
- grok_oct() NEED_grok_oct NEED_grok_oct_GLOBAL
- load_module() NEED_load_module NEED_load_module_GLOBAL
- mg_findext() NEED_mg_findext NEED_mg_findext_GLOBAL
- my_snprintf() NEED_my_snprintf NEED_my_snprintf_GLOBAL
- my_sprintf() NEED_my_sprintf NEED_my_sprintf_GLOBAL
- my_strlcat() NEED_my_strlcat NEED_my_strlcat_GLOBAL
- my_strlcpy() NEED_my_strlcpy NEED_my_strlcpy_GLOBAL
- newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL
- newRV_noinc() NEED_newRV_noinc NEED_newRV_noinc_GLOBAL
- newSV_type() NEED_newSV_type NEED_newSV_type_GLOBAL
- newSVpvn_flags() NEED_newSVpvn_flags NEED_newSVpvn_flags_GLOBAL
- newSVpvn_share() NEED_newSVpvn_share NEED_newSVpvn_share_GLOBAL
- pv_display() NEED_pv_display NEED_pv_display_GLOBAL
- pv_escape() NEED_pv_escape NEED_pv_escape_GLOBAL
- pv_pretty() NEED_pv_pretty NEED_pv_pretty_GLOBAL
- sv_2pv_flags() NEED_sv_2pv_flags NEED_sv_2pv_flags_GLOBAL
- sv_2pvbyte() NEED_sv_2pvbyte NEED_sv_2pvbyte_GLOBAL
- sv_catpvf_mg() NEED_sv_catpvf_mg NEED_sv_catpvf_mg_GLOBAL
- sv_catpvf_mg_nocontext() NEED_sv_catpvf_mg_nocontext NEED_sv_catpvf_mg_nocontext_GLOBAL
- sv_pvn_force_flags() NEED_sv_pvn_force_flags NEED_sv_pvn_force_flags_GLOBAL
- sv_setpvf_mg() NEED_sv_setpvf_mg NEED_sv_setpvf_mg_GLOBAL
- sv_setpvf_mg_nocontext() NEED_sv_setpvf_mg_nocontext NEED_sv_setpvf_mg_nocontext_GLOBAL
- sv_unmagicext() NEED_sv_unmagicext NEED_sv_unmagicext_GLOBAL
- vload_module() NEED_vload_module NEED_vload_module_GLOBAL
- vnewSVpvf() NEED_vnewSVpvf NEED_vnewSVpvf_GLOBAL
- warner() NEED_warner NEED_warner_GLOBAL
-
-To avoid namespace conflicts, you can change the namespace of the
-explicitly exported functions / variables using the C<DPPP_NAMESPACE>
-macro. Just C<#define> the macro before including C<ppport.h>:
-
- #define DPPP_NAMESPACE MyOwnNamespace_
- #include "ppport.h"
-
-The default namespace is C<DPPP_>.
-
-=back
-
-The good thing is that most of the above can be checked by running
-F<ppport.h> on your source code. See the next section for
-details.
-
-=head1 EXAMPLES
-
-To verify whether F<ppport.h> is needed for your module, whether you
-should make any changes to your code, and whether any special defines
-should be used, F<ppport.h> can be run as a Perl script to check your
-source code. Simply say:
-
- perl ppport.h
-
-The result will usually be a list of patches suggesting changes
-that should at least be acceptable, if not necessarily the most
-efficient solution, or a fix for all possible problems.
-
-If you know that your XS module uses features only available in
-newer Perl releases, if you're aware that it uses C++ comments,
-and if you want all suggestions as a single patch file, you could
-use something like this:
-
- perl ppport.h --compat-version=5.6.0 --cplusplus --patch=test.diff
-
-If you only want your code to be scanned without any suggestions
-for changes, use:
-
- perl ppport.h --nochanges
-
-You can specify a different C<diff> program or options, using
-the C<--diff> option:
-
- perl ppport.h --diff='diff -C 10'
-
-This would output context diffs with 10 lines of context.
-
-If you want to create patched copies of your files instead, use:
-
- perl ppport.h --copy=.new
-
-To display portability information for the C<newSVpvn> function,
-use:
-
- perl ppport.h --api-info=newSVpvn
-
-Since the argument to C<--api-info> can be a regular expression,
-you can use
-
- perl ppport.h --api-info=/_nomg$/
-
-to display portability information for all C<_nomg> functions or
-
- perl ppport.h --api-info=/./
-
-to display information for all known API elements.
-
-=head1 BUGS
-
-If this version of F<ppport.h> is causing failure during
-the compilation of this module, please check if newer versions
-of either this module or C<Devel::PPPort> are available on CPAN
-before sending a bug report.
-
-If F<ppport.h> was generated using the latest version of
-C<Devel::PPPort> and is causing failure of this module, please
-file a bug report here: L<https://github.com/mhx/Devel-PPPort/issues/>
-
-Please include the following information:
-
-=over 4
-
-=item 1.
-
-The complete output from running "perl -V"
-
-=item 2.
-
-This file.
-
-=item 3.
-
-The name and version of the module you were trying to build.
-
-=item 4.
-
-A full log of the build that failed.
-
-=item 5.
-
-Any other information that you think could be relevant.
-
-=back
-
-For the latest version of this code, please get the C<Devel::PPPort>
-module from CPAN.
-
-=head1 COPYRIGHT
-
-Version 3.x, Copyright (c) 2004-2013, Marcus Holland-Moritz.
-
-Version 2.x, Copyright (C) 2001, Paul Marquess.
-
-Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
-
-This program is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself.
-
-=head1 SEE ALSO
-
-See L<Devel::PPPort>.
-
-=cut
-
-use strict;
-
-# Disable broken TRIE-optimization
-BEGIN { eval '${^RE_TRIE_MAXBUF} = -1' if $] >= 5.009004 && $] <= 5.009005 }
-
-my $VERSION = 3.32;
-
-my %opt = (
- quiet => 0,
- diag => 1,
- hints => 1,
- changes => 1,
- cplusplus => 0,
- filter => 1,
- strip => 0,
- version => 0,
-);
-
-my($ppport) = $0 =~ /([\w.]+)$/;
-my $LF = '(?:\r\n|[\r\n])'; # line feed
-my $HS = "[ \t]"; # horizontal whitespace
-
-# Never use C comments in this file!
-my $ccs = '/'.'*';
-my $cce = '*'.'/';
-my $rccs = quotemeta $ccs;
-my $rcce = quotemeta $cce;
-
-eval {
- require Getopt::Long;
- Getopt::Long::GetOptions(\%opt, qw(
- help quiet diag! filter! hints! changes! cplusplus strip version
- patch=s copy=s diff=s compat-version=s
- list-provided list-unsupported api-info=s
- )) or usage();
-};
-
-if ($@ and grep /^-/, @ARGV) {
- usage() if "@ARGV" =~ /^--?h(?:elp)?$/;
- die "Getopt::Long not found. Please don't use any options.\n";
-}
-
-if ($opt{version}) {
- print "This is $0 $VERSION.\n";
- exit 0;
-}
-
-usage() if $opt{help};
-strip() if $opt{strip};
-
-if (exists $opt{'compat-version'}) {
- my($r,$v,$s) = eval { parse_version($opt{'compat-version'}) };
- if ($@) {
- die "Invalid version number format: '$opt{'compat-version'}'\n";
- }
- die "Only Perl 5 is supported\n" if $r != 5;
- die "Invalid version number: $opt{'compat-version'}\n" if $v >= 1000 || $s >= 1000;
- $opt{'compat-version'} = sprintf "%d.%03d%03d", $r, $v, $s;
-}
-else {
- $opt{'compat-version'} = 5;
-}
-
-my %API = map { /^(\w+)\|([^|]*)\|([^|]*)\|(\w*)$/
- ? ( $1 => {
- ($2 ? ( base => $2 ) : ()),
- ($3 ? ( todo => $3 ) : ()),
- (index($4, 'v') >= 0 ? ( varargs => 1 ) : ()),
- (index($4, 'p') >= 0 ? ( provided => 1 ) : ()),
- (index($4, 'n') >= 0 ? ( nothxarg => 1 ) : ()),
- } )
- : die "invalid spec: $_" } qw(
-ASCII_TO_NEED||5.007001|n
-AvFILLp|5.004050||p
-AvFILL|||
-BhkDISABLE||5.021008|
-BhkENABLE||5.021008|
-BhkENTRY_set||5.021008|
-BhkENTRY|||
-BhkFLAGS|||
-CALL_BLOCK_HOOKS|||
-CLASS|||n
-CPERLscope|5.005000||p
-CX_CURPAD_SAVE|||
-CX_CURPAD_SV|||
-CopFILEAV|5.006000||p
-CopFILEGV_set|5.006000||p
-CopFILEGV|5.006000||p
-CopFILESV|5.006000||p
-CopFILE_set|5.006000||p
-CopFILE|5.006000||p
-CopSTASHPV_set|5.006000||p
-CopSTASHPV|5.006000||p
-CopSTASH_eq|5.006000||p
-CopSTASH_set|5.006000||p
-CopSTASH|5.006000||p
-CopyD|5.009002|5.004050|p
-Copy|||
-CvPADLIST||5.008001|
-CvSTASH|||
-CvWEAKOUTSIDE|||
-DEFSV_set|5.010001||p
-DEFSV|5.004050||p
-END_EXTERN_C|5.005000||p
-ENTER|||
-ERRSV|5.004050||p
-EXTEND|||
-EXTERN_C|5.005000||p
-F0convert|||n
-FREETMPS|||
-GIMME_V||5.004000|n
-GIMME|||n
-GROK_NUMERIC_RADIX|5.007002||p
-G_ARRAY|||
-G_DISCARD|||
-G_EVAL|||
-G_METHOD|5.006001||p
-G_NOARGS|||
-G_SCALAR|||
-G_VOID||5.004000|
-GetVars|||
-GvAV|||
-GvCV|||
-GvHV|||
-GvSVn|5.009003||p
-GvSV|||
-Gv_AMupdate||5.011000|
-HEf_SVKEY|5.003070||p
-HeHASH||5.003070|
-HeKEY||5.003070|
-HeKLEN||5.003070|
-HePV||5.004000|
-HeSVKEY_force||5.003070|
-HeSVKEY_set||5.004000|
-HeSVKEY||5.003070|
-HeUTF8|5.010001|5.008000|p
-HeVAL||5.003070|
-HvENAMELEN||5.015004|
-HvENAMEUTF8||5.015004|
-HvENAME||5.013007|
-HvNAMELEN_get|5.009003||p
-HvNAMELEN||5.015004|
-HvNAMEUTF8||5.015004|
-HvNAME_get|5.009003||p
-HvNAME|||
-INT2PTR|5.006000||p
-IN_LOCALE_COMPILETIME|5.007002||p
-IN_LOCALE_RUNTIME|5.007002||p
-IN_LOCALE|5.007002||p
-IN_PERL_COMPILETIME|5.008001||p
-IS_NUMBER_GREATER_THAN_UV_MAX|5.007002||p
-IS_NUMBER_INFINITY|5.007002||p
-IS_NUMBER_IN_UV|5.007002||p
-IS_NUMBER_NAN|5.007003||p
-IS_NUMBER_NEG|5.007002||p
-IS_NUMBER_NOT_INT|5.007002||p
-IVSIZE|5.006000||p
-IVTYPE|5.006000||p
-IVdf|5.006000||p
-LEAVE|||
-LINKLIST||5.013006|
-LVRET|||
-MARK|||
-MULTICALL||5.021008|
-MUTABLE_PTR|5.010001||p
-MUTABLE_SV|5.010001||p
-MY_CXT_CLONE|5.009002||p
-MY_CXT_INIT|5.007003||p
-MY_CXT|5.007003||p
-MoveD|5.009002|5.004050|p
-Move|||
-NATIVE_TO_NEED||5.007001|n
-NOOP|5.005000||p
-NUM2PTR|5.006000||p
-NVTYPE|5.006000||p
-NVef|5.006001||p
-NVff|5.006001||p
-NVgf|5.006001||p
-Newxc|5.009003||p
-Newxz|5.009003||p
-Newx|5.009003||p
-Nullav|||
-Nullch|||
-Nullcv|||
-Nullhv|||
-Nullsv|||
-OP_CLASS||5.013007|
-OP_DESC||5.007003|
-OP_NAME||5.007003|
-OP_TYPE_IS_OR_WAS||5.019010|
-OP_TYPE_IS||5.019007|
-ORIGMARK|||
-OpHAS_SIBLING||5.021007|
-OpSIBLING_set||5.021007|
-OpSIBLING||5.021007|
-PAD_BASE_SV|||
-PAD_CLONE_VARS|||
-PAD_COMPNAME_FLAGS|||
-PAD_COMPNAME_GEN_set|||
-PAD_COMPNAME_GEN|||
-PAD_COMPNAME_OURSTASH|||
-PAD_COMPNAME_PV|||
-PAD_COMPNAME_TYPE|||
-PAD_RESTORE_LOCAL|||
-PAD_SAVE_LOCAL|||
-PAD_SAVE_SETNULLPAD|||
-PAD_SETSV|||
-PAD_SET_CUR_NOSAVE|||
-PAD_SET_CUR|||
-PAD_SVl|||
-PAD_SV|||
-PERLIO_FUNCS_CAST|5.009003||p
-PERLIO_FUNCS_DECL|5.009003||p
-PERL_ABS|5.008001||p
-PERL_BCDVERSION|5.021008||p
-PERL_GCC_BRACE_GROUPS_FORBIDDEN|5.008001||p
-PERL_HASH|5.003070||p
-PERL_INT_MAX|5.003070||p
-PERL_INT_MIN|5.003070||p
-PERL_LONG_MAX|5.003070||p
-PERL_LONG_MIN|5.003070||p
-PERL_MAGIC_arylen|5.007002||p
-PERL_MAGIC_backref|5.007002||p
-PERL_MAGIC_bm|5.007002||p
-PERL_MAGIC_collxfrm|5.007002||p
-PERL_MAGIC_dbfile|5.007002||p
-PERL_MAGIC_dbline|5.007002||p
-PERL_MAGIC_defelem|5.007002||p
-PERL_MAGIC_envelem|5.007002||p
-PERL_MAGIC_env|5.007002||p
-PERL_MAGIC_ext|5.007002||p
-PERL_MAGIC_fm|5.007002||p
-PERL_MAGIC_glob|5.021008||p
-PERL_MAGIC_isaelem|5.007002||p
-PERL_MAGIC_isa|5.007002||p
-PERL_MAGIC_mutex|5.021008||p
-PERL_MAGIC_nkeys|5.007002||p
-PERL_MAGIC_overload_elem|5.021008||p
-PERL_MAGIC_overload_table|5.007002||p
-PERL_MAGIC_overload|5.021008||p
-PERL_MAGIC_pos|5.007002||p
-PERL_MAGIC_qr|5.007002||p
-PERL_MAGIC_regdata|5.007002||p
-PERL_MAGIC_regdatum|5.007002||p
-PERL_MAGIC_regex_global|5.007002||p
-PERL_MAGIC_shared_scalar|5.007003||p
-PERL_MAGIC_shared|5.007003||p
-PERL_MAGIC_sigelem|5.007002||p
-PERL_MAGIC_sig|5.007002||p
-PERL_MAGIC_substr|5.007002||p
-PERL_MAGIC_sv|5.007002||p
-PERL_MAGIC_taint|5.007002||p
-PERL_MAGIC_tiedelem|5.007002||p
-PERL_MAGIC_tiedscalar|5.007002||p
-PERL_MAGIC_tied|5.007002||p
-PERL_MAGIC_utf8|5.008001||p
-PERL_MAGIC_uvar_elem|5.007003||p
-PERL_MAGIC_uvar|5.007002||p
-PERL_MAGIC_vec|5.007002||p
-PERL_MAGIC_vstring|5.008001||p
-PERL_PV_ESCAPE_ALL|5.009004||p
-PERL_PV_ESCAPE_FIRSTCHAR|5.009004||p
-PERL_PV_ESCAPE_NOBACKSLASH|5.009004||p
-PERL_PV_ESCAPE_NOCLEAR|5.009004||p
-PERL_PV_ESCAPE_QUOTE|5.009004||p
-PERL_PV_ESCAPE_RE|5.009005||p
-PERL_PV_ESCAPE_UNI_DETECT|5.009004||p
-PERL_PV_ESCAPE_UNI|5.009004||p
-PERL_PV_PRETTY_DUMP|5.009004||p
-PERL_PV_PRETTY_ELLIPSES|5.010000||p
-PERL_PV_PRETTY_LTGT|5.009004||p
-PERL_PV_PRETTY_NOCLEAR|5.010000||p
-PERL_PV_PRETTY_QUOTE|5.009004||p
-PERL_PV_PRETTY_REGPROP|5.009004||p
-PERL_QUAD_MAX|5.003070||p
-PERL_QUAD_MIN|5.003070||p
-PERL_REVISION|5.006000||p
-PERL_SCAN_ALLOW_UNDERSCORES|5.007003||p
-PERL_SCAN_DISALLOW_PREFIX|5.007003||p
-PERL_SCAN_GREATER_THAN_UV_MAX|5.007003||p
-PERL_SCAN_SILENT_ILLDIGIT|5.008001||p
-PERL_SHORT_MAX|5.003070||p
-PERL_SHORT_MIN|5.003070||p
-PERL_SIGNALS_UNSAFE_FLAG|5.008001||p
-PERL_SUBVERSION|5.006000||p
-PERL_SYS_INIT3||5.006000|
-PERL_SYS_INIT|||
-PERL_SYS_TERM||5.021008|
-PERL_UCHAR_MAX|5.003070||p
-PERL_UCHAR_MIN|5.003070||p
-PERL_UINT_MAX|5.003070||p
-PERL_UINT_MIN|5.003070||p
-PERL_ULONG_MAX|5.003070||p
-PERL_ULONG_MIN|5.003070||p
-PERL_UNUSED_ARG|5.009003||p
-PERL_UNUSED_CONTEXT|5.009004||p
-PERL_UNUSED_DECL|5.007002||p
-PERL_UNUSED_VAR|5.007002||p
-PERL_UQUAD_MAX|5.003070||p
-PERL_UQUAD_MIN|5.003070||p
-PERL_USE_GCC_BRACE_GROUPS|5.009004||p
-PERL_USHORT_MAX|5.003070||p
-PERL_USHORT_MIN|5.003070||p
-PERL_VERSION|5.006000||p
-PL_DBsignal|5.005000||p
-PL_DBsingle|||pn
-PL_DBsub|||pn
-PL_DBtrace|||pn
-PL_Sv|5.005000||p
-PL_bufend|5.021008||p
-PL_bufptr|5.021008||p
-PL_check||5.006000|
-PL_compiling|5.004050||p
-PL_comppad_name||5.017004|
-PL_comppad||5.008001|
-PL_copline|5.021008||p
-PL_curcop|5.004050||p
-PL_curpad||5.005000|
-PL_curstash|5.004050||p
-PL_debstash|5.004050||p
-PL_defgv|5.004050||p
-PL_diehook|5.004050||p
-PL_dirty|5.004050||p
-PL_dowarn|||pn
-PL_errgv|5.004050||p
-PL_error_count|5.021008||p
-PL_expect|5.021008||p
-PL_hexdigit|5.005000||p
-PL_hints|5.005000||p
-PL_in_my_stash|5.021008||p
-PL_in_my|5.021008||p
-PL_keyword_plugin||5.011002|
-PL_last_in_gv|||n
-PL_laststatval|5.005000||p
-PL_lex_state|5.021008||p
-PL_lex_stuff|5.021008||p
-PL_linestr|5.021008||p
-PL_modglobal||5.005000|n
-PL_na|5.004050||pn
-PL_no_modify|5.006000||p
-PL_ofsgv|||n
-PL_opfreehook||5.011000|n
-PL_parser|5.009005||p
-PL_peepp||5.007003|n
-PL_perl_destruct_level|5.004050||p
-PL_perldb|5.004050||p
-PL_ppaddr|5.006000||p
-PL_rpeepp||5.013005|n
-PL_rsfp_filters|5.021008||p
-PL_rsfp|5.021008||p
-PL_rs|||n
-PL_signals|5.008001||p
-PL_stack_base|5.004050||p
-PL_stack_sp|5.004050||p
-PL_statcache|5.005000||p
-PL_stdingv|5.004050||p
-PL_sv_arenaroot|5.004050||p
-PL_sv_no|5.004050||pn
-PL_sv_undef|5.004050||pn
-PL_sv_yes|5.004050||pn
-PL_tainted|5.004050||p
-PL_tainting|5.004050||p
-PL_tokenbuf|5.021008||p
-POP_MULTICALL||5.021008|
-POPi|||n
-POPl|||n
-POPn|||n
-POPpbytex||5.007001|n
-POPpx||5.005030|n
-POPp|||n
-POPs|||n
-PTR2IV|5.006000||p
-PTR2NV|5.006000||p
-PTR2UV|5.006000||p
-PTR2nat|5.009003||p
-PTR2ul|5.007001||p
-PTRV|5.006000||p
-PUSHMARK|||
-PUSH_MULTICALL||5.021008|
-PUSHi|||
-PUSHmortal|5.009002||p
-PUSHn|||
-PUSHp|||
-PUSHs|||
-PUSHu|5.004000||p
-PUTBACK|||
-PadARRAY||5.021008|
-PadMAX||5.021008|
-PadlistARRAY||5.021008|
-PadlistMAX||5.021008|
-PadlistNAMESARRAY||5.021008|
-PadlistNAMESMAX||5.021008|
-PadlistNAMES||5.021008|
-PadlistREFCNT||5.017004|
-PadnameIsOUR|||
-PadnameIsSTATE|||
-PadnameLEN||5.021008|
-PadnameOURSTASH|||
-PadnameOUTER|||
-PadnamePV||5.021008|
-PadnameREFCNT_dec||5.021008|
-PadnameREFCNT||5.021008|
-PadnameSV||5.021008|
-PadnameTYPE|||
-PadnameUTF8||5.021007|
-PadnamelistARRAY||5.021008|
-PadnamelistMAX||5.021008|
-PadnamelistREFCNT_dec||5.021008|
-PadnamelistREFCNT||5.021008|
-PerlIO_clearerr||5.007003|
-PerlIO_close||5.007003|
-PerlIO_context_layers||5.009004|
-PerlIO_eof||5.007003|
-PerlIO_error||5.007003|
-PerlIO_fileno||5.007003|
-PerlIO_fill||5.007003|
-PerlIO_flush||5.007003|
-PerlIO_get_base||5.007003|
-PerlIO_get_bufsiz||5.007003|
-PerlIO_get_cnt||5.007003|
-PerlIO_get_ptr||5.007003|
-PerlIO_read||5.007003|
-PerlIO_restore_errno|||
-PerlIO_save_errno|||
-PerlIO_seek||5.007003|
-PerlIO_set_cnt||5.007003|
-PerlIO_set_ptrcnt||5.007003|
-PerlIO_setlinebuf||5.007003|
-PerlIO_stderr||5.007003|
-PerlIO_stdin||5.007003|
-PerlIO_stdout||5.007003|
-PerlIO_tell||5.007003|
-PerlIO_unread||5.007003|
-PerlIO_write||5.007003|
-Perl_signbit||5.009005|n
-PoisonFree|5.009004||p
-PoisonNew|5.009004||p
-PoisonWith|5.009004||p
-Poison|5.008000||p
-READ_XDIGIT||5.017006|
-RETVAL|||n
-Renewc|||
-Renew|||
-SAVECLEARSV|||
-SAVECOMPPAD|||
-SAVEPADSV|||
-SAVETMPS|||
-SAVE_DEFSV|5.004050||p
-SPAGAIN|||
-SP|||
-START_EXTERN_C|5.005000||p
-START_MY_CXT|5.007003||p
-STMT_END|||p
-STMT_START|||p
-STR_WITH_LEN|5.009003||p
-ST|||
-SV_CONST_RETURN|5.009003||p
-SV_COW_DROP_PV|5.008001||p
-SV_COW_SHARED_HASH_KEYS|5.009005||p
-SV_GMAGIC|5.007002||p
-SV_HAS_TRAILING_NUL|5.009004||p
-SV_IMMEDIATE_UNREF|5.007001||p
-SV_MUTABLE_RETURN|5.009003||p
-SV_NOSTEAL|5.009002||p
-SV_SMAGIC|5.009003||p
-SV_UTF8_NO_ENCODING|5.008001||p
-SVfARG|5.009005||p
-SVf_UTF8|5.006000||p
-SVf|5.006000||p
-SVt_INVLIST||5.019002|
-SVt_IV|||
-SVt_NULL|||
-SVt_NV|||
-SVt_PVAV|||
-SVt_PVCV|||
-SVt_PVFM|||
-SVt_PVGV|||
-SVt_PVHV|||
-SVt_PVIO|||
-SVt_PVIV|||
-SVt_PVLV|||
-SVt_PVMG|||
-SVt_PVNV|||
-SVt_PV|||
-SVt_REGEXP||5.011000|
-Safefree|||
-Slab_Alloc|||
-Slab_Free|||
-Slab_to_ro|||
-Slab_to_rw|||
-StructCopy|||
-SvCUR_set|||
-SvCUR|||
-SvEND|||
-SvGAMAGIC||5.006001|
-SvGETMAGIC|5.004050||p
-SvGROW|||
-SvIOK_UV||5.006000|
-SvIOK_notUV||5.006000|
-SvIOK_off|||
-SvIOK_only_UV||5.006000|
-SvIOK_only|||
-SvIOK_on|||
-SvIOKp|||
-SvIOK|||
-SvIVX|||
-SvIV_nomg|5.009001||p
-SvIV_set|||
-SvIVx|||
-SvIV|||
-SvIsCOW_shared_hash||5.008003|
-SvIsCOW||5.008003|
-SvLEN_set|||
-SvLEN|||
-SvLOCK||5.007003|
-SvMAGIC_set|5.009003||p
-SvNIOK_off|||
-SvNIOKp|||
-SvNIOK|||
-SvNOK_off|||
-SvNOK_only|||
-SvNOK_on|||
-SvNOKp|||
-SvNOK|||
-SvNVX|||
-SvNV_nomg||5.013002|
-SvNV_set|||
-SvNVx|||
-SvNV|||
-SvOK|||
-SvOOK_offset||5.011000|
-SvOOK|||
-SvPOK_off|||
-SvPOK_only_UTF8||5.006000|
-SvPOK_only|||
-SvPOK_on|||
-SvPOKp|||
-SvPOK|||
-SvPVX_const|5.009003||p
-SvPVX_mutable|5.009003||p
-SvPVX|||
-SvPV_const|5.009003||p
-SvPV_flags_const_nolen|5.009003||p
-SvPV_flags_const|5.009003||p
-SvPV_flags_mutable|5.009003||p
-SvPV_flags|5.007002||p
-SvPV_force_flags_mutable|5.009003||p
-SvPV_force_flags_nolen|5.009003||p
-SvPV_force_flags|5.007002||p
-SvPV_force_mutable|5.009003||p
-SvPV_force_nolen|5.009003||p
-SvPV_force_nomg_nolen|5.009003||p
-SvPV_force_nomg|5.007002||p
-SvPV_force|||p
-SvPV_mutable|5.009003||p
-SvPV_nolen_const|5.009003||p
-SvPV_nolen|5.006000||p
-SvPV_nomg_const_nolen|5.009003||p
-SvPV_nomg_const|5.009003||p
-SvPV_nomg_nolen|5.013007||p
-SvPV_nomg|5.007002||p
-SvPV_renew|5.009003||p
-SvPV_set|||
-SvPVbyte_force||5.009002|
-SvPVbyte_nolen||5.006000|
-SvPVbytex_force||5.006000|
-SvPVbytex||5.006000|
-SvPVbyte|5.006000||p
-SvPVutf8_force||5.006000|
-SvPVutf8_nolen||5.006000|
-SvPVutf8x_force||5.006000|
-SvPVutf8x||5.006000|
-SvPVutf8||5.006000|
-SvPVx|||
-SvPV|||
-SvREFCNT_dec_NN||5.017007|
-SvREFCNT_dec|||
-SvREFCNT_inc_NN|5.009004||p
-SvREFCNT_inc_simple_NN|5.009004||p
-SvREFCNT_inc_simple_void_NN|5.009004||p
-SvREFCNT_inc_simple_void|5.009004||p
-SvREFCNT_inc_simple|5.009004||p
-SvREFCNT_inc_void_NN|5.009004||p
-SvREFCNT_inc_void|5.009004||p
-SvREFCNT_inc|||p
-SvREFCNT|||
-SvROK_off|||
-SvROK_on|||
-SvROK|||
-SvRV_set|5.009003||p
-SvRV|||
-SvRXOK||5.009005|
-SvRX||5.009005|
-SvSETMAGIC|||
-SvSHARED_HASH|5.009003||p
-SvSHARE||5.007003|
-SvSTASH_set|5.009003||p
-SvSTASH|||
-SvSetMagicSV_nosteal||5.004000|
-SvSetMagicSV||5.004000|
-SvSetSV_nosteal||5.004000|
-SvSetSV|||
-SvTAINTED_off||5.004000|
-SvTAINTED_on||5.004000|
-SvTAINTED||5.004000|
-SvTAINT|||
-SvTHINKFIRST|||
-SvTRUE_nomg||5.013006|
-SvTRUE|||
-SvTYPE|||
-SvUNLOCK||5.007003|
-SvUOK|5.007001|5.006000|p
-SvUPGRADE|||
-SvUTF8_off||5.006000|
-SvUTF8_on||5.006000|
-SvUTF8||5.006000|
-SvUVXx|5.004000||p
-SvUVX|5.004000||p
-SvUV_nomg|5.009001||p
-SvUV_set|5.009003||p
-SvUVx|5.004000||p
-SvUV|5.004000||p
-SvVOK||5.008001|
-SvVSTRING_mg|5.009004||p
-THIS|||n
-UNDERBAR|5.009002||p
-UTF8_MAXBYTES|5.009002||p
-UVSIZE|5.006000||p
-UVTYPE|5.006000||p
-UVXf|5.007001||p
-UVof|5.006000||p
-UVuf|5.006000||p
-UVxf|5.006000||p
-WARN_ALL|5.006000||p
-WARN_AMBIGUOUS|5.006000||p
-WARN_ASSERTIONS|5.021008||p
-WARN_BAREWORD|5.006000||p
-WARN_CLOSED|5.006000||p
-WARN_CLOSURE|5.006000||p
-WARN_DEBUGGING|5.006000||p
-WARN_DEPRECATED|5.006000||p
-WARN_DIGIT|5.006000||p
-WARN_EXEC|5.006000||p
-WARN_EXITING|5.006000||p
-WARN_GLOB|5.006000||p
-WARN_INPLACE|5.006000||p
-WARN_INTERNAL|5.006000||p
-WARN_IO|5.006000||p
-WARN_LAYER|5.008000||p
-WARN_MALLOC|5.006000||p
-WARN_MISC|5.006000||p
-WARN_NEWLINE|5.006000||p
-WARN_NUMERIC|5.006000||p
-WARN_ONCE|5.006000||p
-WARN_OVERFLOW|5.006000||p
-WARN_PACK|5.006000||p
-WARN_PARENTHESIS|5.006000||p
-WARN_PIPE|5.006000||p
-WARN_PORTABLE|5.006000||p
-WARN_PRECEDENCE|5.006000||p
-WARN_PRINTF|5.006000||p
-WARN_PROTOTYPE|5.006000||p
-WARN_QW|5.006000||p
-WARN_RECURSION|5.006000||p
-WARN_REDEFINE|5.006000||p
-WARN_REGEXP|5.006000||p
-WARN_RESERVED|5.006000||p
-WARN_SEMICOLON|5.006000||p
-WARN_SEVERE|5.006000||p
-WARN_SIGNAL|5.006000||p
-WARN_SUBSTR|5.006000||p
-WARN_SYNTAX|5.006000||p
-WARN_TAINT|5.006000||p
-WARN_THREADS|5.008000||p
-WARN_UNINITIALIZED|5.006000||p
-WARN_UNOPENED|5.006000||p
-WARN_UNPACK|5.006000||p
-WARN_UNTIE|5.006000||p
-WARN_UTF8|5.006000||p
-WARN_VOID|5.006000||p
-WIDEST_UTYPE|5.015004||p
-XCPT_CATCH|5.009002||p
-XCPT_RETHROW|5.009002||p
-XCPT_TRY_END|5.009002||p
-XCPT_TRY_START|5.009002||p
-XPUSHi|||
-XPUSHmortal|5.009002||p
-XPUSHn|||
-XPUSHp|||
-XPUSHs|||
-XPUSHu|5.004000||p
-XSPROTO|5.010000||p
-XSRETURN_EMPTY|||
-XSRETURN_IV|||
-XSRETURN_NO|||
-XSRETURN_NV|||
-XSRETURN_PV|||
-XSRETURN_UNDEF|||
-XSRETURN_UV|5.008001||p
-XSRETURN_YES|||
-XSRETURN|||p
-XST_mIV|||
-XST_mNO|||
-XST_mNV|||
-XST_mPV|||
-XST_mUNDEF|||
-XST_mUV|5.008001||p
-XST_mYES|||
-XS_APIVERSION_BOOTCHECK||5.021008|
-XS_EXTERNAL||5.021008|
-XS_INTERNAL||5.021008|
-XS_VERSION_BOOTCHECK||5.021008|
-XS_VERSION|||
-XSprePUSH|5.006000||p
-XS|||
-XopDISABLE||5.021008|
-XopENABLE||5.021008|
-XopENTRYCUSTOM||5.021008|
-XopENTRY_set||5.021008|
-XopENTRY||5.021008|
-XopFLAGS||5.013007|
-ZeroD|5.009002||p
-Zero|||
-_aMY_CXT|5.007003||p
-_add_range_to_invlist|||
-_append_range_to_invlist|||
-_core_swash_init|||
-_get_encoding|||
-_get_regclass_nonbitmap_data|||
-_get_swash_invlist|||
-_invlist_array_init|||n
-_invlist_contains_cp|||n
-_invlist_contents|||
-_invlist_dump|||
-_invlist_intersection_maybe_complement_2nd|||
-_invlist_intersection|||
-_invlist_invert|||
-_invlist_len|||n
-_invlist_populate_swatch|||n
-_invlist_search|||n
-_invlist_subtract|||
-_invlist_union_maybe_complement_2nd|||
-_invlist_union|||
-_is_cur_LC_category_utf8|||
-_is_in_locale_category||5.021001|
-_is_uni_FOO||5.017008|
-_is_uni_perl_idcont||5.017008|
-_is_uni_perl_idstart||5.017007|
-_is_utf8_FOO||5.017008|
-_is_utf8_char_slow||5.021001|n
-_is_utf8_idcont||5.021001|
-_is_utf8_idstart||5.021001|
-_is_utf8_mark||5.017008|
-_is_utf8_perl_idcont||5.017008|
-_is_utf8_perl_idstart||5.017007|
-_is_utf8_xidcont||5.021001|
-_is_utf8_xidstart||5.021001|
-_load_PL_utf8_foldclosures|||
-_make_exactf_invlist|||
-_new_invlist_C_array|||
-_new_invlist|||
-_pMY_CXT|5.007003||p
-_setup_canned_invlist|||
-_swash_inversion_hash|||
-_swash_to_invlist|||
-_to_fold_latin1|||
-_to_uni_fold_flags||5.014000|
-_to_upper_title_latin1|||
-_to_utf8_fold_flags||5.019009|
-_to_utf8_lower_flags||5.019009|
-_to_utf8_title_flags||5.019009|
-_to_utf8_upper_flags||5.019009|
-_warn_problematic_locale|||n
-aMY_CXT_|5.007003||p
-aMY_CXT|5.007003||p
-aTHXR_|5.021008||p
-aTHXR|5.021008||p
-aTHX_|5.006000||p
-aTHX|5.006000||p
-aassign_common_vars|||
-add_above_Latin1_folds|||
-add_cp_to_invlist|||
-add_data|||n
-add_multi_match|||
-add_utf16_textfilter|||
-adjust_size_and_find_bucket|||n
-advance_one_SB|||
-advance_one_WB|||
-alloc_maybe_populate_EXACT|||
-alloccopstash|||
-allocmy|||
-amagic_call|||
-amagic_cmp_locale|||
-amagic_cmp|||
-amagic_deref_call||5.013007|
-amagic_i_ncmp|||
-amagic_is_enabled|||
-amagic_ncmp|||
-anonymise_cv_maybe|||
-any_dup|||
-ao|||
-append_utf8_from_native_byte||5.019004|n
-apply_attrs_my|||
-apply_attrs_string||5.006001|
-apply_attrs|||
-apply|||
-assert_uft8_cache_coherent|||
-assignment_type|||
-atfork_lock||5.007003|n
-atfork_unlock||5.007003|n
-av_arylen_p||5.009003|
-av_clear|||
-av_create_and_push||5.009005|
-av_create_and_unshift_one||5.009005|
-av_delete||5.006000|
-av_exists||5.006000|
-av_extend_guts|||
-av_extend|||
-av_fetch|||
-av_fill|||
-av_iter_p||5.011000|
-av_len|||
-av_make|||
-av_pop|||
-av_push|||
-av_reify|||
-av_shift|||
-av_store|||
-av_tindex||5.017009|
-av_top_index||5.017009|
-av_undef|||
-av_unshift|||
-ax|||n
-backup_one_SB|||
-backup_one_WB|||
-bad_type_gv|||
-bad_type_pv|||
-bind_match|||
-block_end||5.004000|
-block_gimme||5.004000|
-block_start||5.004000|
-blockhook_register||5.013003|
-boolSV|5.004000||p
-boot_core_PerlIO|||
-boot_core_UNIVERSAL|||
-boot_core_mro|||
-bytes_cmp_utf8||5.013007|
-bytes_from_utf8||5.007001|
-bytes_to_utf8||5.006001|
-call_argv|5.006000||p
-call_atexit||5.006000|
-call_list||5.004000|
-call_method|5.006000||p
-call_pv|5.006000||p
-call_sv|5.006000||p
-caller_cx|5.013005|5.006000|p
-calloc||5.007002|n
-cando|||
-cast_i32||5.006000|n
-cast_iv||5.006000|n
-cast_ulong||5.006000|n
-cast_uv||5.006000|n
-check_locale_boundary_crossing|||
-check_type_and_open|||
-check_uni|||
-check_utf8_print|||
-checkcomma|||
-ckWARN|5.006000||p
-ck_entersub_args_core|||
-ck_entersub_args_list||5.013006|
-ck_entersub_args_proto_or_list||5.013006|
-ck_entersub_args_proto||5.013006|
-ck_warner_d||5.011001|v
-ck_warner||5.011001|v
-ckwarn_common|||
-ckwarn_d||5.009003|
-ckwarn||5.009003|
-clear_placeholders|||
-clear_special_blocks|||
-clone_params_del|||n
-clone_params_new|||n
-closest_cop|||
-cntrl_to_mnemonic|||n
-compute_EXACTish|||n
-construct_ahocorasick_from_trie|||
-cop_fetch_label||5.015001|
-cop_free|||
-cop_hints_2hv||5.013007|
-cop_hints_fetch_pvn||5.013007|
-cop_hints_fetch_pvs||5.013007|
-cop_hints_fetch_pv||5.013007|
-cop_hints_fetch_sv||5.013007|
-cop_store_label||5.015001|
-cophh_2hv||5.013007|
-cophh_copy||5.013007|
-cophh_delete_pvn||5.013007|
-cophh_delete_pvs||5.013007|
-cophh_delete_pv||5.013007|
-cophh_delete_sv||5.013007|
-cophh_fetch_pvn||5.013007|
-cophh_fetch_pvs||5.013007|
-cophh_fetch_pv||5.013007|
-cophh_fetch_sv||5.013007|
-cophh_free||5.013007|
-cophh_new_empty||5.021008|
-cophh_store_pvn||5.013007|
-cophh_store_pvs||5.013007|
-cophh_store_pv||5.013007|
-cophh_store_sv||5.013007|
-core_prototype|||
-coresub_op|||
-could_it_be_a_POSIX_class|||n
-cr_textfilter|||
-create_eval_scope|||
-croak_memory_wrap||5.019003|n
-croak_no_mem|||n
-croak_no_modify||5.013003|n
-croak_nocontext|||vn
-croak_popstack|||n
-croak_sv||5.013001|
-croak_xs_usage||5.010001|n
-croak|||v
-csighandler||5.009003|n
-current_re_engine|||
-curse|||
-custom_op_desc||5.007003|
-custom_op_get_field|||
-custom_op_name||5.007003|
-custom_op_register||5.013007|
-custom_op_xop||5.013007|
-cv_ckproto_len_flags|||
-cv_clone_into|||
-cv_clone|||
-cv_const_sv_or_av|||n
-cv_const_sv||5.003070|n
-cv_dump|||
-cv_forget_slab|||
-cv_get_call_checker||5.013006|
-cv_name||5.021005|
-cv_set_call_checker_flags||5.021004|
-cv_set_call_checker||5.013006|
-cv_undef_flags|||
-cv_undef|||
-cvgv_from_hek|||
-cvgv_set|||
-cvstash_set|||
-cx_dump||5.005000|
-cx_dup|||
-cxinc|||
-dAXMARK|5.009003||p
-dAX|5.007002||p
-dITEMS|5.007002||p
-dMARK|||
-dMULTICALL||5.009003|
-dMY_CXT_SV|5.007003||p
-dMY_CXT|5.007003||p
-dNOOP|5.006000||p
-dORIGMARK|||
-dSP|||
-dTHR|5.004050||p
-dTHXR|5.021008||p
-dTHXa|5.006000||p
-dTHXoa|5.006000||p
-dTHX|5.006000||p
-dUNDERBAR|5.009002||p
-dVAR|5.009003||p
-dXCPT|5.009002||p
-dXSARGS|||
-dXSI32|||
-dXSTARG|5.006000||p
-deb_curcv|||
-deb_nocontext|||vn
-deb_stack_all|||
-deb_stack_n|||
-debop||5.005000|
-debprofdump||5.005000|
-debprof|||
-debstackptrs||5.007003|
-debstack||5.007003|
-debug_start_match|||
-deb||5.007003|v
-defelem_target|||
-del_sv|||
-delete_eval_scope|||
-delimcpy||5.004000|n
-deprecate_commaless_var_list|||
-despatch_signals||5.007001|
-destroy_matcher|||
-die_nocontext|||vn
-die_sv||5.013001|
-die_unwind|||
-die|||v
-dirp_dup|||
-div128|||
-djSP|||
-do_aexec5|||
-do_aexec|||
-do_aspawn|||
-do_binmode||5.004050|
-do_chomp|||
-do_close|||
-do_delete_local|||
-do_dump_pad|||
-do_eof|||
-do_exec3|||
-do_execfree|||
-do_exec|||
-do_gv_dump||5.006000|
-do_gvgv_dump||5.006000|
-do_hv_dump||5.006000|
-do_ipcctl|||
-do_ipcget|||
-do_join|||
-do_magic_dump||5.006000|
-do_msgrcv|||
-do_msgsnd|||
-do_ncmp|||
-do_oddball|||
-do_op_dump||5.006000|
-do_open6|||
-do_open9||5.006000|
-do_open_raw|||
-do_openn||5.007001|
-do_open||5.003070|
-do_pmop_dump||5.006000|
-do_print|||
-do_readline|||
-do_seek|||
-do_semop|||
-do_shmio|||
-do_smartmatch|||
-do_spawn_nowait|||
-do_spawn|||
-do_sprintf|||
-do_sv_dump||5.006000|
-do_sysseek|||
-do_tell|||
-do_trans_complex_utf8|||
-do_trans_complex|||
-do_trans_count_utf8|||
-do_trans_count|||
-do_trans_simple_utf8|||
-do_trans_simple|||
-do_trans|||
-do_vecget|||
-do_vecset|||
-do_vop|||
-docatch|||
-doeval|||
-dofile|||
-dofindlabel|||
-doform|||
-doing_taint||5.008001|n
-dooneliner|||
-doopen_pm|||
-doparseform|||
-dopoptoeval|||
-dopoptogiven|||
-dopoptolabel|||
-dopoptoloop|||
-dopoptosub_at|||
-dopoptowhen|||
-doref||5.009003|
-dounwind|||
-dowantarray|||
-drand48_init_r|||n
-drand48_r|||n
-dump_all_perl|||
-dump_all||5.006000|
-dump_c_backtrace|||
-dump_eval||5.006000|
-dump_exec_pos|||
-dump_form||5.006000|
-dump_indent||5.006000|v
-dump_mstats|||
-dump_packsubs_perl|||
-dump_packsubs||5.006000|
-dump_sub_perl|||
-dump_sub||5.006000|
-dump_sv_child|||
-dump_trie_interim_list|||
-dump_trie_interim_table|||
-dump_trie|||
-dump_vindent||5.006000|
-dumpuntil|||
-dup_attrlist|||
-emulate_cop_io|||
-eval_pv|5.006000||p
-eval_sv|5.006000||p
-exec_failed|||
-expect_number|||
-fbm_compile||5.005000|
-fbm_instr||5.005000|
-feature_is_enabled|||
-filter_add|||
-filter_del|||
-filter_gets|||
-filter_read|||
-finalize_optree|||
-finalize_op|||
-find_and_forget_pmops|||
-find_array_subscript|||
-find_beginning|||
-find_byclass|||
-find_default_stash|||
-find_hash_subscript|||
-find_in_my_stash|||
-find_lexical_cv|||
-find_runcv_where|||
-find_runcv||5.008001|
-find_rundefsv2|||
-find_rundefsvoffset||5.009002|
-find_rundefsv||5.013002|
-find_script|||
-find_uninit_var|||
-first_symbol|||n
-fixup_errno_string|||
-foldEQ_latin1||5.013008|n
-foldEQ_locale||5.013002|n
-foldEQ_utf8_flags||5.013010|
-foldEQ_utf8||5.013002|
-foldEQ||5.013002|n
-fold_constants|||
-forbid_setid|||
-force_ident_maybe_lex|||
-force_ident|||
-force_list|||
-force_next|||
-force_strict_version|||
-force_version|||
-force_word|||
-forget_pmop|||
-form_nocontext|||vn
-form_short_octal_warning|||
-form||5.004000|v
-fp_dup|||
-fprintf_nocontext|||vn
-free_c_backtrace|||
-free_global_struct|||
-free_tied_hv_pool|||
-free_tmps|||
-gen_constant_list|||
-get_ANYOF_cp_list_for_ssc|||
-get_and_check_backslash_N_name|||
-get_aux_mg|||
-get_av|5.006000||p
-get_c_backtrace_dump|||
-get_c_backtrace|||
-get_context||5.006000|n
-get_cvn_flags|5.009005||p
-get_cvs|5.011000||p
-get_cv|5.006000||p
-get_db_sub|||
-get_debug_opts|||
-get_hash_seed|||
-get_hv|5.006000||p
-get_invlist_iter_addr|||n
-get_invlist_offset_addr|||n
-get_invlist_previous_index_addr|||n
-get_mstats|||
-get_no_modify|||
-get_num|||
-get_op_descs||5.005000|
-get_op_names||5.005000|
-get_opargs|||
-get_ppaddr||5.006000|
-get_re_arg|||
-get_sv|5.006000||p
-get_vtbl||5.005030|
-getcwd_sv||5.007002|
-getenv_len|||
-glob_2number|||
-glob_assign_glob|||
-gp_dup|||
-gp_free|||
-gp_ref|||
-grok_atoUV|||n
-grok_bin|5.007003||p
-grok_bslash_N|||
-grok_bslash_c|||
-grok_bslash_o|||
-grok_bslash_x|||
-grok_hex|5.007003||p
-grok_infnan||5.021004|
-grok_number_flags||5.021002|
-grok_number|5.007002||p
-grok_numeric_radix|5.007002||p
-grok_oct|5.007003||p
-group_end|||
-gv_AVadd|||
-gv_HVadd|||
-gv_IOadd|||
-gv_SVadd|||
-gv_add_by_type||5.011000|
-gv_autoload4||5.004000|
-gv_autoload_pvn||5.015004|
-gv_autoload_pv||5.015004|
-gv_autoload_sv||5.015004|
-gv_check|||
-gv_const_sv||5.009003|
-gv_dump||5.006000|
-gv_efullname3||5.003070|
-gv_efullname4||5.006001|
-gv_efullname|||
-gv_fetchfile_flags||5.009005|
-gv_fetchfile|||
-gv_fetchmeth_autoload||5.007003|
-gv_fetchmeth_internal|||
-gv_fetchmeth_pv_autoload||5.015004|
-gv_fetchmeth_pvn_autoload||5.015004|
-gv_fetchmeth_pvn||5.015004|
-gv_fetchmeth_pv||5.015004|
-gv_fetchmeth_sv_autoload||5.015004|
-gv_fetchmeth_sv||5.015004|
-gv_fetchmethod_autoload||5.004000|
-gv_fetchmethod_pv_flags||5.015004|
-gv_fetchmethod_pvn_flags||5.015004|
-gv_fetchmethod_sv_flags||5.015004|
-gv_fetchmethod|||
-gv_fetchmeth|||
-gv_fetchpvn_flags|5.009002||p
-gv_fetchpvs|5.009004||p
-gv_fetchpv|||
-gv_fetchsv|5.009002||p
-gv_fullname3||5.003070|
-gv_fullname4||5.006001|
-gv_fullname|||
-gv_handler||5.007001|
-gv_init_pvn||5.015004|
-gv_init_pv||5.015004|
-gv_init_svtype|||
-gv_init_sv||5.015004|
-gv_init|||
-gv_is_in_main|||
-gv_magicalize_isa|||
-gv_magicalize|||
-gv_name_set||5.009004|
-gv_override|||
-gv_setref|||
-gv_stashpvn_internal|||
-gv_stashpvn|5.003070||p
-gv_stashpvs|5.009003||p
-gv_stashpv|||
-gv_stashsvpvn_cached|||
-gv_stashsv|||
-gv_try_downgrade|||
-handle_regex_sets|||
-he_dup|||
-hek_dup|||
-hfree_next_entry|||
-hfreeentries|||
-hsplit|||
-hv_assert|||
-hv_auxinit_internal|||n
-hv_auxinit|||
-hv_backreferences_p|||
-hv_clear_placeholders||5.009001|
-hv_clear|||
-hv_common_key_len||5.010000|
-hv_common||5.010000|
-hv_copy_hints_hv||5.009004|
-hv_delayfree_ent||5.004000|
-hv_delete_common|||
-hv_delete_ent||5.003070|
-hv_delete|||
-hv_eiter_p||5.009003|
-hv_eiter_set||5.009003|
-hv_ename_add|||
-hv_ename_delete|||
-hv_exists_ent||5.003070|
-hv_exists|||
-hv_fetch_ent||5.003070|
-hv_fetchs|5.009003||p
-hv_fetch|||
-hv_fill||5.013002|
-hv_free_ent_ret|||
-hv_free_ent||5.004000|
-hv_iterinit|||
-hv_iterkeysv||5.003070|
-hv_iterkey|||
-hv_iternext_flags||5.008000|
-hv_iternextsv|||
-hv_iternext|||
-hv_iterval|||
-hv_kill_backrefs|||
-hv_ksplit||5.003070|
-hv_magic_check|||n
-hv_magic|||
-hv_name_set||5.009003|
-hv_notallowed|||
-hv_placeholders_get||5.009003|
-hv_placeholders_p|||
-hv_placeholders_set||5.009003|
-hv_rand_set||5.018000|
-hv_riter_p||5.009003|
-hv_riter_set||5.009003|
-hv_scalar||5.009001|
-hv_store_ent||5.003070|
-hv_store_flags||5.008000|
-hv_stores|5.009004||p
-hv_store|||
-hv_undef_flags|||
-hv_undef|||
-ibcmp_locale||5.004000|
-ibcmp_utf8||5.007003|
-ibcmp|||
-incline|||
-incpush_if_exists|||
-incpush_use_sep|||
-incpush|||
-ingroup|||
-init_argv_symbols|||
-init_constants|||
-init_dbargs|||
-init_debugger|||
-init_global_struct|||
-init_i18nl10n||5.006000|
-init_i18nl14n||5.006000|
-init_ids|||
-init_interp|||
-init_main_stash|||
-init_perllib|||
-init_postdump_symbols|||
-init_predump_symbols|||
-init_stacks||5.005000|
-init_tm||5.007002|
-inplace_aassign|||
-instr|||n
-intro_my||5.004000|
-intuit_method|||
-intuit_more|||
-invert|||
-invlist_array|||n
-invlist_clone|||
-invlist_extend|||
-invlist_highest|||n
-invlist_is_iterating|||n
-invlist_iterfinish|||n
-invlist_iterinit|||n
-invlist_iternext|||n
-invlist_max|||n
-invlist_previous_index|||n
-invlist_set_len|||
-invlist_set_previous_index|||n
-invlist_trim|||n
-invoke_exception_hook|||
-io_close|||
-isALNUMC|5.006000||p
-isALNUM_lazy||5.021001|
-isALPHANUMERIC||5.017008|
-isALPHA|||
-isASCII|5.006000||p
-isBLANK|5.006001||p
-isCNTRL|5.006000||p
-isDIGIT|||
-isFOO_lc|||
-isFOO_utf8_lc|||
-isGCB|||n
-isGRAPH|5.006000||p
-isGV_with_GP|5.009004||p
-isIDCONT||5.017008|
-isIDFIRST_lazy||5.021001|
-isIDFIRST|||
-isLOWER|||
-isOCTAL||5.013005|
-isPRINT|5.004000||p
-isPSXSPC|5.006001||p
-isPUNCT|5.006000||p
-isSB|||
-isSPACE|||
-isUPPER|||
-isUTF8_CHAR||5.021001|
-isWB|||
-isWORDCHAR||5.013006|
-isXDIGIT|5.006000||p
-is_an_int|||
-is_ascii_string||5.011000|
-is_handle_constructor|||n
-is_invariant_string||5.021007|n
-is_lvalue_sub||5.007001|
-is_safe_syscall||5.019004|
-is_ssc_worth_it|||n
-is_uni_alnum_lc||5.006000|
-is_uni_alnumc_lc||5.017007|
-is_uni_alnumc||5.017007|
-is_uni_alnum||5.006000|
-is_uni_alpha_lc||5.006000|
-is_uni_alpha||5.006000|
-is_uni_ascii_lc||5.006000|
-is_uni_ascii||5.006000|
-is_uni_blank_lc||5.017002|
-is_uni_blank||5.017002|
-is_uni_cntrl_lc||5.006000|
-is_uni_cntrl||5.006000|
-is_uni_digit_lc||5.006000|
-is_uni_digit||5.006000|
-is_uni_graph_lc||5.006000|
-is_uni_graph||5.006000|
-is_uni_idfirst_lc||5.006000|
-is_uni_idfirst||5.006000|
-is_uni_lower_lc||5.006000|
-is_uni_lower||5.006000|
-is_uni_print_lc||5.006000|
-is_uni_print||5.006000|
-is_uni_punct_lc||5.006000|
-is_uni_punct||5.006000|
-is_uni_space_lc||5.006000|
-is_uni_space||5.006000|
-is_uni_upper_lc||5.006000|
-is_uni_upper||5.006000|
-is_uni_xdigit_lc||5.006000|
-is_uni_xdigit||5.006000|
-is_utf8_alnumc||5.017007|
-is_utf8_alnum||5.006000|
-is_utf8_alpha||5.006000|
-is_utf8_ascii||5.006000|
-is_utf8_blank||5.017002|
-is_utf8_char_buf||5.015008|n
-is_utf8_char||5.006000|n
-is_utf8_cntrl||5.006000|
-is_utf8_common|||
-is_utf8_digit||5.006000|
-is_utf8_graph||5.006000|
-is_utf8_idcont||5.008000|
-is_utf8_idfirst||5.006000|
-is_utf8_lower||5.006000|
-is_utf8_mark||5.006000|
-is_utf8_perl_space||5.011001|
-is_utf8_perl_word||5.011001|
-is_utf8_posix_digit||5.011001|
-is_utf8_print||5.006000|
-is_utf8_punct||5.006000|
-is_utf8_space||5.006000|
-is_utf8_string_loclen||5.009003|n
-is_utf8_string_loc||5.008001|n
-is_utf8_string||5.006001|n
-is_utf8_upper||5.006000|
-is_utf8_xdigit||5.006000|
-is_utf8_xidcont||5.013010|
-is_utf8_xidfirst||5.013010|
-isa_lookup|||
-isinfnansv|||
-isinfnan||5.021004|n
-items|||n
-ix|||n
-jmaybe|||
-join_exact|||
-keyword_plugin_standard|||
-keyword|||
-leave_common|||
-leave_scope|||
-lex_bufutf8||5.011002|
-lex_discard_to||5.011002|
-lex_grow_linestr||5.011002|
-lex_next_chunk||5.011002|
-lex_peek_unichar||5.011002|
-lex_read_space||5.011002|
-lex_read_to||5.011002|
-lex_read_unichar||5.011002|
-lex_start||5.009005|
-lex_stuff_pvn||5.011002|
-lex_stuff_pvs||5.013005|
-lex_stuff_pv||5.013006|
-lex_stuff_sv||5.011002|
-lex_unstuff||5.011002|
-listkids|||
-list|||
-load_module_nocontext|||vn
-load_module|5.006000||pv
-localize|||
-looks_like_bool|||
-looks_like_number|||
-lop|||
-mPUSHi|5.009002||p
-mPUSHn|5.009002||p
-mPUSHp|5.009002||p
-mPUSHs|5.010001||p
-mPUSHu|5.009002||p
-mXPUSHi|5.009002||p
-mXPUSHn|5.009002||p
-mXPUSHp|5.009002||p
-mXPUSHs|5.010001||p
-mXPUSHu|5.009002||p
-magic_clear_all_env|||
-magic_cleararylen_p|||
-magic_clearenv|||
-magic_clearhints|||
-magic_clearhint|||
-magic_clearisa|||
-magic_clearpack|||
-magic_clearsig|||
-magic_copycallchecker|||
-magic_dump||5.006000|
-magic_existspack|||
-magic_freearylen_p|||
-magic_freeovrld|||
-magic_getarylen|||
-magic_getdebugvar|||
-magic_getdefelem|||
-magic_getnkeys|||
-magic_getpack|||
-magic_getpos|||
-magic_getsig|||
-magic_getsubstr|||
-magic_gettaint|||
-magic_getuvar|||
-magic_getvec|||
-magic_get|||
-magic_killbackrefs|||
-magic_methcall1|||
-magic_methcall|||v
-magic_methpack|||
-magic_nextpack|||
-magic_regdata_cnt|||
-magic_regdatum_get|||
-magic_regdatum_set|||
-magic_scalarpack|||
-magic_set_all_env|||
-magic_setarylen|||
-magic_setcollxfrm|||
-magic_setdbline|||
-magic_setdebugvar|||
-magic_setdefelem|||
-magic_setenv|||
-magic_sethint|||
-magic_setisa|||
-magic_setlvref|||
-magic_setmglob|||
-magic_setnkeys|||
-magic_setpack|||
-magic_setpos|||
-magic_setregexp|||
-magic_setsig|||
-magic_setsubstr|||
-magic_settaint|||
-magic_setutf8|||
-magic_setuvar|||
-magic_setvec|||
-magic_set|||
-magic_sizepack|||
-magic_wipepack|||
-make_matcher|||
-make_trie|||
-malloc_good_size|||n
-malloced_size|||n
-malloc||5.007002|n
-markstack_grow||5.021001|
-matcher_matches_sv|||
-maybe_multimagic_gv|||
-mayberelocate|||
-measure_struct|||
-memEQs|5.009005||p
-memEQ|5.004000||p
-memNEs|5.009005||p
-memNE|5.004000||p
-mem_collxfrm|||
-mem_log_common|||n
-mess_alloc|||
-mess_nocontext|||vn
-mess_sv||5.013001|
-mess||5.006000|v
-mfree||5.007002|n
-mg_clear|||
-mg_copy|||
-mg_dup|||
-mg_find_mglob|||
-mg_findext|5.013008||pn
-mg_find|||n
-mg_free_type||5.013006|
-mg_free|||
-mg_get|||
-mg_length||5.005000|
-mg_localize|||
-mg_magical|||n
-mg_set|||
-mg_size||5.005000|
-mini_mktime||5.007002|n
-minus_v|||
-missingterm|||
-mode_from_discipline|||
-modkids|||
-more_bodies|||
-more_sv|||
-moreswitches|||
-move_proto_attr|||
-mro_clean_isarev|||
-mro_gather_and_rename|||
-mro_get_from_name||5.010001|
-mro_get_linear_isa_dfs|||
-mro_get_linear_isa||5.009005|
-mro_get_private_data||5.010001|
-mro_isa_changed_in|||
-mro_meta_dup|||
-mro_meta_init|||
-mro_method_changed_in||5.009005|
-mro_package_moved|||
-mro_register||5.010001|
-mro_set_mro||5.010001|
-mro_set_private_data||5.010001|
-mul128|||
-mulexp10|||n
-multideref_stringify|||
-my_atof2||5.007002|
-my_atof||5.006000|
-my_attrs|||
-my_bcopy|||n
-my_bytes_to_utf8|||n
-my_bzero|||n
-my_chsize|||
-my_clearenv|||
-my_cxt_index|||
-my_cxt_init|||
-my_dirfd||5.009005|n
-my_exit_jump|||
-my_exit|||
-my_failure_exit||5.004000|
-my_fflush_all||5.006000|
-my_fork||5.007003|n
-my_kid|||
-my_lstat_flags|||
-my_lstat||5.021008|
-my_memcmp|||n
-my_memset|||n
-my_pclose||5.003070|
-my_popen_list||5.007001|
-my_popen||5.003070|
-my_setenv|||
-my_setlocale|||
-my_snprintf|5.009004||pvn
-my_socketpair||5.007003|n
-my_sprintf|5.009003||pvn
-my_stat_flags|||
-my_stat||5.021008|
-my_strerror||5.021001|
-my_strftime||5.007002|
-my_strlcat|5.009004||pn
-my_strlcpy|5.009004||pn
-my_unexec|||
-my_vsnprintf||5.009004|n
-need_utf8|||n
-newANONATTRSUB||5.006000|
-newANONHASH|||
-newANONLIST|||
-newANONSUB|||
-newASSIGNOP|||
-newATTRSUB_x|||
-newATTRSUB||5.006000|
-newAVREF|||
-newAV|||
-newBINOP|||
-newCONDOP|||
-newCONSTSUB_flags||5.015006|
-newCONSTSUB|5.004050||p
-newCVREF|||
-newDEFSVOP||5.021006|
-newFORM|||
-newFOROP||5.013007|
-newGIVENOP||5.009003|
-newGIVWHENOP|||
-newGP|||
-newGVOP|||
-newGVREF|||
-newGVgen_flags||5.015004|
-newGVgen|||
-newHVREF|||
-newHVhv||5.005000|
-newHV|||
-newIO|||
-newLISTOP|||
-newLOGOP|||
-newLOOPEX|||
-newLOOPOP|||
-newMETHOP_internal|||
-newMETHOP_named||5.021005|
-newMETHOP||5.021005|
-newMYSUB||5.017004|
-newNULLLIST|||
-newOP|||
-newPADNAMELIST||5.021007|n
-newPADNAMEouter||5.021007|n
-newPADNAMEpvn||5.021007|n
-newPADOP|||
-newPMOP|||
-newPROG|||
-newPVOP|||
-newRANGE|||
-newRV_inc|5.004000||p
-newRV_noinc|5.004000||p
-newRV|||
-newSLICEOP|||
-newSTATEOP|||
-newSTUB|||
-newSUB|||
-newSVOP|||
-newSVREF|||
-newSV_type|5.009005||p
-newSVavdefelem|||
-newSVhek||5.009003|
-newSViv|||
-newSVnv|||
-newSVpadname||5.017004|
-newSVpv_share||5.013006|
-newSVpvf_nocontext|||vn
-newSVpvf||5.004000|v
-newSVpvn_flags|5.010001||p
-newSVpvn_share|5.007001||p
-newSVpvn_utf8|5.010001||p
-newSVpvn|5.004050||p
-newSVpvs_flags|5.010001||p
-newSVpvs_share|5.009003||p
-newSVpvs|5.009003||p
-newSVpv|||
-newSVrv|||
-newSVsv|||
-newSVuv|5.006000||p
-newSV|||
-newUNOP_AUX||5.021007|
-newUNOP|||
-newWHENOP||5.009003|
-newWHILEOP||5.013007|
-newXS_deffile|||
-newXS_flags||5.009004|
-newXS_len_flags|||
-newXSproto||5.006000|
-newXS||5.006000|
-new_collate||5.006000|
-new_constant|||
-new_ctype||5.006000|
-new_he|||
-new_logop|||
-new_numeric||5.006000|
-new_stackinfo||5.005000|
-new_version||5.009000|
-new_warnings_bitfield|||
-next_symbol|||
-nextargv|||
-nextchar|||
-ninstr|||n
-no_bareword_allowed|||
-no_fh_allowed|||
-no_op|||
-noperl_die|||vn
-not_a_number|||
-not_incrementable|||
-nothreadhook||5.008000|
-nuke_stacks|||
-num_overflow|||n
-oopsAV|||
-oopsHV|||
-op_append_elem||5.013006|
-op_append_list||5.013006|
-op_clear|||
-op_contextualize||5.013006|
-op_convert_list||5.021006|
-op_dump||5.006000|
-op_free|||
-op_integerize|||
-op_linklist||5.013006|
-op_lvalue_flags|||
-op_lvalue||5.013007|
-op_null||5.007002|
-op_parent||5.021002|n
-op_prepend_elem||5.013006|
-op_refcnt_dec|||
-op_refcnt_inc|||
-op_refcnt_lock||5.009002|
-op_refcnt_unlock||5.009002|
-op_relocate_sv|||
-op_scope||5.013007|
-op_sibling_splice||5.021002|n
-op_std_init|||
-op_unscope|||
-open_script|||
-openn_cleanup|||
-openn_setup|||
-opmethod_stash|||
-opslab_force_free|||
-opslab_free_nopad|||
-opslab_free|||
-pMY_CXT_|5.007003||p
-pMY_CXT|5.007003||p
-pTHX_|5.006000||p
-pTHX|5.006000||p
-packWARN|5.007003||p
-pack_cat||5.007003|
-pack_rec|||
-package_version|||
-package|||
-packlist||5.008001|
-pad_add_anon||5.008001|
-pad_add_name_pvn||5.015001|
-pad_add_name_pvs||5.015001|
-pad_add_name_pv||5.015001|
-pad_add_name_sv||5.015001|
-pad_add_weakref|||
-pad_alloc_name|||
-pad_alloc|||
-pad_block_start|||
-pad_check_dup|||
-pad_compname_type||5.009003|
-pad_findlex|||
-pad_findmy_pvn||5.015001|
-pad_findmy_pvs||5.015001|
-pad_findmy_pv||5.015001|
-pad_findmy_sv||5.015001|
-pad_fixup_inner_anons|||
-pad_free|||
-pad_leavemy|||
-pad_new||5.008001|
-pad_push|||
-pad_reset|||
-pad_setsv|||
-pad_sv|||
-pad_swipe|||
-pad_tidy||5.008001|
-padlist_dup|||
-padlist_store|||
-padname_dup|||
-padname_free|||
-padnamelist_dup|||
-padnamelist_fetch||5.021007|n
-padnamelist_free|||
-padnamelist_store||5.021007|
-parse_arithexpr||5.013008|
-parse_barestmt||5.013007|
-parse_block||5.013007|
-parse_body|||
-parse_fullexpr||5.013008|
-parse_fullstmt||5.013005|
-parse_gv_stash_name|||
-parse_ident|||
-parse_label||5.013007|
-parse_listexpr||5.013008|
-parse_lparen_question_flags|||
-parse_stmtseq||5.013006|
-parse_subsignature|||
-parse_termexpr||5.013008|
-parse_unicode_opts|||
-parser_dup|||
-parser_free_nexttoke_ops|||
-parser_free|||
-path_is_searchable|||n
-peep|||
-pending_ident|||
-perl_alloc_using|||n
-perl_alloc|||n
-perl_clone_using|||n
-perl_clone|||n
-perl_construct|||n
-perl_destruct||5.007003|n
-perl_free|||n
-perl_parse||5.006000|n
-perl_run|||n
-pidgone|||
-pm_description|||
-pmop_dump||5.006000|
-pmruntime|||
-pmtrans|||
-pop_scope|||
-populate_ANYOF_from_invlist|||
-populate_isa|||v
-pregcomp||5.009005|
-pregexec|||
-pregfree2||5.011000|
-pregfree|||
-prescan_version||5.011004|
-printbuf|||
-printf_nocontext|||vn
-process_special_blocks|||
-ptr_hash|||n
-ptr_table_clear||5.009005|
-ptr_table_fetch||5.009005|
-ptr_table_find|||n
-ptr_table_free||5.009005|
-ptr_table_new||5.009005|
-ptr_table_split||5.009005|
-ptr_table_store||5.009005|
-push_scope|||
-put_charclass_bitmap_innards|||
-put_code_point|||
-put_range|||
-pv_display|5.006000||p
-pv_escape|5.009004||p
-pv_pretty|5.009004||p
-pv_uni_display||5.007003|
-qerror|||
-qsortsvu|||
-quadmath_format_needed|||n
-quadmath_format_single|||n
-re_compile||5.009005|
-re_croak2|||
-re_dup_guts|||
-re_intuit_start||5.019001|
-re_intuit_string||5.006000|
-re_op_compile|||
-realloc||5.007002|n
-reentrant_free||5.021008|
-reentrant_init||5.021008|
-reentrant_retry||5.021008|vn
-reentrant_size||5.021008|
-ref_array_or_hash|||
-refcounted_he_chain_2hv|||
-refcounted_he_fetch_pvn|||
-refcounted_he_fetch_pvs|||
-refcounted_he_fetch_pv|||
-refcounted_he_fetch_sv|||
-refcounted_he_free|||
-refcounted_he_inc|||
-refcounted_he_new_pvn|||
-refcounted_he_new_pvs|||
-refcounted_he_new_pv|||
-refcounted_he_new_sv|||
-refcounted_he_value|||
-refkids|||
-refto|||
-ref||5.021008|
-reg2Lanode|||
-reg_check_named_buff_matched|||n
-reg_named_buff_all||5.009005|
-reg_named_buff_exists||5.009005|
-reg_named_buff_fetch||5.009005|
-reg_named_buff_firstkey||5.009005|
-reg_named_buff_iter|||
-reg_named_buff_nextkey||5.009005|
-reg_named_buff_scalar||5.009005|
-reg_named_buff|||
-reg_node|||
-reg_numbered_buff_fetch|||
-reg_numbered_buff_length|||
-reg_numbered_buff_store|||
-reg_qr_package|||
-reg_recode|||
-reg_scan_name|||
-reg_skipcomment|||n
-reg_temp_copy|||
-reganode|||
-regatom|||
-regbranch|||
-regclass_swash||5.009004|
-regclass|||
-regcppop|||
-regcppush|||
-regcurly|||n
-regdump_extflags|||
-regdump_intflags|||
-regdump||5.005000|
-regdupe_internal|||
-regexec_flags||5.005000|
-regfree_internal||5.009005|
-reghop3|||n
-reghop4|||n
-reghopmaybe3|||n
-reginclass|||
-reginitcolors||5.006000|
-reginsert|||
-regmatch|||
-regnext||5.005000|
-regnode_guts|||
-regpatws|||n
-regpiece|||
-regpposixcc|||
-regprop|||
-regrepeat|||
-regtail_study|||
-regtail|||
-regtry|||
-reg|||
-repeatcpy|||n
-report_evil_fh|||
-report_redefined_cv|||
-report_uninit|||
-report_wrongway_fh|||
-require_pv||5.006000|
-require_tie_mod|||
-restore_magic|||
-rninstr|||n
-rpeep|||
-rsignal_restore|||
-rsignal_save|||
-rsignal_state||5.004000|
-rsignal||5.004000|
-run_body|||
-run_user_filter|||
-runops_debug||5.005000|
-runops_standard||5.005000|
-rv2cv_op_cv||5.013006|
-rvpv_dup|||
-rxres_free|||
-rxres_restore|||
-rxres_save|||
-safesyscalloc||5.006000|n
-safesysfree||5.006000|n
-safesysmalloc||5.006000|n
-safesysrealloc||5.006000|n
-same_dirent|||
-save_I16||5.004000|
-save_I32|||
-save_I8||5.006000|
-save_adelete||5.011000|
-save_aelem_flags||5.011000|
-save_aelem||5.004050|
-save_aliased_sv|||
-save_alloc||5.006000|
-save_aptr|||
-save_ary|||
-save_bool||5.008001|
-save_clearsv|||
-save_delete|||
-save_destructor_x||5.006000|
-save_destructor||5.006000|
-save_freeop|||
-save_freepv|||
-save_freesv|||
-save_generic_pvref||5.006001|
-save_generic_svref||5.005030|
-save_gp||5.004000|
-save_hash|||
-save_hdelete||5.011000|
-save_hek_flags|||n
-save_helem_flags||5.011000|
-save_helem||5.004050|
-save_hints||5.010001|
-save_hptr|||
-save_int|||
-save_item|||
-save_iv||5.005000|
-save_lines|||
-save_list|||
-save_long|||
-save_magic_flags|||
-save_mortalizesv||5.007001|
-save_nogv|||
-save_op||5.005000|
-save_padsv_and_mortalize||5.010001|
-save_pptr|||
-save_pushi32ptr||5.010001|
-save_pushptri32ptr|||
-save_pushptrptr||5.010001|
-save_pushptr||5.010001|
-save_re_context||5.006000|
-save_scalar_at|||
-save_scalar|||
-save_set_svflags||5.009000|
-save_shared_pvref||5.007003|
-save_sptr|||
-save_strlen|||
-save_svref|||
-save_vptr||5.006000|
-savepvn|||
-savepvs||5.009003|
-savepv|||
-savesharedpvn||5.009005|
-savesharedpvs||5.013006|
-savesharedpv||5.007003|
-savesharedsvpv||5.013006|
-savestack_grow_cnt||5.008001|
-savestack_grow|||
-savesvpv||5.009002|
-sawparens|||
-scalar_mod_type|||n
-scalarboolean|||
-scalarkids|||
-scalarseq|||
-scalarvoid|||
-scalar|||
-scan_bin||5.006000|
-scan_commit|||
-scan_const|||
-scan_formline|||
-scan_heredoc|||
-scan_hex|||
-scan_ident|||
-scan_inputsymbol|||
-scan_num||5.007001|
-scan_oct|||
-scan_pat|||
-scan_str|||
-scan_subst|||
-scan_trans|||
-scan_version||5.009001|
-scan_vstring||5.009005|
-scan_word|||
-search_const|||
-seed||5.008001|
-sequence_num|||
-set_ANYOF_arg|||
-set_caret_X|||
-set_context||5.006000|n
-set_numeric_local||5.006000|
-set_numeric_radix||5.006000|
-set_numeric_standard||5.006000|
-set_padlist|||n
-setdefout|||
-share_hek_flags|||
-share_hek||5.004000|
-should_warn_nl|||n
-si_dup|||
-sighandler|||n
-simplify_sort|||
-skipspace_flags|||
-softref2xv|||
-sortcv_stacked|||
-sortcv_xsub|||
-sortcv|||
-sortsv_flags||5.009003|
-sortsv||5.007003|
-space_join_names_mortal|||
-ss_dup|||
-ssc_add_range|||
-ssc_and|||
-ssc_anything|||
-ssc_clear_locale|||n
-ssc_cp_and|||
-ssc_finalize|||
-ssc_init|||
-ssc_intersection|||
-ssc_is_anything|||n
-ssc_is_cp_posixl_init|||n
-ssc_or|||
-ssc_union|||
-stack_grow|||
-start_glob|||
-start_subparse||5.004000|
-stdize_locale|||
-strEQ|||
-strGE|||
-strGT|||
-strLE|||
-strLT|||
-strNE|||
-str_to_version||5.006000|
-strip_return|||
-strnEQ|||
-strnNE|||
-study_chunk|||
-sub_crush_depth|||
-sublex_done|||
-sublex_push|||
-sublex_start|||
-sv_2bool_flags||5.013006|
-sv_2bool|||
-sv_2cv|||
-sv_2io|||
-sv_2iuv_common|||
-sv_2iuv_non_preserve|||
-sv_2iv_flags||5.009001|
-sv_2iv|||
-sv_2mortal|||
-sv_2num|||
-sv_2nv_flags||5.013001|
-sv_2pv_flags|5.007002||p
-sv_2pv_nolen|5.006000||p
-sv_2pvbyte_nolen|5.006000||p
-sv_2pvbyte|5.006000||p
-sv_2pvutf8_nolen||5.006000|
-sv_2pvutf8||5.006000|
-sv_2pv|||
-sv_2uv_flags||5.009001|
-sv_2uv|5.004000||p
-sv_add_arena|||
-sv_add_backref|||
-sv_backoff|||n
-sv_bless|||
-sv_buf_to_ro|||
-sv_buf_to_rw|||
-sv_cat_decode||5.008001|
-sv_catpv_flags||5.013006|
-sv_catpv_mg|5.004050||p
-sv_catpv_nomg||5.013006|
-sv_catpvf_mg_nocontext|||pvn
-sv_catpvf_mg|5.006000|5.004000|pv
-sv_catpvf_nocontext|||vn
-sv_catpvf||5.004000|v
-sv_catpvn_flags||5.007002|
-sv_catpvn_mg|5.004050||p
-sv_catpvn_nomg|5.007002||p
-sv_catpvn|||
-sv_catpvs_flags||5.013006|
-sv_catpvs_mg||5.013006|
-sv_catpvs_nomg||5.013006|
-sv_catpvs|5.009003||p
-sv_catpv|||
-sv_catsv_flags||5.007002|
-sv_catsv_mg|5.004050||p
-sv_catsv_nomg|5.007002||p
-sv_catsv|||
-sv_chop|||
-sv_clean_all|||
-sv_clean_objs|||
-sv_clear|||
-sv_cmp_flags||5.013006|
-sv_cmp_locale_flags||5.013006|
-sv_cmp_locale||5.004000|
-sv_cmp|||
-sv_collxfrm_flags||5.013006|
-sv_collxfrm|||
-sv_copypv_flags||5.017002|
-sv_copypv_nomg||5.017002|
-sv_copypv|||
-sv_dec_nomg||5.013002|
-sv_dec|||
-sv_del_backref|||
-sv_derived_from_pvn||5.015004|
-sv_derived_from_pv||5.015004|
-sv_derived_from_sv||5.015004|
-sv_derived_from||5.004000|
-sv_destroyable||5.010000|
-sv_display|||
-sv_does_pvn||5.015004|
-sv_does_pv||5.015004|
-sv_does_sv||5.015004|
-sv_does||5.009004|
-sv_dump|||
-sv_dup_common|||
-sv_dup_inc_multiple|||
-sv_dup_inc|||
-sv_dup|||
-sv_eq_flags||5.013006|
-sv_eq|||
-sv_exp_grow|||
-sv_force_normal_flags||5.007001|
-sv_force_normal||5.006000|
-sv_free2|||
-sv_free_arenas|||
-sv_free|||
-sv_get_backrefs||5.021008|n
-sv_gets||5.003070|
-sv_grow|||
-sv_i_ncmp|||
-sv_inc_nomg||5.013002|
-sv_inc|||
-sv_insert_flags||5.010001|
-sv_insert|||
-sv_isa|||
-sv_isobject|||
-sv_iv||5.005000|
-sv_kill_backrefs|||
-sv_len_utf8_nomg|||
-sv_len_utf8||5.006000|
-sv_len|||
-sv_magic_portable|5.021008|5.004000|p
-sv_magicext_mglob|||
-sv_magicext||5.007003|
-sv_magic|||
-sv_mortalcopy_flags|||
-sv_mortalcopy|||
-sv_ncmp|||
-sv_newmortal|||
-sv_newref|||
-sv_nolocking||5.007003|
-sv_nosharing||5.007003|
-sv_nounlocking|||
-sv_nv||5.005000|
-sv_only_taint_gmagic|||n
-sv_or_pv_pos_u2b|||
-sv_peek||5.005000|
-sv_pos_b2u_flags||5.019003|
-sv_pos_b2u_midway|||
-sv_pos_b2u||5.006000|
-sv_pos_u2b_cached|||
-sv_pos_u2b_flags||5.011005|
-sv_pos_u2b_forwards|||n
-sv_pos_u2b_midway|||n
-sv_pos_u2b||5.006000|
-sv_pvbyten_force||5.006000|
-sv_pvbyten||5.006000|
-sv_pvbyte||5.006000|
-sv_pvn_force_flags|5.007002||p
-sv_pvn_force|||
-sv_pvn_nomg|5.007003|5.005000|p
-sv_pvn||5.005000|
-sv_pvutf8n_force||5.006000|
-sv_pvutf8n||5.006000|
-sv_pvutf8||5.006000|
-sv_pv||5.006000|
-sv_recode_to_utf8||5.007003|
-sv_reftype|||
-sv_ref|||
-sv_release_COW|||
-sv_replace|||
-sv_report_used|||
-sv_resetpvn|||
-sv_reset|||
-sv_rvweaken||5.006000|
-sv_sethek|||
-sv_setiv_mg|5.004050||p
-sv_setiv|||
-sv_setnv_mg|5.006000||p
-sv_setnv|||
-sv_setpv_mg|5.004050||p
-sv_setpvf_mg_nocontext|||pvn
-sv_setpvf_mg|5.006000|5.004000|pv
-sv_setpvf_nocontext|||vn
-sv_setpvf||5.004000|v
-sv_setpviv_mg||5.008001|
-sv_setpviv||5.008001|
-sv_setpvn_mg|5.004050||p
-sv_setpvn|||
-sv_setpvs_mg||5.013006|
-sv_setpvs|5.009004||p
-sv_setpv|||
-sv_setref_iv|||
-sv_setref_nv|||
-sv_setref_pvn|||
-sv_setref_pvs||5.021008|
-sv_setref_pv|||
-sv_setref_uv||5.007001|
-sv_setsv_cow|||
-sv_setsv_flags||5.007002|
-sv_setsv_mg|5.004050||p
-sv_setsv_nomg|5.007002||p
-sv_setsv|||
-sv_setuv_mg|5.004050||p
-sv_setuv|5.004000||p
-sv_tainted||5.004000|
-sv_taint||5.004000|
-sv_true||5.005000|
-sv_unglob|||
-sv_uni_display||5.007003|
-sv_unmagicext|5.013008||p
-sv_unmagic|||
-sv_unref_flags||5.007001|
-sv_unref|||
-sv_untaint||5.004000|
-sv_upgrade|||
-sv_usepvn_flags||5.009004|
-sv_usepvn_mg|5.004050||p
-sv_usepvn|||
-sv_utf8_decode||5.006000|
-sv_utf8_downgrade||5.006000|
-sv_utf8_encode||5.006000|
-sv_utf8_upgrade_flags_grow||5.011000|
-sv_utf8_upgrade_flags||5.007002|
-sv_utf8_upgrade_nomg||5.007002|
-sv_utf8_upgrade||5.007001|
-sv_uv|5.005000||p
-sv_vcatpvf_mg|5.006000|5.004000|p
-sv_vcatpvfn_flags||5.017002|
-sv_vcatpvfn||5.004000|
-sv_vcatpvf|5.006000|5.004000|p
-sv_vsetpvf_mg|5.006000|5.004000|p
-sv_vsetpvfn||5.004000|
-sv_vsetpvf|5.006000|5.004000|p
-svtype|||
-swallow_bom|||
-swash_fetch||5.007002|
-swash_init||5.006000|
-swash_scan_list_line|||
-swatch_get|||
-sync_locale||5.021004|
-sys_init3||5.010000|n
-sys_init||5.010000|n
-sys_intern_clear|||
-sys_intern_dup|||
-sys_intern_init|||
-sys_term||5.010000|n
-taint_env|||
-taint_proper|||
-tied_method|||v
-tmps_grow_p|||
-toFOLD_uni||5.007003|
-toFOLD_utf8||5.019001|
-toFOLD||5.019001|
-toLOWER_L1||5.019001|
-toLOWER_LC||5.004000|
-toLOWER_uni||5.007003|
-toLOWER_utf8||5.015007|
-toLOWER|||
-toTITLE_uni||5.007003|
-toTITLE_utf8||5.015007|
-toTITLE||5.019001|
-toUPPER_uni||5.007003|
-toUPPER_utf8||5.015007|
-toUPPER|||
-to_byte_substr|||
-to_lower_latin1|||n
-to_uni_fold||5.007003|
-to_uni_lower_lc||5.006000|
-to_uni_lower||5.007003|
-to_uni_title_lc||5.006000|
-to_uni_title||5.007003|
-to_uni_upper_lc||5.006000|
-to_uni_upper||5.007003|
-to_utf8_case||5.007003|
-to_utf8_fold||5.015007|
-to_utf8_lower||5.015007|
-to_utf8_substr|||
-to_utf8_title||5.015007|
-to_utf8_upper||5.015007|
-tokenize_use|||
-tokeq|||
-tokereport|||
-too_few_arguments_pv|||
-too_many_arguments_pv|||
-translate_substr_offsets|||n
-try_amagic_bin|||
-try_amagic_un|||
-uiv_2buf|||n
-unlnk|||
-unpack_rec|||
-unpack_str||5.007003|
-unpackstring||5.008001|
-unreferenced_to_tmp_stack|||
-unshare_hek_or_pvn|||
-unshare_hek|||
-unsharepvn||5.003070|
-unwind_handler_stack|||
-update_debugger_info|||
-upg_version||5.009005|
-usage|||
-utf16_textfilter|||
-utf16_to_utf8_reversed||5.006001|
-utf16_to_utf8||5.006001|
-utf8_distance||5.006000|
-utf8_hop||5.006000|n
-utf8_length||5.007001|
-utf8_mg_len_cache_update|||
-utf8_mg_pos_cache_update|||
-utf8_to_bytes||5.006001|
-utf8_to_uvchr_buf||5.015009|
-utf8_to_uvchr||5.007001|
-utf8_to_uvuni_buf||5.015009|
-utf8_to_uvuni||5.007001|
-utf8n_to_uvchr||5.007001|
-utf8n_to_uvuni||5.007001|
-utilize|||
-uvchr_to_utf8_flags||5.007003|
-uvchr_to_utf8||5.007001|
-uvoffuni_to_utf8_flags||5.019004|
-uvuni_to_utf8_flags||5.007003|
-uvuni_to_utf8||5.007001|
-valid_utf8_to_uvchr||5.015009|
-valid_utf8_to_uvuni||5.015009|
-validate_proto|||
-validate_suid|||
-varname|||
-vcmp||5.009000|
-vcroak||5.006000|
-vdeb||5.007003|
-vform||5.006000|
-visit|||
-vivify_defelem|||
-vivify_ref|||
-vload_module|5.006000||p
-vmess||5.006000|
-vnewSVpvf|5.006000|5.004000|p
-vnormal||5.009002|
-vnumify||5.009000|
-vstringify||5.009000|
-vverify||5.009003|
-vwarner||5.006000|
-vwarn||5.006000|
-wait4pid|||
-warn_nocontext|||vn
-warn_sv||5.013001|
-warner_nocontext|||vn
-warner|5.006000|5.004000|pv
-warn|||v
-was_lvalue_sub|||
-watch|||
-whichsig_pvn||5.015004|
-whichsig_pv||5.015004|
-whichsig_sv||5.015004|
-whichsig|||
-win32_croak_not_implemented|||n
-with_queued_errors|||
-wrap_op_checker||5.015008|
-write_to_stderr|||
-xs_boot_epilog|||
-xs_handshake|||vn
-xs_version_bootcheck|||
-yyerror_pvn|||
-yyerror_pv|||
-yyerror|||
-yylex|||
-yyparse|||
-yyunlex|||
-yywarn|||
-);
-
-if (exists $opt{'list-unsupported'}) {
- my $f;
- for $f (sort { lc $a cmp lc $b } keys %API) {
- next unless $API{$f}{todo};
- print "$f ", '.'x(40-length($f)), " ", format_version($API{$f}{todo}), "\n";
- }
- exit 0;
-}
-
-# Scan for possible replacement candidates
-
-my(%replace, %need, %hints, %warnings, %depends);
-my $replace = 0;
-my($hint, $define, $function);
-
-sub find_api
-{
- my $code = shift;
- $code =~ s{
- / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]*)
- | "[^"\\]*(?:\\.[^"\\]*)*"
- | '[^'\\]*(?:\\.[^'\\]*)*' }{}egsx;
- grep { exists $API{$_} } $code =~ /(\w+)/mg;
-}
-
-while (<DATA>) {
- if ($hint) {
- my $h = $hint->[0] eq 'Hint' ? \%hints : \%warnings;
- if (m{^\s*\*\s(.*?)\s*$}) {
- for (@{$hint->[1]}) {
- $h->{$_} ||= ''; # suppress warning with older perls
- $h->{$_} .= "$1\n";
- }
- }
- else { undef $hint }
- }
-
- $hint = [$1, [split /,?\s+/, $2]]
- if m{^\s*$rccs\s+(Hint|Warning):\s+(\w+(?:,?\s+\w+)*)\s*$};
-
- if ($define) {
- if ($define->[1] =~ /\\$/) {
- $define->[1] .= $_;
- }
- else {
- if (exists $API{$define->[0]} && $define->[1] !~ /^DPPP_\(/) {
- my @n = find_api($define->[1]);
- push @{$depends{$define->[0]}}, @n if @n
- }
- undef $define;
- }
- }
-
- $define = [$1, $2] if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(.*)};
-
- if ($function) {
- if (/^}/) {
- if (exists $API{$function->[0]}) {
- my @n = find_api($function->[1]);
- push @{$depends{$function->[0]}}, @n if @n
- }
- undef $function;
- }
- else {
- $function->[1] .= $_;
- }
- }
-
- $function = [$1, ''] if m{^DPPP_\(my_(\w+)\)};
-
- $replace = $1 if m{^\s*$rccs\s+Replace:\s+(\d+)\s+$rcce\s*$};
- $replace{$2} = $1 if $replace and m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+)};
- $replace{$2} = $1 if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+).*$rccs\s+Replace\s+$rcce};
- $replace{$1} = $2 if m{^\s*$rccs\s+Replace (\w+) with (\w+)\s+$rcce\s*$};
-
- if (m{^\s*$rccs\s+(\w+(\s*,\s*\w+)*)\s+depends\s+on\s+(\w+(\s*,\s*\w+)*)\s+$rcce\s*$}) {
- my @deps = map { s/\s+//g; $_ } split /,/, $3;
- my $d;
- for $d (map { s/\s+//g; $_ } split /,/, $1) {
- push @{$depends{$d}}, @deps;
- }
- }
-
- $need{$1} = 1 if m{^#if\s+defined\(NEED_(\w+)(?:_GLOBAL)?\)};
-}
-
-for (values %depends) {
- my %s;
- $_ = [sort grep !$s{$_}++, @$_];
-}
-
-if (exists $opt{'api-info'}) {
- my $f;
- my $count = 0;
- my $match = $opt{'api-info'} =~ m!^/(.*)/$! ? $1 : "^\Q$opt{'api-info'}\E\$";
- for $f (sort { lc $a cmp lc $b } keys %API) {
- next unless $f =~ /$match/;
- print "\n=== $f ===\n\n";
- my $info = 0;
- if ($API{$f}{base} || $API{$f}{todo}) {
- my $base = format_version($API{$f}{base} || $API{$f}{todo});
- print "Supported at least starting from perl-$base.\n";
- $info++;
- }
- if ($API{$f}{provided}) {
- my $todo = $API{$f}{todo} ? format_version($API{$f}{todo}) : "5.003";
- print "Support by $ppport provided back to perl-$todo.\n";
- print "Support needs to be explicitly requested by NEED_$f.\n" if exists $need{$f};
- print "Depends on: ", join(', ', @{$depends{$f}}), ".\n" if exists $depends{$f};
- print "\n$hints{$f}" if exists $hints{$f};
- print "\nWARNING:\n$warnings{$f}" if exists $warnings{$f};
- $info++;
- }
- print "No portability information available.\n" unless $info;
- $count++;
- }
- $count or print "Found no API matching '$opt{'api-info'}'.";
- print "\n";
- exit 0;
-}
-
-if (exists $opt{'list-provided'}) {
- my $f;
- for $f (sort { lc $a cmp lc $b } keys %API) {
- next unless $API{$f}{provided};
- my @flags;
- push @flags, 'explicit' if exists $need{$f};
- push @flags, 'depend' if exists $depends{$f};
- push @flags, 'hint' if exists $hints{$f};
- push @flags, 'warning' if exists $warnings{$f};
- my $flags = @flags ? ' ['.join(', ', @flags).']' : '';
- print "$f$flags\n";
- }
- exit 0;
-}
-
-my @files;
-my @srcext = qw( .xs .c .h .cc .cpp -c.inc -xs.inc );
-my $srcext = join '|', map { quotemeta $_ } @srcext;
-
-if (@ARGV) {
- my %seen;
- for (@ARGV) {
- if (-e) {
- if (-f) {
- push @files, $_ unless $seen{$_}++;
- }
- else { warn "'$_' is not a file.\n" }
- }
- else {
- my @new = grep { -f } glob $_
- or warn "'$_' does not exist.\n";
- push @files, grep { !$seen{$_}++ } @new;
- }
- }
-}
-else {
- eval {
- require File::Find;
- File::Find::find(sub {
- $File::Find::name =~ /($srcext)$/i
- and push @files, $File::Find::name;
- }, '.');
- };
- if ($@) {
- @files = map { glob "*$_" } @srcext;
- }
-}
-
-if (!@ARGV || $opt{filter}) {
- my(@in, @out);
- my %xsc = map { /(.*)\.xs$/ ? ("$1.c" => 1, "$1.cc" => 1) : () } @files;
- for (@files) {
- my $out = exists $xsc{$_} || /\b\Q$ppport\E$/i || !/($srcext)$/i;
- push @{ $out ? \@out : \@in }, $_;
- }
- if (@ARGV && @out) {
- warning("Skipping the following files (use --nofilter to avoid this):\n| ", join "\n| ", @out);
- }
- @files = @in;
-}
-
-die "No input files given!\n" unless @files;
-
-my(%files, %global, %revreplace);
-%revreplace = reverse %replace;
-my $filename;
-my $patch_opened = 0;
-
-for $filename (@files) {
- unless (open IN, "<$filename") {
- warn "Unable to read from $filename: $!\n";
- next;
- }
-
- info("Scanning $filename ...");
-
- my $c = do { local $/; <IN> };
- close IN;
-
- my %file = (orig => $c, changes => 0);
-
- # Temporarily remove C/XS comments and strings from the code
- my @ccom;
-
- $c =~ s{
- ( ^$HS*\#$HS*include\b[^\r\n]+\b(?:\Q$ppport\E|XSUB\.h)\b[^\r\n]*
- | ^$HS*\#$HS*(?:define|elif|if(?:def)?)\b[^\r\n]* )
- | ( ^$HS*\#[^\r\n]*
- | "[^"\\]*(?:\\.[^"\\]*)*"
- | '[^'\\]*(?:\\.[^'\\]*)*'
- | / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]* ) )
- }{ defined $2 and push @ccom, $2;
- defined $1 ? $1 : "$ccs$#ccom$cce" }mgsex;
-
- $file{ccom} = \@ccom;
- $file{code} = $c;
- $file{has_inc_ppport} = $c =~ /^$HS*#$HS*include[^\r\n]+\b\Q$ppport\E\b/m;
-
- my $func;
-
- for $func (keys %API) {
- my $match = $func;
- $match .= "|$revreplace{$func}" if exists $revreplace{$func};
- if ($c =~ /\b(?:Perl_)?($match)\b/) {
- $file{uses_replace}{$1}++ if exists $revreplace{$func} && $1 eq $revreplace{$func};
- $file{uses_Perl}{$func}++ if $c =~ /\bPerl_$func\b/;
- if (exists $API{$func}{provided}) {
- $file{uses_provided}{$func}++;
- if (!exists $API{$func}{base} || $API{$func}{base} > $opt{'compat-version'}) {
- $file{uses}{$func}++;
- my @deps = rec_depend($func);
- if (@deps) {
- $file{uses_deps}{$func} = \@deps;
- for (@deps) {
- $file{uses}{$_} = 0 unless exists $file{uses}{$_};
- }
- }
- for ($func, @deps) {
- $file{needs}{$_} = 'static' if exists $need{$_};
- }
- }
- }
- if (exists $API{$func}{todo} && $API{$func}{todo} > $opt{'compat-version'}) {
- if ($c =~ /\b$func\b/) {
- $file{uses_todo}{$func}++;
- }
- }
- }
- }
-
- while ($c =~ /^$HS*#$HS*define$HS+(NEED_(\w+?)(_GLOBAL)?)\b/mg) {
- if (exists $need{$2}) {
- $file{defined $3 ? 'needed_global' : 'needed_static'}{$2}++;
- }
- else { warning("Possibly wrong #define $1 in $filename") }
- }
-
- for (qw(uses needs uses_todo needed_global needed_static)) {
- for $func (keys %{$file{$_}}) {
- push @{$global{$_}{$func}}, $filename;
- }
- }
-
- $files{$filename} = \%file;
-}
-
-# Globally resolve NEED_'s
-my $need;
-for $need (keys %{$global{needs}}) {
- if (@{$global{needs}{$need}} > 1) {
- my @targets = @{$global{needs}{$need}};
- my @t = grep $files{$_}{needed_global}{$need}, @targets;
- @targets = @t if @t;
- @t = grep /\.xs$/i, @targets;
- @targets = @t if @t;
- my $target = shift @targets;
- $files{$target}{needs}{$need} = 'global';
- for (@{$global{needs}{$need}}) {
- $files{$_}{needs}{$need} = 'extern' if $_ ne $target;
- }
- }
-}
-
-for $filename (@files) {
- exists $files{$filename} or next;
-
- info("=== Analyzing $filename ===");
-
- my %file = %{$files{$filename}};
- my $func;
- my $c = $file{code};
- my $warnings = 0;
-
- for $func (sort keys %{$file{uses_Perl}}) {
- if ($API{$func}{varargs}) {
- unless ($API{$func}{nothxarg}) {
- my $changes = ($c =~ s{\b(Perl_$func\s*\(\s*)(?!aTHX_?)(\)|[^\s)]*\))}
- { $1 . ($2 eq ')' ? 'aTHX' : 'aTHX_ ') . $2 }ge);
- if ($changes) {
- warning("Doesn't pass interpreter argument aTHX to Perl_$func");
- $file{changes} += $changes;
- }
- }
- }
- else {
- warning("Uses Perl_$func instead of $func");
- $file{changes} += ($c =~ s{\bPerl_$func(\s*)\((\s*aTHX_?)?\s*}
- {$func$1(}g);
- }
- }
-
- for $func (sort keys %{$file{uses_replace}}) {
- warning("Uses $func instead of $replace{$func}");
- $file{changes} += ($c =~ s/\b$func\b/$replace{$func}/g);
- }
-
- for $func (sort keys %{$file{uses_provided}}) {
- if ($file{uses}{$func}) {
- if (exists $file{uses_deps}{$func}) {
- diag("Uses $func, which depends on ", join(', ', @{$file{uses_deps}{$func}}));
- }
- else {
- diag("Uses $func");
- }
- }
- $warnings += hint($func);
- }
-
- unless ($opt{quiet}) {
- for $func (sort keys %{$file{uses_todo}}) {
- print "*** WARNING: Uses $func, which may not be portable below perl ",
- format_version($API{$func}{todo}), ", even with '$ppport'\n";
- $warnings++;
- }
- }
-
- for $func (sort keys %{$file{needed_static}}) {
- my $message = '';
- if (not exists $file{uses}{$func}) {
- $message = "No need to define NEED_$func if $func is never used";
- }
- elsif (exists $file{needs}{$func} && $file{needs}{$func} ne 'static') {
- $message = "No need to define NEED_$func when already needed globally";
- }
- if ($message) {
- diag($message);
- $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_$func\b.*$LF//mg);
- }
- }
-
- for $func (sort keys %{$file{needed_global}}) {
- my $message = '';
- if (not exists $global{uses}{$func}) {
- $message = "No need to define NEED_${func}_GLOBAL if $func is never used";
- }
- elsif (exists $file{needs}{$func}) {
- if ($file{needs}{$func} eq 'extern') {
- $message = "No need to define NEED_${func}_GLOBAL when already needed globally";
- }
- elsif ($file{needs}{$func} eq 'static') {
- $message = "No need to define NEED_${func}_GLOBAL when only used in this file";
- }
- }
- if ($message) {
- diag($message);
- $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_${func}_GLOBAL\b.*$LF//mg);
- }
- }
-
- $file{needs_inc_ppport} = keys %{$file{uses}};
-
- if ($file{needs_inc_ppport}) {
- my $pp = '';
-
- for $func (sort keys %{$file{needs}}) {
- my $type = $file{needs}{$func};
- next if $type eq 'extern';
- my $suffix = $type eq 'global' ? '_GLOBAL' : '';
- unless (exists $file{"needed_$type"}{$func}) {
- if ($type eq 'global') {
- diag("Files [@{$global{needs}{$func}}] need $func, adding global request");
- }
- else {
- diag("File needs $func, adding static request");
- }
- $pp .= "#define NEED_$func$suffix\n";
- }
- }
-
- if ($pp && ($c =~ s/^(?=$HS*#$HS*define$HS+NEED_\w+)/$pp/m)) {
- $pp = '';
- $file{changes}++;
- }
-
- unless ($file{has_inc_ppport}) {
- diag("Needs to include '$ppport'");
- $pp .= qq(#include "$ppport"\n)
- }
-
- if ($pp) {
- $file{changes} += ($c =~ s/^($HS*#$HS*define$HS+NEED_\w+.*?)^/$1$pp/ms)
- || ($c =~ s/^(?=$HS*#$HS*include.*\Q$ppport\E)/$pp/m)
- || ($c =~ s/^($HS*#$HS*include.*XSUB.*\s*?)^/$1$pp/m)
- || ($c =~ s/^/$pp/);
- }
- }
- else {
- if ($file{has_inc_ppport}) {
- diag("No need to include '$ppport'");
- $file{changes} += ($c =~ s/^$HS*?#$HS*include.*\Q$ppport\E.*?$LF//m);
- }
- }
-
- # put back in our C comments
- my $ix;
- my $cppc = 0;
- my @ccom = @{$file{ccom}};
- for $ix (0 .. $#ccom) {
- if (!$opt{cplusplus} && $ccom[$ix] =~ s!^//!!) {
- $cppc++;
- $file{changes} += $c =~ s/$rccs$ix$rcce/$ccs$ccom[$ix] $cce/;
- }
- else {
- $c =~ s/$rccs$ix$rcce/$ccom[$ix]/;
- }
- }
-
- if ($cppc) {
- my $s = $cppc != 1 ? 's' : '';
- warning("Uses $cppc C++ style comment$s, which is not portable");
- }
-
- my $s = $warnings != 1 ? 's' : '';
- my $warn = $warnings ? " ($warnings warning$s)" : '';
- info("Analysis completed$warn");
-
- if ($file{changes}) {
- if (exists $opt{copy}) {
- my $newfile = "$filename$opt{copy}";
- if (-e $newfile) {
- error("'$newfile' already exists, refusing to write copy of '$filename'");
- }
- else {
- local *F;
- if (open F, ">$newfile") {
- info("Writing copy of '$filename' with changes to '$newfile'");
- print F $c;
- close F;
- }
- else {
- error("Cannot open '$newfile' for writing: $!");
- }
- }
- }
- elsif (exists $opt{patch} || $opt{changes}) {
- if (exists $opt{patch}) {
- unless ($patch_opened) {
- if (open PATCH, ">$opt{patch}") {
- $patch_opened = 1;
- }
- else {
- error("Cannot open '$opt{patch}' for writing: $!");
- delete $opt{patch};
- $opt{changes} = 1;
- goto fallback;
- }
- }
- mydiff(\*PATCH, $filename, $c);
- }
- else {
-fallback:
- info("Suggested changes:");
- mydiff(\*STDOUT, $filename, $c);
- }
- }
- else {
- my $s = $file{changes} == 1 ? '' : 's';
- info("$file{changes} potentially required change$s detected");
- }
- }
- else {
- info("Looks good");
- }
-}
-
-close PATCH if $patch_opened;
-
-exit 0;
-
-
-sub try_use { eval "use @_;"; return $@ eq '' }
-
-sub mydiff
-{
- local *F = shift;
- my($file, $str) = @_;
- my $diff;
-
- if (exists $opt{diff}) {
- $diff = run_diff($opt{diff}, $file, $str);
- }
-
- if (!defined $diff and try_use('Text::Diff')) {
- $diff = Text::Diff::diff($file, \$str, { STYLE => 'Unified' });
- $diff = <<HEADER . $diff;
---- $file
-+++ $file.patched
-HEADER
- }
-
- if (!defined $diff) {
- $diff = run_diff('diff -u', $file, $str);
- }
-
- if (!defined $diff) {
- $diff = run_diff('diff', $file, $str);
- }
-
- if (!defined $diff) {
- error("Cannot generate a diff. Please install Text::Diff or use --copy.");
- return;
- }
-
- print F $diff;
-}
-
-sub run_diff
-{
- my($prog, $file, $str) = @_;
- my $tmp = 'dppptemp';
- my $suf = 'aaa';
- my $diff = '';
- local *F;
-
- while (-e "$tmp.$suf") { $suf++ }
- $tmp = "$tmp.$suf";
-
- if (open F, ">$tmp") {
- print F $str;
- close F;
-
- if (open F, "$prog $file $tmp |") {
- while (<F>) {
- s/\Q$tmp\E/$file.patched/;
- $diff .= $_;
- }
- close F;
- unlink $tmp;
- return $diff;
- }
-
- unlink $tmp;
- }
- else {
- error("Cannot open '$tmp' for writing: $!");
- }
-
- return undef;
-}
-
-sub rec_depend
-{
- my($func, $seen) = @_;
- return () unless exists $depends{$func};
- $seen = {%{$seen||{}}};
- return () if $seen->{$func}++;
- my %s;
- grep !$s{$_}++, map { ($_, rec_depend($_, $seen)) } @{$depends{$func}};
-}
-
-sub parse_version
-{
- my $ver = shift;
-
- if ($ver =~ /^(\d+)\.(\d+)\.(\d+)$/) {
- return ($1, $2, $3);
- }
- elsif ($ver !~ /^\d+\.[\d_]+$/) {
- die "cannot parse version '$ver'\n";
- }
-
- $ver =~ s/_//g;
- $ver =~ s/$/000000/;
-
- my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/;
-
- $v = int $v;
- $s = int $s;
-
- if ($r < 5 || ($r == 5 && $v < 6)) {
- if ($s % 10) {
- die "cannot parse version '$ver'\n";
- }
- }
-
- return ($r, $v, $s);
-}
-
-sub format_version
-{
- my $ver = shift;
-
- $ver =~ s/$/000000/;
- my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/;
-
- $v = int $v;
- $s = int $s;
-
- if ($r < 5 || ($r == 5 && $v < 6)) {
- if ($s % 10) {
- die "invalid version '$ver'\n";
- }
- $s /= 10;
-
- $ver = sprintf "%d.%03d", $r, $v;
- $s > 0 and $ver .= sprintf "_%02d", $s;
-
- return $ver;
- }
-
- return sprintf "%d.%d.%d", $r, $v, $s;
-}
-
-sub info
-{
- $opt{quiet} and return;
- print @_, "\n";
-}
-
-sub diag
-{
- $opt{quiet} and return;
- $opt{diag} and print @_, "\n";
-}
-
-sub warning
-{
- $opt{quiet} and return;
- print "*** ", @_, "\n";
-}
-
-sub error
-{
- print "*** ERROR: ", @_, "\n";
-}
-
-my %given_hints;
-my %given_warnings;
-sub hint
-{
- $opt{quiet} and return;
- my $func = shift;
- my $rv = 0;
- if (exists $warnings{$func} && !$given_warnings{$func}++) {
- my $warn = $warnings{$func};
- $warn =~ s!^!*** !mg;
- print "*** WARNING: $func\n", $warn;
- $rv++;
- }
- if ($opt{hints} && exists $hints{$func} && !$given_hints{$func}++) {
- my $hint = $hints{$func};
- $hint =~ s/^/ /mg;
- print " --- hint for $func ---\n", $hint;
- }
- $rv;
-}
-
-sub usage
-{
- my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms;
- my %M = ( 'I' => '*' );
- $usage =~ s/^\s*perl\s+\S+/$^X $0/;
- $usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g;
-
- print <<ENDUSAGE;
-
-Usage: $usage
-
-See perldoc $0 for details.
-
-ENDUSAGE
-
- exit 2;
-}
-
-sub strip
-{
- my $self = do { local(@ARGV,$/)=($0); <> };
- my($copy) = $self =~ /^=head\d\s+COPYRIGHT\s*^(.*?)^=\w+/ms;
- $copy =~ s/^(?=\S+)/ /gms;
- $self =~ s/^$HS+Do NOT edit.*?(?=^-)/$copy/ms;
- $self =~ s/^SKIP.*(?=^__DATA__)/SKIP
-if (\@ARGV && \$ARGV[0] eq '--unstrip') {
- eval { require Devel::PPPort };
- \$@ and die "Cannot require Devel::PPPort, please install.\\n";
- if (eval \$Devel::PPPort::VERSION < $VERSION) {
- die "$0 was originally generated with Devel::PPPort $VERSION.\\n"
- . "Your Devel::PPPort is only version \$Devel::PPPort::VERSION.\\n"
- . "Please install a newer version, or --unstrip will not work.\\n";
- }
- Devel::PPPort::WriteFile(\$0);
- exit 0;
-}
-print <<END;
-
-Sorry, but this is a stripped version of \$0.
-
-To be able to use its original script and doc functionality,
-please try to regenerate this file using:
-
- \$^X \$0 --unstrip
-
-END
-/ms;
- my($pl, $c) = $self =~ /(.*^__DATA__)(.*)/ms;
- $c =~ s{
- / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]*)
- | ( "[^"\\]*(?:\\.[^"\\]*)*"
- | '[^'\\]*(?:\\.[^'\\]*)*' )
- | ($HS+) }{ defined $2 ? ' ' : ($1 || '') }gsex;
- $c =~ s!\s+$!!mg;
- $c =~ s!^$LF!!mg;
- $c =~ s!^\s*#\s*!#!mg;
- $c =~ s!^\s+!!mg;
-
- open OUT, ">$0" or die "cannot strip $0: $!\n";
- print OUT "$pl$c\n";
-
- exit 0;
-}
-
-__DATA__
-*/
-
-#ifndef _P_P_PORTABILITY_H_
-#define _P_P_PORTABILITY_H_
-
-#ifndef DPPP_NAMESPACE
-# define DPPP_NAMESPACE DPPP_
-#endif
-
-#define DPPP_CAT2(x,y) CAT2(x,y)
-#define DPPP_(name) DPPP_CAT2(DPPP_NAMESPACE, name)
-
-#ifndef PERL_REVISION
-# if !defined(__PATCHLEVEL_H_INCLUDED__) && !(defined(PATCHLEVEL) && defined(SUBVERSION))
-# define PERL_PATCHLEVEL_H_IMPLICIT
-# include <patchlevel.h>
-# endif
-# if !(defined(PERL_VERSION) || (defined(SUBVERSION) && defined(PATCHLEVEL)))
-# include <could_not_find_Perl_patchlevel.h>
-# endif
-# ifndef PERL_REVISION
-# define PERL_REVISION (5)
- /* Replace: 1 */
-# define PERL_VERSION PATCHLEVEL
-# define PERL_SUBVERSION SUBVERSION
- /* Replace PERL_PATCHLEVEL with PERL_VERSION */
- /* Replace: 0 */
-# endif
-#endif
-
-#define _dpppDEC2BCD(dec) ((((dec)/100)<<8)|((((dec)%100)/10)<<4)|((dec)%10))
-#define PERL_BCDVERSION ((_dpppDEC2BCD(PERL_REVISION)<<24)|(_dpppDEC2BCD(PERL_VERSION)<<12)|_dpppDEC2BCD(PERL_SUBVERSION))
-
-/* It is very unlikely that anyone will try to use this with Perl 6
- (or greater), but who knows.
- */
-#if PERL_REVISION != 5
-# error ppport.h only works with Perl version 5
-#endif /* PERL_REVISION != 5 */
-#ifndef dTHR
-# define dTHR dNOOP
-#endif
-#ifndef dTHX
-# define dTHX dNOOP
-#endif
-
-#ifndef dTHXa
-# define dTHXa(x) dNOOP
-#endif
-#ifndef pTHX
-# define pTHX void
-#endif
-
-#ifndef pTHX_
-# define pTHX_
-#endif
-
-#ifndef aTHX
-# define aTHX
-#endif
-
-#ifndef aTHX_
-# define aTHX_
-#endif
-
-#if (PERL_BCDVERSION < 0x5006000)
-# ifdef USE_THREADS
-# define aTHXR thr
-# define aTHXR_ thr,
-# else
-# define aTHXR
-# define aTHXR_
-# endif
-# define dTHXR dTHR
-#else
-# define aTHXR aTHX
-# define aTHXR_ aTHX_
-# define dTHXR dTHX
-#endif
-#ifndef dTHXoa
-# define dTHXoa(x) dTHXa(x)
-#endif
-
-#ifdef I_LIMITS
-# include <limits.h>
-#endif
-
-#ifndef PERL_UCHAR_MIN
-# define PERL_UCHAR_MIN ((unsigned char)0)
-#endif
-
-#ifndef PERL_UCHAR_MAX
-# ifdef UCHAR_MAX
-# define PERL_UCHAR_MAX ((unsigned char)UCHAR_MAX)
-# else
-# ifdef MAXUCHAR
-# define PERL_UCHAR_MAX ((unsigned char)MAXUCHAR)
-# else
-# define PERL_UCHAR_MAX ((unsigned char)~(unsigned)0)
-# endif
-# endif
-#endif
-
-#ifndef PERL_USHORT_MIN
-# define PERL_USHORT_MIN ((unsigned short)0)
-#endif
-
-#ifndef PERL_USHORT_MAX
-# ifdef USHORT_MAX
-# define PERL_USHORT_MAX ((unsigned short)USHORT_MAX)
-# else
-# ifdef MAXUSHORT
-# define PERL_USHORT_MAX ((unsigned short)MAXUSHORT)
-# else
-# ifdef USHRT_MAX
-# define PERL_USHORT_MAX ((unsigned short)USHRT_MAX)
-# else
-# define PERL_USHORT_MAX ((unsigned short)~(unsigned)0)
-# endif
-# endif
-# endif
-#endif
-
-#ifndef PERL_SHORT_MAX
-# ifdef SHORT_MAX
-# define PERL_SHORT_MAX ((short)SHORT_MAX)
-# else
-# ifdef MAXSHORT /* Often used in <values.h> */
-# define PERL_SHORT_MAX ((short)MAXSHORT)
-# else
-# ifdef SHRT_MAX
-# define PERL_SHORT_MAX ((short)SHRT_MAX)
-# else
-# define PERL_SHORT_MAX ((short) (PERL_USHORT_MAX >> 1))
-# endif
-# endif
-# endif
-#endif
-
-#ifndef PERL_SHORT_MIN
-# ifdef SHORT_MIN
-# define PERL_SHORT_MIN ((short)SHORT_MIN)
-# else
-# ifdef MINSHORT
-# define PERL_SHORT_MIN ((short)MINSHORT)
-# else
-# ifdef SHRT_MIN
-# define PERL_SHORT_MIN ((short)SHRT_MIN)
-# else
-# define PERL_SHORT_MIN (-PERL_SHORT_MAX - ((3 & -1) == 3))
-# endif
-# endif
-# endif
-#endif
-
-#ifndef PERL_UINT_MAX
-# ifdef UINT_MAX
-# define PERL_UINT_MAX ((unsigned int)UINT_MAX)
-# else
-# ifdef MAXUINT
-# define PERL_UINT_MAX ((unsigned int)MAXUINT)
-# else
-# define PERL_UINT_MAX (~(unsigned int)0)
-# endif
-# endif
-#endif
-
-#ifndef PERL_UINT_MIN
-# define PERL_UINT_MIN ((unsigned int)0)
-#endif
-
-#ifndef PERL_INT_MAX
-# ifdef INT_MAX
-# define PERL_INT_MAX ((int)INT_MAX)
-# else
-# ifdef MAXINT /* Often used in <values.h> */
-# define PERL_INT_MAX ((int)MAXINT)
-# else
-# define PERL_INT_MAX ((int)(PERL_UINT_MAX >> 1))
-# endif
-# endif
-#endif
-
-#ifndef PERL_INT_MIN
-# ifdef INT_MIN
-# define PERL_INT_MIN ((int)INT_MIN)
-# else
-# ifdef MININT
-# define PERL_INT_MIN ((int)MININT)
-# else
-# define PERL_INT_MIN (-PERL_INT_MAX - ((3 & -1) == 3))
-# endif
-# endif
-#endif
-
-#ifndef PERL_ULONG_MAX
-# ifdef ULONG_MAX
-# define PERL_ULONG_MAX ((unsigned long)ULONG_MAX)
-# else
-# ifdef MAXULONG
-# define PERL_ULONG_MAX ((unsigned long)MAXULONG)
-# else
-# define PERL_ULONG_MAX (~(unsigned long)0)
-# endif
-# endif
-#endif
-
-#ifndef PERL_ULONG_MIN
-# define PERL_ULONG_MIN ((unsigned long)0L)
-#endif
-
-#ifndef PERL_LONG_MAX
-# ifdef LONG_MAX
-# define PERL_LONG_MAX ((long)LONG_MAX)
-# else
-# ifdef MAXLONG
-# define PERL_LONG_MAX ((long)MAXLONG)
-# else
-# define PERL_LONG_MAX ((long) (PERL_ULONG_MAX >> 1))
-# endif
-# endif
-#endif
-
-#ifndef PERL_LONG_MIN
-# ifdef LONG_MIN
-# define PERL_LONG_MIN ((long)LONG_MIN)
-# else
-# ifdef MINLONG
-# define PERL_LONG_MIN ((long)MINLONG)
-# else
-# define PERL_LONG_MIN (-PERL_LONG_MAX - ((3 & -1) == 3))
-# endif
-# endif
-#endif
-
-#if defined(HAS_QUAD) && (defined(convex) || defined(uts))
-# ifndef PERL_UQUAD_MAX
-# ifdef ULONGLONG_MAX
-# define PERL_UQUAD_MAX ((unsigned long long)ULONGLONG_MAX)
-# else
-# ifdef MAXULONGLONG
-# define PERL_UQUAD_MAX ((unsigned long long)MAXULONGLONG)
-# else
-# define PERL_UQUAD_MAX (~(unsigned long long)0)
-# endif
-# endif
-# endif
-
-# ifndef PERL_UQUAD_MIN
-# define PERL_UQUAD_MIN ((unsigned long long)0L)
-# endif
-
-# ifndef PERL_QUAD_MAX
-# ifdef LONGLONG_MAX
-# define PERL_QUAD_MAX ((long long)LONGLONG_MAX)
-# else
-# ifdef MAXLONGLONG
-# define PERL_QUAD_MAX ((long long)MAXLONGLONG)
-# else
-# define PERL_QUAD_MAX ((long long) (PERL_UQUAD_MAX >> 1))
-# endif
-# endif
-# endif
-
-# ifndef PERL_QUAD_MIN
-# ifdef LONGLONG_MIN
-# define PERL_QUAD_MIN ((long long)LONGLONG_MIN)
-# else
-# ifdef MINLONGLONG
-# define PERL_QUAD_MIN ((long long)MINLONGLONG)
-# else
-# define PERL_QUAD_MIN (-PERL_QUAD_MAX - ((3 & -1) == 3))
-# endif
-# endif
-# endif
-#endif
-
-/* This is based on code from 5.003 perl.h */
-#ifdef HAS_QUAD
-# ifdef cray
-#ifndef IVTYPE
-# define IVTYPE int
-#endif
-
-#ifndef IV_MIN
-# define IV_MIN PERL_INT_MIN
-#endif
-
-#ifndef IV_MAX
-# define IV_MAX PERL_INT_MAX
-#endif
-
-#ifndef UV_MIN
-# define UV_MIN PERL_UINT_MIN
-#endif
-
-#ifndef UV_MAX
-# define UV_MAX PERL_UINT_MAX
-#endif
-
-# ifdef INTSIZE
-#ifndef IVSIZE
-# define IVSIZE INTSIZE
-#endif
-
-# endif
-# else
-# if defined(convex) || defined(uts)
-#ifndef IVTYPE
-# define IVTYPE long long
-#endif
-
-#ifndef IV_MIN
-# define IV_MIN PERL_QUAD_MIN
-#endif
-
-#ifndef IV_MAX
-# define IV_MAX PERL_QUAD_MAX
-#endif
-
-#ifndef UV_MIN
-# define UV_MIN PERL_UQUAD_MIN
-#endif
-
-#ifndef UV_MAX
-# define UV_MAX PERL_UQUAD_MAX
-#endif
-
-# ifdef LONGLONGSIZE
-#ifndef IVSIZE
-# define IVSIZE LONGLONGSIZE
-#endif
-
-# endif
-# else
-#ifndef IVTYPE
-# define IVTYPE long
-#endif
-
-#ifndef IV_MIN
-# define IV_MIN PERL_LONG_MIN
-#endif
-
-#ifndef IV_MAX
-# define IV_MAX PERL_LONG_MAX
-#endif
-
-#ifndef UV_MIN
-# define UV_MIN PERL_ULONG_MIN
-#endif
-
-#ifndef UV_MAX
-# define UV_MAX PERL_ULONG_MAX
-#endif
-
-# ifdef LONGSIZE
-#ifndef IVSIZE
-# define IVSIZE LONGSIZE
-#endif
-
-# endif
-# endif
-# endif
-#ifndef IVSIZE
-# define IVSIZE 8
-#endif
-
-#ifndef LONGSIZE
-# define LONGSIZE 8
-#endif
-
-#ifndef PERL_QUAD_MIN
-# define PERL_QUAD_MIN IV_MIN
-#endif
-
-#ifndef PERL_QUAD_MAX
-# define PERL_QUAD_MAX IV_MAX
-#endif
-
-#ifndef PERL_UQUAD_MIN
-# define PERL_UQUAD_MIN UV_MIN
-#endif
-
-#ifndef PERL_UQUAD_MAX
-# define PERL_UQUAD_MAX UV_MAX
-#endif
-
-#else
-#ifndef IVTYPE
-# define IVTYPE long
-#endif
-
-#ifndef LONGSIZE
-# define LONGSIZE 4
-#endif
-
-#ifndef IV_MIN
-# define IV_MIN PERL_LONG_MIN
-#endif
-
-#ifndef IV_MAX
-# define IV_MAX PERL_LONG_MAX
-#endif
-
-#ifndef UV_MIN
-# define UV_MIN PERL_ULONG_MIN
-#endif
-
-#ifndef UV_MAX
-# define UV_MAX PERL_ULONG_MAX
-#endif
-
-#endif
-
-#ifndef IVSIZE
-# ifdef LONGSIZE
-# define IVSIZE LONGSIZE
-# else
-# define IVSIZE 4 /* A bold guess, but the best we can make. */
-# endif
-#endif
-#ifndef UVTYPE
-# define UVTYPE unsigned IVTYPE
-#endif
-
-#ifndef UVSIZE
-# define UVSIZE IVSIZE
-#endif
-#ifndef sv_setuv
-# define sv_setuv(sv, uv) \
- STMT_START { \
- UV TeMpUv = uv; \
- if (TeMpUv <= IV_MAX) \
- sv_setiv(sv, TeMpUv); \
- else \
- sv_setnv(sv, (double)TeMpUv); \
- } STMT_END
-#endif
-#ifndef newSVuv
-# define newSVuv(uv) ((uv) <= IV_MAX ? newSViv((IV)uv) : newSVnv((NV)uv))
-#endif
-#ifndef sv_2uv
-# define sv_2uv(sv) ((PL_Sv = (sv)), (UV) (SvNOK(PL_Sv) ? SvNV(PL_Sv) : sv_2nv(PL_Sv)))
-#endif
-
-#ifndef SvUVX
-# define SvUVX(sv) ((UV)SvIVX(sv))
-#endif
-
-#ifndef SvUVXx
-# define SvUVXx(sv) SvUVX(sv)
-#endif
-
-#ifndef SvUV
-# define SvUV(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv(sv))
-#endif
-
-#ifndef SvUVx
-# define SvUVx(sv) ((PL_Sv = (sv)), SvUV(PL_Sv))
-#endif
-
-/* Hint: sv_uv
- * Always use the SvUVx() macro instead of sv_uv().
- */
-#ifndef sv_uv
-# define sv_uv(sv) SvUVx(sv)
-#endif
-
-#if !defined(SvUOK) && defined(SvIOK_UV)
-# define SvUOK(sv) SvIOK_UV(sv)
-#endif
-#ifndef XST_mUV
-# define XST_mUV(i,v) (ST(i) = sv_2mortal(newSVuv(v)) )
-#endif
-
-#ifndef XSRETURN_UV
-# define XSRETURN_UV(v) STMT_START { XST_mUV(0,v); XSRETURN(1); } STMT_END
-#endif
-#ifndef PUSHu
-# define PUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); PUSHTARG; } STMT_END
-#endif
-
-#ifndef XPUSHu
-# define XPUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); XPUSHTARG; } STMT_END
-#endif
-
-#ifdef HAS_MEMCMP
-#ifndef memNE
-# define memNE(s1,s2,l) (memcmp(s1,s2,l))
-#endif
-
-#ifndef memEQ
-# define memEQ(s1,s2,l) (!memcmp(s1,s2,l))
-#endif
-
-#else
-#ifndef memNE
-# define memNE(s1,s2,l) (bcmp(s1,s2,l))
-#endif
-
-#ifndef memEQ
-# define memEQ(s1,s2,l) (!bcmp(s1,s2,l))
-#endif
-
-#endif
-#ifndef memEQs
-# define memEQs(s1, l, s2) \
- (sizeof(s2)-1 == l && memEQ(s1, (s2 ""), (sizeof(s2)-1)))
-#endif
-
-#ifndef memNEs
-# define memNEs(s1, l, s2) !memEQs(s1, l, s2)
-#endif
-#ifndef MoveD
-# define MoveD(s,d,n,t) memmove((char*)(d),(char*)(s), (n) * sizeof(t))
-#endif
-
-#ifndef CopyD
-# define CopyD(s,d,n,t) memcpy((char*)(d),(char*)(s), (n) * sizeof(t))
-#endif
-
-#ifdef HAS_MEMSET
-#ifndef ZeroD
-# define ZeroD(d,n,t) memzero((char*)(d), (n) * sizeof(t))
-#endif
-
-#else
-#ifndef ZeroD
-# define ZeroD(d,n,t) ((void)memzero((char*)(d), (n) * sizeof(t)), d)
-#endif
-
-#endif
-#ifndef PoisonWith
-# define PoisonWith(d,n,t,b) (void)memset((char*)(d), (U8)(b), (n) * sizeof(t))
-#endif
-
-#ifndef PoisonNew
-# define PoisonNew(d,n,t) PoisonWith(d,n,t,0xAB)
-#endif
-
-#ifndef PoisonFree
-# define PoisonFree(d,n,t) PoisonWith(d,n,t,0xEF)
-#endif
-
-#ifndef Poison
-# define Poison(d,n,t) PoisonFree(d,n,t)
-#endif
-#ifndef Newx
-# define Newx(v,n,t) New(0,v,n,t)
-#endif
-
-#ifndef Newxc
-# define Newxc(v,n,t,c) Newc(0,v,n,t,c)
-#endif
-
-#ifndef Newxz
-# define Newxz(v,n,t) Newz(0,v,n,t)
-#endif
-
-#ifndef PERL_UNUSED_DECL
-# ifdef HASATTRIBUTE
-# if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
-# define PERL_UNUSED_DECL
-# else
-# define PERL_UNUSED_DECL __attribute__((unused))
-# endif
-# else
-# define PERL_UNUSED_DECL
-# endif
-#endif
-
-#ifndef PERL_UNUSED_ARG
-# if defined(lint) && defined(S_SPLINT_S) /* www.splint.org */
-# include <note.h>
-# define PERL_UNUSED_ARG(x) NOTE(ARGUNUSED(x))
-# else
-# define PERL_UNUSED_ARG(x) ((void)x)
-# endif
-#endif
-
-#ifndef PERL_UNUSED_VAR
-# define PERL_UNUSED_VAR(x) ((void)x)
-#endif
-
-#ifndef PERL_UNUSED_CONTEXT
-# ifdef USE_ITHREADS
-# define PERL_UNUSED_CONTEXT PERL_UNUSED_ARG(my_perl)
-# else
-# define PERL_UNUSED_CONTEXT
-# endif
-#endif
-#ifndef NOOP
-# define NOOP /*EMPTY*/(void)0
-#endif
-
-#ifndef dNOOP
-# define dNOOP extern int /*@unused@*/ Perl___notused PERL_UNUSED_DECL
-#endif
-
-#ifndef NVTYPE
-# if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
-# define NVTYPE long double
-# else
-# define NVTYPE double
-# endif
-typedef NVTYPE NV;
-#endif
-
-#ifndef INT2PTR
-# if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE)
-# define PTRV UV
-# define INT2PTR(any,d) (any)(d)
-# else
-# if PTRSIZE == LONGSIZE
-# define PTRV unsigned long
-# else
-# define PTRV unsigned
-# endif
-# define INT2PTR(any,d) (any)(PTRV)(d)
-# endif
-#endif
-
-#ifndef PTR2ul
-# if PTRSIZE == LONGSIZE
-# define PTR2ul(p) (unsigned long)(p)
-# else
-# define PTR2ul(p) INT2PTR(unsigned long,p)
-# endif
-#endif
-#ifndef PTR2nat
-# define PTR2nat(p) (PTRV)(p)
-#endif
-
-#ifndef NUM2PTR
-# define NUM2PTR(any,d) (any)PTR2nat(d)
-#endif
-
-#ifndef PTR2IV
-# define PTR2IV(p) INT2PTR(IV,p)
-#endif
-
-#ifndef PTR2UV
-# define PTR2UV(p) INT2PTR(UV,p)
-#endif
-
-#ifndef PTR2NV
-# define PTR2NV(p) NUM2PTR(NV,p)
-#endif
-
-#undef START_EXTERN_C
-#undef END_EXTERN_C
-#undef EXTERN_C
-#ifdef __cplusplus
-# define START_EXTERN_C extern "C" {
-# define END_EXTERN_C }
-# define EXTERN_C extern "C"
-#else
-# define START_EXTERN_C
-# define END_EXTERN_C
-# define EXTERN_C extern
-#endif
-
-#if defined(PERL_GCC_PEDANTIC)
-# ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN
-# define PERL_GCC_BRACE_GROUPS_FORBIDDEN
-# endif
-#endif
-
-#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus)
-# ifndef PERL_USE_GCC_BRACE_GROUPS
-# define PERL_USE_GCC_BRACE_GROUPS
-# endif
-#endif
-
-#undef STMT_START
-#undef STMT_END
-#ifdef PERL_USE_GCC_BRACE_GROUPS
-# define STMT_START (void)( /* gcc supports ``({ STATEMENTS; })'' */
-# define STMT_END )
-#else
-# if defined(VOIDFLAGS) && (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && !defined(__GNUC__)
-# define STMT_START if (1)
-# define STMT_END else (void)0
-# else
-# define STMT_START do
-# define STMT_END while (0)
-# endif
-#endif
-#ifndef boolSV
-# define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)
-#endif
-
-/* DEFSV appears first in 5.004_56 */
-#ifndef DEFSV
-# define DEFSV GvSV(PL_defgv)
-#endif
-
-#ifndef SAVE_DEFSV
-# define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
-#endif
-
-#ifndef DEFSV_set
-# define DEFSV_set(sv) (DEFSV = (sv))
-#endif
-
-/* Older perls (<=5.003) lack AvFILLp */
-#ifndef AvFILLp
-# define AvFILLp AvFILL
-#endif
-#ifndef ERRSV
-# define ERRSV get_sv("@",FALSE)
-#endif
-
-/* Hint: gv_stashpvn
- * This function's backport doesn't support the length parameter, but
- * rather ignores it. Portability can only be ensured if the length
- * parameter is used for speed reasons, but the length can always be
- * correctly computed from the string argument.
- */
-#ifndef gv_stashpvn
-# define gv_stashpvn(str,len,create) gv_stashpv(str,create)
-#endif
-
-/* Replace: 1 */
-#ifndef get_cv
-# define get_cv perl_get_cv
-#endif
-
-#ifndef get_sv
-# define get_sv perl_get_sv
-#endif
-
-#ifndef get_av
-# define get_av perl_get_av
-#endif
-
-#ifndef get_hv
-# define get_hv perl_get_hv
-#endif
-
-/* Replace: 0 */
-#ifndef dUNDERBAR
-# define dUNDERBAR dNOOP
-#endif
-
-#ifndef UNDERBAR
-# define UNDERBAR DEFSV
-#endif
-#ifndef dAX
-# define dAX I32 ax = MARK - PL_stack_base + 1
-#endif
-
-#ifndef dITEMS
-# define dITEMS I32 items = SP - MARK
-#endif
-#ifndef dXSTARG
-# define dXSTARG SV * targ = sv_newmortal()
-#endif
-#ifndef dAXMARK
-# define dAXMARK I32 ax = POPMARK; \
- register SV ** const mark = PL_stack_base + ax++
-#endif
-#ifndef XSprePUSH
-# define XSprePUSH (sp = PL_stack_base + ax - 1)
-#endif
-
-#if (PERL_BCDVERSION < 0x5005000)
-# undef XSRETURN
-# define XSRETURN(off) \
- STMT_START { \
- PL_stack_sp = PL_stack_base + ax + ((off) - 1); \
- return; \
- } STMT_END
-#endif
-#ifndef XSPROTO
-# define XSPROTO(name) void name(pTHX_ CV* cv)
-#endif
-
-#ifndef SVfARG
-# define SVfARG(p) ((void*)(p))
-#endif
-#ifndef PERL_ABS
-# define PERL_ABS(x) ((x) < 0 ? -(x) : (x))
-#endif
-#ifndef dVAR
-# define dVAR dNOOP
-#endif
-#ifndef SVf
-# define SVf "_"
-#endif
-#ifndef UTF8_MAXBYTES
-# define UTF8_MAXBYTES UTF8_MAXLEN
-#endif
-#ifndef CPERLscope
-# define CPERLscope(x) x
-#endif
-#ifndef PERL_HASH
-# define PERL_HASH(hash,str,len) \
- STMT_START { \
- const char *s_PeRlHaSh = str; \
- I32 i_PeRlHaSh = len; \
- U32 hash_PeRlHaSh = 0; \
- while (i_PeRlHaSh--) \
- hash_PeRlHaSh = hash_PeRlHaSh * 33 + *s_PeRlHaSh++; \
- (hash) = hash_PeRlHaSh; \
- } STMT_END
-#endif
-
-#ifndef PERLIO_FUNCS_DECL
-# ifdef PERLIO_FUNCS_CONST
-# define PERLIO_FUNCS_DECL(funcs) const PerlIO_funcs funcs
-# define PERLIO_FUNCS_CAST(funcs) (PerlIO_funcs*)(funcs)
-# else
-# define PERLIO_FUNCS_DECL(funcs) PerlIO_funcs funcs
-# define PERLIO_FUNCS_CAST(funcs) (funcs)
-# endif
-#endif
-
-/* provide these typedefs for older perls */
-#if (PERL_BCDVERSION < 0x5009003)
-
-# ifdef ARGSproto
-typedef OP* (CPERLscope(*Perl_ppaddr_t))(ARGSproto);
-# else
-typedef OP* (CPERLscope(*Perl_ppaddr_t))(pTHX);
-# endif
-
-typedef OP* (CPERLscope(*Perl_check_t)) (pTHX_ OP*);
-
-#endif
-#ifndef isPSXSPC
-# define isPSXSPC(c) (isSPACE(c) || (c) == '\v')
-#endif
-
-#ifndef isBLANK
-# define isBLANK(c) ((c) == ' ' || (c) == '\t')
-#endif
-
-#ifdef EBCDIC
-#ifndef isALNUMC
-# define isALNUMC(c) isalnum(c)
-#endif
-
-#ifndef isASCII
-# define isASCII(c) isascii(c)
-#endif
-
-#ifndef isCNTRL
-# define isCNTRL(c) iscntrl(c)
-#endif
-
-#ifndef isGRAPH
-# define isGRAPH(c) isgraph(c)
-#endif
-
-#ifndef isPRINT
-# define isPRINT(c) isprint(c)
-#endif
-
-#ifndef isPUNCT
-# define isPUNCT(c) ispunct(c)
-#endif
-
-#ifndef isXDIGIT
-# define isXDIGIT(c) isxdigit(c)
-#endif
-
-#else
-# if (PERL_BCDVERSION < 0x5010000)
-/* Hint: isPRINT
- * The implementation in older perl versions includes all of the
- * isSPACE() characters, which is wrong. The version provided by
- * Devel::PPPort always overrides a present buggy version.
- */
-# undef isPRINT
-# endif
-
-#ifdef HAS_QUAD
-# ifdef U64TYPE
-# define WIDEST_UTYPE U64TYPE
-# else
-# define WIDEST_UTYPE Quad_t
-# endif
-#else
-# define WIDEST_UTYPE U32
-#endif
-#ifndef isALNUMC
-# define isALNUMC(c) (isALPHA(c) || isDIGIT(c))
-#endif
-
-#ifndef isASCII
-# define isASCII(c) ((WIDEST_UTYPE) (c) <= 127)
-#endif
-
-#ifndef isCNTRL
-# define isCNTRL(c) ((WIDEST_UTYPE) (c) < ' ' || (c) == 127)
-#endif
-
-#ifndef isGRAPH
-# define isGRAPH(c) (isALNUM(c) || isPUNCT(c))
-#endif
-
-#ifndef isPRINT
-# define isPRINT(c) (((c) >= 32 && (c) < 127))
-#endif
-
-#ifndef isPUNCT
-# define isPUNCT(c) (((c) >= 33 && (c) <= 47) || ((c) >= 58 && (c) <= 64) || ((c) >= 91 && (c) <= 96) || ((c) >= 123 && (c) <= 126))
-#endif
-
-#ifndef isXDIGIT
-# define isXDIGIT(c) (isDIGIT(c) || ((c) >= 'a' && (c) <= 'f') || ((c) >= 'A' && (c) <= 'F'))
-#endif
-
-#endif
-
-/* Until we figure out how to support this in older perls... */
-#if (PERL_BCDVERSION >= 0x5008000)
-#ifndef HeUTF8
-# define HeUTF8(he) ((HeKLEN(he) == HEf_SVKEY) ? \
- SvUTF8(HeKEY_sv(he)) : \
- (U32)HeKUTF8(he))
-#endif
-
-#endif
-
-#ifndef PERL_SIGNALS_UNSAFE_FLAG
-
-#define PERL_SIGNALS_UNSAFE_FLAG 0x0001
-
-#if (PERL_BCDVERSION < 0x5008000)
-# define D_PPP_PERL_SIGNALS_INIT PERL_SIGNALS_UNSAFE_FLAG
-#else
-# define D_PPP_PERL_SIGNALS_INIT 0
-#endif
-
-#if defined(NEED_PL_signals)
-static U32 DPPP_(my_PL_signals) = D_PPP_PERL_SIGNALS_INIT;
-#elif defined(NEED_PL_signals_GLOBAL)
-U32 DPPP_(my_PL_signals) = D_PPP_PERL_SIGNALS_INIT;
-#else
-extern U32 DPPP_(my_PL_signals);
-#endif
-#define PL_signals DPPP_(my_PL_signals)
-
-#endif
-
-/* Hint: PL_ppaddr
- * Calling an op via PL_ppaddr requires passing a context argument
- * for threaded builds. Since the context argument is different for
- * 5.005 perls, you can use aTHXR (supplied by ppport.h), which will
- * automatically be defined as the correct argument.
- */
-
-#if (PERL_BCDVERSION <= 0x5005005)
-/* Replace: 1 */
-# define PL_ppaddr ppaddr
-# define PL_no_modify no_modify
-/* Replace: 0 */
-#endif
-
-#if (PERL_BCDVERSION <= 0x5004005)
-/* Replace: 1 */
-# define PL_DBsignal DBsignal
-# define PL_DBsingle DBsingle
-# define PL_DBsub DBsub
-# define PL_DBtrace DBtrace
-# define PL_Sv Sv
-# define PL_bufend bufend
-# define PL_bufptr bufptr
-# define PL_compiling compiling
-# define PL_copline copline
-# define PL_curcop curcop
-# define PL_curstash curstash
-# define PL_debstash debstash
-# define PL_defgv defgv
-# define PL_diehook diehook
-# define PL_dirty dirty
-# define PL_dowarn dowarn
-# define PL_errgv errgv
-# define PL_error_count error_count
-# define PL_expect expect
-# define PL_hexdigit hexdigit
-# define PL_hints hints
-# define PL_in_my in_my
-# define PL_laststatval laststatval
-# define PL_lex_state lex_state
-# define PL_lex_stuff lex_stuff
-# define PL_linestr linestr
-# define PL_na na
-# define PL_perl_destruct_level perl_destruct_level
-# define PL_perldb perldb
-# define PL_rsfp_filters rsfp_filters
-# define PL_rsfp rsfp
-# define PL_stack_base stack_base
-# define PL_stack_sp stack_sp
-# define PL_statcache statcache
-# define PL_stdingv stdingv
-# define PL_sv_arenaroot sv_arenaroot
-# define PL_sv_no sv_no
-# define PL_sv_undef sv_undef
-# define PL_sv_yes sv_yes
-# define PL_tainted tainted
-# define PL_tainting tainting
-# define PL_tokenbuf tokenbuf
-/* Replace: 0 */
-#endif
-
-/* Warning: PL_parser
- * For perl versions earlier than 5.9.5, this is an always
- * non-NULL dummy. Also, it cannot be dereferenced. Don't
- * use it if you can avoid is and unless you absolutely know
- * what you're doing.
- * If you always check that PL_parser is non-NULL, you can
- * define DPPP_PL_parser_NO_DUMMY to avoid the creation of
- * a dummy parser structure.
- */
-
-#if (PERL_BCDVERSION >= 0x5009005)
-# ifdef DPPP_PL_parser_NO_DUMMY
-# define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \
- (croak("panic: PL_parser == NULL in %s:%d", \
- __FILE__, __LINE__), (yy_parser *) NULL))->var)
-# else
-# ifdef DPPP_PL_parser_NO_DUMMY_WARNING
-# define D_PPP_parser_dummy_warning(var)
-# else
-# define D_PPP_parser_dummy_warning(var) \
- warn("warning: dummy PL_" #var " used in %s:%d", __FILE__, __LINE__),
-# endif
-# define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \
- (D_PPP_parser_dummy_warning(var) &DPPP_(dummy_PL_parser)))->var)
-#if defined(NEED_PL_parser)
-static yy_parser DPPP_(dummy_PL_parser);
-#elif defined(NEED_PL_parser_GLOBAL)
-yy_parser DPPP_(dummy_PL_parser);
-#else
-extern yy_parser DPPP_(dummy_PL_parser);
-#endif
-
-# endif
-
-/* PL_expect, PL_copline, PL_rsfp, PL_rsfp_filters, PL_linestr, PL_bufptr, PL_bufend, PL_lex_state, PL_lex_stuff, PL_tokenbuf depends on PL_parser */
-/* Warning: PL_expect, PL_copline, PL_rsfp, PL_rsfp_filters, PL_linestr, PL_bufptr, PL_bufend, PL_lex_state, PL_lex_stuff, PL_tokenbuf
- * Do not use this variable unless you know exactly what you're
- * doint. It is internal to the perl parser and may change or even
- * be removed in the future. As of perl 5.9.5, you have to check
- * for (PL_parser != NULL) for this variable to have any effect.
- * An always non-NULL PL_parser dummy is provided for earlier
- * perl versions.
- * If PL_parser is NULL when you try to access this variable, a
- * dummy is being accessed instead and a warning is issued unless
- * you define DPPP_PL_parser_NO_DUMMY_WARNING.
- * If DPPP_PL_parser_NO_DUMMY is defined, the code trying to access
- * this variable will croak with a panic message.
- */
-
-# define PL_expect D_PPP_my_PL_parser_var(expect)
-# define PL_copline D_PPP_my_PL_parser_var(copline)
-# define PL_rsfp D_PPP_my_PL_parser_var(rsfp)
-# define PL_rsfp_filters D_PPP_my_PL_parser_var(rsfp_filters)
-# define PL_linestr D_PPP_my_PL_parser_var(linestr)
-# define PL_bufptr D_PPP_my_PL_parser_var(bufptr)
-# define PL_bufend D_PPP_my_PL_parser_var(bufend)
-# define PL_lex_state D_PPP_my_PL_parser_var(lex_state)
-# define PL_lex_stuff D_PPP_my_PL_parser_var(lex_stuff)
-# define PL_tokenbuf D_PPP_my_PL_parser_var(tokenbuf)
-# define PL_in_my D_PPP_my_PL_parser_var(in_my)
-# define PL_in_my_stash D_PPP_my_PL_parser_var(in_my_stash)
-# define PL_error_count D_PPP_my_PL_parser_var(error_count)
-
-
-#else
-
-/* ensure that PL_parser != NULL and cannot be dereferenced */
-# define PL_parser ((void *) 1)
-
-#endif
-#ifndef mPUSHs
-# define mPUSHs(s) PUSHs(sv_2mortal(s))
-#endif
-
-#ifndef PUSHmortal
-# define PUSHmortal PUSHs(sv_newmortal())
-#endif
-
-#ifndef mPUSHp
-# define mPUSHp(p,l) sv_setpvn(PUSHmortal, (p), (l))
-#endif
-
-#ifndef mPUSHn
-# define mPUSHn(n) sv_setnv(PUSHmortal, (NV)(n))
-#endif
-
-#ifndef mPUSHi
-# define mPUSHi(i) sv_setiv(PUSHmortal, (IV)(i))
-#endif
-
-#ifndef mPUSHu
-# define mPUSHu(u) sv_setuv(PUSHmortal, (UV)(u))
-#endif
-#ifndef mXPUSHs
-# define mXPUSHs(s) XPUSHs(sv_2mortal(s))
-#endif
-
-#ifndef XPUSHmortal
-# define XPUSHmortal XPUSHs(sv_newmortal())
-#endif
-
-#ifndef mXPUSHp
-# define mXPUSHp(p,l) STMT_START { EXTEND(sp,1); sv_setpvn(PUSHmortal, (p), (l)); } STMT_END
-#endif
-
-#ifndef mXPUSHn
-# define mXPUSHn(n) STMT_START { EXTEND(sp,1); sv_setnv(PUSHmortal, (NV)(n)); } STMT_END
-#endif
-
-#ifndef mXPUSHi
-# define mXPUSHi(i) STMT_START { EXTEND(sp,1); sv_setiv(PUSHmortal, (IV)(i)); } STMT_END
-#endif
-
-#ifndef mXPUSHu
-# define mXPUSHu(u) STMT_START { EXTEND(sp,1); sv_setuv(PUSHmortal, (UV)(u)); } STMT_END
-#endif
-
-/* Replace: 1 */
-#ifndef call_sv
-# define call_sv perl_call_sv
-#endif
-
-#ifndef call_pv
-# define call_pv perl_call_pv
-#endif
-
-#ifndef call_argv
-# define call_argv perl_call_argv
-#endif
-
-#ifndef call_method
-# define call_method perl_call_method
-#endif
-#ifndef eval_sv
-# define eval_sv perl_eval_sv
-#endif
-
-/* Replace: 0 */
-#ifndef PERL_LOADMOD_DENY
-# define PERL_LOADMOD_DENY 0x1
-#endif
-
-#ifndef PERL_LOADMOD_NOIMPORT
-# define PERL_LOADMOD_NOIMPORT 0x2
-#endif
-
-#ifndef PERL_LOADMOD_IMPORT_OPS
-# define PERL_LOADMOD_IMPORT_OPS 0x4
-#endif
-
-#ifndef G_METHOD
-# define G_METHOD 64
-# ifdef call_sv
-# undef call_sv
-# endif
-# if (PERL_BCDVERSION < 0x5006000)
-# define call_sv(sv, flags) ((flags) & G_METHOD ? perl_call_method((char *) SvPV_nolen_const(sv), \
- (flags) & ~G_METHOD) : perl_call_sv(sv, flags))
-# else
-# define call_sv(sv, flags) ((flags) & G_METHOD ? Perl_call_method(aTHX_ (char *) SvPV_nolen_const(sv), \
- (flags) & ~G_METHOD) : Perl_call_sv(aTHX_ sv, flags))
-# endif
-#endif
-
-/* Replace perl_eval_pv with eval_pv */
-
-#ifndef eval_pv
-#if defined(NEED_eval_pv)
-static SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
-static
-#else
-extern SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
-#endif
-
-#ifdef eval_pv
-# undef eval_pv
-#endif
-#define eval_pv(a,b) DPPP_(my_eval_pv)(aTHX_ a,b)
-#define Perl_eval_pv DPPP_(my_eval_pv)
-
-#if defined(NEED_eval_pv) || defined(NEED_eval_pv_GLOBAL)
-
-SV*
-DPPP_(my_eval_pv)(char *p, I32 croak_on_error)
-{
- dSP;
- SV* sv = newSVpv(p, 0);
-
- PUSHMARK(sp);
- eval_sv(sv, G_SCALAR);
- SvREFCNT_dec(sv);
-
- SPAGAIN;
- sv = POPs;
- PUTBACK;
-
- if (croak_on_error && SvTRUE(GvSV(errgv)))
- croak("%s", SvPVx(GvSV(errgv), na));
-
- return sv;
-}
-
-#endif
-#endif
-
-#ifndef vload_module
-#if defined(NEED_vload_module)
-static void DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args);
-static
-#else
-extern void DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args);
-#endif
-
-#ifdef vload_module
-# undef vload_module
-#endif
-#define vload_module(a,b,c,d) DPPP_(my_vload_module)(aTHX_ a,b,c,d)
-#define Perl_vload_module DPPP_(my_vload_module)
-
-#if defined(NEED_vload_module) || defined(NEED_vload_module_GLOBAL)
-
-void
-DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args)
-{
- dTHR;
- dVAR;
- OP *veop, *imop;
-
- OP * const modname = newSVOP(OP_CONST, 0, name);
- /* 5.005 has a somewhat hacky force_normal that doesn't croak on
- SvREADONLY() if PL_compling is true. Current perls take care in
- ck_require() to correctly turn off SvREADONLY before calling
- force_normal_flags(). This seems a better fix than fudging PL_compling
- */
- SvREADONLY_off(((SVOP*)modname)->op_sv);
- modname->op_private |= OPpCONST_BARE;
- if (ver) {
- veop = newSVOP(OP_CONST, 0, ver);
- }
- else
- veop = NULL;
- if (flags & PERL_LOADMOD_NOIMPORT) {
- imop = sawparens(newNULLLIST());
- }
- else if (flags & PERL_LOADMOD_IMPORT_OPS) {
- imop = va_arg(*args, OP*);
- }
- else {
- SV *sv;
- imop = NULL;
- sv = va_arg(*args, SV*);
- while (sv) {
- imop = append_elem(OP_LIST, imop, newSVOP(OP_CONST, 0, sv));
- sv = va_arg(*args, SV*);
- }
- }
- {
- const line_t ocopline = PL_copline;
- COP * const ocurcop = PL_curcop;
- const int oexpect = PL_expect;
-
-#if (PERL_BCDVERSION >= 0x5004000)
- utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(FALSE, 0),
- veop, modname, imop);
-#elif (PERL_BCDVERSION > 0x5003000)
- utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(),
- veop, modname, imop);
-#else
- utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(),
- modname, imop);
-#endif
- PL_expect = oexpect;
- PL_copline = ocopline;
- PL_curcop = ocurcop;
- }
-}
-
-#endif
-#endif
-
-#ifndef load_module
-#if defined(NEED_load_module)
-static void DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...);
-static
-#else
-extern void DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...);
-#endif
-
-#ifdef load_module
-# undef load_module
-#endif
-#define load_module DPPP_(my_load_module)
-#define Perl_load_module DPPP_(my_load_module)
-
-#if defined(NEED_load_module) || defined(NEED_load_module_GLOBAL)
-
-void
-DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...)
-{
- va_list args;
- va_start(args, ver);
- vload_module(flags, name, ver, &args);
- va_end(args);
-}
-
-#endif
-#endif
-#ifndef newRV_inc
-# define newRV_inc(sv) newRV(sv) /* Replace */
-#endif
-
-#ifndef newRV_noinc
-#if defined(NEED_newRV_noinc)
-static SV * DPPP_(my_newRV_noinc)(SV *sv);
-static
-#else
-extern SV * DPPP_(my_newRV_noinc)(SV *sv);
-#endif
-
-#ifdef newRV_noinc
-# undef newRV_noinc
-#endif
-#define newRV_noinc(a) DPPP_(my_newRV_noinc)(aTHX_ a)
-#define Perl_newRV_noinc DPPP_(my_newRV_noinc)
-
-#if defined(NEED_newRV_noinc) || defined(NEED_newRV_noinc_GLOBAL)
-SV *
-DPPP_(my_newRV_noinc)(SV *sv)
-{
- SV *rv = (SV *)newRV(sv);
- SvREFCNT_dec(sv);
- return rv;
-}
-#endif
-#endif
-
-/* Hint: newCONSTSUB
- * Returns a CV* as of perl-5.7.1. This return value is not supported
- * by Devel::PPPort.
- */
-
-/* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */
-#if (PERL_BCDVERSION < 0x5004063) && (PERL_BCDVERSION != 0x5004005)
-#if defined(NEED_newCONSTSUB)
-static void DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv);
-static
-#else
-extern void DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv);
-#endif
-
-#ifdef newCONSTSUB
-# undef newCONSTSUB
-#endif
-#define newCONSTSUB(a,b,c) DPPP_(my_newCONSTSUB)(aTHX_ a,b,c)
-#define Perl_newCONSTSUB DPPP_(my_newCONSTSUB)
-
-#if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL)
-
-/* This is just a trick to avoid a dependency of newCONSTSUB on PL_parser */
-/* (There's no PL_parser in perl < 5.005, so this is completely safe) */
-#define D_PPP_PL_copline PL_copline
-
-void
-DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv)
-{
- U32 oldhints = PL_hints;
- HV *old_cop_stash = PL_curcop->cop_stash;
- HV *old_curstash = PL_curstash;
- line_t oldline = PL_curcop->cop_line;
- PL_curcop->cop_line = D_PPP_PL_copline;
-
- PL_hints &= ~HINT_BLOCK_SCOPE;
- if (stash)
- PL_curstash = PL_curcop->cop_stash = stash;
-
- newSUB(
-
-#if (PERL_BCDVERSION < 0x5003022)
- start_subparse(),
-#elif (PERL_BCDVERSION == 0x5003022)
- start_subparse(0),
-#else /* 5.003_23 onwards */
- start_subparse(FALSE, 0),
-#endif
-
- newSVOP(OP_CONST, 0, newSVpv((char *) name, 0)),
- newSVOP(OP_CONST, 0, &PL_sv_no), /* SvPV(&PL_sv_no) == "" -- GMB */
- newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
- );
-
- PL_hints = oldhints;
- PL_curcop->cop_stash = old_cop_stash;
- PL_curstash = old_curstash;
- PL_curcop->cop_line = oldline;
-}
-#endif
-#endif
-
-/*
- * Boilerplate macros for initializing and accessing interpreter-local
- * data from C. All statics in extensions should be reworked to use
- * this, if you want to make the extension thread-safe. See ext/re/re.xs
- * for an example of the use of these macros.
- *
- * Code that uses these macros is responsible for the following:
- * 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts"
- * 2. Declare a typedef named my_cxt_t that is a structure that contains
- * all the data that needs to be interpreter-local.
- * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t.
- * 4. Use the MY_CXT_INIT macro such that it is called exactly once
- * (typically put in the BOOT: section).
- * 5. Use the members of the my_cxt_t structure everywhere as
- * MY_CXT.member.
- * 6. Use the dMY_CXT macro (a declaration) in all the functions that
- * access MY_CXT.
- */
-
-#if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \
- defined(PERL_CAPI) || defined(PERL_IMPLICIT_CONTEXT)
-
-#ifndef START_MY_CXT
-
-/* This must appear in all extensions that define a my_cxt_t structure,
- * right after the definition (i.e. at file scope). The non-threads
- * case below uses it to declare the data as static. */
-#define START_MY_CXT
-
-#if (PERL_BCDVERSION < 0x5004068)
-/* Fetches the SV that keeps the per-interpreter data. */
-#define dMY_CXT_SV \
- SV *my_cxt_sv = get_sv(MY_CXT_KEY, FALSE)
-#else /* >= perl5.004_68 */
-#define dMY_CXT_SV \
- SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY, \
- sizeof(MY_CXT_KEY)-1, TRUE)
-#endif /* < perl5.004_68 */
-
-/* This declaration should be used within all functions that use the
- * interpreter-local data. */
-#define dMY_CXT \
- dMY_CXT_SV; \
- my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*,SvUV(my_cxt_sv))
-
-/* Creates and zeroes the per-interpreter data.
- * (We allocate my_cxtp in a Perl SV so that it will be released when
- * the interpreter goes away.) */
-#define MY_CXT_INIT \
- dMY_CXT_SV; \
- /* newSV() allocates one more than needed */ \
- my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
- Zero(my_cxtp, 1, my_cxt_t); \
- sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
-
-/* This macro must be used to access members of the my_cxt_t structure.
- * e.g. MYCXT.some_data */
-#define MY_CXT (*my_cxtp)
-
-/* Judicious use of these macros can reduce the number of times dMY_CXT
- * is used. Use is similar to pTHX, aTHX etc. */
-#define pMY_CXT my_cxt_t *my_cxtp
-#define pMY_CXT_ pMY_CXT,
-#define _pMY_CXT ,pMY_CXT
-#define aMY_CXT my_cxtp
-#define aMY_CXT_ aMY_CXT,
-#define _aMY_CXT ,aMY_CXT
-
-#endif /* START_MY_CXT */
-
-#ifndef MY_CXT_CLONE
-/* Clones the per-interpreter data. */
-#define MY_CXT_CLONE \
- dMY_CXT_SV; \
- my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
- Copy(INT2PTR(my_cxt_t*, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t);\
- sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
-#endif
-
-#else /* single interpreter */
-
-#ifndef START_MY_CXT
-
-#define START_MY_CXT static my_cxt_t my_cxt;
-#define dMY_CXT_SV dNOOP
-#define dMY_CXT dNOOP
-#define MY_CXT_INIT NOOP
-#define MY_CXT my_cxt
-
-#define pMY_CXT void
-#define pMY_CXT_
-#define _pMY_CXT
-#define aMY_CXT
-#define aMY_CXT_
-#define _aMY_CXT
-
-#endif /* START_MY_CXT */
-
-#ifndef MY_CXT_CLONE
-#define MY_CXT_CLONE NOOP
-#endif
-
-#endif
-
-#ifndef IVdf
-# if IVSIZE == LONGSIZE
-# define IVdf "ld"
-# define UVuf "lu"
-# define UVof "lo"
-# define UVxf "lx"
-# define UVXf "lX"
-# elif IVSIZE == INTSIZE
-# define IVdf "d"
-# define UVuf "u"
-# define UVof "o"
-# define UVxf "x"
-# define UVXf "X"
-# else
-# error "cannot define IV/UV formats"
-# endif
-#endif
-
-#ifndef NVef
-# if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \
- defined(PERL_PRIfldbl) && (PERL_BCDVERSION != 0x5006000)
- /* Not very likely, but let's try anyway. */
-# define NVef PERL_PRIeldbl
-# define NVff PERL_PRIfldbl
-# define NVgf PERL_PRIgldbl
-# else
-# define NVef "e"
-# define NVff "f"
-# define NVgf "g"
-# endif
-#endif
-
-#ifndef SvREFCNT_inc
-# ifdef PERL_USE_GCC_BRACE_GROUPS
-# define SvREFCNT_inc(sv) \
- ({ \
- SV * const _sv = (SV*)(sv); \
- if (_sv) \
- (SvREFCNT(_sv))++; \
- _sv; \
- })
-# else
-# define SvREFCNT_inc(sv) \
- ((PL_Sv=(SV*)(sv)) ? (++(SvREFCNT(PL_Sv)),PL_Sv) : NULL)
-# endif
-#endif
-
-#ifndef SvREFCNT_inc_simple
-# ifdef PERL_USE_GCC_BRACE_GROUPS
-# define SvREFCNT_inc_simple(sv) \
- ({ \
- if (sv) \
- (SvREFCNT(sv))++; \
- (SV *)(sv); \
- })
-# else
-# define SvREFCNT_inc_simple(sv) \
- ((sv) ? (SvREFCNT(sv)++,(SV*)(sv)) : NULL)
-# endif
-#endif
-
-#ifndef SvREFCNT_inc_NN
-# ifdef PERL_USE_GCC_BRACE_GROUPS
-# define SvREFCNT_inc_NN(sv) \
- ({ \
- SV * const _sv = (SV*)(sv); \
- SvREFCNT(_sv)++; \
- _sv; \
- })
-# else
-# define SvREFCNT_inc_NN(sv) \
- (PL_Sv=(SV*)(sv),++(SvREFCNT(PL_Sv)),PL_Sv)
-# endif
-#endif
-
-#ifndef SvREFCNT_inc_void
-# ifdef PERL_USE_GCC_BRACE_GROUPS
-# define SvREFCNT_inc_void(sv) \
- ({ \
- SV * const _sv = (SV*)(sv); \
- if (_sv) \
- (void)(SvREFCNT(_sv)++); \
- })
-# else
-# define SvREFCNT_inc_void(sv) \
- (void)((PL_Sv=(SV*)(sv)) ? ++(SvREFCNT(PL_Sv)) : 0)
-# endif
-#endif
-#ifndef SvREFCNT_inc_simple_void
-# define SvREFCNT_inc_simple_void(sv) STMT_START { if (sv) SvREFCNT(sv)++; } STMT_END
-#endif
-
-#ifndef SvREFCNT_inc_simple_NN
-# define SvREFCNT_inc_simple_NN(sv) (++SvREFCNT(sv), (SV*)(sv))
-#endif
-
-#ifndef SvREFCNT_inc_void_NN
-# define SvREFCNT_inc_void_NN(sv) (void)(++SvREFCNT((SV*)(sv)))
-#endif
-
-#ifndef SvREFCNT_inc_simple_void_NN
-# define SvREFCNT_inc_simple_void_NN(sv) (void)(++SvREFCNT((SV*)(sv)))
-#endif
-
-#ifndef newSV_type
-
-#if defined(NEED_newSV_type)
-static SV* DPPP_(my_newSV_type)(pTHX_ svtype const t);
-static
-#else
-extern SV* DPPP_(my_newSV_type)(pTHX_ svtype const t);
-#endif
-
-#ifdef newSV_type
-# undef newSV_type
-#endif
-#define newSV_type(a) DPPP_(my_newSV_type)(aTHX_ a)
-#define Perl_newSV_type DPPP_(my_newSV_type)
-
-#if defined(NEED_newSV_type) || defined(NEED_newSV_type_GLOBAL)
-
-SV*
-DPPP_(my_newSV_type)(pTHX_ svtype const t)
-{
- SV* const sv = newSV(0);
- sv_upgrade(sv, t);
- return sv;
-}
-
-#endif
-
-#endif
-
-#if (PERL_BCDVERSION < 0x5006000)
-# define D_PPP_CONSTPV_ARG(x) ((char *) (x))
-#else
-# define D_PPP_CONSTPV_ARG(x) (x)
-#endif
-#ifndef newSVpvn
-# define newSVpvn(data,len) ((data) \
- ? ((len) ? newSVpv((data), (len)) : newSVpv("", 0)) \
- : newSV(0))
-#endif
-#ifndef newSVpvn_utf8
-# define newSVpvn_utf8(s, len, u) newSVpvn_flags((s), (len), (u) ? SVf_UTF8 : 0)
-#endif
-#ifndef SVf_UTF8
-# define SVf_UTF8 0
-#endif
-
-#ifndef newSVpvn_flags
-
-#if defined(NEED_newSVpvn_flags)
-static SV * DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags);
-static
-#else
-extern SV * DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags);
-#endif
-
-#ifdef newSVpvn_flags
-# undef newSVpvn_flags
-#endif
-#define newSVpvn_flags(a,b,c) DPPP_(my_newSVpvn_flags)(aTHX_ a,b,c)
-#define Perl_newSVpvn_flags DPPP_(my_newSVpvn_flags)
-
-#if defined(NEED_newSVpvn_flags) || defined(NEED_newSVpvn_flags_GLOBAL)
-
-SV *
-DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags)
-{
- SV *sv = newSVpvn(D_PPP_CONSTPV_ARG(s), len);
- SvFLAGS(sv) |= (flags & SVf_UTF8);
- return (flags & SVs_TEMP) ? sv_2mortal(sv) : sv;
-}
-
-#endif
-
-#endif
-
-/* Backwards compatibility stuff... :-( */
-#if !defined(NEED_sv_2pv_flags) && defined(NEED_sv_2pv_nolen)
-# define NEED_sv_2pv_flags
-#endif
-#if !defined(NEED_sv_2pv_flags_GLOBAL) && defined(NEED_sv_2pv_nolen_GLOBAL)
-# define NEED_sv_2pv_flags_GLOBAL
-#endif
-
-/* Hint: sv_2pv_nolen
- * Use the SvPV_nolen() or SvPV_nolen_const() macros instead of sv_2pv_nolen().
- */
-#ifndef sv_2pv_nolen
-# define sv_2pv_nolen(sv) SvPV_nolen(sv)
-#endif
-
-#ifdef SvPVbyte
-
-/* Hint: SvPVbyte
- * Does not work in perl-5.6.1, ppport.h implements a version
- * borrowed from perl-5.7.3.
- */
-
-#if (PERL_BCDVERSION < 0x5007000)
-
-#if defined(NEED_sv_2pvbyte)
-static char * DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp);
-static
-#else
-extern char * DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp);
-#endif
-
-#ifdef sv_2pvbyte
-# undef sv_2pvbyte
-#endif
-#define sv_2pvbyte(a,b) DPPP_(my_sv_2pvbyte)(aTHX_ a,b)
-#define Perl_sv_2pvbyte DPPP_(my_sv_2pvbyte)
-
-#if defined(NEED_sv_2pvbyte) || defined(NEED_sv_2pvbyte_GLOBAL)
-
-char *
-DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp)
-{
- sv_utf8_downgrade(sv,0);
- return SvPV(sv,*lp);
-}
-
-#endif
-
-/* Hint: sv_2pvbyte
- * Use the SvPVbyte() macro instead of sv_2pvbyte().
- */
-
-#undef SvPVbyte
-
-#define SvPVbyte(sv, lp) \
- ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \
- ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte(sv, &lp))
-
-#endif
-
-#else
-
-# define SvPVbyte SvPV
-# define sv_2pvbyte sv_2pv
-
-#endif
-#ifndef sv_2pvbyte_nolen
-# define sv_2pvbyte_nolen(sv) sv_2pv_nolen(sv)
-#endif
-
-/* Hint: sv_pvn
- * Always use the SvPV() macro instead of sv_pvn().
- */
-
-/* Hint: sv_pvn_force
- * Always use the SvPV_force() macro instead of sv_pvn_force().
- */
-
-/* If these are undefined, they're not handled by the core anyway */
-#ifndef SV_IMMEDIATE_UNREF
-# define SV_IMMEDIATE_UNREF 0
-#endif
-
-#ifndef SV_GMAGIC
-# define SV_GMAGIC 0
-#endif
-
-#ifndef SV_COW_DROP_PV
-# define SV_COW_DROP_PV 0
-#endif
-
-#ifndef SV_UTF8_NO_ENCODING
-# define SV_UTF8_NO_ENCODING 0
-#endif
-
-#ifndef SV_NOSTEAL
-# define SV_NOSTEAL 0
-#endif
-
-#ifndef SV_CONST_RETURN
-# define SV_CONST_RETURN 0
-#endif
-
-#ifndef SV_MUTABLE_RETURN
-# define SV_MUTABLE_RETURN 0
-#endif
-
-#ifndef SV_SMAGIC
-# define SV_SMAGIC 0
-#endif
-
-#ifndef SV_HAS_TRAILING_NUL
-# define SV_HAS_TRAILING_NUL 0
-#endif
-
-#ifndef SV_COW_SHARED_HASH_KEYS
-# define SV_COW_SHARED_HASH_KEYS 0
-#endif
-
-#if (PERL_BCDVERSION < 0x5007002)
-
-#if defined(NEED_sv_2pv_flags)
-static char * DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
-static
-#else
-extern char * DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
-#endif
-
-#ifdef sv_2pv_flags
-# undef sv_2pv_flags
-#endif
-#define sv_2pv_flags(a,b,c) DPPP_(my_sv_2pv_flags)(aTHX_ a,b,c)
-#define Perl_sv_2pv_flags DPPP_(my_sv_2pv_flags)
-
-#if defined(NEED_sv_2pv_flags) || defined(NEED_sv_2pv_flags_GLOBAL)
-
-char *
-DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags)
-{
- STRLEN n_a = (STRLEN) flags;
- return sv_2pv(sv, lp ? lp : &n_a);
-}
-
-#endif
-
-#if defined(NEED_sv_pvn_force_flags)
-static char * DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
-static
-#else
-extern char * DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
-#endif
-
-#ifdef sv_pvn_force_flags
-# undef sv_pvn_force_flags
-#endif
-#define sv_pvn_force_flags(a,b,c) DPPP_(my_sv_pvn_force_flags)(aTHX_ a,b,c)
-#define Perl_sv_pvn_force_flags DPPP_(my_sv_pvn_force_flags)
-
-#if defined(NEED_sv_pvn_force_flags) || defined(NEED_sv_pvn_force_flags_GLOBAL)
-
-char *
-DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags)
-{
- STRLEN n_a = (STRLEN) flags;
- return sv_pvn_force(sv, lp ? lp : &n_a);
-}
-
-#endif
-
-#endif
-
-#if (PERL_BCDVERSION < 0x5008008) || ( (PERL_BCDVERSION >= 0x5009000) && (PERL_BCDVERSION < 0x5009003) )
-# define DPPP_SVPV_NOLEN_LP_ARG &PL_na
-#else
-# define DPPP_SVPV_NOLEN_LP_ARG 0
-#endif
-#ifndef SvPV_const
-# define SvPV_const(sv, lp) SvPV_flags_const(sv, lp, SV_GMAGIC)
-#endif
-
-#ifndef SvPV_mutable
-# define SvPV_mutable(sv, lp) SvPV_flags_mutable(sv, lp, SV_GMAGIC)
-#endif
-#ifndef SvPV_flags
-# define SvPV_flags(sv, lp, flags) \
- ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
- ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pv_flags(sv, &lp, flags))
-#endif
-#ifndef SvPV_flags_const
-# define SvPV_flags_const(sv, lp, flags) \
- ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
- ? ((lp = SvCUR(sv)), SvPVX_const(sv)) : \
- (const char*) sv_2pv_flags(sv, &lp, flags|SV_CONST_RETURN))
-#endif
-#ifndef SvPV_flags_const_nolen
-# define SvPV_flags_const_nolen(sv, flags) \
- ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
- ? SvPVX_const(sv) : \
- (const char*) sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, flags|SV_CONST_RETURN))
-#endif
-#ifndef SvPV_flags_mutable
-# define SvPV_flags_mutable(sv, lp, flags) \
- ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
- ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) : \
- sv_2pv_flags(sv, &lp, flags|SV_MUTABLE_RETURN))
-#endif
-#ifndef SvPV_force
-# define SvPV_force(sv, lp) SvPV_force_flags(sv, lp, SV_GMAGIC)
-#endif
-
-#ifndef SvPV_force_nolen
-# define SvPV_force_nolen(sv) SvPV_force_flags_nolen(sv, SV_GMAGIC)
-#endif
-
-#ifndef SvPV_force_mutable
-# define SvPV_force_mutable(sv, lp) SvPV_force_flags_mutable(sv, lp, SV_GMAGIC)
-#endif
-
-#ifndef SvPV_force_nomg
-# define SvPV_force_nomg(sv, lp) SvPV_force_flags(sv, lp, 0)
-#endif
-
-#ifndef SvPV_force_nomg_nolen
-# define SvPV_force_nomg_nolen(sv) SvPV_force_flags_nolen(sv, 0)
-#endif
-#ifndef SvPV_force_flags
-# define SvPV_force_flags(sv, lp, flags) \
- ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
- ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvn_force_flags(sv, &lp, flags))
-#endif
-#ifndef SvPV_force_flags_nolen
-# define SvPV_force_flags_nolen(sv, flags) \
- ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
- ? SvPVX(sv) : sv_pvn_force_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, flags))
-#endif
-#ifndef SvPV_force_flags_mutable
-# define SvPV_force_flags_mutable(sv, lp, flags) \
- ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
- ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) \
- : sv_pvn_force_flags(sv, &lp, flags|SV_MUTABLE_RETURN))
-#endif
-#ifndef SvPV_nolen
-# define SvPV_nolen(sv) \
- ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
- ? SvPVX(sv) : sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, SV_GMAGIC))
-#endif
-#ifndef SvPV_nolen_const
-# define SvPV_nolen_const(sv) \
- ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
- ? SvPVX_const(sv) : sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, SV_GMAGIC|SV_CONST_RETURN))
-#endif
-#ifndef SvPV_nomg
-# define SvPV_nomg(sv, lp) SvPV_flags(sv, lp, 0)
-#endif
-
-#ifndef SvPV_nomg_const
-# define SvPV_nomg_const(sv, lp) SvPV_flags_const(sv, lp, 0)
-#endif
-
-#ifndef SvPV_nomg_const_nolen
-# define SvPV_nomg_const_nolen(sv) SvPV_flags_const_nolen(sv, 0)
-#endif
-
-#ifndef SvPV_nomg_nolen
-# define SvPV_nomg_nolen(sv) ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
- ? SvPVX(sv) : sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, 0))
-#endif
-#ifndef SvPV_renew
-# define SvPV_renew(sv,n) STMT_START { SvLEN_set(sv, n); \
- SvPV_set((sv), (char *) saferealloc( \
- (Malloc_t)SvPVX(sv), (MEM_SIZE)((n)))); \
- } STMT_END
-#endif
-#ifndef SvMAGIC_set
-# define SvMAGIC_set(sv, val) \
- STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
- (((XPVMG*) SvANY(sv))->xmg_magic = (val)); } STMT_END
-#endif
-
-#if (PERL_BCDVERSION < 0x5009003)
-#ifndef SvPVX_const
-# define SvPVX_const(sv) ((const char*) (0 + SvPVX(sv)))
-#endif
-
-#ifndef SvPVX_mutable
-# define SvPVX_mutable(sv) (0 + SvPVX(sv))
-#endif
-#ifndef SvRV_set
-# define SvRV_set(sv, val) \
- STMT_START { assert(SvTYPE(sv) >= SVt_RV); \
- (((XRV*) SvANY(sv))->xrv_rv = (val)); } STMT_END
-#endif
-
-#else
-#ifndef SvPVX_const
-# define SvPVX_const(sv) ((const char*)((sv)->sv_u.svu_pv))
-#endif
-
-#ifndef SvPVX_mutable
-# define SvPVX_mutable(sv) ((sv)->sv_u.svu_pv)
-#endif
-#ifndef SvRV_set
-# define SvRV_set(sv, val) \
- STMT_START { assert(SvTYPE(sv) >= SVt_RV); \
- ((sv)->sv_u.svu_rv = (val)); } STMT_END
-#endif
-
-#endif
-#ifndef SvSTASH_set
-# define SvSTASH_set(sv, val) \
- STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
- (((XPVMG*) SvANY(sv))->xmg_stash = (val)); } STMT_END
-#endif
-
-#if (PERL_BCDVERSION < 0x5004000)
-#ifndef SvUV_set
-# define SvUV_set(sv, val) \
- STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
- (((XPVIV*) SvANY(sv))->xiv_iv = (IV) (val)); } STMT_END
-#endif
-
-#else
-#ifndef SvUV_set
-# define SvUV_set(sv, val) \
- STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
- (((XPVUV*) SvANY(sv))->xuv_uv = (val)); } STMT_END
-#endif
-
-#endif
-
-#if (PERL_BCDVERSION >= 0x5004000) && !defined(vnewSVpvf)
-#if defined(NEED_vnewSVpvf)
-static SV * DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args);
-static
-#else
-extern SV * DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args);
-#endif
-
-#ifdef vnewSVpvf
-# undef vnewSVpvf
-#endif
-#define vnewSVpvf(a,b) DPPP_(my_vnewSVpvf)(aTHX_ a,b)
-#define Perl_vnewSVpvf DPPP_(my_vnewSVpvf)
-
-#if defined(NEED_vnewSVpvf) || defined(NEED_vnewSVpvf_GLOBAL)
-
-SV *
-DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args)
-{
- register SV *sv = newSV(0);
- sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));
- return sv;
-}
-
-#endif
-#endif
-
-#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vcatpvf)
-# define sv_vcatpvf(sv, pat, args) sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
-#endif
-
-#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vsetpvf)
-# define sv_vsetpvf(sv, pat, args) sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
-#endif
-
-#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_catpvf_mg)
-#if defined(NEED_sv_catpvf_mg)
-static void DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
-static
-#else
-extern void DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
-#endif
-
-#define Perl_sv_catpvf_mg DPPP_(my_sv_catpvf_mg)
-
-#if defined(NEED_sv_catpvf_mg) || defined(NEED_sv_catpvf_mg_GLOBAL)
-
-void
-DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
-{
- va_list args;
- va_start(args, pat);
- sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
- SvSETMAGIC(sv);
- va_end(args);
-}
-
-#endif
-#endif
-
-#ifdef PERL_IMPLICIT_CONTEXT
-#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_catpvf_mg_nocontext)
-#if defined(NEED_sv_catpvf_mg_nocontext)
-static void DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...);
-static
-#else
-extern void DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...);
-#endif
-
-#define sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
-#define Perl_sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
-
-#if defined(NEED_sv_catpvf_mg_nocontext) || defined(NEED_sv_catpvf_mg_nocontext_GLOBAL)
-
-void
-DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...)
-{
- dTHX;
- va_list args;
- va_start(args, pat);
- sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
- SvSETMAGIC(sv);
- va_end(args);
-}
-
-#endif
-#endif
-#endif
-
-/* sv_catpvf_mg depends on sv_catpvf_mg_nocontext */
-#ifndef sv_catpvf_mg
-# ifdef PERL_IMPLICIT_CONTEXT
-# define sv_catpvf_mg Perl_sv_catpvf_mg_nocontext
-# else
-# define sv_catpvf_mg Perl_sv_catpvf_mg
-# endif
-#endif
-
-#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vcatpvf_mg)
-# define sv_vcatpvf_mg(sv, pat, args) \
- STMT_START { \
- sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
- SvSETMAGIC(sv); \
- } STMT_END
-#endif
-
-#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_setpvf_mg)
-#if defined(NEED_sv_setpvf_mg)
-static void DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
-static
-#else
-extern void DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
-#endif
-
-#define Perl_sv_setpvf_mg DPPP_(my_sv_setpvf_mg)
-
-#if defined(NEED_sv_setpvf_mg) || defined(NEED_sv_setpvf_mg_GLOBAL)
-
-void
-DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
-{
- va_list args;
- va_start(args, pat);
- sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
- SvSETMAGIC(sv);
- va_end(args);
-}
-
-#endif
-#endif
-
-#ifdef PERL_IMPLICIT_CONTEXT
-#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_setpvf_mg_nocontext)
-#if defined(NEED_sv_setpvf_mg_nocontext)
-static void DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...);
-static
-#else
-extern void DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...);
-#endif
-
-#define sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
-#define Perl_sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
-
-#if defined(NEED_sv_setpvf_mg_nocontext) || defined(NEED_sv_setpvf_mg_nocontext_GLOBAL)
-
-void
-DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...)
-{
- dTHX;
- va_list args;
- va_start(args, pat);
- sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
- SvSETMAGIC(sv);
- va_end(args);
-}
-
-#endif
-#endif
-#endif
-
-/* sv_setpvf_mg depends on sv_setpvf_mg_nocontext */
-#ifndef sv_setpvf_mg
-# ifdef PERL_IMPLICIT_CONTEXT
-# define sv_setpvf_mg Perl_sv_setpvf_mg_nocontext
-# else
-# define sv_setpvf_mg Perl_sv_setpvf_mg
-# endif
-#endif
-
-#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vsetpvf_mg)
-# define sv_vsetpvf_mg(sv, pat, args) \
- STMT_START { \
- sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
- SvSETMAGIC(sv); \
- } STMT_END
-#endif
-
-/* Hint: newSVpvn_share
- * The SVs created by this function only mimic the behaviour of
- * shared PVs without really being shared. Only use if you know
- * what you're doing.
- */
-
-#ifndef newSVpvn_share
-
-#if defined(NEED_newSVpvn_share)
-static SV * DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash);
-static
-#else
-extern SV * DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash);
-#endif
-
-#ifdef newSVpvn_share
-# undef newSVpvn_share
-#endif
-#define newSVpvn_share(a,b,c) DPPP_(my_newSVpvn_share)(aTHX_ a,b,c)
-#define Perl_newSVpvn_share DPPP_(my_newSVpvn_share)
-
-#if defined(NEED_newSVpvn_share) || defined(NEED_newSVpvn_share_GLOBAL)
-
-SV *
-DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash)
-{
- SV *sv;
- if (len < 0)
- len = -len;
- if (!hash)
- PERL_HASH(hash, (char*) src, len);
- sv = newSVpvn((char *) src, len);
- sv_upgrade(sv, SVt_PVIV);
- SvIVX(sv) = hash;
- SvREADONLY_on(sv);
- SvPOK_on(sv);
- return sv;
-}
-
-#endif
-
-#endif
-#ifndef SvSHARED_HASH
-# define SvSHARED_HASH(sv) (0 + SvUVX(sv))
-#endif
-#ifndef HvNAME_get
-# define HvNAME_get(hv) HvNAME(hv)
-#endif
-#ifndef HvNAMELEN_get
-# define HvNAMELEN_get(hv) (HvNAME_get(hv) ? (I32)strlen(HvNAME_get(hv)) : 0)
-#endif
-#ifndef GvSVn
-# define GvSVn(gv) GvSV(gv)
-#endif
-
-#ifndef isGV_with_GP
-# define isGV_with_GP(gv) isGV(gv)
-#endif
-
-#ifndef gv_fetchpvn_flags
-# define gv_fetchpvn_flags(name, len, flags, svt) gv_fetchpv(name, flags, svt)
-#endif
-
-#ifndef gv_fetchsv
-# define gv_fetchsv(name, flags, svt) gv_fetchpv(SvPV_nolen_const(name), flags, svt)
-#endif
-#ifndef get_cvn_flags
-# define get_cvn_flags(name, namelen, flags) get_cv(name, flags)
-#endif
-#ifndef WARN_ALL
-# define WARN_ALL 0
-#endif
-
-#ifndef WARN_CLOSURE
-# define WARN_CLOSURE 1
-#endif
-
-#ifndef WARN_DEPRECATED
-# define WARN_DEPRECATED 2
-#endif
-
-#ifndef WARN_EXITING
-# define WARN_EXITING 3
-#endif
-
-#ifndef WARN_GLOB
-# define WARN_GLOB 4
-#endif
-
-#ifndef WARN_IO
-# define WARN_IO 5
-#endif
-
-#ifndef WARN_CLOSED
-# define WARN_CLOSED 6
-#endif
-
-#ifndef WARN_EXEC
-# define WARN_EXEC 7
-#endif
-
-#ifndef WARN_LAYER
-# define WARN_LAYER 8
-#endif
-
-#ifndef WARN_NEWLINE
-# define WARN_NEWLINE 9
-#endif
-
-#ifndef WARN_PIPE
-# define WARN_PIPE 10
-#endif
-
-#ifndef WARN_UNOPENED
-# define WARN_UNOPENED 11
-#endif
-
-#ifndef WARN_MISC
-# define WARN_MISC 12
-#endif
-
-#ifndef WARN_NUMERIC
-# define WARN_NUMERIC 13
-#endif
-
-#ifndef WARN_ONCE
-# define WARN_ONCE 14
-#endif
-
-#ifndef WARN_OVERFLOW
-# define WARN_OVERFLOW 15
-#endif
-
-#ifndef WARN_PACK
-# define WARN_PACK 16
-#endif
-
-#ifndef WARN_PORTABLE
-# define WARN_PORTABLE 17
-#endif
-
-#ifndef WARN_RECURSION
-# define WARN_RECURSION 18
-#endif
-
-#ifndef WARN_REDEFINE
-# define WARN_REDEFINE 19
-#endif
-
-#ifndef WARN_REGEXP
-# define WARN_REGEXP 20
-#endif
-
-#ifndef WARN_SEVERE
-# define WARN_SEVERE 21
-#endif
-
-#ifndef WARN_DEBUGGING
-# define WARN_DEBUGGING 22
-#endif
-
-#ifndef WARN_INPLACE
-# define WARN_INPLACE 23
-#endif
-
-#ifndef WARN_INTERNAL
-# define WARN_INTERNAL 24
-#endif
-
-#ifndef WARN_MALLOC
-# define WARN_MALLOC 25
-#endif
-
-#ifndef WARN_SIGNAL
-# define WARN_SIGNAL 26
-#endif
-
-#ifndef WARN_SUBSTR
-# define WARN_SUBSTR 27
-#endif
-
-#ifndef WARN_SYNTAX
-# define WARN_SYNTAX 28
-#endif
-
-#ifndef WARN_AMBIGUOUS
-# define WARN_AMBIGUOUS 29
-#endif
-
-#ifndef WARN_BAREWORD
-# define WARN_BAREWORD 30
-#endif
-
-#ifndef WARN_DIGIT
-# define WARN_DIGIT 31
-#endif
-
-#ifndef WARN_PARENTHESIS
-# define WARN_PARENTHESIS 32
-#endif
-
-#ifndef WARN_PRECEDENCE
-# define WARN_PRECEDENCE 33
-#endif
-
-#ifndef WARN_PRINTF
-# define WARN_PRINTF 34
-#endif
-
-#ifndef WARN_PROTOTYPE
-# define WARN_PROTOTYPE 35
-#endif
-
-#ifndef WARN_QW
-# define WARN_QW 36
-#endif
-
-#ifndef WARN_RESERVED
-# define WARN_RESERVED 37
-#endif
-
-#ifndef WARN_SEMICOLON
-# define WARN_SEMICOLON 38
-#endif
-
-#ifndef WARN_TAINT
-# define WARN_TAINT 39
-#endif
-
-#ifndef WARN_THREADS
-# define WARN_THREADS 40
-#endif
-
-#ifndef WARN_UNINITIALIZED
-# define WARN_UNINITIALIZED 41
-#endif
-
-#ifndef WARN_UNPACK
-# define WARN_UNPACK 42
-#endif
-
-#ifndef WARN_UNTIE
-# define WARN_UNTIE 43
-#endif
-
-#ifndef WARN_UTF8
-# define WARN_UTF8 44
-#endif
-
-#ifndef WARN_VOID
-# define WARN_VOID 45
-#endif
-
-#ifndef WARN_ASSERTIONS
-# define WARN_ASSERTIONS 46
-#endif
-#ifndef packWARN
-# define packWARN(a) (a)
-#endif
-
-#ifndef ckWARN
-# ifdef G_WARN_ON
-# define ckWARN(a) (PL_dowarn & G_WARN_ON)
-# else
-# define ckWARN(a) PL_dowarn
-# endif
-#endif
-
-#if (PERL_BCDVERSION >= 0x5004000) && !defined(warner)
-#if defined(NEED_warner)
-static void DPPP_(my_warner)(U32 err, const char *pat, ...);
-static
-#else
-extern void DPPP_(my_warner)(U32 err, const char *pat, ...);
-#endif
-
-#define Perl_warner DPPP_(my_warner)
-
-#if defined(NEED_warner) || defined(NEED_warner_GLOBAL)
-
-void
-DPPP_(my_warner)(U32 err, const char *pat, ...)
-{
- SV *sv;
- va_list args;
-
- PERL_UNUSED_ARG(err);
-
- va_start(args, pat);
- sv = vnewSVpvf(pat, &args);
- va_end(args);
- sv_2mortal(sv);
- warn("%s", SvPV_nolen(sv));
-}
-
-#define warner Perl_warner
-
-#define Perl_warner_nocontext Perl_warner
-
-#endif
-#endif
-
-/* concatenating with "" ensures that only literal strings are accepted as argument
- * note that STR_WITH_LEN() can't be used as argument to macros or functions that
- * under some configurations might be macros
- */
-#ifndef STR_WITH_LEN
-# define STR_WITH_LEN(s) (s ""), (sizeof(s)-1)
-#endif
-#ifndef newSVpvs
-# define newSVpvs(str) newSVpvn(str "", sizeof(str) - 1)
-#endif
-
-#ifndef newSVpvs_flags
-# define newSVpvs_flags(str, flags) newSVpvn_flags(str "", sizeof(str) - 1, flags)
-#endif
-
-#ifndef newSVpvs_share
-# define newSVpvs_share(str) newSVpvn_share(str "", sizeof(str) - 1, 0)
-#endif
-
-#ifndef sv_catpvs
-# define sv_catpvs(sv, str) sv_catpvn(sv, str "", sizeof(str) - 1)
-#endif
-
-#ifndef sv_setpvs
-# define sv_setpvs(sv, str) sv_setpvn(sv, str "", sizeof(str) - 1)
-#endif
-
-#ifndef hv_fetchs
-# define hv_fetchs(hv, key, lval) hv_fetch(hv, key "", sizeof(key) - 1, lval)
-#endif
-
-#ifndef hv_stores
-# define hv_stores(hv, key, val) hv_store(hv, key "", sizeof(key) - 1, val, 0)
-#endif
-#ifndef gv_fetchpvs
-# define gv_fetchpvs(name, flags, svt) gv_fetchpvn_flags(name "", sizeof(name) - 1, flags, svt)
-#endif
-
-#ifndef gv_stashpvs
-# define gv_stashpvs(name, flags) gv_stashpvn(name "", sizeof(name) - 1, flags)
-#endif
-#ifndef get_cvs
-# define get_cvs(name, flags) get_cvn_flags(name "", sizeof(name)-1, flags)
-#endif
-#ifndef SvGETMAGIC
-# define SvGETMAGIC(x) STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END
-#endif
-
-/* Some random bits for sv_unmagicext. These should probably be pulled in for
- real and organized at some point */
-#ifndef HEf_SVKEY
-# define HEf_SVKEY -2
-#endif
-
-#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
-# define MUTABLE_PTR(p) ({ void *_p = (p); _p; })
-#else
-# define MUTABLE_PTR(p) ((void *) (p))
-#endif
-
-#define MUTABLE_SV(p) ((SV *)MUTABLE_PTR(p))
-
-/* end of random bits */
-#ifndef PERL_MAGIC_sv
-# define PERL_MAGIC_sv '\0'
-#endif
-
-#ifndef PERL_MAGIC_overload
-# define PERL_MAGIC_overload 'A'
-#endif
-
-#ifndef PERL_MAGIC_overload_elem
-# define PERL_MAGIC_overload_elem 'a'
-#endif
-
-#ifndef PERL_MAGIC_overload_table
-# define PERL_MAGIC_overload_table 'c'
-#endif
-
-#ifndef PERL_MAGIC_bm
-# define PERL_MAGIC_bm 'B'
-#endif
-
-#ifndef PERL_MAGIC_regdata
-# define PERL_MAGIC_regdata 'D'
-#endif
-
-#ifndef PERL_MAGIC_regdatum
-# define PERL_MAGIC_regdatum 'd'
-#endif
-
-#ifndef PERL_MAGIC_env
-# define PERL_MAGIC_env 'E'
-#endif
-
-#ifndef PERL_MAGIC_envelem
-# define PERL_MAGIC_envelem 'e'
-#endif
-
-#ifndef PERL_MAGIC_fm
-# define PERL_MAGIC_fm 'f'
-#endif
-
-#ifndef PERL_MAGIC_regex_global
-# define PERL_MAGIC_regex_global 'g'
-#endif
-
-#ifndef PERL_MAGIC_isa
-# define PERL_MAGIC_isa 'I'
-#endif
-
-#ifndef PERL_MAGIC_isaelem
-# define PERL_MAGIC_isaelem 'i'
-#endif
-
-#ifndef PERL_MAGIC_nkeys
-# define PERL_MAGIC_nkeys 'k'
-#endif
-
-#ifndef PERL_MAGIC_dbfile
-# define PERL_MAGIC_dbfile 'L'
-#endif
-
-#ifndef PERL_MAGIC_dbline
-# define PERL_MAGIC_dbline 'l'
-#endif
-
-#ifndef PERL_MAGIC_mutex
-# define PERL_MAGIC_mutex 'm'
-#endif
-
-#ifndef PERL_MAGIC_shared
-# define PERL_MAGIC_shared 'N'
-#endif
-
-#ifndef PERL_MAGIC_shared_scalar
-# define PERL_MAGIC_shared_scalar 'n'
-#endif
-
-#ifndef PERL_MAGIC_collxfrm
-# define PERL_MAGIC_collxfrm 'o'
-#endif
-
-#ifndef PERL_MAGIC_tied
-# define PERL_MAGIC_tied 'P'
-#endif
-
-#ifndef PERL_MAGIC_tiedelem
-# define PERL_MAGIC_tiedelem 'p'
-#endif
-
-#ifndef PERL_MAGIC_tiedscalar
-# define PERL_MAGIC_tiedscalar 'q'
-#endif
-
-#ifndef PERL_MAGIC_qr
-# define PERL_MAGIC_qr 'r'
-#endif
-
-#ifndef PERL_MAGIC_sig
-# define PERL_MAGIC_sig 'S'
-#endif
-
-#ifndef PERL_MAGIC_sigelem
-# define PERL_MAGIC_sigelem 's'
-#endif
-
-#ifndef PERL_MAGIC_taint
-# define PERL_MAGIC_taint 't'
-#endif
-
-#ifndef PERL_MAGIC_uvar
-# define PERL_MAGIC_uvar 'U'
-#endif
-
-#ifndef PERL_MAGIC_uvar_elem
-# define PERL_MAGIC_uvar_elem 'u'
-#endif
-
-#ifndef PERL_MAGIC_vstring
-# define PERL_MAGIC_vstring 'V'
-#endif
-
-#ifndef PERL_MAGIC_vec
-# define PERL_MAGIC_vec 'v'
-#endif
-
-#ifndef PERL_MAGIC_utf8
-# define PERL_MAGIC_utf8 'w'
-#endif
-
-#ifndef PERL_MAGIC_substr
-# define PERL_MAGIC_substr 'x'
-#endif
-
-#ifndef PERL_MAGIC_defelem
-# define PERL_MAGIC_defelem 'y'
-#endif
-
-#ifndef PERL_MAGIC_glob
-# define PERL_MAGIC_glob '*'
-#endif
-
-#ifndef PERL_MAGIC_arylen
-# define PERL_MAGIC_arylen '#'
-#endif
-
-#ifndef PERL_MAGIC_pos
-# define PERL_MAGIC_pos '.'
-#endif
-
-#ifndef PERL_MAGIC_backref
-# define PERL_MAGIC_backref '<'
-#endif
-
-#ifndef PERL_MAGIC_ext
-# define PERL_MAGIC_ext '~'
-#endif
-
-/* That's the best we can do... */
-#ifndef sv_catpvn_nomg
-# define sv_catpvn_nomg sv_catpvn
-#endif
-
-#ifndef sv_catsv_nomg
-# define sv_catsv_nomg sv_catsv
-#endif
-
-#ifndef sv_setsv_nomg
-# define sv_setsv_nomg sv_setsv
-#endif
-
-#ifndef sv_pvn_nomg
-# define sv_pvn_nomg sv_pvn
-#endif
-
-#ifndef SvIV_nomg
-# define SvIV_nomg SvIV
-#endif
-
-#ifndef SvUV_nomg
-# define SvUV_nomg SvUV
-#endif
-
-#ifndef sv_catpv_mg
-# define sv_catpv_mg(sv, ptr) \
- STMT_START { \
- SV *TeMpSv = sv; \
- sv_catpv(TeMpSv,ptr); \
- SvSETMAGIC(TeMpSv); \
- } STMT_END
-#endif
-
-#ifndef sv_catpvn_mg
-# define sv_catpvn_mg(sv, ptr, len) \
- STMT_START { \
- SV *TeMpSv = sv; \
- sv_catpvn(TeMpSv,ptr,len); \
- SvSETMAGIC(TeMpSv); \
- } STMT_END
-#endif
-
-#ifndef sv_catsv_mg
-# define sv_catsv_mg(dsv, ssv) \
- STMT_START { \
- SV *TeMpSv = dsv; \
- sv_catsv(TeMpSv,ssv); \
- SvSETMAGIC(TeMpSv); \
- } STMT_END
-#endif
-
-#ifndef sv_setiv_mg
-# define sv_setiv_mg(sv, i) \
- STMT_START { \
- SV *TeMpSv = sv; \
- sv_setiv(TeMpSv,i); \
- SvSETMAGIC(TeMpSv); \
- } STMT_END
-#endif
-
-#ifndef sv_setnv_mg
-# define sv_setnv_mg(sv, num) \
- STMT_START { \
- SV *TeMpSv = sv; \
- sv_setnv(TeMpSv,num); \
- SvSETMAGIC(TeMpSv); \
- } STMT_END
-#endif
-
-#ifndef sv_setpv_mg
-# define sv_setpv_mg(sv, ptr) \
- STMT_START { \
- SV *TeMpSv = sv; \
- sv_setpv(TeMpSv,ptr); \
- SvSETMAGIC(TeMpSv); \
- } STMT_END
-#endif
-
-#ifndef sv_setpvn_mg
-# define sv_setpvn_mg(sv, ptr, len) \
- STMT_START { \
- SV *TeMpSv = sv; \
- sv_setpvn(TeMpSv,ptr,len); \
- SvSETMAGIC(TeMpSv); \
- } STMT_END
-#endif
-
-#ifndef sv_setsv_mg
-# define sv_setsv_mg(dsv, ssv) \
- STMT_START { \
- SV *TeMpSv = dsv; \
- sv_setsv(TeMpSv,ssv); \
- SvSETMAGIC(TeMpSv); \
- } STMT_END
-#endif
-
-#ifndef sv_setuv_mg
-# define sv_setuv_mg(sv, i) \
- STMT_START { \
- SV *TeMpSv = sv; \
- sv_setuv(TeMpSv,i); \
- SvSETMAGIC(TeMpSv); \
- } STMT_END
-#endif
-
-#ifndef sv_usepvn_mg
-# define sv_usepvn_mg(sv, ptr, len) \
- STMT_START { \
- SV *TeMpSv = sv; \
- sv_usepvn(TeMpSv,ptr,len); \
- SvSETMAGIC(TeMpSv); \
- } STMT_END
-#endif
-#ifndef SvVSTRING_mg
-# define SvVSTRING_mg(sv) (SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_vstring) : NULL)
-#endif
-
-/* Hint: sv_magic_portable
- * This is a compatibility function that is only available with
- * Devel::PPPort. It is NOT in the perl core.
- * Its purpose is to mimic the 5.8.0 behaviour of sv_magic() when
- * it is being passed a name pointer with namlen == 0. In that
- * case, perl 5.8.0 and later store the pointer, not a copy of it.
- * The compatibility can be provided back to perl 5.004. With
- * earlier versions, the code will not compile.
- */
-
-#if (PERL_BCDVERSION < 0x5004000)
-
- /* code that uses sv_magic_portable will not compile */
-
-#elif (PERL_BCDVERSION < 0x5008000)
-
-# define sv_magic_portable(sv, obj, how, name, namlen) \
- STMT_START { \
- SV *SvMp_sv = (sv); \
- char *SvMp_name = (char *) (name); \
- I32 SvMp_namlen = (namlen); \
- if (SvMp_name && SvMp_namlen == 0) \
- { \
- MAGIC *mg; \
- sv_magic(SvMp_sv, obj, how, 0, 0); \
- mg = SvMAGIC(SvMp_sv); \
- mg->mg_len = -42; /* XXX: this is the tricky part */ \
- mg->mg_ptr = SvMp_name; \
- } \
- else \
- { \
- sv_magic(SvMp_sv, obj, how, SvMp_name, SvMp_namlen); \
- } \
- } STMT_END
-
-#else
-
-# define sv_magic_portable(a, b, c, d, e) sv_magic(a, b, c, d, e)
-
-#endif
-
-#if !defined(mg_findext)
-#if defined(NEED_mg_findext)
-static MAGIC * DPPP_(my_mg_findext)(SV * sv, int type, const MGVTBL *vtbl);
-static
-#else
-extern MAGIC * DPPP_(my_mg_findext)(SV * sv, int type, const MGVTBL *vtbl);
-#endif
-
-#define mg_findext DPPP_(my_mg_findext)
-#define Perl_mg_findext DPPP_(my_mg_findext)
-
-#if defined(NEED_mg_findext) || defined(NEED_mg_findext_GLOBAL)
-
-MAGIC *
-DPPP_(my_mg_findext)(SV * sv, int type, const MGVTBL *vtbl) {
- if (sv) {
- MAGIC *mg;
-
-#ifdef AvPAD_NAMELIST
- assert(!(SvTYPE(sv) == SVt_PVAV && AvPAD_NAMELIST(sv)));
-#endif
-
- for (mg = SvMAGIC (sv); mg; mg = mg->mg_moremagic) {
- if (mg->mg_type == type && mg->mg_virtual == vtbl)
- return mg;
- }
- }
-
- return NULL;
-}
-
-#endif
-#endif
-
-#if !defined(sv_unmagicext)
-#if defined(NEED_sv_unmagicext)
-static int DPPP_(my_sv_unmagicext)(pTHX_ SV * const sv, const int type, MGVTBL * vtbl);
-static
-#else
-extern int DPPP_(my_sv_unmagicext)(pTHX_ SV * const sv, const int type, MGVTBL * vtbl);
-#endif
-
-#ifdef sv_unmagicext
-# undef sv_unmagicext
-#endif
-#define sv_unmagicext(a,b,c) DPPP_(my_sv_unmagicext)(aTHX_ a,b,c)
-#define Perl_sv_unmagicext DPPP_(my_sv_unmagicext)
-
-#if defined(NEED_sv_unmagicext) || defined(NEED_sv_unmagicext_GLOBAL)
-
-int
-DPPP_(my_sv_unmagicext)(pTHX_ SV *const sv, const int type, MGVTBL *vtbl)
-{
- MAGIC* mg;
- MAGIC** mgp;
-
- if (SvTYPE(sv) < SVt_PVMG || !SvMAGIC(sv))
- return 0;
- mgp = &(SvMAGIC(sv));
- for (mg = *mgp; mg; mg = *mgp) {
- const MGVTBL* const virt = mg->mg_virtual;
- if (mg->mg_type == type && virt == vtbl) {
- *mgp = mg->mg_moremagic;
- if (virt && virt->svt_free)
- virt->svt_free(aTHX_ sv, mg);
- if (mg->mg_ptr && mg->mg_type != PERL_MAGIC_regex_global) {
- if (mg->mg_len > 0)
- Safefree(mg->mg_ptr);
- else if (mg->mg_len == HEf_SVKEY) /* Questionable on older perls... */
- SvREFCNT_dec(MUTABLE_SV(mg->mg_ptr));
- else if (mg->mg_type == PERL_MAGIC_utf8)
- Safefree(mg->mg_ptr);
- }
- if (mg->mg_flags & MGf_REFCOUNTED)
- SvREFCNT_dec(mg->mg_obj);
- Safefree(mg);
- }
- else
- mgp = &mg->mg_moremagic;
- }
- if (SvMAGIC(sv)) {
- if (SvMAGICAL(sv)) /* if we're under save_magic, wait for restore_magic; */
- mg_magical(sv); /* else fix the flags now */
- }
- else {
- SvMAGICAL_off(sv);
- SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
- }
- return 0;
-}
-
-#endif
-#endif
-
-#ifdef USE_ITHREADS
-#ifndef CopFILE
-# define CopFILE(c) ((c)->cop_file)
-#endif
-
-#ifndef CopFILEGV
-# define CopFILEGV(c) (CopFILE(c) ? gv_fetchfile(CopFILE(c)) : Nullgv)
-#endif
-
-#ifndef CopFILE_set
-# define CopFILE_set(c,pv) ((c)->cop_file = savepv(pv))
-#endif
-
-#ifndef CopFILESV
-# define CopFILESV(c) (CopFILE(c) ? GvSV(gv_fetchfile(CopFILE(c))) : Nullsv)
-#endif
-
-#ifndef CopFILEAV
-# define CopFILEAV(c) (CopFILE(c) ? GvAV(gv_fetchfile(CopFILE(c))) : Nullav)
-#endif
-
-#ifndef CopSTASHPV
-# define CopSTASHPV(c) ((c)->cop_stashpv)
-#endif
-
-#ifndef CopSTASHPV_set
-# define CopSTASHPV_set(c,pv) ((c)->cop_stashpv = ((pv) ? savepv(pv) : Nullch))
-#endif
-
-#ifndef CopSTASH
-# define CopSTASH(c) (CopSTASHPV(c) ? gv_stashpv(CopSTASHPV(c),GV_ADD) : Nullhv)
-#endif
-
-#ifndef CopSTASH_set
-# define CopSTASH_set(c,hv) CopSTASHPV_set(c, (hv) ? HvNAME(hv) : Nullch)
-#endif
-
-#ifndef CopSTASH_eq
-# define CopSTASH_eq(c,hv) ((hv) && (CopSTASHPV(c) == HvNAME(hv) \
- || (CopSTASHPV(c) && HvNAME(hv) \
- && strEQ(CopSTASHPV(c), HvNAME(hv)))))
-#endif
-
-#else
-#ifndef CopFILEGV
-# define CopFILEGV(c) ((c)->cop_filegv)
-#endif
-
-#ifndef CopFILEGV_set
-# define CopFILEGV_set(c,gv) ((c)->cop_filegv = (GV*)SvREFCNT_inc(gv))
-#endif
-
-#ifndef CopFILE_set
-# define CopFILE_set(c,pv) CopFILEGV_set((c), gv_fetchfile(pv))
-#endif
-
-#ifndef CopFILESV
-# define CopFILESV(c) (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : Nullsv)
-#endif
-
-#ifndef CopFILEAV
-# define CopFILEAV(c) (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : Nullav)
-#endif
-
-#ifndef CopFILE
-# define CopFILE(c) (CopFILESV(c) ? SvPVX(CopFILESV(c)) : Nullch)
-#endif
-
-#ifndef CopSTASH
-# define CopSTASH(c) ((c)->cop_stash)
-#endif
-
-#ifndef CopSTASH_set
-# define CopSTASH_set(c,hv) ((c)->cop_stash = (hv))
-#endif
-
-#ifndef CopSTASHPV
-# define CopSTASHPV(c) (CopSTASH(c) ? HvNAME(CopSTASH(c)) : Nullch)
-#endif
-
-#ifndef CopSTASHPV_set
-# define CopSTASHPV_set(c,pv) CopSTASH_set((c), gv_stashpv(pv,GV_ADD))
-#endif
-
-#ifndef CopSTASH_eq
-# define CopSTASH_eq(c,hv) (CopSTASH(c) == (hv))
-#endif
-
-#endif /* USE_ITHREADS */
-
-#if (PERL_BCDVERSION >= 0x5006000)
-#ifndef caller_cx
-
-# if defined(NEED_caller_cx) || defined(NEED_caller_cx_GLOBAL)
-static I32
-DPPP_dopoptosub_at(const PERL_CONTEXT *cxstk, I32 startingblock)
-{
- I32 i;
-
- for (i = startingblock; i >= 0; i--) {
- register const PERL_CONTEXT * const cx = &cxstk[i];
- switch (CxTYPE(cx)) {
- default:
- continue;
- case CXt_EVAL:
- case CXt_SUB:
- case CXt_FORMAT:
- return i;
- }
- }
- return i;
-}
-# endif
-
-# if defined(NEED_caller_cx)
-static const PERL_CONTEXT * DPPP_(my_caller_cx)(pTHX_ I32 count, const PERL_CONTEXT **dbcxp);
-static
-#else
-extern const PERL_CONTEXT * DPPP_(my_caller_cx)(pTHX_ I32 count, const PERL_CONTEXT **dbcxp);
-#endif
-
-#ifdef caller_cx
-# undef caller_cx
-#endif
-#define caller_cx(a,b) DPPP_(my_caller_cx)(aTHX_ a,b)
-#define Perl_caller_cx DPPP_(my_caller_cx)
-
-#if defined(NEED_caller_cx) || defined(NEED_caller_cx_GLOBAL)
-
-const PERL_CONTEXT *
-DPPP_(my_caller_cx)(pTHX_ I32 count, const PERL_CONTEXT **dbcxp)
-{
- register I32 cxix = DPPP_dopoptosub_at(cxstack, cxstack_ix);
- register const PERL_CONTEXT *cx;
- register const PERL_CONTEXT *ccstack = cxstack;
- const PERL_SI *top_si = PL_curstackinfo;
-
- for (;;) {
- /* we may be in a higher stacklevel, so dig down deeper */
- while (cxix < 0 && top_si->si_type != PERLSI_MAIN) {
- top_si = top_si->si_prev;
- ccstack = top_si->si_cxstack;
- cxix = DPPP_dopoptosub_at(ccstack, top_si->si_cxix);
- }
- if (cxix < 0)
- return NULL;
- /* caller() should not report the automatic calls to &DB::sub */
- if (PL_DBsub && GvCV(PL_DBsub) && cxix >= 0 &&
- ccstack[cxix].blk_sub.cv == GvCV(PL_DBsub))
- count++;
- if (!count--)
- break;
- cxix = DPPP_dopoptosub_at(ccstack, cxix - 1);
- }
-
- cx = &ccstack[cxix];
- if (dbcxp) *dbcxp = cx;
-
- if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT) {
- const I32 dbcxix = DPPP_dopoptosub_at(ccstack, cxix - 1);
- /* We expect that ccstack[dbcxix] is CXt_SUB, anyway, the
- field below is defined for any cx. */
- /* caller() should not report the automatic calls to &DB::sub */
- if (PL_DBsub && GvCV(PL_DBsub) && dbcxix >= 0 && ccstack[dbcxix].blk_sub.cv == GvCV(PL_DBsub))
- cx = &ccstack[dbcxix];
- }
-
- return cx;
-}
-
-# endif
-#endif /* caller_cx */
-#endif /* 5.6.0 */
-#ifndef IN_PERL_COMPILETIME
-# define IN_PERL_COMPILETIME (PL_curcop == &PL_compiling)
-#endif
-
-#ifndef IN_LOCALE_RUNTIME
-# define IN_LOCALE_RUNTIME (PL_curcop->op_private & HINT_LOCALE)
-#endif
-
-#ifndef IN_LOCALE_COMPILETIME
-# define IN_LOCALE_COMPILETIME (PL_hints & HINT_LOCALE)
-#endif
-
-#ifndef IN_LOCALE
-# define IN_LOCALE (IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME)
-#endif
-#ifndef IS_NUMBER_IN_UV
-# define IS_NUMBER_IN_UV 0x01
-#endif
-
-#ifndef IS_NUMBER_GREATER_THAN_UV_MAX
-# define IS_NUMBER_GREATER_THAN_UV_MAX 0x02
-#endif
-
-#ifndef IS_NUMBER_NOT_INT
-# define IS_NUMBER_NOT_INT 0x04
-#endif
-
-#ifndef IS_NUMBER_NEG
-# define IS_NUMBER_NEG 0x08
-#endif
-
-#ifndef IS_NUMBER_INFINITY
-# define IS_NUMBER_INFINITY 0x10
-#endif
-
-#ifndef IS_NUMBER_NAN
-# define IS_NUMBER_NAN 0x20
-#endif
-#ifndef GROK_NUMERIC_RADIX
-# define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(sp, send)
-#endif
-#ifndef PERL_SCAN_GREATER_THAN_UV_MAX
-# define PERL_SCAN_GREATER_THAN_UV_MAX 0x02
-#endif
-
-#ifndef PERL_SCAN_SILENT_ILLDIGIT
-# define PERL_SCAN_SILENT_ILLDIGIT 0x04
-#endif
-
-#ifndef PERL_SCAN_ALLOW_UNDERSCORES
-# define PERL_SCAN_ALLOW_UNDERSCORES 0x01
-#endif
-
-#ifndef PERL_SCAN_DISALLOW_PREFIX
-# define PERL_SCAN_DISALLOW_PREFIX 0x02
-#endif
-
-#ifndef grok_numeric_radix
-#if defined(NEED_grok_numeric_radix)
-static bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
-static
-#else
-extern bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
-#endif
-
-#ifdef grok_numeric_radix
-# undef grok_numeric_radix
-#endif
-#define grok_numeric_radix(a,b) DPPP_(my_grok_numeric_radix)(aTHX_ a,b)
-#define Perl_grok_numeric_radix DPPP_(my_grok_numeric_radix)
-
-#if defined(NEED_grok_numeric_radix) || defined(NEED_grok_numeric_radix_GLOBAL)
-bool
-DPPP_(my_grok_numeric_radix)(pTHX_ const char **sp, const char *send)
-{
-#ifdef USE_LOCALE_NUMERIC
-#ifdef PL_numeric_radix_sv
- if (PL_numeric_radix_sv && IN_LOCALE) {
- STRLEN len;
- char* radix = SvPV(PL_numeric_radix_sv, len);
- if (*sp + len <= send && memEQ(*sp, radix, len)) {
- *sp += len;
- return TRUE;
- }
- }
-#else
- /* older perls don't have PL_numeric_radix_sv so the radix
- * must manually be requested from locale.h
- */
-#include <locale.h>
- dTHR; /* needed for older threaded perls */
- struct lconv *lc = localeconv();
- char *radix = lc->decimal_point;
- if (radix && IN_LOCALE) {
- STRLEN len = strlen(radix);
- if (*sp + len <= send && memEQ(*sp, radix, len)) {
- *sp += len;
- return TRUE;
- }
- }
-#endif
-#endif /* USE_LOCALE_NUMERIC */
- /* always try "." if numeric radix didn't match because
- * we may have data from different locales mixed */
- if (*sp < send && **sp == '.') {
- ++*sp;
- return TRUE;
- }
- return FALSE;
-}
-#endif
-#endif
-
-#ifndef grok_number
-#if defined(NEED_grok_number)
-static int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
-static
-#else
-extern int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
-#endif
-
-#ifdef grok_number
-# undef grok_number
-#endif
-#define grok_number(a,b,c) DPPP_(my_grok_number)(aTHX_ a,b,c)
-#define Perl_grok_number DPPP_(my_grok_number)
-
-#if defined(NEED_grok_number) || defined(NEED_grok_number_GLOBAL)
-int
-DPPP_(my_grok_number)(pTHX_ const char *pv, STRLEN len, UV *valuep)
-{
- const char *s = pv;
- const char *send = pv + len;
- const UV max_div_10 = UV_MAX / 10;
- const char max_mod_10 = UV_MAX % 10;
- int numtype = 0;
- int sawinf = 0;
- int sawnan = 0;
-
- while (s < send && isSPACE(*s))
- s++;
- if (s == send) {
- return 0;
- } else if (*s == '-') {
- s++;
- numtype = IS_NUMBER_NEG;
- }
- else if (*s == '+')
- s++;
-
- if (s == send)
- return 0;
-
- /* next must be digit or the radix separator or beginning of infinity */
- if (isDIGIT(*s)) {
- /* UVs are at least 32 bits, so the first 9 decimal digits cannot
- overflow. */
- UV value = *s - '0';
- /* This construction seems to be more optimiser friendly.
- (without it gcc does the isDIGIT test and the *s - '0' separately)
- With it gcc on arm is managing 6 instructions (6 cycles) per digit.
- In theory the optimiser could deduce how far to unroll the loop
- before checking for overflow. */
- if (++s < send) {
- int digit = *s - '0';
- if (digit >= 0 && digit <= 9) {
- value = value * 10 + digit;
- if (++s < send) {
- digit = *s - '0';
- if (digit >= 0 && digit <= 9) {
- value = value * 10 + digit;
- if (++s < send) {
- digit = *s - '0';
- if (digit >= 0 && digit <= 9) {
- value = value * 10 + digit;
- if (++s < send) {
- digit = *s - '0';
- if (digit >= 0 && digit <= 9) {
- value = value * 10 + digit;
- if (++s < send) {
- digit = *s - '0';
- if (digit >= 0 && digit <= 9) {
- value = value * 10 + digit;
- if (++s < send) {
- digit = *s - '0';
- if (digit >= 0 && digit <= 9) {
- value = value * 10 + digit;
- if (++s < send) {
- digit = *s - '0';
- if (digit >= 0 && digit <= 9) {
- value = value * 10 + digit;
- if (++s < send) {
- digit = *s - '0';
- if (digit >= 0 && digit <= 9) {
- value = value * 10 + digit;
- if (++s < send) {
- /* Now got 9 digits, so need to check
- each time for overflow. */
- digit = *s - '0';
- while (digit >= 0 && digit <= 9
- && (value < max_div_10
- || (value == max_div_10
- && digit <= max_mod_10))) {
- value = value * 10 + digit;
- if (++s < send)
- digit = *s - '0';
- else
- break;
- }
- if (digit >= 0 && digit <= 9
- && (s < send)) {
- /* value overflowed.
- skip the remaining digits, don't
- worry about setting *valuep. */
- do {
- s++;
- } while (s < send && isDIGIT(*s));
- numtype |=
- IS_NUMBER_GREATER_THAN_UV_MAX;
- goto skip_value;
- }
- }
- }
- }
- }
- }
- }
- }
- }
- }
- }
- }
- }
- }
- }
- }
- }
- }
- numtype |= IS_NUMBER_IN_UV;
- if (valuep)
- *valuep = value;
-
- skip_value:
- if (GROK_NUMERIC_RADIX(&s, send)) {
- numtype |= IS_NUMBER_NOT_INT;
- while (s < send && isDIGIT(*s)) /* optional digits after the radix */
- s++;
- }
- }
- else if (GROK_NUMERIC_RADIX(&s, send)) {
- numtype |= IS_NUMBER_NOT_INT | IS_NUMBER_IN_UV; /* valuep assigned below */
- /* no digits before the radix means we need digits after it */
- if (s < send && isDIGIT(*s)) {
- do {
- s++;
- } while (s < send && isDIGIT(*s));
- if (valuep) {
- /* integer approximation is valid - it's 0. */
- *valuep = 0;
- }
- }
- else
- return 0;
- } else if (*s == 'I' || *s == 'i') {
- s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
- s++; if (s == send || (*s != 'F' && *s != 'f')) return 0;
- s++; if (s < send && (*s == 'I' || *s == 'i')) {
- s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
- s++; if (s == send || (*s != 'I' && *s != 'i')) return 0;
- s++; if (s == send || (*s != 'T' && *s != 't')) return 0;
- s++; if (s == send || (*s != 'Y' && *s != 'y')) return 0;
- s++;
- }
- sawinf = 1;
- } else if (*s == 'N' || *s == 'n') {
- /* XXX TODO: There are signaling NaNs and quiet NaNs. */
- s++; if (s == send || (*s != 'A' && *s != 'a')) return 0;
- s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
- s++;
- sawnan = 1;
- } else
- return 0;
-
- if (sawinf) {
- numtype &= IS_NUMBER_NEG; /* Keep track of sign */
- numtype |= IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT;
- } else if (sawnan) {
- numtype &= IS_NUMBER_NEG; /* Keep track of sign */
- numtype |= IS_NUMBER_NAN | IS_NUMBER_NOT_INT;
- } else if (s < send) {
- /* we can have an optional exponent part */
- if (*s == 'e' || *s == 'E') {
- /* The only flag we keep is sign. Blow away any "it's UV" */
- numtype &= IS_NUMBER_NEG;
- numtype |= IS_NUMBER_NOT_INT;
- s++;
- if (s < send && (*s == '-' || *s == '+'))
- s++;
- if (s < send && isDIGIT(*s)) {
- do {
- s++;
- } while (s < send && isDIGIT(*s));
- }
- else
- return 0;
- }
- }
- while (s < send && isSPACE(*s))
- s++;
- if (s >= send)
- return numtype;
- if (len == 10 && memEQ(pv, "0 but true", 10)) {
- if (valuep)
- *valuep = 0;
- return IS_NUMBER_IN_UV;
- }
- return 0;
-}
-#endif
-#endif
-
-/*
- * The grok_* routines have been modified to use warn() instead of
- * Perl_warner(). Also, 'hexdigit' was the former name of PL_hexdigit,
- * which is why the stack variable has been renamed to 'xdigit'.
- */
-
-#ifndef grok_bin
-#if defined(NEED_grok_bin)
-static UV DPPP_(my_grok_bin)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
-static
-#else
-extern UV DPPP_(my_grok_bin)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
-#endif
-
-#ifdef grok_bin
-# undef grok_bin
-#endif
-#define grok_bin(a,b,c,d) DPPP_(my_grok_bin)(aTHX_ a,b,c,d)
-#define Perl_grok_bin DPPP_(my_grok_bin)
-
-#if defined(NEED_grok_bin) || defined(NEED_grok_bin_GLOBAL)
-UV
-DPPP_(my_grok_bin)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
-{
- const char *s = start;
- STRLEN len = *len_p;
- UV value = 0;
- NV value_nv = 0;
-
- const UV max_div_2 = UV_MAX / 2;
- bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
- bool overflowed = FALSE;
-
- if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
- /* strip off leading b or 0b.
- for compatibility silently suffer "b" and "0b" as valid binary
- numbers. */
- if (len >= 1) {
- if (s[0] == 'b') {
- s++;
- len--;
- }
- else if (len >= 2 && s[0] == '0' && s[1] == 'b') {
- s+=2;
- len-=2;
- }
- }
- }
-
- for (; len-- && *s; s++) {
- char bit = *s;
- if (bit == '0' || bit == '1') {
- /* Write it in this wonky order with a goto to attempt to get the
- compiler to make the common case integer-only loop pretty tight.
- With gcc seems to be much straighter code than old scan_bin. */
- redo:
- if (!overflowed) {
- if (value <= max_div_2) {
- value = (value << 1) | (bit - '0');
- continue;
- }
- /* Bah. We're just overflowed. */
- warn("Integer overflow in binary number");
- overflowed = TRUE;
- value_nv = (NV) value;
- }
- value_nv *= 2.0;
- /* If an NV has not enough bits in its mantissa to
- * represent a UV this summing of small low-order numbers
- * is a waste of time (because the NV cannot preserve
- * the low-order bits anyway): we could just remember when
- * did we overflow and in the end just multiply value_nv by the
- * right amount. */
- value_nv += (NV)(bit - '0');
- continue;
- }
- if (bit == '_' && len && allow_underscores && (bit = s[1])
- && (bit == '0' || bit == '1'))
- {
- --len;
- ++s;
- goto redo;
- }
- if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
- warn("Illegal binary digit '%c' ignored", *s);
- break;
- }
-
- if ( ( overflowed && value_nv > 4294967295.0)
-#if UVSIZE > 4
- || (!overflowed && value > 0xffffffff )
-#endif
- ) {
- warn("Binary number > 0b11111111111111111111111111111111 non-portable");
- }
- *len_p = s - start;
- if (!overflowed) {
- *flags = 0;
- return value;
- }
- *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
- if (result)
- *result = value_nv;
- return UV_MAX;
-}
-#endif
-#endif
-
-#ifndef grok_hex
-#if defined(NEED_grok_hex)
-static UV DPPP_(my_grok_hex)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
-static
-#else
-extern UV DPPP_(my_grok_hex)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
-#endif
-
-#ifdef grok_hex
-# undef grok_hex
-#endif
-#define grok_hex(a,b,c,d) DPPP_(my_grok_hex)(aTHX_ a,b,c,d)
-#define Perl_grok_hex DPPP_(my_grok_hex)
-
-#if defined(NEED_grok_hex) || defined(NEED_grok_hex_GLOBAL)
-UV
-DPPP_(my_grok_hex)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
-{
- const char *s = start;
- STRLEN len = *len_p;
- UV value = 0;
- NV value_nv = 0;
-
- const UV max_div_16 = UV_MAX / 16;
- bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
- bool overflowed = FALSE;
- const char *xdigit;
-
- if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
- /* strip off leading x or 0x.
- for compatibility silently suffer "x" and "0x" as valid hex numbers.
- */
- if (len >= 1) {
- if (s[0] == 'x') {
- s++;
- len--;
- }
- else if (len >= 2 && s[0] == '0' && s[1] == 'x') {
- s+=2;
- len-=2;
- }
- }
- }
-
- for (; len-- && *s; s++) {
- xdigit = strchr((char *) PL_hexdigit, *s);
- if (xdigit) {
- /* Write it in this wonky order with a goto to attempt to get the
- compiler to make the common case integer-only loop pretty tight.
- With gcc seems to be much straighter code than old scan_hex. */
- redo:
- if (!overflowed) {
- if (value <= max_div_16) {
- value = (value << 4) | ((xdigit - PL_hexdigit) & 15);
- continue;
- }
- warn("Integer overflow in hexadecimal number");
- overflowed = TRUE;
- value_nv = (NV) value;
- }
- value_nv *= 16.0;
- /* If an NV has not enough bits in its mantissa to
- * represent a UV this summing of small low-order numbers
- * is a waste of time (because the NV cannot preserve
- * the low-order bits anyway): we could just remember when
- * did we overflow and in the end just multiply value_nv by the
- * right amount of 16-tuples. */
- value_nv += (NV)((xdigit - PL_hexdigit) & 15);
- continue;
- }
- if (*s == '_' && len && allow_underscores && s[1]
- && (xdigit = strchr((char *) PL_hexdigit, s[1])))
- {
- --len;
- ++s;
- goto redo;
- }
- if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
- warn("Illegal hexadecimal digit '%c' ignored", *s);
- break;
- }
-
- if ( ( overflowed && value_nv > 4294967295.0)
-#if UVSIZE > 4
- || (!overflowed && value > 0xffffffff )
-#endif
- ) {
- warn("Hexadecimal number > 0xffffffff non-portable");
- }
- *len_p = s - start;
- if (!overflowed) {
- *flags = 0;
- return value;
- }
- *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
- if (result)
- *result = value_nv;
- return UV_MAX;
-}
-#endif
-#endif
-
-#ifndef grok_oct
-#if defined(NEED_grok_oct)
-static UV DPPP_(my_grok_oct)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
-static
-#else
-extern UV DPPP_(my_grok_oct)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
-#endif
-
-#ifdef grok_oct
-# undef grok_oct
-#endif
-#define grok_oct(a,b,c,d) DPPP_(my_grok_oct)(aTHX_ a,b,c,d)
-#define Perl_grok_oct DPPP_(my_grok_oct)
-
-#if defined(NEED_grok_oct) || defined(NEED_grok_oct_GLOBAL)
-UV
-DPPP_(my_grok_oct)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
-{
- const char *s = start;
- STRLEN len = *len_p;
- UV value = 0;
- NV value_nv = 0;
-
- const UV max_div_8 = UV_MAX / 8;
- bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
- bool overflowed = FALSE;
-
- for (; len-- && *s; s++) {
- /* gcc 2.95 optimiser not smart enough to figure that this subtraction
- out front allows slicker code. */
- int digit = *s - '0';
- if (digit >= 0 && digit <= 7) {
- /* Write it in this wonky order with a goto to attempt to get the
- compiler to make the common case integer-only loop pretty tight.
- */
- redo:
- if (!overflowed) {
- if (value <= max_div_8) {
- value = (value << 3) | digit;
- continue;
- }
- /* Bah. We're just overflowed. */
- warn("Integer overflow in octal number");
- overflowed = TRUE;
- value_nv = (NV) value;
- }
- value_nv *= 8.0;
- /* If an NV has not enough bits in its mantissa to
- * represent a UV this summing of small low-order numbers
- * is a waste of time (because the NV cannot preserve
- * the low-order bits anyway): we could just remember when
- * did we overflow and in the end just multiply value_nv by the
- * right amount of 8-tuples. */
- value_nv += (NV)digit;
- continue;
- }
- if (digit == ('_' - '0') && len && allow_underscores
- && (digit = s[1] - '0') && (digit >= 0 && digit <= 7))
- {
- --len;
- ++s;
- goto redo;
- }
- /* Allow \octal to work the DWIM way (that is, stop scanning
- * as soon as non-octal characters are seen, complain only iff
- * someone seems to want to use the digits eight and nine). */
- if (digit == 8 || digit == 9) {
- if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
- warn("Illegal octal digit '%c' ignored", *s);
- }
- break;
- }
-
- if ( ( overflowed && value_nv > 4294967295.0)
-#if UVSIZE > 4
- || (!overflowed && value > 0xffffffff )
-#endif
- ) {
- warn("Octal number > 037777777777 non-portable");
- }
- *len_p = s - start;
- if (!overflowed) {
- *flags = 0;
- return value;
- }
- *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
- if (result)
- *result = value_nv;
- return UV_MAX;
-}
-#endif
-#endif
-
-#if !defined(my_snprintf)
-#if defined(NEED_my_snprintf)
-static int DPPP_(my_my_snprintf)(char * buffer, const Size_t len, const char * format, ...);
-static
-#else
-extern int DPPP_(my_my_snprintf)(char * buffer, const Size_t len, const char * format, ...);
-#endif
-
-#define my_snprintf DPPP_(my_my_snprintf)
-#define Perl_my_snprintf DPPP_(my_my_snprintf)
-
-#if defined(NEED_my_snprintf) || defined(NEED_my_snprintf_GLOBAL)
-
-int
-DPPP_(my_my_snprintf)(char *buffer, const Size_t len, const char *format, ...)
-{
- dTHX;
- int retval;
- va_list ap;
- va_start(ap, format);
-#ifdef HAS_VSNPRINTF
- retval = vsnprintf(buffer, len, format, ap);
-#else
- retval = vsprintf(buffer, format, ap);
-#endif
- va_end(ap);
- if (retval < 0 || (len > 0 && (Size_t)retval >= len))
- Perl_croak(aTHX_ "panic: my_snprintf buffer overflow");
- return retval;
-}
-
-#endif
-#endif
-
-#if !defined(my_sprintf)
-#if defined(NEED_my_sprintf)
-static int DPPP_(my_my_sprintf)(char * buffer, const char * pat, ...);
-static
-#else
-extern int DPPP_(my_my_sprintf)(char * buffer, const char * pat, ...);
-#endif
-
-#define my_sprintf DPPP_(my_my_sprintf)
-#define Perl_my_sprintf DPPP_(my_my_sprintf)
-
-#if defined(NEED_my_sprintf) || defined(NEED_my_sprintf_GLOBAL)
-
-int
-DPPP_(my_my_sprintf)(char *buffer, const char* pat, ...)
-{
- va_list args;
- va_start(args, pat);
- vsprintf(buffer, pat, args);
- va_end(args);
- return strlen(buffer);
-}
-
-#endif
-#endif
-
-#ifdef NO_XSLOCKS
-# ifdef dJMPENV
-# define dXCPT dJMPENV; int rEtV = 0
-# define XCPT_TRY_START JMPENV_PUSH(rEtV); if (rEtV == 0)
-# define XCPT_TRY_END JMPENV_POP;
-# define XCPT_CATCH if (rEtV != 0)
-# define XCPT_RETHROW JMPENV_JUMP(rEtV)
-# else
-# define dXCPT Sigjmp_buf oldTOP; int rEtV = 0
-# define XCPT_TRY_START Copy(top_env, oldTOP, 1, Sigjmp_buf); rEtV = Sigsetjmp(top_env, 1); if (rEtV == 0)
-# define XCPT_TRY_END Copy(oldTOP, top_env, 1, Sigjmp_buf);
-# define XCPT_CATCH if (rEtV != 0)
-# define XCPT_RETHROW Siglongjmp(top_env, rEtV)
-# endif
-#endif
-
-#if !defined(my_strlcat)
-#if defined(NEED_my_strlcat)
-static Size_t DPPP_(my_my_strlcat)(char * dst, const char * src, Size_t size);
-static
-#else
-extern Size_t DPPP_(my_my_strlcat)(char * dst, const char * src, Size_t size);
-#endif
-
-#define my_strlcat DPPP_(my_my_strlcat)
-#define Perl_my_strlcat DPPP_(my_my_strlcat)
-
-#if defined(NEED_my_strlcat) || defined(NEED_my_strlcat_GLOBAL)
-
-Size_t
-DPPP_(my_my_strlcat)(char *dst, const char *src, Size_t size)
-{
- Size_t used, length, copy;
-
- used = strlen(dst);
- length = strlen(src);
- if (size > 0 && used < size - 1) {
- copy = (length >= size - used) ? size - used - 1 : length;
- memcpy(dst + used, src, copy);
- dst[used + copy] = '\0';
- }
- return used + length;
-}
-#endif
-#endif
-
-#if !defined(my_strlcpy)
-#if defined(NEED_my_strlcpy)
-static Size_t DPPP_(my_my_strlcpy)(char * dst, const char * src, Size_t size);
-static
-#else
-extern Size_t DPPP_(my_my_strlcpy)(char * dst, const char * src, Size_t size);
-#endif
-
-#define my_strlcpy DPPP_(my_my_strlcpy)
-#define Perl_my_strlcpy DPPP_(my_my_strlcpy)
-
-#if defined(NEED_my_strlcpy) || defined(NEED_my_strlcpy_GLOBAL)
-
-Size_t
-DPPP_(my_my_strlcpy)(char *dst, const char *src, Size_t size)
-{
- Size_t length, copy;
-
- length = strlen(src);
- if (size > 0) {
- copy = (length >= size) ? size - 1 : length;
- memcpy(dst, src, copy);
- dst[copy] = '\0';
- }
- return length;
-}
-
-#endif
-#endif
-#ifndef PERL_PV_ESCAPE_QUOTE
-# define PERL_PV_ESCAPE_QUOTE 0x0001
-#endif
-
-#ifndef PERL_PV_PRETTY_QUOTE
-# define PERL_PV_PRETTY_QUOTE PERL_PV_ESCAPE_QUOTE
-#endif
-
-#ifndef PERL_PV_PRETTY_ELLIPSES
-# define PERL_PV_PRETTY_ELLIPSES 0x0002
-#endif
-
-#ifndef PERL_PV_PRETTY_LTGT
-# define PERL_PV_PRETTY_LTGT 0x0004
-#endif
-
-#ifndef PERL_PV_ESCAPE_FIRSTCHAR
-# define PERL_PV_ESCAPE_FIRSTCHAR 0x0008
-#endif
-
-#ifndef PERL_PV_ESCAPE_UNI
-# define PERL_PV_ESCAPE_UNI 0x0100
-#endif
-
-#ifndef PERL_PV_ESCAPE_UNI_DETECT
-# define PERL_PV_ESCAPE_UNI_DETECT 0x0200
-#endif
-
-#ifndef PERL_PV_ESCAPE_ALL
-# define PERL_PV_ESCAPE_ALL 0x1000
-#endif
-
-#ifndef PERL_PV_ESCAPE_NOBACKSLASH
-# define PERL_PV_ESCAPE_NOBACKSLASH 0x2000
-#endif
-
-#ifndef PERL_PV_ESCAPE_NOCLEAR
-# define PERL_PV_ESCAPE_NOCLEAR 0x4000
-#endif
-
-#ifndef PERL_PV_ESCAPE_RE
-# define PERL_PV_ESCAPE_RE 0x8000
-#endif
-
-#ifndef PERL_PV_PRETTY_NOCLEAR
-# define PERL_PV_PRETTY_NOCLEAR PERL_PV_ESCAPE_NOCLEAR
-#endif
-#ifndef PERL_PV_PRETTY_DUMP
-# define PERL_PV_PRETTY_DUMP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_QUOTE
-#endif
-
-#ifndef PERL_PV_PRETTY_REGPROP
-# define PERL_PV_PRETTY_REGPROP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_LTGT|PERL_PV_ESCAPE_RE
-#endif
-
-/* Hint: pv_escape
- * Note that unicode functionality is only backported to
- * those perl versions that support it. For older perl
- * versions, the implementation will fall back to bytes.
- */
-
-#ifndef pv_escape
-#if defined(NEED_pv_escape)
-static char * DPPP_(my_pv_escape)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, STRLEN * const escaped, const U32 flags);
-static
-#else
-extern char * DPPP_(my_pv_escape)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, STRLEN * const escaped, const U32 flags);
-#endif
-
-#ifdef pv_escape
-# undef pv_escape
-#endif
-#define pv_escape(a,b,c,d,e,f) DPPP_(my_pv_escape)(aTHX_ a,b,c,d,e,f)
-#define Perl_pv_escape DPPP_(my_pv_escape)
-
-#if defined(NEED_pv_escape) || defined(NEED_pv_escape_GLOBAL)
-
-char *
-DPPP_(my_pv_escape)(pTHX_ SV *dsv, char const * const str,
- const STRLEN count, const STRLEN max,
- STRLEN * const escaped, const U32 flags)
-{
- const char esc = flags & PERL_PV_ESCAPE_RE ? '%' : '\\';
- const char dq = flags & PERL_PV_ESCAPE_QUOTE ? '"' : esc;
- char octbuf[32] = "%123456789ABCDF";
- STRLEN wrote = 0;
- STRLEN chsize = 0;
- STRLEN readsize = 1;
-#if defined(is_utf8_string) && defined(utf8_to_uvchr)
- bool isuni = flags & PERL_PV_ESCAPE_UNI ? 1 : 0;
-#endif
- const char *pv = str;
- const char * const end = pv + count;
- octbuf[0] = esc;
-
- if (!(flags & PERL_PV_ESCAPE_NOCLEAR))
- sv_setpvs(dsv, "");
-
-#if defined(is_utf8_string) && defined(utf8_to_uvchr)
- if ((flags & PERL_PV_ESCAPE_UNI_DETECT) && is_utf8_string((U8*)pv, count))
- isuni = 1;
-#endif
-
- for (; pv < end && (!max || wrote < max) ; pv += readsize) {
- const UV u =
-#if defined(is_utf8_string) && defined(utf8_to_uvchr)
- isuni ? utf8_to_uvchr((U8*)pv, &readsize) :
-#endif
- (U8)*pv;
- const U8 c = (U8)u & 0xFF;
-
- if (u > 255 || (flags & PERL_PV_ESCAPE_ALL)) {
- if (flags & PERL_PV_ESCAPE_FIRSTCHAR)
- chsize = my_snprintf(octbuf, sizeof octbuf,
- "%" UVxf, u);
- else
- chsize = my_snprintf(octbuf, sizeof octbuf,
- "%cx{%" UVxf "}", esc, u);
- } else if (flags & PERL_PV_ESCAPE_NOBACKSLASH) {
- chsize = 1;
- } else {
- if (c == dq || c == esc || !isPRINT(c)) {
- chsize = 2;
- switch (c) {
- case '\\' : /* fallthrough */
- case '%' : if (c == esc)
- octbuf[1] = esc;
- else
- chsize = 1;
- break;
- case '\v' : octbuf[1] = 'v'; break;
- case '\t' : octbuf[1] = 't'; break;
- case '\r' : octbuf[1] = 'r'; break;
- case '\n' : octbuf[1] = 'n'; break;
- case '\f' : octbuf[1] = 'f'; break;
- case '"' : if (dq == '"')
- octbuf[1] = '"';
- else
- chsize = 1;
- break;
- default: chsize = my_snprintf(octbuf, sizeof octbuf,
- pv < end && isDIGIT((U8)*(pv+readsize))
- ? "%c%03o" : "%c%o", esc, c);
- }
- } else {
- chsize = 1;
- }
- }
- if (max && wrote + chsize > max) {
- break;
- } else if (chsize > 1) {
- sv_catpvn(dsv, octbuf, chsize);
- wrote += chsize;
- } else {
- char tmp[2];
- my_snprintf(tmp, sizeof tmp, "%c", c);
- sv_catpvn(dsv, tmp, 1);
- wrote++;
- }
- if (flags & PERL_PV_ESCAPE_FIRSTCHAR)
- break;
- }
- if (escaped != NULL)
- *escaped= pv - str;
- return SvPVX(dsv);
-}
-
-#endif
-#endif
-
-#ifndef pv_pretty
-#if defined(NEED_pv_pretty)
-static char * DPPP_(my_pv_pretty)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, char const * const start_color, char const * const end_color, const U32 flags);
-static
-#else
-extern char * DPPP_(my_pv_pretty)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, char const * const start_color, char const * const end_color, const U32 flags);
-#endif
-
-#ifdef pv_pretty
-# undef pv_pretty
-#endif
-#define pv_pretty(a,b,c,d,e,f,g) DPPP_(my_pv_pretty)(aTHX_ a,b,c,d,e,f,g)
-#define Perl_pv_pretty DPPP_(my_pv_pretty)
-
-#if defined(NEED_pv_pretty) || defined(NEED_pv_pretty_GLOBAL)
-
-char *
-DPPP_(my_pv_pretty)(pTHX_ SV *dsv, char const * const str, const STRLEN count,
- const STRLEN max, char const * const start_color, char const * const end_color,
- const U32 flags)
-{
- const U8 dq = (flags & PERL_PV_PRETTY_QUOTE) ? '"' : '%';
- STRLEN escaped;
-
- if (!(flags & PERL_PV_PRETTY_NOCLEAR))
- sv_setpvs(dsv, "");
-
- if (dq == '"')
- sv_catpvs(dsv, "\"");
- else if (flags & PERL_PV_PRETTY_LTGT)
- sv_catpvs(dsv, "<");
-
- if (start_color != NULL)
- sv_catpv(dsv, D_PPP_CONSTPV_ARG(start_color));
-
- pv_escape(dsv, str, count, max, &escaped, flags | PERL_PV_ESCAPE_NOCLEAR);
-
- if (end_color != NULL)
- sv_catpv(dsv, D_PPP_CONSTPV_ARG(end_color));
-
- if (dq == '"')
- sv_catpvs(dsv, "\"");
- else if (flags & PERL_PV_PRETTY_LTGT)
- sv_catpvs(dsv, ">");
-
- if ((flags & PERL_PV_PRETTY_ELLIPSES) && escaped < count)
- sv_catpvs(dsv, "...");
-
- return SvPVX(dsv);
-}
-
-#endif
-#endif
-
-#ifndef pv_display
-#if defined(NEED_pv_display)
-static char * DPPP_(my_pv_display)(pTHX_ SV * dsv, const char * pv, STRLEN cur, STRLEN len, STRLEN pvlim);
-static
-#else
-extern char * DPPP_(my_pv_display)(pTHX_ SV * dsv, const char * pv, STRLEN cur, STRLEN len, STRLEN pvlim);
-#endif
-
-#ifdef pv_display
-# undef pv_display
-#endif
-#define pv_display(a,b,c,d,e) DPPP_(my_pv_display)(aTHX_ a,b,c,d,e)
-#define Perl_pv_display DPPP_(my_pv_display)
-
-#if defined(NEED_pv_display) || defined(NEED_pv_display_GLOBAL)
-
-char *
-DPPP_(my_pv_display)(pTHX_ SV *dsv, const char *pv, STRLEN cur, STRLEN len, STRLEN pvlim)
-{
- pv_pretty(dsv, pv, cur, pvlim, NULL, NULL, PERL_PV_PRETTY_DUMP);
- if (len > cur && pv[cur] == '\0')
- sv_catpvs(dsv, "\\0");
- return SvPVX(dsv);
-}
-
-#endif
-#endif
-
-#endif /* _P_P_PORTABILITY_H_ */
-
-/* End of File ppport.h */
+++ /dev/null
-/* dbivport.h
-
- Provides macros that enable greater portability between DBI versions.
-
- This file should be *copied* and included in driver distributions
- and #included into the source, after #include DBIXS.h
-
- New driver releases should include an updated copy of dbivport.h
- from the most recent DBI release.
-*/
-
-#ifndef DBI_VPORT_H
-#define DBI_VPORT_H
-
-#ifndef DBIh_SET_ERR_CHAR
-/* Emulate DBIh_SET_ERR_CHAR
- Only uses the err_i, errstr and state parameters.
-*/
-#define DBIh_SET_ERR_CHAR(h, imp_xxh, err_c, err_i, errstr, state, method) \
- sv_setiv(DBIc_ERR(imp_xxh), err_i); \
- (state) ? (void)sv_setpv(DBIc_STATE(imp_xxh), state) : (void)SvOK_off(DBIc_STATE(imp_xxh)); \
- sv_setpv(DBIc_ERRSTR(imp_xxh), errstr)
-#endif
-
-#ifndef DBIcf_Executed
-#define DBIcf_Executed 0x080000
-#endif
-
-#ifndef DBIc_TRACE_LEVEL_MASK
-#define DBIc_TRACE_LEVEL_MASK 0x0000000F
-#define DBIc_TRACE_FLAGS_MASK 0xFFFFFF00
-#define DBIc_TRACE_SETTINGS(imp) (DBIc_DBISTATE(imp)->debug)
-#define DBIc_TRACE_LEVEL(imp) (DBIc_TRACE_SETTINGS(imp) & DBIc_TRACE_LEVEL_MASK)
-#define DBIc_TRACE_FLAGS(imp) (DBIc_TRACE_SETTINGS(imp) & DBIc_TRACE_FLAGS_MASK)
-/* DBIc_TRACE_MATCHES - true if s1 'matches' s2 (c.f. trace_msg())
- DBIc_TRACE_MATCHES(foo, DBIc_TRACE_SETTINGS(imp))
-*/
-#define DBIc_TRACE_MATCHES(s1, s2) \
- ( ((s1 & DBIc_TRACE_LEVEL_MASK) >= (s2 & DBIc_TRACE_LEVEL_MASK)) \
- || ((s1 & DBIc_TRACE_FLAGS_MASK) & (s2 & DBIc_TRACE_FLAGS_MASK)) )
-/* DBIc_TRACE - true if flags match & DBI level>=flaglevel, or if DBI level>level
- DBIc_TRACE(imp, 0, 0, 4) = if level >= 4
- DBIc_TRACE(imp, DBDtf_FOO, 2, 4) = if tracing DBDtf_FOO & level>=2 or level>=4
- DBIc_TRACE(imp, DBDtf_FOO, 2, 0) = as above but never trace just due to level
-*/
-#define DBIc_TRACE(imp, flags, flaglevel, level) \
- ( (flags && (DBIc_TRACE_FLAGS(imp) & flags) && (DBIc_TRACE_LEVEL(imp) >= flaglevel)) \
- || (level && DBIc_TRACE_LEVEL(imp) >= level) )
-#endif
-
-
-#endif /* !DBI_VPORT_H */
+++ /dev/null
-/* Fri Jul 13 13:32:02 2012 */
-/* Mixed revision working copy (15349:15353) */
-#define DBIXS_REVISION 15349
+++ /dev/null
-# -*- perl -*-
-
-package Bundle::DBI;
-
-use strict;
-our $VERSION = "12.008696";
-
-1;
-
-__END__
-
-=head1 NAME
-
-Bundle::DBI - A bundle to install DBI and required modules.
-
-=head1 SYNOPSIS
-
- perl -MCPAN -e 'install Bundle::DBI'
-
-=head1 CONTENTS
-
-DBI - for to get to know thyself
-
-DBI::Shell 11.91 - the DBI command line shell
-
-Storable 2.06 - for DBD::Proxy, DBI::ProxyServer, DBD::Forward
-
-Net::Daemon 0.37 - for DBD::Proxy and DBI::ProxyServer
-
-RPC::PlServer 0.2016 - for DBD::Proxy and DBI::ProxyServer
-
-DBD::Multiplex 1.19 - treat multiple db handles as one
-
-=head1 DESCRIPTION
-
-This bundle includes all the modules used by the Perl Database
-Interface (DBI) module, created by Tim Bunce.
-
-A I<Bundle> is a module that simply defines a collection of other
-modules. It is used by the L<CPAN> module to automate the fetching,
-building and installing of modules from the CPAN ftp archive sites.
-
-This bundle does not deal with the various database drivers (e.g.
-DBD::Informix, DBD::Oracle etc), most of which require software from
-sources other than CPAN. You'll need to fetch and build those drivers
-yourself.
-
-=head1 AUTHORS
-
-Jonathan Leffler, Jochen Wiedmann and Tim Bunce.
-
-=cut
+++ /dev/null
-#######################################################################
-#
-# DBD::DBM - a DBI driver for DBM files
-#
-# Copyright (c) 2004 by Jeff Zucker < jzucker AT cpan.org >
-# Copyright (c) 2010-2013 by Jens Rehsack & H.Merijn Brand
-#
-# All rights reserved.
-#
-# You may freely distribute and/or modify this module under the terms
-# of either the GNU General Public License (GPL) or the Artistic License,
-# as specified in the Perl README file.
-#
-# USERS - see the pod at the bottom of this file
-#
-# DBD AUTHORS - see the comments in the code
-#
-#######################################################################
-require 5.008;
-use strict;
-
-#################
-package DBD::DBM;
-#################
-use base qw( DBD::File );
-use vars qw($VERSION $ATTRIBUTION $drh $methods_already_installed);
-$VERSION = '0.08';
-$ATTRIBUTION = 'DBD::DBM by Jens Rehsack';
-
-# no need to have driver() unless you need private methods
-#
-sub driver ($;$)
-{
- my ( $class, $attr ) = @_;
- return $drh if ($drh);
-
- # do the real work in DBD::File
- #
- $attr->{Attribution} = 'DBD::DBM by Jens Rehsack';
- $drh = $class->SUPER::driver($attr);
-
- # install private methods
- #
- # this requires that dbm_ (or foo_) be a registered prefix
- # but you can write private methods before official registration
- # by hacking the $dbd_prefix_registry in a private copy of DBI.pm
- #
- unless ( $methods_already_installed++ )
- {
- DBD::DBM::st->install_method('dbm_schema');
- }
-
- return $drh;
-}
-
-sub CLONE
-{
- undef $drh;
-}
-
-#####################
-package DBD::DBM::dr;
-#####################
-$DBD::DBM::dr::imp_data_size = 0;
-@DBD::DBM::dr::ISA = qw(DBD::File::dr);
-
-# you could put some :dr private methods here
-
-# you may need to over-ride some DBD::File::dr methods here
-# but you can probably get away with just letting it do the work
-# in most cases
-
-#####################
-package DBD::DBM::db;
-#####################
-$DBD::DBM::db::imp_data_size = 0;
-@DBD::DBM::db::ISA = qw(DBD::File::db);
-
-use Carp qw/carp/;
-
-sub validate_STORE_attr
-{
- my ( $dbh, $attrib, $value ) = @_;
-
- if ( $attrib eq "dbm_ext" or $attrib eq "dbm_lockfile" )
- {
- ( my $newattrib = $attrib ) =~ s/^dbm_/f_/g;
- carp "Attribute '$attrib' is depreciated, use '$newattrib' instead" if ($^W);
- $attrib = $newattrib;
- }
-
- return $dbh->SUPER::validate_STORE_attr( $attrib, $value );
-}
-
-sub validate_FETCH_attr
-{
- my ( $dbh, $attrib ) = @_;
-
- if ( $attrib eq "dbm_ext" or $attrib eq "dbm_lockfile" )
- {
- ( my $newattrib = $attrib ) =~ s/^dbm_/f_/g;
- carp "Attribute '$attrib' is depreciated, use '$newattrib' instead" if ($^W);
- $attrib = $newattrib;
- }
-
- return $dbh->SUPER::validate_FETCH_attr($attrib);
-}
-
-sub set_versions
-{
- my $this = $_[0];
- $this->{dbm_version} = $DBD::DBM::VERSION;
- return $this->SUPER::set_versions();
-}
-
-sub init_valid_attributes
-{
- my $dbh = shift;
-
- # define valid private attributes
- #
- # attempts to set non-valid attrs in connect() or
- # with $dbh->{attr} will throw errors
- #
- # the attrs here *must* start with dbm_ or foo_
- #
- # see the STORE methods below for how to check these attrs
- #
- $dbh->{dbm_valid_attrs} = {
- dbm_type => 1, # the global DBM type e.g. SDBM_File
- dbm_mldbm => 1, # the global MLDBM serializer
- dbm_cols => 1, # the global column names
- dbm_version => 1, # verbose DBD::DBM version
- dbm_store_metadata => 1, # column names, etc.
- dbm_berkeley_flags => 1, # for BerkeleyDB
- dbm_valid_attrs => 1, # DBD::DBM::db valid attrs
- dbm_readonly_attrs => 1, # DBD::DBM::db r/o attrs
- dbm_meta => 1, # DBD::DBM public access for f_meta
- dbm_tables => 1, # DBD::DBM public access for f_meta
- };
- $dbh->{dbm_readonly_attrs} = {
- dbm_version => 1, # verbose DBD::DBM version
- dbm_valid_attrs => 1, # DBD::DBM::db valid attrs
- dbm_readonly_attrs => 1, # DBD::DBM::db r/o attrs
- dbm_meta => 1, # DBD::DBM public access for f_meta
- };
-
- $dbh->{dbm_meta} = "dbm_tables";
-
- return $dbh->SUPER::init_valid_attributes();
-}
-
-sub init_default_attributes
-{
- my ( $dbh, $phase ) = @_;
-
- $dbh->SUPER::init_default_attributes($phase);
- $dbh->{f_lockfile} = '.lck';
-
- return $dbh;
-}
-
-sub get_dbm_versions
-{
- my ( $dbh, $table ) = @_;
- $table ||= '';
-
- my $meta;
- my $class = $dbh->{ImplementorClass};
- $class =~ s/::db$/::Table/;
- $table and ( undef, $meta ) = $class->get_table_meta( $dbh, $table, 1 );
- $meta or ( $meta = {} and $class->bootstrap_table_meta( $dbh, $meta, $table ) );
-
- my $dver;
- my $dtype = $meta->{dbm_type};
- eval {
- $dver = $meta->{dbm_type}->VERSION();
-
- # *) when we're still alive here, everything went ok - no need to check for $@
- $dtype .= " ($dver)";
- };
- if ( $meta->{dbm_mldbm} )
- {
- $dtype .= ' + MLDBM';
- eval {
- $dver = MLDBM->VERSION();
- $dtype .= " ($dver)"; # (*)
- };
- eval {
- my $ser_class = "MLDBM::Serializer::" . $meta->{dbm_mldbm};
- my $ser_mod = $ser_class;
- $ser_mod =~ s|::|/|g;
- $ser_mod .= ".pm";
- require $ser_mod;
- $dver = $ser_class->VERSION();
- $dtype .= ' + ' . $ser_class; # (*)
- $dver and $dtype .= " ($dver)"; # (*)
- };
- }
- return sprintf( "%s using %s", $dbh->{dbm_version}, $dtype );
-}
-
-# you may need to over-ride some DBD::File::db methods here
-# but you can probably get away with just letting it do the work
-# in most cases
-
-#####################
-package DBD::DBM::st;
-#####################
-$DBD::DBM::st::imp_data_size = 0;
-@DBD::DBM::st::ISA = qw(DBD::File::st);
-
-sub FETCH
-{
- my ( $sth, $attr ) = @_;
-
- if ( $attr eq "NULLABLE" )
- {
- my @colnames = $sth->sql_get_colnames();
-
- # XXX only BerkeleyDB fails having NULL values for non-MLDBM databases,
- # none accept it for key - but it requires more knowledge between
- # queries and tables storage to return fully correct information
- $attr eq "NULLABLE" and return [ map { 0 } @colnames ];
- }
-
- return $sth->SUPER::FETCH($attr);
-} # FETCH
-
-sub dbm_schema
-{
- my ( $sth, $tname ) = @_;
- return $sth->set_err( $DBI::stderr, 'No table name supplied!' ) unless $tname;
- my $tbl_meta = $sth->{Database}->func( $tname, "f_schema", "get_sql_engine_meta" )
- or return $sth->set_err( $sth->{Database}->err(), $sth->{Database}->errstr() );
- return $tbl_meta->{$tname}->{f_schema};
-}
-# you could put some :st private methods here
-
-# you may need to over-ride some DBD::File::st methods here
-# but you can probably get away with just letting it do the work
-# in most cases
-
-############################
-package DBD::DBM::Statement;
-############################
-
-@DBD::DBM::Statement::ISA = qw(DBD::File::Statement);
-
-########################
-package DBD::DBM::Table;
-########################
-use Carp;
-use Fcntl;
-
-@DBD::DBM::Table::ISA = qw(DBD::File::Table);
-
-my $dirfext = $^O eq 'VMS' ? '.sdbm_dir' : '.dir';
-
-my %reset_on_modify = (
- dbm_type => "dbm_tietype",
- dbm_mldbm => "dbm_tietype",
- );
-__PACKAGE__->register_reset_on_modify( \%reset_on_modify );
-
-my %compat_map = (
- ( map { $_ => "dbm_$_" } qw(type mldbm store_metadata) ),
- dbm_ext => 'f_ext',
- dbm_file => 'f_file',
- dbm_lockfile => ' f_lockfile',
- );
-__PACKAGE__->register_compat_map( \%compat_map );
-
-sub bootstrap_table_meta
-{
- my ( $self, $dbh, $meta, $table ) = @_;
-
- $meta->{dbm_type} ||= $dbh->{dbm_type} || 'SDBM_File';
- $meta->{dbm_mldbm} ||= $dbh->{dbm_mldbm} if ( $dbh->{dbm_mldbm} );
- $meta->{dbm_berkeley_flags} ||= $dbh->{dbm_berkeley_flags};
-
- defined $meta->{f_ext}
- or $meta->{f_ext} = $dbh->{f_ext};
- unless ( defined( $meta->{f_ext} ) )
- {
- my $ext;
- if ( $meta->{dbm_type} eq 'SDBM_File' or $meta->{dbm_type} eq 'ODBM_File' )
- {
- $ext = '.pag/r';
- }
- elsif ( $meta->{dbm_type} eq 'NDBM_File' )
- {
- # XXX NDBM_File on FreeBSD (and elsewhere?) may actually be Berkeley
- # behind the scenes and so create a single .db file.
- if ( $^O =~ /bsd/i or lc($^O) eq 'darwin' )
- {
- $ext = '.db/r';
- }
- elsif ( $^O eq 'SunOS' or $^O eq 'Solaris' or $^O eq 'AIX' )
- {
- $ext = '.pag/r'; # here it's implemented like dbm - just a bit improved
- }
- # else wrapped GDBM
- }
- defined($ext) and $meta->{f_ext} = $ext;
- }
-
- $self->SUPER::bootstrap_table_meta( $dbh, $meta, $table );
-}
-
-sub init_table_meta
-{
- my ( $self, $dbh, $meta, $table ) = @_;
-
- $meta->{f_dontopen} = 1;
-
- unless ( defined( $meta->{dbm_tietype} ) )
- {
- my $tie_type = $meta->{dbm_type};
- $INC{"$tie_type.pm"} or require "$tie_type.pm";
- $tie_type eq 'BerkeleyDB' and $tie_type = 'BerkeleyDB::Hash';
-
- if ( $meta->{dbm_mldbm} )
- {
- $INC{"MLDBM.pm"} or require "MLDBM.pm";
- $meta->{dbm_usedb} = $tie_type;
- $tie_type = 'MLDBM';
- }
-
- $meta->{dbm_tietype} = $tie_type;
- }
-
- unless ( defined( $meta->{dbm_store_metadata} ) )
- {
- my $store = $dbh->{dbm_store_metadata};
- defined($store) or $store = 1;
- $meta->{dbm_store_metadata} = $store;
- }
-
- unless ( defined( $meta->{col_names} ) )
- {
- defined( $dbh->{dbm_cols} ) and $meta->{col_names} = $dbh->{dbm_cols};
- }
-
- $self->SUPER::init_table_meta( $dbh, $meta, $table );
-}
-
-sub open_data
-{
- my ( $className, $meta, $attrs, $flags ) = @_;
- $className->SUPER::open_data( $meta, $attrs, $flags );
-
- unless ( $flags->{dropMode} )
- {
- # TIEING
- #
- # XXX allow users to pass in a pre-created tied object
- #
- my @tie_args;
- if ( $meta->{dbm_type} eq 'BerkeleyDB' )
- {
- my $DB_CREATE = BerkeleyDB::DB_CREATE();
- my $DB_RDONLY = BerkeleyDB::DB_RDONLY();
- my %tie_flags;
- if ( my $f = $meta->{dbm_berkeley_flags} )
- {
- defined( $f->{DB_CREATE} ) and $DB_CREATE = delete $f->{DB_CREATE};
- defined( $f->{DB_RDONLY} ) and $DB_RDONLY = delete $f->{DB_RDONLY};
- %tie_flags = %$f;
- }
- my $open_mode = $flags->{lockMode} || $flags->{createMode} ? $DB_CREATE : $DB_RDONLY;
- @tie_args = (
- -Filename => $meta->{f_fqbn},
- -Flags => $open_mode,
- %tie_flags
- );
- }
- else
- {
- my $open_mode = O_RDONLY;
- $flags->{lockMode} and $open_mode = O_RDWR;
- $flags->{createMode} and $open_mode = O_RDWR | O_CREAT | O_TRUNC;
-
- @tie_args = ( $meta->{f_fqbn}, $open_mode, 0666 );
- }
-
- if ( $meta->{dbm_mldbm} )
- {
- $MLDBM::UseDB = $meta->{dbm_usedb};
- $MLDBM::Serializer = $meta->{dbm_mldbm};
- }
-
- $meta->{hash} = {};
- my $tie_class = $meta->{dbm_tietype};
- eval { tie %{ $meta->{hash} }, $tie_class, @tie_args };
- $@ and croak "Cannot tie(\%h $tie_class @tie_args): $@";
- -f $meta->{f_fqfn} or croak( "No such file: '" . $meta->{f_fqfn} . "'" );
- }
-
- unless ( $flags->{createMode} )
- {
- my ( $meta_data, $schema, $col_names );
- if ( $meta->{dbm_store_metadata} )
- {
- $meta_data = $col_names = $meta->{hash}->{"_metadata \0"};
- if ( $meta_data and $meta_data =~ m~<dbd_metadata>(.+)</dbd_metadata>~is )
- {
- $schema = $col_names = $1;
- $schema =~ s~.*<schema>(.+)</schema>.*~$1~is;
- $col_names =~ s~.*<col_names>(.+)</col_names>.*~$1~is;
- }
- }
- $col_names ||= $meta->{col_names} || [ 'k', 'v' ];
- $col_names = [ split /,/, $col_names ] if ( ref $col_names ne 'ARRAY' );
- if ( $meta->{dbm_store_metadata} and not $meta->{hash}->{"_metadata \0"} )
- {
- $schema or $schema = '';
- $meta->{hash}->{"_metadata \0"} =
- "<dbd_metadata>"
- . "<schema>$schema</schema>"
- . "<col_names>"
- . join( ",", @{$col_names} )
- . "</col_names>"
- . "</dbd_metadata>";
- }
-
- $meta->{schema} = $schema;
- $meta->{col_names} = $col_names;
- }
-}
-
-# you must define drop
-# it is called from execute of a SQL DROP statement
-#
-sub drop ($$)
-{
- my ( $self, $data ) = @_;
- my $meta = $self->{meta};
- $meta->{hash} and untie %{ $meta->{hash} };
- $self->SUPER::drop($data);
- # XXX extra_files
- -f $meta->{f_fqbn} . $dirfext
- and $meta->{f_ext} eq '.pag/r'
- and unlink( $meta->{f_fqbn} . $dirfext );
- return 1;
-}
-
-# you must define fetch_row, it is called on all fetches;
-# it MUST return undef when no rows are left to fetch;
-# checking for $ary[0] is specific to hashes so you'll
-# probably need some other kind of check for nothing-left.
-# as Janis might say: "undef's just another word for
-# nothing left to fetch" :-)
-#
-sub fetch_row ($$)
-{
- my ( $self, $data ) = @_;
- my $meta = $self->{meta};
- # fetch with %each
- #
- my @ary = each %{ $meta->{hash} };
- $meta->{dbm_store_metadata}
- and $ary[0]
- and $ary[0] eq "_metadata \0"
- and @ary = each %{ $meta->{hash} };
-
- my ( $key, $val ) = @ary;
- unless ($key)
- {
- delete $self->{row};
- return;
- }
- my @row = ( ref($val) eq 'ARRAY' ) ? ( $key, @$val ) : ( $key, $val );
- $self->{row} = @row ? \@row : undef;
- return wantarray ? @row : \@row;
-}
-
-# you must define push_row except insert_new_row and update_specific_row is defined
-# it is called on inserts and updates as primitive
-#
-sub insert_new_row ($$$)
-{
- my ( $self, $data, $row_aryref ) = @_;
- my $meta = $self->{meta};
- my $ncols = scalar( @{ $meta->{col_names} } );
- my $nitems = scalar( @{$row_aryref} );
- $ncols == $nitems
- or croak "You tried to insert $nitems, but table is created with $ncols columns";
-
- my $key = shift @$row_aryref;
- my $exists;
- eval { $exists = exists( $meta->{hash}->{$key} ); };
- $exists and croak "Row with PK '$key' already exists";
-
- $meta->{hash}->{$key} = $meta->{dbm_mldbm} ? $row_aryref : $row_aryref->[0];
-
- return 1;
-}
-
-# this is where you grab the column names from a CREATE statement
-# if you don't need to do that, it must be defined but can be empty
-#
-sub push_names ($$$)
-{
- my ( $self, $data, $row_aryref ) = @_;
- my $meta = $self->{meta};
-
- # some sanity checks ...
- my $ncols = scalar(@$row_aryref);
- $ncols < 2 and croak "At least 2 columns are required for DBD::DBM tables ...";
- !$meta->{dbm_mldbm}
- and $ncols > 2
- and croak "Without serializing with MLDBM only 2 columns are supported, you give $ncols";
- $meta->{col_names} = $row_aryref;
- return unless $meta->{dbm_store_metadata};
-
- my $stmt = $data->{sql_stmt};
- my $col_names = join( ',', @{$row_aryref} );
- my $schema = $data->{Database}->{Statement};
- $schema =~ s/^[^\(]+\((.+)\)$/$1/s;
- $schema = $stmt->schema_str() if ( $stmt->can('schema_str') );
- $meta->{hash}->{"_metadata \0"} =
- "<dbd_metadata>"
- . "<schema>$schema</schema>"
- . "<col_names>$col_names</col_names>"
- . "</dbd_metadata>";
-}
-
-# fetch_one_row, delete_one_row, update_one_row
-# are optimized for hash-style lookup without looping;
-# if you don't need them, omit them, they're optional
-# but, in that case you may need to define
-# truncate() and seek(), see below
-#
-sub fetch_one_row ($$;$)
-{
- my ( $self, $key_only, $key ) = @_;
- my $meta = $self->{meta};
- $key_only and return $meta->{col_names}->[0];
- exists $meta->{hash}->{$key} or return;
- my $val = $meta->{hash}->{$key};
- $val = ( ref($val) eq 'ARRAY' ) ? $val : [$val];
- my $row = [ $key, @$val ];
- return wantarray ? @{$row} : $row;
-}
-
-sub delete_one_row ($$$)
-{
- my ( $self, $data, $aryref ) = @_;
- my $meta = $self->{meta};
- delete $meta->{hash}->{ $aryref->[0] };
-}
-
-sub update_one_row ($$$)
-{
- my ( $self, $data, $aryref ) = @_;
- my $meta = $self->{meta};
- my $key = shift @$aryref;
- defined $key or return;
- my $row = ( ref($aryref) eq 'ARRAY' ) ? $aryref : [$aryref];
- $meta->{hash}->{$key} = $meta->{dbm_mldbm} ? $row : $row->[0];
-}
-
-sub update_specific_row ($$$$)
-{
- my ( $self, $data, $aryref, $origary ) = @_;
- my $meta = $self->{meta};
- my $key = shift @$origary;
- my $newkey = shift @$aryref;
- return unless ( defined $key );
- $key eq $newkey or delete $meta->{hash}->{$key};
- my $row = ( ref($aryref) eq 'ARRAY' ) ? $aryref : [$aryref];
- $meta->{hash}->{$newkey} = $meta->{dbm_mldbm} ? $row : $row->[0];
-}
-
-# you may not need to explicitly DESTROY the ::Table
-# put cleanup code to run when the execute is done
-#
-sub DESTROY ($)
-{
- my $self = shift;
- my $meta = $self->{meta};
- $meta->{hash} and untie %{ $meta->{hash} };
-
- $self->SUPER::DESTROY();
-}
-
-# truncate() and seek() must be defined to satisfy DBI::SQL::Nano
-# *IF* you define the *_one_row methods above, truncate() and
-# seek() can be empty or you can use them without actually
-# truncating or seeking anything but if you don't define the
-# *_one_row methods, you may need to define these
-
-# if you need to do something after a series of
-# deletes or updates, you can put it in truncate()
-# which is called at the end of executing
-#
-sub truncate ($$)
-{
- # my ( $self, $data ) = @_;
- return 1;
-}
-
-# seek() is only needed if you use IO::File
-# though it could be used for other non-file operations
-# that you need to do before "writes" or truncate()
-#
-sub seek ($$$$)
-{
- # my ( $self, $data, $pos, $whence ) = @_;
- return 1;
-}
-
-# Th, th, th, that's all folks! See DBD::File and DBD::CSV for other
-# examples of creating pure perl DBDs. I hope this helped.
-# Now it's time to go forth and create your own DBD!
-# Remember to check in with dbi-dev@perl.org before you get too far.
-# We may be able to make suggestions or point you to other related
-# projects.
-
-1;
-__END__
-
-=pod
-
-=head1 NAME
-
-DBD::DBM - a DBI driver for DBM & MLDBM files
-
-=head1 SYNOPSIS
-
- use DBI;
- $dbh = DBI->connect('dbi:DBM:'); # defaults to SDBM_File
- $dbh = DBI->connect('DBI:DBM(RaiseError=1):'); # defaults to SDBM_File
- $dbh = DBI->connect('dbi:DBM:dbm_type=DB_File'); # defaults to DB_File
- $dbh = DBI->connect('dbi:DBM:dbm_mldbm=Storable'); # MLDBM with SDBM_File
-
- # or
- $dbh = DBI->connect('dbi:DBM:', undef, undef);
- $dbh = DBI->connect('dbi:DBM:', undef, undef, {
- f_ext => '.db/r',
- f_dir => '/path/to/dbfiles/',
- f_lockfile => '.lck',
- dbm_type => 'BerkeleyDB',
- dbm_mldbm => 'FreezeThaw',
- dbm_store_metadata => 1,
- dbm_berkeley_flags => {
- '-Cachesize' => 1000, # set a ::Hash flag
- },
- });
-
-and other variations on connect() as shown in the L<DBI> docs,
-L<DBD::File metadata|DBD::File/Metadata> and L</Metadata>
-shown below.
-
-Use standard DBI prepare, execute, fetch, placeholders, etc.,
-see L<QUICK START> for an example.
-
-=head1 DESCRIPTION
-
-DBD::DBM is a database management system that works right out of the
-box. If you have a standard installation of Perl and DBI you can
-begin creating, accessing, and modifying simple database tables
-without any further modules. You can add other modules (e.g.,
-SQL::Statement, DB_File etc) for improved functionality.
-
-The module uses a DBM file storage layer. DBM file storage is common on
-many platforms and files can be created with it in many programming
-languages using different APIs. That means, in addition to creating
-files with DBI/SQL, you can also use DBI/SQL to access and modify files
-created by other DBM modules and programs and vice versa. B<Note> that
-in those cases it might be necessary to use a common subset of the
-provided features.
-
-DBM files are stored in binary format optimized for quick retrieval
-when using a key field. That optimization can be used advantageously
-to make DBD::DBM SQL operations that use key fields very fast. There
-are several different "flavors" of DBM which use different storage
-formats supported by perl modules such as SDBM_File and MLDBM. This
-module supports all of the flavors that perl supports and, when used
-with MLDBM, supports tables with any number of columns and insertion
-of Perl objects into tables.
-
-DBD::DBM has been tested with the following DBM types: SDBM_File,
-NDBM_File, ODBM_File, GDBM_File, DB_File, BerkeleyDB. Each type was
-tested both with and without MLDBM and with the Data::Dumper,
-Storable, FreezeThaw, YAML and JSON serializers using the DBI::SQL::Nano
-or the SQL::Statement engines.
-
-=head1 QUICK START
-
-DBD::DBM operates like all other DBD drivers - it's basic syntax and
-operation is specified by DBI. If you're not familiar with DBI, you should
-start by reading L<DBI> and the documents it points to and then come back
-and read this file. If you are familiar with DBI, you already know most of
-what you need to know to operate this module. Just jump in and create a
-test script something like the one shown below.
-
-You should be aware that there are several options for the SQL engine
-underlying DBD::DBM, see L<Supported SQL syntax>. There are also many
-options for DBM support, see especially the section on L<Adding
-multi-column support with MLDBM>.
-
-But here's a sample to get you started.
-
- use DBI;
- my $dbh = DBI->connect('dbi:DBM:');
- $dbh->{RaiseError} = 1;
- for my $sql( split /;\n+/,"
- CREATE TABLE user ( user_name TEXT, phone TEXT );
- INSERT INTO user VALUES ('Fred Bloggs','233-7777');
- INSERT INTO user VALUES ('Sanjay Patel','777-3333');
- INSERT INTO user VALUES ('Junk','xxx-xxxx');
- DELETE FROM user WHERE user_name = 'Junk';
- UPDATE user SET phone = '999-4444' WHERE user_name = 'Sanjay Patel';
- SELECT * FROM user
- "){
- my $sth = $dbh->prepare($sql);
- $sth->execute;
- $sth->dump_results if $sth->{NUM_OF_FIELDS};
- }
- $dbh->disconnect;
-
-=head1 USAGE
-
-This section will explain some usage cases in more detail. To get an
-overview about the available attributes, see L</Metadata>.
-
-=head2 Specifying Files and Directories
-
-DBD::DBM will automatically supply an appropriate file extension for the
-type of DBM you are using. For example, if you use SDBM_File, a table
-called "fruit" will be stored in two files called "fruit.pag" and
-"fruit.dir". You should B<never> specify the file extensions in your SQL
-statements.
-
-DBD::DBM recognizes following default extensions for following types:
-
-=over 4
-
-=item .pag/r
-
-Chosen for dbm_type C<< SDBM_File >>, C<< ODBM_File >> and C<< NDBM_File >>
-when an implementation is detected which wraps C<< -ldbm >> for
-C<< NDBM_File >> (e.g. Solaris, AIX, ...).
-
-For those types, the C<< .dir >> extension is recognized, too (for being
-deleted when dropping a table).
-
-=item .db/r
-
-Chosen for dbm_type C<< NDBM_File >> when an implementation is detected
-which wraps BerkeleyDB 1.x for C<< NDBM_File >> (typically BSD's, Darwin).
-
-=back
-
-C<< GDBM_File >>, C<< DB_File >> and C<< BerkeleyDB >> don't usually
-use a file extension.
-
-If your DBM type uses an extension other than one of the recognized
-types of extensions, you should set the I<f_ext> attribute to the
-extension B<and> file a bug report as described in DBI with the name
-of the implementation and extension so we can add it to DBD::DBM.
-Thanks in advance for that :-).
-
- $dbh = DBI->connect('dbi:DBM:f_ext=.db'); # .db extension is used
- $dbh = DBI->connect('dbi:DBM:f_ext='); # no extension is used
-
- # or
- $dbh->{f_ext}='.db'; # global setting
- $dbh->{f_meta}->{'qux'}->{f_ext}='.db'; # setting for table 'qux'
-
-By default files are assumed to be in the current working directory.
-To use other directories specify the I<f_dir> attribute in either the
-connect string or by setting the database handle attribute.
-
-For example, this will look for the file /foo/bar/fruit (or
-/foo/bar/fruit.pag for DBM types that use that extension)
-
- my $dbh = DBI->connect('dbi:DBM:f_dir=/foo/bar');
- # and this will too:
- my $dbh = DBI->connect('dbi:DBM:');
- $dbh->{f_dir} = '/foo/bar';
- # but this is recommended
- my $dbh = DBI->connect('dbi:DBM:', undef, undef, { f_dir => '/foo/bar' } );
-
- # now you can do
- my $ary = $dbh->selectall_arrayref(q{ SELECT x FROM fruit });
-
-You can also use delimited identifiers to specify paths directly in SQL
-statements. This looks in the same place as the two examples above but
-without setting I<f_dir>:
-
- my $dbh = DBI->connect('dbi:DBM:');
- my $ary = $dbh->selectall_arrayref(q{
- SELECT x FROM "/foo/bar/fruit"
- });
-
-You can also tell DBD::DBM to use a specified path for a specific table:
-
- $dbh->{dbm_tables}->{f}->{file} = q(/foo/bar/fruit);
-
-Please be aware that you cannot specify this during connection.
-
-If you have SQL::Statement installed, you can use table aliases:
-
- my $dbh = DBI->connect('dbi:DBM:');
- my $ary = $dbh->selectall_arrayref(q{
- SELECT f.x FROM "/foo/bar/fruit" AS f
- });
-
-See the L<GOTCHAS AND WARNINGS> for using DROP on tables.
-
-=head2 Table locking and flock()
-
-Table locking is accomplished using a lockfile which has the same
-basename as the table's file but with the file extension '.lck' (or a
-lockfile extension that you supply, see below). This lock file is
-created with the table during a CREATE and removed during a DROP.
-Every time the table itself is opened, the lockfile is flocked(). For
-SELECT, this is a shared lock. For all other operations, it is an
-exclusive lock (except when you specify something different using the
-I<f_lock> attribute).
-
-Since the locking depends on flock(), it only works on operating
-systems that support flock(). In cases where flock() is not
-implemented, DBD::DBM will simply behave as if the flock() had
-occurred although no actual locking will happen. Read the
-documentation for flock() for more information.
-
-Even on those systems that do support flock(), locking is only
-advisory - as is always the case with flock(). This means that if
-another program tries to access the table file while DBD::DBM has the
-table locked, that other program will *succeed* at opening unless
-it is also using flock on the '.lck' file. As a result DBD::DBM's
-locking only really applies to other programs using DBD::DBM or other
-program written to cooperate with DBD::DBM locking.
-
-=head2 Specifying the DBM type
-
-Each "flavor" of DBM stores its files in a different format and has
-different capabilities and limitations. See L<AnyDBM_File> for a
-comparison of DBM types.
-
-By default, DBD::DBM uses the C<< SDBM_File >> type of storage since
-C<< SDBM_File >> comes with Perl itself. If you have other types of
-DBM storage available, you can use any of them with DBD::DBM. It is
-strongly recommended to use at least C<< DB_File >>, because C<<
-SDBM_File >> has quirks and limitations and C<< ODBM_file >>, C<<
-NDBM_File >> and C<< GDBM_File >> are not always available.
-
-You can specify the DBM type using the I<dbm_type> attribute which can
-be set in the connection string or with C<< $dbh->{dbm_type} >> and
-C<< $dbh->{f_meta}->{$table_name}->{type} >> for per-table settings in
-cases where a single script is accessing more than one kind of DBM
-file.
-
-In the connection string, just set C<< dbm_type=TYPENAME >> where
-C<< TYPENAME >> is any DBM type such as GDBM_File, DB_File, etc. Do I<not>
-use MLDBM as your I<dbm_type> as that is set differently, see below.
-
- my $dbh=DBI->connect('dbi:DBM:'); # uses the default SDBM_File
- my $dbh=DBI->connect('dbi:DBM:dbm_type=GDBM_File'); # uses the GDBM_File
-
- # You can also use $dbh->{dbm_type} to set the DBM type for the connection:
- $dbh->{dbm_type} = 'DB_File'; # set the global DBM type
- print $dbh->{dbm_type}; # display the global DBM type
-
-If you have several tables in your script that use different DBM
-types, you can use the $dbh->{dbm_tables} hash to store different
-settings for the various tables. You can even use this to perform
-joins on files that have completely different storage mechanisms.
-
- # sets global default of GDBM_File
- my $dbh->('dbi:DBM:type=GDBM_File');
-
- # overrides the global setting, but only for the tables called
- # I<foo> and I<bar>
- my $dbh->{f_meta}->{foo}->{dbm_type} = 'DB_File';
- my $dbh->{f_meta}->{bar}->{dbm_type} = 'BerkeleyDB';
-
- # prints the dbm_type for the table "foo"
- print $dbh->{f_meta}->{foo}->{dbm_type};
-
-B<Note> that you must change the I<dbm_type> of a table before you access
-it for first time.
-
-=head2 Adding multi-column support with MLDBM
-
-Most of the DBM types only support two columns and even if it would
-support more, DBD::DBM would only use two. However a CPAN module
-called MLDBM overcomes this limitation by allowing more than two
-columns. MLDBM does this by serializing the data - basically it puts
-a reference to an array into the second column. It can also put almost
-any kind of Perl object or even B<Perl coderefs> into columns.
-
-If you want more than two columns, you B<must> install MLDBM. It's available
-for many platforms and is easy to install.
-
-MLDBM is by default distributed with three serializers - Data::Dumper,
-Storable, and FreezeThaw. Data::Dumper is the default and Storable is the
-fastest. MLDBM can also make use of user-defined serialization methods or
-other serialization modules (e.g. L<YAML::MLDBM> or
-L<MLDBM::Serializer::JSON>. You select the serializer using the
-I<dbm_mldbm> attribute.
-
-Some examples:
-
- $dbh=DBI->connect('dbi:DBM:dbm_mldbm=Storable'); # use MLDBM with Storable
- $dbh=DBI->connect(
- 'dbi:DBM:dbm_mldbm=MySerializer' # use MLDBM with a user defined module
- );
- $dbh=DBI->connect('dbi::dbm:', undef,
- undef, { dbm_mldbm => 'YAML' }); # use 3rd party serializer
- $dbh->{dbm_mldbm} = 'YAML'; # same as above
- print $dbh->{dbm_mldbm} # show the MLDBM serializer
- $dbh->{f_meta}->{foo}->{dbm_mldbm}='Data::Dumper'; # set Data::Dumper for table "foo"
- print $dbh->{f_meta}->{foo}->{mldbm}; # show serializer for table "foo"
-
-MLDBM works on top of other DBM modules so you can also set a DBM type
-along with setting dbm_mldbm. The examples above would default to using
-SDBM_File with MLDBM. If you wanted GDBM_File instead, here's how:
-
- # uses DB_File with MLDBM and Storable
- $dbh = DBI->connect('dbi:DBM:', undef, undef, {
- dbm_type => 'DB_File',
- dbm_mldbm => 'Storable',
- });
-
-SDBM_File, the default I<dbm_type> is quite limited, so if you are going to
-use MLDBM, you should probably use a different type, see L<AnyDBM_File>.
-
-See below for some L<GOTCHAS AND WARNINGS> about MLDBM.
-
-=head2 Support for Berkeley DB
-
-The Berkeley DB storage type is supported through two different Perl
-modules - DB_File (which supports only features in old versions of Berkeley
-DB) and BerkeleyDB (which supports all versions). DBD::DBM supports
-specifying either "DB_File" or "BerkeleyDB" as a I<dbm_type>, with or
-without MLDBM support.
-
-The "BerkeleyDB" dbm_type is experimental and it's interface is likely to
-change. It currently defaults to BerkeleyDB::Hash and does not currently
-support ::Btree or ::Recno.
-
-With BerkeleyDB, you can specify initialization flags by setting them in
-your script like this:
-
- use BerkeleyDB;
- my $env = new BerkeleyDB::Env -Home => $dir; # and/or other Env flags
- $dbh = DBI->connect('dbi:DBM:', undef, undef, {
- dbm_type => 'BerkeleyDB',
- dbm_mldbm => 'Storable',
- dbm_berkeley_flags => {
- 'DB_CREATE' => DB_CREATE, # pass in constants
- 'DB_RDONLY' => DB_RDONLY, # pass in constants
- '-Cachesize' => 1000, # set a ::Hash flag
- '-Env' => $env, # pass in an environment
- },
- });
-
-Do I<not> set the -Flags or -Filename flags as those are determined and
-overwritten by the SQL (e.g. -Flags => DB_RDONLY is set automatically
-when you issue a SELECT statement).
-
-Time has not permitted us to provide support in this release of DBD::DBM
-for further Berkeley DB features such as transactions, concurrency,
-locking, etc. We will be working on these in the future and would value
-suggestions, patches, etc.
-
-See L<DB_File> and L<BerkeleyDB> for further details.
-
-=head2 Optimizing the use of key fields
-
-Most "flavors" of DBM have only two physical columns (but can contain
-multiple logical columns as explained above in
-L<Adding multi-column support with MLDBM>). They work similarly to a
-Perl hash with the first column serving as the key. Like a Perl hash, DBM
-files permit you to do quick lookups by specifying the key and thus avoid
-looping through all records (supported by DBI::SQL::Nano only). Also like
-a Perl hash, the keys must be unique. It is impossible to create two
-records with the same key. To put this more simply and in SQL terms,
-the key column functions as the I<PRIMARY KEY> or UNIQUE INDEX.
-
-In DBD::DBM, you can take advantage of the speed of keyed lookups by using
-DBI::SQL::Nano and a WHERE clause with a single equal comparison on the key
-field. For example, the following SQL statements are optimized for keyed
-lookup:
-
- CREATE TABLE user ( user_name TEXT, phone TEXT);
- INSERT INTO user VALUES ('Fred Bloggs','233-7777');
- # ... many more inserts
- SELECT phone FROM user WHERE user_name='Fred Bloggs';
-
-The "user_name" column is the key column since it is the first
-column. The SELECT statement uses the key column in a single equal
-comparison - "user_name='Fred Bloggs'" - so the search will find it
-very quickly without having to loop through all the names which were
-inserted into the table.
-
-In contrast, these searches on the same table are not optimized:
-
- 1. SELECT phone FROM user WHERE user_name < 'Fred';
- 2. SELECT user_name FROM user WHERE phone = '233-7777';
-
-In #1, the operation uses a less-than (<) comparison rather than an equals
-comparison, so it will not be optimized for key searching. In #2, the key
-field "user_name" is not specified in the WHERE clause, and therefore the
-search will need to loop through all rows to find the requested row(s).
-
-B<Note> that the underlying DBM storage needs to loop over all I<key/value>
-pairs when the optimized fetch is used. SQL::Statement has a massively
-improved where clause evaluation which costs around 15% of the evaluation
-in DBI::SQL::Nano - combined with the loop in the DBM storage the speed
-improvement isn't so impressive.
-
-Even if lookups are faster by around 50%, DBI::SQL::Nano and
-SQL::Statement can benefit from the key field optimizations on
-updating and deleting rows - and here the improved where clause
-evaluation of SQL::Statement might beat DBI::SQL::Nano every time the
-where clause contains not only the key field (or more than one).
-
-=head2 Supported SQL syntax
-
-DBD::DBM uses a subset of SQL. The robustness of that subset depends on
-what other modules you have installed. Both options support basic SQL
-operations including CREATE TABLE, DROP TABLE, INSERT, DELETE, UPDATE, and
-SELECT.
-
-B<Option #1:> By default, this module inherits its SQL support from
-DBI::SQL::Nano that comes with DBI. Nano is, as its name implies, a *very*
-small SQL engine. Although limited in scope, it is faster than option #2
-for some operations (especially single I<primary key> lookups). See
-L<DBI::SQL::Nano> for a description of the SQL it supports and comparisons
-of it with option #2.
-
-B<Option #2:> If you install the pure Perl CPAN module SQL::Statement,
-DBD::DBM will use it instead of Nano. This adds support for table aliases,
-functions, joins, and much more. If you're going to use DBD::DBM
-for anything other than very simple tables and queries, you should install
-SQL::Statement. You don't have to change DBD::DBM or your scripts in any
-way, simply installing SQL::Statement will give you the more robust SQL
-capabilities without breaking scripts written for DBI::SQL::Nano. See
-L<SQL::Statement> for a description of the SQL it supports.
-
-To find out which SQL module is working in a given script, you can use the
-dbm_versions() method or, if you don't need the full output and version
-numbers, just do this:
-
- print $dbh->{sql_handler}, "\n";
-
-That will print out either "SQL::Statement" or "DBI::SQL::Nano".
-
-Baring the section about optimized access to the DBM storage in mind,
-comparing the benefits of both engines:
-
- # DBI::SQL::Nano is faster
- $sth = $dbh->prepare( "update foo set value='new' where key=15" );
- $sth->execute();
- $sth = $dbh->prepare( "delete from foo where key=27" );
- $sth->execute();
- $sth = $dbh->prepare( "select * from foo where key='abc'" );
-
- # SQL::Statement might faster (depending on DB size)
- $sth = $dbh->prepare( "update foo set value='new' where key=?" );
- $sth->execute(15);
- $sth = $dbh->prepare( "update foo set value=? where key=15" );
- $sth->execute('new');
- $sth = $dbh->prepare( "delete from foo where key=?" );
- $sth->execute(27);
-
- # SQL::Statement is faster
- $sth = $dbh->prepare( "update foo set value='new' where value='old'" );
- $sth->execute();
- # must be expressed using "where key = 15 or key = 27 or key = 42 or key = 'abc'"
- # in DBI::SQL::Nano
- $sth = $dbh->prepare( "delete from foo where key in (15,27,42,'abc')" );
- $sth->execute();
- # must be expressed using "where key > 10 and key < 90" in DBI::SQL::Nano
- $sth = $dbh->prepare( "select * from foo where key between (10,90)" );
- $sth->execute();
-
- # only SQL::Statement can handle
- $sth->prepare( "select * from foo,bar where foo.name = bar.name" );
- $sth->execute();
- $sth->prepare( "insert into foo values ( 1, 'foo' ), ( 2, 'bar' )" );
- $sth->execute();
-
-=head2 Specifying Column Names
-
-DBM files don't have a standard way to store column names. DBD::DBM gets
-around this issue with a DBD::DBM specific way of storing the column names.
-B<If you are working only with DBD::DBM and not using files created by or
-accessed with other DBM programs, you can ignore this section.>
-
-DBD::DBM stores column names as a row in the file with the key I<_metadata
-\0>. So this code
-
- my $dbh = DBI->connect('dbi:DBM:');
- $dbh->do("CREATE TABLE baz (foo CHAR(10), bar INTEGER)");
- $dbh->do("INSERT INTO baz (foo,bar) VALUES ('zippy',1)");
-
-Will create a file that has a structure something like this:
-
- _metadata \0 | <dbd_metadata><schema></schema><col_names>foo,bar</col_names></dbd_metadata>
- zippy | 1
-
-The next time you access this table with DBD::DBM, it will treat the
-I<_metadata \0> row as a header rather than as data and will pull the column
-names from there. However, if you access the file with something other
-than DBD::DBM, the row will be treated as a regular data row.
-
-If you do not want the column names stored as a data row in the table you
-can set the I<dbm_store_metadata> attribute to 0.
-
- my $dbh = DBI->connect('dbi:DBM:', undef, undef, { dbm_store_metadata => 0 });
-
- # or
- $dbh->{dbm_store_metadata} = 0;
-
- # or for per-table setting
- $dbh->{f_meta}->{qux}->{dbm_store_metadata} = 0;
-
-By default, DBD::DBM assumes that you have two columns named "k" and "v"
-(short for "key" and "value"). So if you have I<dbm_store_metadata> set to
-1 and you want to use alternate column names, you need to specify the
-column names like this:
-
- my $dbh = DBI->connect('dbi:DBM:', undef, undef, {
- dbm_store_metadata => 0,
- dbm_cols => [ qw(foo bar) ],
- });
-
- # or
- $dbh->{dbm_store_metadata} = 0;
- $dbh->{dbm_cols} = 'foo,bar';
-
- # or to set the column names on per-table basis, do this:
- # sets the column names only for table "qux"
- $dbh->{f_meta}->{qux}->{dbm_store_metadata} = 0;
- $dbh->{f_meta}->{qux}->{col_names} = [qw(foo bar)];
-
-If you have a file that was created by another DBM program or created with
-I<dbm_store_metadata> set to zero and you want to convert it to using
-DBD::DBM's column name storage, just use one of the methods above to name
-the columns but *without* specifying I<dbm_store_metadata> as zero. You
-only have to do that once - thereafter you can get by without setting
-either I<dbm_store_metadata> or setting I<dbm_cols> because the names will
-be stored in the file.
-
-=head1 DBI database handle attributes
-
-=head2 Metadata
-
-=head3 Statement handle ($sth) attributes and methods
-
-Most statement handle attributes such as NAME, NUM_OF_FIELDS, etc. are
-available only after an execute. The same is true of $sth->rows which is
-available after the execute but does I<not> require a fetch.
-
-=head3 Driver handle ($dbh) attributes
-
-It is not supported anymore to use dbm-attributes without the dbm_-prefix.
-Currently, if an DBD::DBM private attribute is accessed without an
-underscore in it's name, dbm_ is prepended to that attribute and it's
-processed further. If the resulting attribute name is invalid, an error is
-thrown.
-
-=head4 dbm_cols
-
-Contains a comma separated list of column names or an array reference to
-the column names.
-
-=head4 dbm_type
-
-Contains the DBM storage type. Currently known supported type are
-C<< ODBM_File >>, C<< NDBM_File >>, C<< SDBM_File >>, C<< GDBM_File >>,
-C<< DB_File >> and C<< BerkeleyDB >>. It is not recommended to use one
-of the first three types - even if C<< SDBM_File >> is the most commonly
-available I<dbm_type>.
-
-=head4 dbm_mldbm
-
-Contains the serializer for DBM storage (value column). Requires the
-CPAN module L<MLDBM> installed. Currently known supported serializers
-are:
-
-=over 8
-
-=item Data::Dumper
-
-Default serializer. Deployed with Perl core.
-
-=item Storable
-
-Faster serializer. Deployed with Perl core.
-
-=item FreezeThaw
-
-Pure Perl serializer, requires L<FreezeThaw> to be installed.
-
-=item YAML
-
-Portable serializer (between languages but not architectures).
-Requires L<YAML::MLDBM> installation.
-
-=item JSON
-
-Portable, fast serializer (between languages but not architectures).
-Requires L<MLDBM::Serializer::JSON> installation.
-
-=back
-
-=head4 dbm_store_metadata
-
-Boolean value which determines if the metadata in DBM is stored or not.
-
-=head4 dbm_berkeley_flags
-
-Hash reference with additional flags for BerkeleyDB::Hash instantiation.
-
-=head4 dbm_version
-
-Readonly attribute containing the version of DBD::DBM.
-
-=head4 f_meta
-
-In addition to the attributes L<DBD::File> recognizes, DBD::DBM knows
-about the (public) attributes C<col_names> (B<Note> not I<dbm_cols>
-here!), C<dbm_type>, C<dbm_mldbm>, C<dbm_store_metadata> and
-C<dbm_berkeley_flags>. As in DBD::File, there are undocumented,
-internal attributes in DBD::DBM. Be very careful when modifying
-attributes you do not know; the consequence might a destroyed or
-corrupted table.
-
-=head4 dbm_tables
-
-This attribute provides restricted access to the table meta data. See
-L<f_meta> and L<DBD::File/f_meta> for attribute details.
-
-dbm_tables is a tied hash providing the internal table names as keys
-(accessing unknown tables might create an entry) and their meta
-data as another tied hash. The table meta storage is obtained via
-the C<get_table_meta> method from the table implementation (see
-L<DBD::File::Developers>). Attribute setting and getting within the
-table meta data is handled via the methods C<set_table_meta_attr> and
-C<get_table_meta_attr>.
-
-=head3 Following attributes are no longer handled by DBD::DBM:
-
-=head4 dbm_ext
-
-This attribute is silently mapped to DBD::File's attribute I<f_ext>.
-Later versions of DBI might show a depreciated warning when this attribute
-is used and eventually it will be removed.
-
-=head4 dbm_lockfile
-
-This attribute is silently mapped to DBD::File's attribute I<f_lockfile>.
-Later versions of DBI might show a depreciated warning when this attribute
-is used and eventually it will be removed.
-
-=head1 DBI database handle methods
-
-=head2 The $dbh->dbm_versions() method
-
-The private method dbm_versions() returns a summary of what other modules
-are being used at any given time. DBD::DBM can work with or without many
-other modules - it can use either SQL::Statement or DBI::SQL::Nano as its
-SQL engine, it can be run with DBI or DBI::PurePerl, it can use many kinds
-of DBM modules, and many kinds of serializers when run with MLDBM. The
-dbm_versions() method reports all of that and more.
-
- print $dbh->dbm_versions; # displays global settings
- print $dbh->dbm_versions($table_name); # displays per table settings
-
-An important thing to note about this method is that when it called
-with no arguments, it displays the *global* settings. If you override
-these by setting per-table attributes, these will I<not> be shown
-unless you specify a table name as an argument to the method call.
-
-=head2 Storing Objects
-
-If you are using MLDBM, you can use DBD::DBM to take advantage of its
-serializing abilities to serialize any Perl object that MLDBM can handle.
-To store objects in columns, you should (but don't absolutely need to)
-declare it as a column of type BLOB (the type is *currently* ignored by
-the SQL engine, but it's good form).
-
-=head1 EXTENSIBILITY
-
-=over 8
-
-=item C<SQL::Statement>
-
-Improved SQL engine compared to the built-in DBI::SQL::Nano - see
-L<Supported SQL syntax>.
-
-=item C<DB_File>
-
-Berkeley DB version 1. This database library is available on many
-systems without additional installation and most systems are
-supported.
-
-=item C<GDBM_File>
-
-Simple dbm type (comparable to C<DB_File>) under the GNU license.
-Typically not available (or requires extra installation) on non-GNU
-operating systems.
-
-=item C<BerkeleyDB>
-
-Berkeley DB version up to v4 (and maybe higher) - requires additional
-installation but is easier than GDBM_File on non-GNU systems.
-
-db4 comes with a many tools which allow repairing and migrating
-databases. This is the B<recommended> dbm type for production use.
-
-=item C<MLDBM>
-
-Serializer wrapper to support more than one column for the files.
-Comes with serializers using C<Data::Dumper>, C<FreezeThaw> and
-C<Storable>.
-
-=item C<YAML::MLDBM>
-
-Additional serializer for MLDBM. YAML is very portable between languages.
-
-=item C<MLDBM::Serializer::JSON>
-
-Additional serializer for MLDBM. JSON is very portable between languages,
-probably more than YAML.
-
-=back
-
-=head1 GOTCHAS AND WARNINGS
-
-Using the SQL DROP command will remove any file that has the name specified
-in the command with either '.pag' and '.dir', '.db' or your {f_ext} appended
-to it. So this be dangerous if you aren't sure what file it refers to:
-
- $dbh->do(qq{DROP TABLE "/path/to/any/file"});
-
-Each DBM type has limitations. SDBM_File, for example, can only store
-values of less than 1,000 characters. *You* as the script author must
-ensure that you don't exceed those bounds. If you try to insert a value
-that is larger than DBM can store, the results will be unpredictable.
-See the documentation for whatever DBM you are using for details.
-
-Different DBM implementations return records in different orders.
-That means that you I<should not> rely on the order of records unless
-you use an ORDER BY statement.
-
-DBM data files are platform-specific. To move them from one platform to
-another, you'll need to do something along the lines of dumping your data
-to CSV on platform #1 and then dumping from CSV to DBM on platform #2.
-DBD::AnyData and DBD::CSV can help with that. There may also be DBM
-conversion tools for your platforms which would probably be quicker.
-
-When using MLDBM, there is a very powerful serializer - it will allow
-you to store Perl code or objects in database columns. When these get
-de-serialized, they may be eval'ed - in other words MLDBM (or actually
-Data::Dumper when used by MLDBM) may take the values and try to
-execute them in Perl. Obviously, this can present dangers, so if you
-do not know what is in a file, be careful before you access it with
-MLDBM turned on!
-
-See the entire section on L<Table locking and flock()> for gotchas and
-warnings about the use of flock().
-
-=head1 BUGS AND LIMITATIONS
-
-This module uses hash interfaces of two column file databases. While
-none of supported SQL engines have support for indices, the following
-statements really do the same (even if they mean something completely
-different) for each dbm type which lacks C<EXISTS> support:
-
- $sth->do( "insert into foo values (1, 'hello')" );
-
- # this statement does ...
- $sth->do( "update foo set v='world' where k=1" );
- # ... the same as this statement
- $sth->do( "insert into foo values (1, 'world')" );
-
-This is considered to be a bug and might change in a future release.
-
-Known affected dbm types are C<ODBM_File> and C<NDBM_File>. We highly
-recommended you use a more modern dbm type such as C<DB_File>.
-
-=head1 GETTING HELP, MAKING SUGGESTIONS, AND REPORTING BUGS
-
-If you need help installing or using DBD::DBM, please write to the DBI
-users mailing list at dbi-users@perl.org or to the
-comp.lang.perl.modules newsgroup on usenet. I cannot always answer
-every question quickly but there are many on the mailing list or in
-the newsgroup who can.
-
-DBD developers for DBD's which rely on DBD::File or DBD::DBM or use
-one of them as an example are suggested to join the DBI developers
-mailing list at dbi-dev@perl.org and strongly encouraged to join our
-IRC channel at L<irc://irc.perl.org/dbi>.
-
-If you have suggestions, ideas for improvements, or bugs to report, please
-report a bug as described in DBI. Do not mail any of the authors directly,
-you might not get an answer.
-
-When reporting bugs, please send the output of $dbh->dbm_versions($table)
-for a table that exhibits the bug and as small a sample as you can make of
-the code that produces the bug. And of course, patches are welcome, too
-:-).
-
-If you need enhancements quickly, you can get commercial support as
-described at L<http://dbi.perl.org/support/> or you can contact Jens Rehsack
-at rehsack@cpan.org for commercial support in Germany.
-
-Please don't bother Jochen Wiedmann or Jeff Zucker for support - they
-handed over further maintenance to H.Merijn Brand and Jens Rehsack.
-
-=head1 ACKNOWLEDGEMENTS
-
-Many, many thanks to Tim Bunce for prodding me to write this, and for
-copious, wise, and patient suggestions all along the way. (Jeff Zucker)
-
-I send my thanks and acknowledgements to H.Merijn Brand for his
-initial refactoring of DBD::File and his strong and ongoing support of
-SQL::Statement. Without him, the current progress would never have
-been made. And I have to name Martin J. Evans for each laugh (and
-correction) of all those funny word creations I (as non-native
-speaker) made to the documentation. And - of course - I have to thank
-all those unnamed contributors and testers from the Perl
-community. (Jens Rehsack)
-
-=head1 AUTHOR AND COPYRIGHT
-
-This module is written by Jeff Zucker < jzucker AT cpan.org >, who also
-maintained it till 2007. After that, in 2010, Jens Rehsack & H.Merijn Brand
-took over maintenance.
-
- Copyright (c) 2004 by Jeff Zucker, all rights reserved.
- Copyright (c) 2010-2013 by Jens Rehsack & H.Merijn Brand, all rights reserved.
-
-You may freely distribute and/or modify this module under the terms of
-either the GNU General Public License (GPL) or the Artistic License, as
-specified in the Perl README file.
-
-=head1 SEE ALSO
-
-L<DBI>,
-L<SQL::Statement>, L<DBI::SQL::Nano>,
-L<AnyDBM_File>, L<DB_File>, L<BerkeleyDB>,
-L<MLDBM>, L<YAML::MLDBM>, L<MLDBM::Serializer::JSON>
-
-=cut
+++ /dev/null
-{
- package DBD::ExampleP;
-
- use strict;
- use Symbol;
-
- use DBI qw(:sql_types);
-
- require File::Spec;
-
- our (@EXPORT,$VERSION,@statnames,%statnames,@stattypes,%stattypes,
- @statprec,%statprec,$drh,);
-
- @EXPORT = qw(); # Do NOT @EXPORT anything.
- $VERSION = "12.014311";
-
-# $Id: ExampleP.pm 14310 2010-08-02 06:35:25Z Jens $
-#
-# Copyright (c) 1994,1997,1998 Tim Bunce
-#
-# You may distribute under the terms of either the GNU General Public
-# License or the Artistic License, as specified in the Perl README file.
-
- @statnames = qw(dev ino mode nlink
- uid gid rdev size
- atime mtime ctime
- blksize blocks name);
- @statnames{@statnames} = (0 .. @statnames-1);
-
- @stattypes = (SQL_INTEGER, SQL_INTEGER, SQL_INTEGER, SQL_INTEGER,
- SQL_INTEGER, SQL_INTEGER, SQL_INTEGER, SQL_INTEGER,
- SQL_INTEGER, SQL_INTEGER, SQL_INTEGER,
- SQL_INTEGER, SQL_INTEGER, SQL_VARCHAR);
- @stattypes{@statnames} = @stattypes;
- @statprec = ((10) x (@statnames-1), 1024);
- @statprec{@statnames} = @statprec;
- die unless @statnames == @stattypes;
- die unless @statprec == @stattypes;
-
- $drh = undef; # holds driver handle once initialised
- #$gensym = "SYM000"; # used by st::execute() for filehandles
-
- sub driver{
- return $drh if $drh;
- my($class, $attr) = @_;
- $class .= "::dr";
- ($drh) = DBI::_new_drh($class, {
- 'Name' => 'ExampleP',
- 'Version' => $VERSION,
- 'Attribution' => 'DBD Example Perl stub by Tim Bunce',
- }, ['example implementors private data '.__PACKAGE__]);
- $drh;
- }
-
- sub CLONE {
- undef $drh;
- }
-}
-
-
-{ package DBD::ExampleP::dr; # ====== DRIVER ======
- $imp_data_size = 0;
- use strict;
-
- sub connect { # normally overridden, but a handy default
- my($drh, $dbname, $user, $auth)= @_;
- my ($outer, $dbh) = DBI::_new_dbh($drh, {
- Name => $dbname,
- examplep_private_dbh_attrib => 42, # an example, for testing
- });
- $dbh->{examplep_get_info} = {
- 29 => '"', # SQL_IDENTIFIER_QUOTE_CHAR
- 41 => '.', # SQL_CATALOG_NAME_SEPARATOR
- 114 => 1, # SQL_CATALOG_LOCATION
- };
- #$dbh->{Name} = $dbname;
- $dbh->STORE('Active', 1);
- return $outer;
- }
-
- sub data_sources {
- return ("dbi:ExampleP:dir=."); # possibly usefully meaningless
- }
-
-}
-
-
-{ package DBD::ExampleP::db; # ====== DATABASE ======
- $imp_data_size = 0;
- use strict;
-
- sub prepare {
- my($dbh, $statement)= @_;
- my @fields;
- my($fields, $dir) = $statement =~ m/^\s*select\s+(.*?)\s+from\s+(\S*)/i;
-
- if (defined $fields and defined $dir) {
- @fields = ($fields eq '*')
- ? keys %DBD::ExampleP::statnames
- : split(/\s*,\s*/, $fields);
- }
- else {
- return $dbh->set_err($DBI::stderr, "Syntax error in select statement (\"$statement\")")
- unless $statement =~ m/^\s*set\s+/;
- # the SET syntax is just a hack so the ExampleP driver can
- # be used to test non-select statements.
- # Now we have DBI::DBM etc., ExampleP should be deprecated
- }
-
- my ($outer, $sth) = DBI::_new_sth($dbh, {
- 'Statement' => $statement,
- examplep_private_sth_attrib => 24, # an example, for testing
- }, ['example implementors private data '.__PACKAGE__]);
-
- my @bad = map {
- defined $DBD::ExampleP::statnames{$_} ? () : $_
- } @fields;
- return $dbh->set_err($DBI::stderr, "Unknown field names: @bad")
- if @bad;
-
- $outer->STORE('NUM_OF_FIELDS' => scalar(@fields));
-
- $sth->{examplep_ex_dir} = $dir if defined($dir) && $dir !~ /\?/;
- $outer->STORE('NUM_OF_PARAMS' => ($dir) ? $dir =~ tr/?/?/ : 0);
-
- if (@fields) {
- $outer->STORE('NAME' => \@fields);
- $outer->STORE('NULLABLE' => [ (0) x @fields ]);
- $outer->STORE('SCALE' => [ (0) x @fields ]);
- }
-
- $outer;
- }
-
-
- sub table_info {
- my $dbh = shift;
- my ($catalog, $schema, $table, $type) = @_;
-
- my @types = split(/["']*,["']/, $type || 'TABLE');
- my %types = map { $_=>$_ } @types;
-
- # Return a list of all subdirectories
- my $dh = Symbol::gensym(); # "DBD::ExampleP::".++$DBD::ExampleP::gensym;
- my $dir = $catalog || File::Spec->curdir();
- my @list;
- if ($types{VIEW}) { # for use by test harness
- push @list, [ undef, "schema", "table", 'VIEW', undef ];
- push @list, [ undef, "sch-ema", "table", 'VIEW', undef ];
- push @list, [ undef, "schema", "ta-ble", 'VIEW', undef ];
- push @list, [ undef, "sch ema", "table", 'VIEW', undef ];
- push @list, [ undef, "schema", "ta ble", 'VIEW', undef ];
- }
- if ($types{TABLE}) {
- no strict 'refs';
- opendir($dh, $dir)
- or return $dbh->set_err(int($!), "Failed to open directory $dir: $!");
- while (defined(my $item = readdir($dh))) {
- if ($^O eq 'VMS') {
- # if on VMS then avoid warnings from catdir if you use a file
- # (not a dir) as the item below
- next if $item !~ /\.dir$/oi;
- }
- my $file = File::Spec->catdir($dir,$item);
- next unless -d $file;
- my($dev, $ino, $mode, $nlink, $uid) = lstat($file);
- my $pwnam = undef; # eval { scalar(getpwnam($uid)) } || $uid;
- push @list, [ $dir, $pwnam, $item, 'TABLE', undef ];
- }
- close($dh);
- }
- # We would like to simply do a DBI->connect() here. However,
- # this is wrong if we are in a subclass like DBI::ProxyServer.
- $dbh->{'dbd_sponge_dbh'} ||= DBI->connect("DBI:Sponge:", '','')
- or return $dbh->set_err($DBI::err,
- "Failed to connect to DBI::Sponge: $DBI::errstr");
-
- my $attr = {
- 'rows' => \@list,
- 'NUM_OF_FIELDS' => 5,
- 'NAME' => ['TABLE_CAT', 'TABLE_SCHEM', 'TABLE_NAME',
- 'TABLE_TYPE', 'REMARKS'],
- 'TYPE' => [DBI::SQL_VARCHAR(), DBI::SQL_VARCHAR(),
- DBI::SQL_VARCHAR(), DBI::SQL_VARCHAR(), DBI::SQL_VARCHAR() ],
- 'NULLABLE' => [1, 1, 1, 1, 1]
- };
- my $sdbh = $dbh->{'dbd_sponge_dbh'};
- my $sth = $sdbh->prepare("SHOW TABLES FROM $dir", $attr)
- or return $dbh->set_err($sdbh->err(), $sdbh->errstr());
- $sth;
- }
-
-
- sub type_info_all {
- my ($dbh) = @_;
- my $ti = [
- { TYPE_NAME => 0,
- DATA_TYPE => 1,
- COLUMN_SIZE => 2,
- LITERAL_PREFIX => 3,
- LITERAL_SUFFIX => 4,
- CREATE_PARAMS => 5,
- NULLABLE => 6,
- CASE_SENSITIVE => 7,
- SEARCHABLE => 8,
- UNSIGNED_ATTRIBUTE=> 9,
- FIXED_PREC_SCALE=> 10,
- AUTO_UNIQUE_VALUE => 11,
- LOCAL_TYPE_NAME => 12,
- MINIMUM_SCALE => 13,
- MAXIMUM_SCALE => 14,
- },
- [ 'VARCHAR', DBI::SQL_VARCHAR, 1024, "'","'", undef, 0, 1, 1, 0, 0,0,undef,0,0 ],
- [ 'INTEGER', DBI::SQL_INTEGER, 10, "","", undef, 0, 0, 1, 0, 0,0,undef,0,0 ],
- ];
- return $ti;
- }
-
-
- sub ping {
- (shift->FETCH('Active')) ? 2 : 0; # the value 2 is checked for by t/80proxy.t
- }
-
-
- sub disconnect {
- shift->STORE(Active => 0);
- return 1;
- }
-
-
- sub get_info {
- my ($dbh, $info_type) = @_;
- return $dbh->{examplep_get_info}->{$info_type};
- }
-
-
- sub FETCH {
- my ($dbh, $attrib) = @_;
- # In reality this would interrogate the database engine to
- # either return dynamic values that cannot be precomputed
- # or fetch and cache attribute values too expensive to prefetch.
- # else pass up to DBI to handle
- return $INC{"DBD/ExampleP.pm"} if $attrib eq 'example_driver_path';
- return $dbh->SUPER::FETCH($attrib);
- }
-
-
- sub STORE {
- my ($dbh, $attrib, $value) = @_;
- # store only known attributes else pass up to DBI to handle
- if ($attrib eq 'examplep_set_err') {
- # a fake attribute to enable a test case where STORE issues a warning
- $dbh->set_err($value, $value);
- return;
- }
- if ($attrib eq 'AutoCommit') {
- # convert AutoCommit values to magic ones to let DBI
- # know that the driver has 'handled' the AutoCommit attribute
- $value = ($value) ? -901 : -900;
- }
- return $dbh->{$attrib} = $value if $attrib =~ /^examplep_/;
- return $dbh->SUPER::STORE($attrib, $value);
- }
-
- sub DESTROY {
- my $dbh = shift;
- $dbh->disconnect if $dbh->FETCH('Active');
- undef
- }
-
-
- # This is an example to demonstrate the use of driver-specific
- # methods via $dbh->func().
- # Use it as follows:
- # my @tables = $dbh->func($re, 'examplep_tables');
- #
- # Returns all the tables that match the regular expression $re.
- sub examplep_tables {
- my $dbh = shift; my $re = shift;
- grep { $_ =~ /$re/ } $dbh->tables();
- }
-
- sub parse_trace_flag {
- my ($h, $name) = @_;
- return 0x01000000 if $name eq 'foo';
- return 0x02000000 if $name eq 'bar';
- return 0x04000000 if $name eq 'baz';
- return 0x08000000 if $name eq 'boo';
- return 0x10000000 if $name eq 'bop';
- return $h->SUPER::parse_trace_flag($name);
- }
-
- sub private_attribute_info {
- return { example_driver_path => undef };
- }
-}
-
-
-{ package DBD::ExampleP::st; # ====== STATEMENT ======
- $imp_data_size = 0;
- use strict; no strict 'refs'; # cause problems with filehandles
-
- sub bind_param {
- my($sth, $param, $value, $attribs) = @_;
- $sth->{'dbd_param'}->[$param-1] = $value;
- return 1;
- }
-
-
- sub execute {
- my($sth, @dir) = @_;
- my $dir;
-
- if (@dir) {
- $sth->bind_param($_, $dir[$_-1]) or return
- foreach (1..@dir);
- }
-
- my $dbd_param = $sth->{'dbd_param'} || [];
- return $sth->set_err(2, @$dbd_param." values bound when $sth->{NUM_OF_PARAMS} expected")
- unless @$dbd_param == $sth->{NUM_OF_PARAMS};
-
- return 0 unless $sth->{NUM_OF_FIELDS}; # not a select
-
- $dir = $dbd_param->[0] || $sth->{examplep_ex_dir};
- return $sth->set_err(2, "No bind parameter supplied")
- unless defined $dir;
-
- $sth->finish;
-
- #
- # If the users asks for directory "long_list_4532", then we fake a
- # directory with files "file4351", "file4350", ..., "file0".
- # This is a special case used for testing, especially DBD::Proxy.
- #
- if ($dir =~ /^long_list_(\d+)$/) {
- $sth->{dbd_dir} = [ $1 ]; # array ref indicates special mode
- $sth->{dbd_datahandle} = undef;
- }
- else {
- $sth->{dbd_dir} = $dir;
- my $sym = Symbol::gensym(); # "DBD::ExampleP::".++$DBD::ExampleP::gensym;
- opendir($sym, $dir)
- or return $sth->set_err(2, "opendir($dir): $!");
- $sth->{dbd_datahandle} = $sym;
- }
- $sth->STORE(Active => 1);
- return 1;
- }
-
-
- sub fetch {
- my $sth = shift;
- my $dir = $sth->{dbd_dir};
- my %s;
-
- if (ref $dir) { # special fake-data test mode
- my $num = $dir->[0]--;
- unless ($num > 0) {
- $sth->finish();
- return;
- }
- my $time = time;
- @s{@DBD::ExampleP::statnames} =
- ( 2051, 1000+$num, 0644, 2, $>, $), 0, 1024,
- $time, $time, $time, 512, 2, "file$num")
- }
- else { # normal mode
- my $dh = $sth->{dbd_datahandle}
- or return $sth->set_err($DBI::stderr, "fetch without successful execute");
- my $f = readdir($dh);
- unless ($f) {
- $sth->finish;
- return;
- }
- # untaint $f so that we can use this for DBI taint tests
- ($f) = ($f =~ m/^(.*)$/);
- my $file = File::Spec->catfile($dir, $f);
- # put in all the data fields
- @s{ @DBD::ExampleP::statnames } = (lstat($file), $f);
- }
-
- # return just what fields the query asks for
- my @new = @s{ @{$sth->{NAME}} };
-
- return $sth->_set_fbav(\@new);
- }
- *fetchrow_arrayref = \&fetch;
-
-
- sub finish {
- my $sth = shift;
- closedir($sth->{dbd_datahandle}) if $sth->{dbd_datahandle};
- $sth->{dbd_datahandle} = undef;
- $sth->{dbd_dir} = undef;
- $sth->SUPER::finish();
- return 1;
- }
-
-
- sub FETCH {
- my ($sth, $attrib) = @_;
- # In reality this would interrogate the database engine to
- # either return dynamic values that cannot be precomputed
- # or fetch and cache attribute values too expensive to prefetch.
- if ($attrib eq 'TYPE'){
- return [ @DBD::ExampleP::stattypes{ @{ $sth->FETCH(q{NAME_lc}) } } ];
- }
- elsif ($attrib eq 'PRECISION'){
- return [ @DBD::ExampleP::statprec{ @{ $sth->FETCH(q{NAME_lc}) } } ];
- }
- elsif ($attrib eq 'ParamValues') {
- my $dbd_param = $sth->{dbd_param} || [];
- my %pv = map { $_ => $dbd_param->[$_-1] } 1..@$dbd_param;
- return \%pv;
- }
- # else pass up to DBI to handle
- return $sth->SUPER::FETCH($attrib);
- }
-
-
- sub STORE {
- my ($sth, $attrib, $value) = @_;
- # would normally validate and only store known attributes
- # else pass up to DBI to handle
- return $sth->{$attrib} = $value
- if $attrib eq 'NAME' or $attrib eq 'NULLABLE' or $attrib eq 'SCALE' or $attrib eq 'PRECISION';
- return $sth->SUPER::STORE($attrib, $value);
- }
-
- *parse_trace_flag = \&DBD::ExampleP::db::parse_trace_flag;
-}
-
-1;
-# vim: sw=4:ts=8
+++ /dev/null
-# -*- perl -*-
-#
-# DBD::File - A base class for implementing DBI drivers that
-# act on plain files
-#
-# This module is currently maintained by
-#
-# H.Merijn Brand & Jens Rehsack
-#
-# The original author is Jochen Wiedmann.
-#
-# Copyright (C) 2009-2013 by H.Merijn Brand & Jens Rehsack
-# Copyright (C) 2004 by Jeff Zucker
-# Copyright (C) 1998 by Jochen Wiedmann
-#
-# All rights reserved.
-#
-# You may distribute this module under the terms of either the GNU
-# General Public License or the Artistic License, as specified in
-# the Perl README file.
-
-require 5.008;
-
-use strict;
-use warnings;
-
-use DBI ();
-
-package DBD::File;
-
-use strict;
-use warnings;
-
-use base qw( DBI::DBD::SqlEngine );
-use Carp;
-use vars qw( @ISA $VERSION $drh );
-
-$VERSION = "0.44";
-
-$drh = undef; # holds driver handle(s) once initialized
-
-sub driver ($;$)
-{
- my ($class, $attr) = @_;
-
- # Drivers typically use a singleton object for the $drh
- # We use a hash here to have one singleton per subclass.
- # (Otherwise DBD::CSV and DBD::DBM, for example, would
- # share the same driver object which would cause problems.)
- # An alternative would be to not cache the $drh here at all
- # and require that subclasses do that. Subclasses should do
- # their own caching, so caching here just provides extra safety.
- $drh->{$class} and return $drh->{$class};
-
- $attr ||= {};
- { no strict "refs";
- unless ($attr->{Attribution}) {
- $class eq "DBD::File" and
- $attr->{Attribution} = "$class by Jeff Zucker";
- $attr->{Attribution} ||= ${$class . "::ATTRIBUTION"} ||
- "oops the author of $class forgot to define this";
- }
- $attr->{Version} ||= ${$class . "::VERSION"};
- $attr->{Name} or ($attr->{Name} = $class) =~ s/^DBD\:\://;
- }
-
- $drh->{$class} = $class->SUPER::driver ($attr);
-
- # XXX inject DBD::XXX::Statement unless exists
-
- return $drh->{$class};
- } # driver
-
-sub CLONE
-{
- undef $drh;
- } # CLONE
-
-# ====== DRIVER ================================================================
-
-package DBD::File::dr;
-
-use strict;
-use warnings;
-
-use vars qw( @ISA $imp_data_size );
-
-use Carp;
-
-@DBD::File::dr::ISA = qw( DBI::DBD::SqlEngine::dr );
-$DBD::File::dr::imp_data_size = 0;
-
-sub dsn_quote
-{
- my $str = shift;
- ref $str and return "";
- defined $str or return "";
- $str =~ s/([;:\\])/\\$1/g;
- return $str;
- } # dsn_quote
-
-# XXX rewrite using TableConfig ...
-sub default_table_source { "DBD::File::TableSource::FileSystem" }
-
-sub connect
-{
- my ($drh, $dbname, $user, $auth, $attr) = @_;
-
- # We do not (yet) care about conflicting attributes here
- # my $dbh = DBI->connect ("dbi:CSV:f_dir=test", undef, undef, { f_dir => "text" });
- # will test here that both test and text should exist
- if (my $attr_hash = (DBI->parse_dsn ($dbname))[3]) {
- if (defined $attr_hash->{f_dir} && ! -d $attr_hash->{f_dir}) {
- my $msg = "No such directory '$attr_hash->{f_dir}";
- $drh->set_err (2, $msg);
- $attr_hash->{RaiseError} and croak $msg;
- return;
- }
- }
- if ($attr and defined $attr->{f_dir} && ! -d $attr->{f_dir}) {
- my $msg = "No such directory '$attr->{f_dir}";
- $drh->set_err (2, $msg);
- $attr->{RaiseError} and croak $msg;
- return;
- }
-
- return $drh->SUPER::connect ($dbname, $user, $auth, $attr);
- } # connect
-
-sub disconnect_all
-{
- } # disconnect_all
-
-sub DESTROY
-{
- undef;
- } # DESTROY
-
-# ====== DATABASE ==============================================================
-
-package DBD::File::db;
-
-use strict;
-use warnings;
-
-use vars qw( @ISA $imp_data_size );
-
-use Carp;
-require File::Spec;
-require Cwd;
-use Scalar::Util qw( refaddr ); # in CORE since 5.7.3
-
-@DBD::File::db::ISA = qw( DBI::DBD::SqlEngine::db );
-$DBD::File::db::imp_data_size = 0;
-
-sub data_sources
-{
- my ($dbh, $attr, @other) = @_;
- ref ($attr) eq "HASH" or $attr = {};
- exists $attr->{f_dir} or $attr->{f_dir} = $dbh->{f_dir};
- exists $attr->{f_dir_search} or $attr->{f_dir_search} = $dbh->{f_dir_search};
- return $dbh->SUPER::data_sources ($attr, @other);
- } # data_source
-
-sub set_versions
-{
- my $dbh = shift;
- $dbh->{f_version} = $DBD::File::VERSION;
-
- return $dbh->SUPER::set_versions ();
- } # set_versions
-
-sub init_valid_attributes
-{
- my $dbh = shift;
-
- $dbh->{f_valid_attrs} = {
- f_version => 1, # DBD::File version
- f_dir => 1, # base directory
- f_dir_search => 1, # extended search directories
- f_ext => 1, # file extension
- f_schema => 1, # schema name
- f_lock => 1, # Table locking mode
- f_lockfile => 1, # Table lockfile extension
- f_encoding => 1, # Encoding of the file
- f_valid_attrs => 1, # File valid attributes
- f_readonly_attrs => 1, # File readonly attributes
- };
- $dbh->{f_readonly_attrs} = {
- f_version => 1, # DBD::File version
- f_valid_attrs => 1, # File valid attributes
- f_readonly_attrs => 1, # File readonly attributes
- };
-
- return $dbh->SUPER::init_valid_attributes ();
- } # init_valid_attributes
-
-sub init_default_attributes
-{
- my ($dbh, $phase) = @_;
-
- # must be done first, because setting flags implicitly calls $dbdname::db->STORE
- $dbh->SUPER::init_default_attributes ($phase);
-
- # DBI::BD::SqlEngine::dr::connect will detect old-style drivers and
- # don't call twice
- unless (defined $phase) {
- # we have an "old" driver here
- $phase = defined $dbh->{sql_init_phase};
- $phase and $phase = $dbh->{sql_init_phase};
- }
-
- if (0 == $phase) {
- # f_ext should not be initialized
- # f_map is deprecated (but might return)
- $dbh->{f_dir} = Cwd::abs_path (File::Spec->curdir ());
-
- push @{$dbh->{sql_init_order}{90}}, "f_meta";
-
- # complete derived attributes, if required
- (my $drv_class = $dbh->{ImplementorClass}) =~ s/::db$//;
- my $drv_prefix = DBI->driver_prefix ($drv_class);
- if (exists $dbh->{$drv_prefix . "meta"} and !$dbh->{sql_engine_in_gofer}) {
- my $attr = $dbh->{$drv_prefix . "meta"};
- defined $dbh->{f_valid_attrs}{f_meta}
- and $dbh->{f_valid_attrs}{f_meta} = 1;
-
- $dbh->{f_meta} = $dbh->{$attr};
- }
- }
-
- return $dbh;
- } # init_default_attributes
-
-sub validate_FETCH_attr
-{
- my ($dbh, $attrib) = @_;
-
- $attrib eq "f_meta" and $dbh->{sql_engine_in_gofer} and $attrib = "sql_meta";
-
- return $dbh->SUPER::validate_FETCH_attr ($attrib);
- } # validate_FETCH_attr
-
-sub validate_STORE_attr
-{
- my ($dbh, $attrib, $value) = @_;
-
- if ($attrib eq "f_dir" && defined $value) {
- -d $value or
- return $dbh->set_err ($DBI::stderr, "No such directory '$value'");
- File::Spec->file_name_is_absolute ($value) or
- $value = Cwd::abs_path ($value);
- }
-
- if ($attrib eq "f_ext") {
- $value eq "" || $value =~ m{^\.\w+(?:/[rR]*)?$} or
- carp "'$value' doesn't look like a valid file extension attribute\n";
- }
-
- $attrib eq "f_meta" and $dbh->{sql_engine_in_gofer} and $attrib = "sql_meta";
-
- return $dbh->SUPER::validate_STORE_attr ($attrib, $value);
- } # validate_STORE_attr
-
-sub get_f_versions
-{
- my ($dbh, $table) = @_;
-
- my $class = $dbh->{ImplementorClass};
- $class =~ s/::db$/::Table/;
- my $dver;
- my $dtype = "IO::File";
- eval {
- $dver = IO::File->VERSION ();
-
- # when we're still alive here, everything went ok - no need to check for $@
- $dtype .= " ($dver)";
- };
-
- my $f_encoding;
- if ($table) {
- my $meta;
- $table and (undef, $meta) = $class->get_table_meta ($dbh, $table, 1);
- $meta and $meta->{f_encoding} and $f_encoding = $meta->{f_encoding};
- } # if ($table)
- $f_encoding ||= $dbh->{f_encoding};
-
- $f_encoding and $dtype .= " + " . $f_encoding . " encoding";
-
- return sprintf "%s using %s", $dbh->{f_version}, $dtype;
- } # get_f_versions
-
-# ====== STATEMENT =============================================================
-
-package DBD::File::st;
-
-use strict;
-use warnings;
-
-use vars qw( @ISA $imp_data_size );
-
-@DBD::File::st::ISA = qw( DBI::DBD::SqlEngine::st );
-$DBD::File::st::imp_data_size = 0;
-
-my %supported_attrs = (
- TYPE => 1,
- PRECISION => 1,
- NULLABLE => 1,
- );
-
-sub FETCH
-{
- my ($sth, $attr) = @_;
-
- if ($supported_attrs{$attr}) {
- my $stmt = $sth->{sql_stmt};
-
- if (exists $sth->{ImplementorClass} &&
- exists $sth->{sql_stmt} &&
- $sth->{sql_stmt}->isa ("SQL::Statement")) {
-
- # fill overall_defs unless we know
- unless (exists $sth->{f_overall_defs} && ref $sth->{f_overall_defs}) {
- my $types = $sth->{Database}{Types};
- unless ($types) { # Fetch types only once per database
- if (my $t = $sth->{Database}->type_info_all ()) {
- foreach my $i (1 .. $#$t) {
- $types->{uc $t->[$i][0]} = $t->[$i][1];
- $types->{$t->[$i][1]} ||= uc $t->[$i][0];
- }
- }
- # sane defaults
- for ([ 0, "" ],
- [ 1, "CHAR" ],
- [ 4, "INTEGER" ],
- [ 12, "VARCHAR" ],
- ) {
- $types->{$_->[0]} ||= $_->[1];
- $types->{$_->[1]} ||= $_->[0];
- }
- $sth->{Database}{Types} = $types;
- }
- my $all_meta =
- $sth->{Database}->func ("*", "table_defs", "get_sql_engine_meta");
- foreach my $tbl (keys %$all_meta) {
- my $meta = $all_meta->{$tbl};
- exists $meta->{table_defs} && ref $meta->{table_defs} or next;
- foreach (keys %{$meta->{table_defs}{columns}}) {
- my $field_info = $meta->{table_defs}{columns}{$_};
- if (defined $field_info->{data_type} &&
- $field_info->{data_type} !~ m/^[0-9]+$/) {
- $field_info->{type_name} = uc $field_info->{data_type};
- $field_info->{data_type} = $types->{$field_info->{type_name}} || 0;
- }
- $field_info->{type_name} ||= $types->{$field_info->{data_type}} || "CHAR";
- $sth->{f_overall_defs}{$_} = $field_info;
- }
- }
- }
-
- my @colnames = $sth->sql_get_colnames ();
-
- $attr eq "TYPE" and
- return [ map { $sth->{f_overall_defs}{$_}{data_type} || 12 }
- @colnames ];
-
- $attr eq "TYPE_NAME" and
- return [ map { $sth->{f_overall_defs}{$_}{type_name} || "VARCHAR" }
- @colnames ];
-
- $attr eq "PRECISION" and
- return [ map { $sth->{f_overall_defs}{$_}{data_length} || 0 }
- @colnames ];
-
- $attr eq "NULLABLE" and
- return [ map { ( grep { $_ eq "NOT NULL" }
- @{ $sth->{f_overall_defs}{$_}{constraints} || [] })
- ? 0 : 1 }
- @colnames ];
- }
- }
-
- return $sth->SUPER::FETCH ($attr);
- } # FETCH
-
-# ====== TableSource ===========================================================
-
-package DBD::File::TableSource::FileSystem;
-
-use strict;
-use warnings;
-
-use IO::Dir;
-
-@DBD::File::TableSource::FileSystem::ISA = "DBI::DBD::SqlEngine::TableSource";
-
-sub data_sources
-{
- my ($class, $drh, $attr) = @_;
- my $dir = $attr && exists $attr->{f_dir}
- ? $attr->{f_dir}
- : File::Spec->curdir ();
- defined $dir or return; # Stream-based databases do not have f_dir
- unless (-d $dir && -r $dir && -x $dir) {
- $drh->set_err ($DBI::stderr, "Cannot use directory $dir from f_dir");
- return;
- }
- my %attrs;
- $attr and %attrs = %$attr;
- delete $attrs{f_dir};
- my $dsn_quote = $drh->{ImplementorClass}->can ("dsn_quote");
- my $dsnextra = join ";", map { $_ . "=" . &{$dsn_quote} ($attrs{$_}) } keys %attrs;
- my @dir = ($dir);
- $attr->{f_dir_search} && ref $attr->{f_dir_search} eq "ARRAY" and
- push @dir, grep { -d $_ } @{$attr->{f_dir_search}};
- my @dsns;
- foreach $dir (@dir) {
- my $dirh = IO::Dir->new ($dir);
- unless (defined $dirh) {
- $drh->set_err ($DBI::stderr, "Cannot open directory $dir: $!");
- return;
- }
-
- my ($file, %names, $driver);
- $driver = $drh->{ImplementorClass} =~ m/^dbd\:\:([^\:]+)\:\:/i ? $1 : "File";
-
- while (defined ($file = $dirh->read ())) {
- my $d = File::Spec->catdir ($dir, $file);
- # allow current dir ... it can be a data_source too
- $file ne File::Spec->updir () && -d $d and
- push @dsns, "DBI:$driver:f_dir=" . &{$dsn_quote} ($d) . ($dsnextra ? ";$dsnextra" : "");
- }
- }
- return @dsns;
- } # data_sources
-
-sub avail_tables
-{
- my ($self, $dbh) = @_;
-
- my $dir = $dbh->{f_dir};
- defined $dir or return; # Stream based db's cannot be queried for tables
-
- my %seen;
- my @tables;
- my @dir = ($dir);
- $dbh->{f_dir_search} && ref $dbh->{f_dir_search} eq "ARRAY" and
- push @dir, grep { -d $_ } @{$dbh->{f_dir_search}};
- foreach $dir (@dir) {
- my $dirh = IO::Dir->new ($dir);
-
- unless (defined $dirh) {
- $dbh->set_err ($DBI::stderr, "Cannot open directory $dir: $!");
- return;
- }
-
- my $class = $dbh->FETCH ("ImplementorClass");
- $class =~ s/::db$/::Table/;
- my ($file, %names);
- my $schema = exists $dbh->{f_schema}
- ? defined $dbh->{f_schema} && $dbh->{f_schema} ne ""
- ? $dbh->{f_schema} : undef
- : eval { getpwuid ((stat $dir)[4]) }; # XXX Win32::pwent
- while (defined ($file = $dirh->read ())) {
- my ($tbl, $meta) = $class->get_table_meta ($dbh, $file, 0, 0) or next; # XXX
- # $tbl && $meta && -f $meta->{f_fqfn} or next;
- $seen{defined $schema ? $schema : "\0"}{$dir}{$tbl}++ or
- push @tables, [ undef, $schema, $tbl, "TABLE", "FILE" ];
- }
- $dirh->close () or
- $dbh->set_err ($DBI::stderr, "Cannot close directory $dir: $!");
- }
-
- return @tables;
- } # avail_tables
-
-# ====== DataSource ============================================================
-
-package DBD::File::DataSource::Stream;
-
-use strict;
-use warnings;
-
-use Carp;
-
-@DBD::File::DataSource::Stream::ISA = "DBI::DBD::SqlEngine::DataSource";
-
-# We may have a working flock () built-in but that doesn't mean that locking
-# will work on NFS (flock () may hang hard)
-my $locking = eval {
- my $fh;
- my $nulldevice = File::Spec->devnull ();
- open $fh, ">", $nulldevice or croak "Can't open $nulldevice: $!";
- flock $fh, 0;
- close $fh;
- 1;
- };
-
-sub complete_table_name
-{
- my ($self, $meta, $file, $respect_case) = @_;
-
- my $tbl = $file;
- if (!$respect_case and $meta->{sql_identifier_case} == 1) { # XXX SQL_IC_UPPER
- $tbl = uc $tbl;
- }
- elsif (!$respect_case and $meta->{sql_identifier_case} == 2) { # XXX SQL_IC_LOWER
- $tbl = lc $tbl;
- }
-
- $meta->{f_fqfn} = undef;
- $meta->{f_fqbn} = undef;
- $meta->{f_fqln} = undef;
-
- $meta->{table_name} = $tbl;
-
- return $tbl;
- } # complete_table_name
-
-sub apply_encoding
-{
- my ($self, $meta, $fn) = @_;
- defined $fn or $fn = "file handle " . fileno ($meta->{fh});
- if (my $enc = $meta->{f_encoding}) {
- binmode $meta->{fh}, ":encoding($enc)" or
- croak "Failed to set encoding layer '$enc' on $fn: $!";
- }
- else {
- binmode $meta->{fh} or croak "Failed to set binary mode on $fn: $!";
- }
- } # apply_encoding
-
-sub open_data
-{
- my ($self, $meta, $attrs, $flags) = @_;
-
- $flags->{dropMode} and croak "Can't drop a table in stream";
- my $fn = "file handle " . fileno ($meta->{f_file});
-
- if ($flags->{createMode} || $flags->{lockMode}) {
- $meta->{fh} = IO::Handle->new_from_fd (fileno ($meta->{f_file}), "w+") or
- croak "Cannot open $fn for writing: $! (" . ($!+0) . ")";
- }
- else {
- $meta->{fh} = IO::Handle->new_from_fd (fileno ($meta->{f_file}), "r") or
- croak "Cannot open $fn for reading: $! (" . ($!+0) . ")";
- }
-
- if ($meta->{fh}) {
- $self->apply_encoding ($meta, $fn);
- } # have $meta->{$fh}
-
- if ($self->can_flock && $meta->{fh}) {
- my $lm = defined $flags->{f_lock}
- && $flags->{f_lock} =~ m/^[012]$/
- ? $flags->{f_lock}
- : $flags->{lockMode} ? 2 : 1;
- if ($lm == 2) {
- flock $meta->{fh}, 2 or croak "Cannot obtain exclusive lock on $fn: $!";
- }
- elsif ($lm == 1) {
- flock $meta->{fh}, 1 or croak "Cannot obtain shared lock on $fn: $!";
- }
- # $lm = 0 is forced no locking at all
- }
- } # open_data
-
-sub can_flock { $locking }
-
-package DBD::File::DataSource::File;
-
-use strict;
-use warnings;
-
-@DBD::File::DataSource::File::ISA = "DBD::File::DataSource::Stream";
-
-use Carp;
-
-my $fn_any_ext_regex = qr/\.[^.]*/;
-
-sub complete_table_name
-{
- my ($self, $meta, $file, $respect_case, $file_is_table) = @_;
-
- $file eq "." || $file eq ".." and return; # XXX would break a possible DBD::Dir
-
- # XXX now called without proving f_fqfn first ...
- my ($ext, $req) = ("", 0);
- if ($meta->{f_ext}) {
- ($ext, my $opt) = split m{/}, $meta->{f_ext};
- if ($ext && $opt) {
- $opt =~ m/r/i and $req = 1;
- }
- }
-
- # (my $tbl = $file) =~ s/\Q$ext\E$//i;
- my ($tbl, $basename, $dir, $fn_ext, $user_spec_file, $searchdir);
- if ($file_is_table and defined $meta->{f_file}) {
- $tbl = $file;
- ($basename, $dir, $fn_ext) = File::Basename::fileparse ($meta->{f_file}, $fn_any_ext_regex);
- $file = $basename . $fn_ext;
- $user_spec_file = 1;
- }
- else {
- ($basename, $dir, undef) = File::Basename::fileparse ($file, qr{\Q$ext\E});
- # $dir is returned with trailing (back)slash. We just need to check
- # if it is ".", "./", or ".\" or "[]" (VMS)
- if ($dir =~ m{^(?:[.][/\\]?|\[\])$} && ref $meta->{f_dir_search} eq "ARRAY") {
- foreach my $d ($meta->{f_dir}, @{$meta->{f_dir_search}}) {
- my $f = File::Spec->catdir ($d, $file);
- -f $f or next;
- $searchdir = Cwd::abs_path ($d);
- $dir = "";
- last;
- }
- }
- $file = $tbl = $basename;
- $user_spec_file = 0;
- }
-
- if (!$respect_case and $meta->{sql_identifier_case} == 1) { # XXX SQL_IC_UPPER
- $basename = uc $basename;
- $tbl = uc $tbl;
- }
- elsif (!$respect_case and $meta->{sql_identifier_case} == 2) { # XXX SQL_IC_LOWER
- $basename = lc $basename;
- $tbl = lc $tbl;
- }
-
- unless (defined $searchdir) {
- $searchdir = File::Spec->file_name_is_absolute ($dir)
- ? ($dir =~ s{/$}{}, $dir)
- : Cwd::abs_path (File::Spec->catdir ($meta->{f_dir}, $dir));
- }
- -d $searchdir or
- croak "-d $searchdir: $!";
-
- $searchdir eq $meta->{f_dir} and
- $dir = "";
-
- unless ($user_spec_file) {
- $file_is_table and $file = "$basename$ext";
-
- # Fully Qualified File Name
- my $cmpsub;
- if ($respect_case) {
- $cmpsub = sub {
- my ($fn, undef, $sfx) = File::Basename::fileparse ($_, $fn_any_ext_regex);
- $^O eq "VMS" && $sfx eq "." and
- $sfx = ""; # no extension turns up as a dot
- $fn eq $basename and
- return (lc $sfx eq lc $ext or !$req && !$sfx);
- return 0;
- }
- }
- else {
- $cmpsub = sub {
- my ($fn, undef, $sfx) = File::Basename::fileparse ($_, $fn_any_ext_regex);
- $^O eq "VMS" && $sfx eq "." and
- $sfx = ""; # no extension turns up as a dot
- lc $fn eq lc $basename and
- return (lc $sfx eq lc $ext or !$req && !$sfx);
- return 0;
- }
- }
-
- my @f;
- { my $dh = IO::Dir->new ($searchdir) or croak "Can't open '$searchdir': $!";
- @f = sort { length $b <=> length $a }
- grep { &$cmpsub ($_) }
- $dh->read ();
- $dh->close () or croak "Can't close '$searchdir': $!";
- }
- @f > 0 && @f <= 2 and $file = $f[0];
- !$respect_case && $meta->{sql_identifier_case} == 4 and # XXX SQL_IC_MIXED
- ($tbl = $file) =~ s/\Q$ext\E$//i;
-
- my $tmpfn = $file;
- if ($ext && $req) {
- # File extension required
- $tmpfn =~ s/\Q$ext\E$//i or return;
- }
- }
-
- my $fqfn = File::Spec->catfile ($searchdir, $file);
- my $fqbn = File::Spec->catfile ($searchdir, $basename);
-
- $meta->{f_fqfn} = $fqfn;
- $meta->{f_fqbn} = $fqbn;
- defined $meta->{f_lockfile} && $meta->{f_lockfile} and
- $meta->{f_fqln} = $meta->{f_fqbn} . $meta->{f_lockfile};
-
- $dir && !$user_spec_file and $tbl = File::Spec->catfile ($dir, $tbl);
- $meta->{table_name} = $tbl;
-
- return $tbl;
- } # complete_table_name
-
-sub open_data
-{
- my ($self, $meta, $attrs, $flags) = @_;
-
- defined $meta->{f_fqfn} && $meta->{f_fqfn} ne "" or croak "No filename given";
-
- my ($fh, $fn);
- unless ($meta->{f_dontopen}) {
- $fn = $meta->{f_fqfn};
- if ($flags->{createMode}) {
- -f $meta->{f_fqfn} and
- croak "Cannot create table $attrs->{table}: Already exists";
- $fh = IO::File->new ($fn, "a+") or
- croak "Cannot open $fn for writing: $! (" . ($!+0) . ")";
- }
- else {
- unless ($fh = IO::File->new ($fn, ($flags->{lockMode} ? "r+" : "r"))) {
- croak "Cannot open $fn: $! (" . ($!+0) . ")";
- }
- }
-
- $meta->{fh} = $fh;
-
- if ($fh) {
- $fh->seek (0, 0) or
- croak "Error while seeking back: $!";
-
- $self->apply_encoding ($meta);
- }
- }
- if ($meta->{f_fqln}) {
- $fn = $meta->{f_fqln};
- if ($flags->{createMode}) {
- -f $fn and
- croak "Cannot create table lock at '$fn' for $attrs->{table}: Already exists";
- $fh = IO::File->new ($fn, "a+") or
- croak "Cannot open $fn for writing: $! (" . ($!+0) . ")";
- }
- else {
- unless ($fh = IO::File->new ($fn, ($flags->{lockMode} ? "r+" : "r"))) {
- croak "Cannot open $fn: $! (" . ($!+0) . ")";
- }
- }
-
- $meta->{lockfh} = $fh;
- }
-
- if ($self->can_flock && $fh) {
- my $lm = defined $flags->{f_lock}
- && $flags->{f_lock} =~ m/^[012]$/
- ? $flags->{f_lock}
- : $flags->{lockMode} ? 2 : 1;
- if ($lm == 2) {
- flock $fh, 2 or croak "Cannot obtain exclusive lock on $fn: $!";
- }
- elsif ($lm == 1) {
- flock $fh, 1 or croak "Cannot obtain shared lock on $fn: $!";
- }
- # $lm = 0 is forced no locking at all
- }
- } # open_data
-
-# ====== SQL::STATEMENT ========================================================
-
-package DBD::File::Statement;
-
-use strict;
-use warnings;
-
-@DBD::File::Statement::ISA = qw( DBI::DBD::SqlEngine::Statement );
-
-# ====== SQL::TABLE ============================================================
-
-package DBD::File::Table;
-
-use strict;
-use warnings;
-
-use Carp;
-require IO::File;
-require File::Basename;
-require File::Spec;
-require Cwd;
-require Scalar::Util;
-
-@DBD::File::Table::ISA = qw( DBI::DBD::SqlEngine::Table );
-
-# ====== UTILITIES ============================================================
-
-if (eval { require Params::Util; }) {
- Params::Util->import ("_HANDLE");
- }
-else {
- # taken but modified from Params::Util ...
- *_HANDLE = sub {
- # It has to be defined, of course
- defined $_[0] or return;
-
- # Normal globs are considered to be file handles
- ref $_[0] eq "GLOB" and return $_[0];
-
- # Check for a normal tied filehandle
- # Side Note: 5.5.4's tied () and can () doesn't like getting undef
- tied ($_[0]) and tied ($_[0])->can ("TIEHANDLE") and return $_[0];
-
- # There are no other non-object handles that we support
- Scalar::Util::blessed ($_[0]) or return;
-
- # Check for a common base classes for conventional IO::Handle object
- $_[0]->isa ("IO::Handle") and return $_[0];
-
- # Check for tied file handles using Tie::Handle
- $_[0]->isa ("Tie::Handle") and return $_[0];
-
- # IO::Scalar is not a proper seekable, but it is valid is a
- # regular file handle
- $_[0]->isa ("IO::Scalar") and return $_[0];
-
- # Yet another special case for IO::String, which refuses (for now
- # anyway) to become a subclass of IO::Handle.
- $_[0]->isa ("IO::String") and return $_[0];
-
- # This is not any sort of object we know about
- return;
- };
- }
-
-# ====== FLYWEIGHT SUPPORT =====================================================
-
-# Flyweight support for table_info
-# The functions file2table, init_table_meta, default_table_meta and
-# get_table_meta are using $self arguments for polymorphism only. The
-# must not rely on an instantiated DBD::File::Table
-sub file2table
-{
- my ($self, $meta, $file, $file_is_table, $respect_case) = @_;
-
- return $meta->{sql_data_source}->complete_table_name ($meta, $file, $respect_case, $file_is_table);
- } # file2table
-
-sub bootstrap_table_meta
-{
- my ($self, $dbh, $meta, $table, @other) = @_;
-
- $self->SUPER::bootstrap_table_meta ($dbh, $meta, $table, @other);
-
- exists $meta->{f_dir} or $meta->{f_dir} = $dbh->{f_dir};
- exists $meta->{f_dir_search} or $meta->{f_dir_search} = $dbh->{f_dir_search};
- defined $meta->{f_ext} or $meta->{f_ext} = $dbh->{f_ext};
- defined $meta->{f_encoding} or $meta->{f_encoding} = $dbh->{f_encoding};
- exists $meta->{f_lock} or $meta->{f_lock} = $dbh->{f_lock};
- exists $meta->{f_lockfile} or $meta->{f_lockfile} = $dbh->{f_lockfile};
- defined $meta->{f_schema} or $meta->{f_schema} = $dbh->{f_schema};
-
- defined $meta->{f_open_file_needed} or
- $meta->{f_open_file_needed} = $self->can ("open_file") != DBD::File::Table->can ("open_file");
-
- defined ($meta->{sql_data_source}) or
- $meta->{sql_data_source} = _HANDLE ($meta->{f_file})
- ? "DBD::File::DataSource::Stream"
- : "DBD::File::DataSource::File";
- } # bootstrap_table_meta
-
-sub get_table_meta ($$$$;$)
-{
- my ($self, $dbh, $table, $file_is_table, $respect_case) = @_;
-
- my $meta = $self->SUPER::get_table_meta ($dbh, $table, $respect_case, $file_is_table);
- $table = $meta->{table_name};
- return unless $table;
-
- return ($table, $meta);
- } # get_table_meta
-
-my %reset_on_modify = (
- f_file => [ "f_fqfn", "sql_data_source" ],
- f_dir => "f_fqfn",
- f_dir_search => [],
- f_ext => "f_fqfn",
- f_lockfile => "f_fqfn", # forces new file2table call
- );
-
-__PACKAGE__->register_reset_on_modify (\%reset_on_modify);
-
-my %compat_map = map { $_ => "f_$_" } qw( file ext lock lockfile );
-
-__PACKAGE__->register_compat_map (\%compat_map);
-
-# ====== DBD::File <= 0.40 compat stuff ========================================
-
-# compat to 0.38 .. 0.40 API
-sub open_file
-{
- my ($className, $meta, $attrs, $flags) = @_;
-
- return $className->SUPER::open_data ($meta, $attrs, $flags);
- } # open_file
-
-sub open_data
-{
- my ($className, $meta, $attrs, $flags) = @_;
-
- # compat to 0.38 .. 0.40 API
- $meta->{f_open_file_needed}
- ? $className->open_file ($meta, $attrs, $flags)
- : $className->SUPER::open_data ($meta, $attrs, $flags);
-
- return;
- } # open_data
-
-# ====== SQL::Eval API =========================================================
-
-sub drop ($)
-{
- my ($self, $data) = @_;
- my $meta = $self->{meta};
- # We have to close the file before unlinking it: Some OS'es will
- # refuse the unlink otherwise.
- $meta->{fh} and $meta->{fh}->close ();
- $meta->{lockfh} and $meta->{lockfh}->close ();
- undef $meta->{fh};
- undef $meta->{lockfh};
- $meta->{f_fqfn} and unlink $meta->{f_fqfn}; # XXX ==> sql_data_source
- $meta->{f_fqln} and unlink $meta->{f_fqln}; # XXX ==> sql_data_source
- delete $data->{Database}{sql_meta}{$self->{table}};
- return 1;
- } # drop
-
-sub seek ($$$$)
-{
- my ($self, $data, $pos, $whence) = @_;
- my $meta = $self->{meta};
- if ($whence == 0 && $pos == 0) {
- $pos = defined $meta->{first_row_pos} ? $meta->{first_row_pos} : 0;
- }
- elsif ($whence != 2 || $pos != 0) {
- croak "Illegal seek position: pos = $pos, whence = $whence";
- }
-
- $meta->{fh}->seek ($pos, $whence) or
- croak "Error while seeking in " . $meta->{f_fqfn} . ": $!";
- } # seek
-
-sub truncate ($$)
-{
- my ($self, $data) = @_;
- my $meta = $self->{meta};
- $meta->{fh}->truncate ($meta->{fh}->tell ()) or
- croak "Error while truncating " . $meta->{f_fqfn} . ": $!";
- return 1;
- } # truncate
-
-sub DESTROY
-{
- my $self = shift;
- my $meta = $self->{meta};
- $meta->{fh} and $meta->{fh}->close ();
- $meta->{lockfh} and $meta->{lockfh}->close ();
- undef $meta->{fh};
- undef $meta->{lockfh};
-
- $self->SUPER::DESTROY();
- } # DESTROY
-
-1;
-
-__END__
-
-=head1 NAME
-
-DBD::File - Base class for writing file based DBI drivers
-
-=head1 SYNOPSIS
-
-This module is a base class for writing other L<DBD|DBI::DBD>s.
-It is not intended to function as a DBD itself (though it is possible).
-If you want to access flat files, use L<DBD::AnyData|DBD::AnyData>, or
-L<DBD::CSV|DBD::CSV> (both of which are subclasses of DBD::File).
-
-=head1 DESCRIPTION
-
-The DBD::File module is not a true L<DBI|DBI> driver, but an abstract
-base class for deriving concrete DBI drivers from it. The implication
-is, that these drivers work with plain files, for example CSV files or
-INI files. The module is based on the L<SQL::Statement|SQL::Statement>
-module, a simple SQL engine.
-
-See L<DBI|DBI> for details on DBI, L<SQL::Statement|SQL::Statement> for
-details on SQL::Statement and L<DBD::CSV|DBD::CSV>, L<DBD::DBM|DBD::DBM>
-or L<DBD::AnyData|DBD::AnyData> for example drivers.
-
-=head2 Metadata
-
-The following attributes are handled by DBI itself and not by DBD::File,
-thus they all work as expected:
-
- Active
- ActiveKids
- CachedKids
- CompatMode (Not used)
- InactiveDestroy
- AutoInactiveDestroy
- Kids
- PrintError
- RaiseError
- Warn (Not used)
-
-=head3 The following DBI attributes are handled by DBD::File:
-
-=head4 AutoCommit
-
-Always on.
-
-=head4 ChopBlanks
-
-Works.
-
-=head4 NUM_OF_FIELDS
-
-Valid after C<< $sth->execute >>.
-
-=head4 NUM_OF_PARAMS
-
-Valid after C<< $sth->prepare >>.
-
-=head4 NAME
-
-Valid after C<< $sth->execute >>; undef for Non-Select statements.
-
-=head4 NULLABLE
-
-Not really working, always returns an array ref of ones, except the
-affected table has been created in this session. Valid after
-C<< $sth->execute >>; undef for non-select statements.
-
-=head3 Unsupported DBI attributes and methods
-
-=head4 bind_param_inout
-
-=head4 CursorName
-
-=head4 LongReadLen
-
-=head4 LongTruncOk
-
-=head3 DBD::File specific attributes
-
-In addition to the DBI attributes, you can use the following dbh
-attributes:
-
-=head4 f_dir
-
-This attribute is used for setting the directory where the files are
-opened and it defaults to the current directory (F<.>). Usually you set
-it on the dbh but it may be overridden per table (see L<f_meta>).
-
-When the value for C<f_dir> is a relative path, it is converted into
-the appropriate absolute path name (based on the current working
-directory) when the dbh attribute is set.
-
- f_dir => "/data/foo/csv",
-
-See L<KNOWN BUGS AND LIMITATIONS>.
-
-=head4 f_dir_search
-
-This optional attribute can be set to pass a list of folders to also
-find existing tables. It will B<not> be used to create new files.
-
- f_dir_search => [ "/data/bar/csv", "/dump/blargh/data" ],
-
-=head4 f_ext
-
-This attribute is used for setting the file extension. The format is:
-
- extension{/flag}
-
-where the /flag is optional and the extension is case-insensitive.
-C<f_ext> allows you to specify an extension which:
-
- f_ext => ".csv/r",
-
-=over
-
-=item *
-
-makes DBD::File prefer F<table.extension> over F<table>.
-
-=item *
-
-makes the table name the filename minus the extension.
-
-=back
-
- DBI:CSV:f_dir=data;f_ext=.csv
-
-In the above example and when C<f_dir> contains both F<table.csv> and
-F<table>, DBD::File will open F<table.csv> and the table will be
-named "table". If F<table.csv> does not exist but F<table> does
-that file is opened and the table is also called "table".
-
-If C<f_ext> is not specified and F<table.csv> exists it will be opened
-and the table will be called "table.csv" which is probably not what
-you want.
-
-NOTE: even though extensions are case-insensitive, table names are
-not.
-
- DBI:CSV:f_dir=data;f_ext=.csv/r
-
-The C<r> flag means the file extension is required and any filename
-that does not match the extension is ignored.
-
-Usually you set it on the dbh but it may be overridden per table
-(see L<f_meta>).
-
-=head4 f_schema
-
-This will set the schema name and defaults to the owner of the
-directory in which the table file resides. You can set C<f_schema> to
-C<undef>.
-
- my $dbh = DBI->connect ("dbi:CSV:", "", "", {
- f_schema => undef,
- f_dir => "data",
- f_ext => ".csv/r",
- }) or die $DBI::errstr;
-
-By setting the schema you affect the results from the tables call:
-
- my @tables = $dbh->tables ();
-
- # no f_schema
- "merijn".foo
- "merijn".bar
-
- # f_schema => "dbi"
- "dbi".foo
- "dbi".bar
-
- # f_schema => undef
- foo
- bar
-
-Defining C<f_schema> to the empty string is equal to setting it to C<undef>
-so the DSN can be C<"dbi:CSV:f_schema=;f_dir=.">.
-
-=head4 f_lock
-
-The C<f_lock> attribute is used to set the locking mode on the opened
-table files. Note that not all platforms support locking. By default,
-tables are opened with a shared lock for reading, and with an
-exclusive lock for writing. The supported modes are:
-
- 0: No locking at all.
-
- 1: Shared locks will be used.
-
- 2: Exclusive locks will be used.
-
-But see L<KNOWN BUGS|/"KNOWN BUGS AND LIMITATIONS"> below.
-
-=head4 f_lockfile
-
-If you wish to use a lockfile extension other than C<.lck>, simply specify
-the C<f_lockfile> attribute:
-
- $dbh = DBI->connect ("dbi:DBM:f_lockfile=.foo");
- $dbh->{f_lockfile} = ".foo";
- $dbh->{dbm_tables}{qux}{f_lockfile} = ".foo";
-
-If you wish to disable locking, set the C<f_lockfile> to C<0>.
-
- $dbh = DBI->connect ("dbi:DBM:f_lockfile=0");
- $dbh->{f_lockfile} = 0;
- $dbh->{dbm_tables}{qux}{f_lockfile} = 0;
-
-=head4 f_encoding
-
-With this attribute, you can set the encoding in which the file is opened.
-This is implemented using C<< binmode $fh, ":encoding(<f_encoding>)" >>.
-
-=head4 f_meta
-
-Private data area aliasing L<DBI::DBD::SqlEngine/sql_meta> which
-contains information about the tables this module handles. Table meta
-data might not be available until the table has been accessed for the
-first time e.g., by issuing a select on it however it is possible to
-pre-initialize attributes for each table you use.
-
-DBD::File recognizes the (public) attributes C<f_ext>, C<f_dir>,
-C<f_file>, C<f_encoding>, C<f_lock>, C<f_lockfile>, C<f_schema>,
-in addition to the attributes L<DBI::DBD::SqlEngine/sql_meta> already
-supports. Be very careful when modifying attributes you do not know,
-the consequence might be a destroyed or corrupted table.
-
-C<f_file> is an attribute applicable to table meta data only and you
-will not find a corresponding attribute in the dbh. Whilst it may be
-reasonable to have several tables with the same column names, it is
-not for the same file name. If you need access to the same file using
-different table names, use C<SQL::Statement> as the SQL engine and the
-C<AS> keyword:
-
- SELECT * FROM tbl AS t1, tbl AS t2 WHERE t1.id = t2.id
-
-C<f_file> can be an absolute path name or a relative path name but if
-it is relative, it is interpreted as being relative to the C<f_dir>
-attribute of the table meta data. When C<f_file> is set DBD::File will
-use C<f_file> as specified and will not attempt to work out an
-alternative for C<f_file> using the C<table name> and C<f_ext>
-attribute.
-
-While C<f_meta> is a private and readonly attribute (which means, you
-cannot modify it's values), derived drivers might provide restricted
-write access through another attribute. Well known accessors are
-C<csv_tables> for L<DBD::CSV>, C<ad_tables> for L<DBD::AnyData> and
-C<dbm_tables> for L<DBD::DBM>.
-
-=head3 New opportunities for attributes from DBI::DBD::SqlEngine
-
-=head4 sql_table_source
-
-C<< $dbh->{sql_table_source} >> can be set to
-I<DBD::File::TableSource::FileSystem> (and is the default setting
-of DBD::File). This provides usual behaviour of previous DBD::File
-releases on
-
- @ary = DBI->data_sources ($driver);
- @ary = DBI->data_sources ($driver, \%attr);
-
- @ary = $dbh->data_sources ();
- @ary = $dbh->data_sources (\%attr);
-
- @names = $dbh->tables ($catalog, $schema, $table, $type);
-
- $sth = $dbh->table_info ($catalog, $schema, $table, $type);
- $sth = $dbh->table_info ($catalog, $schema, $table, $type, \%attr);
-
- $dbh->func ("list_tables");
-
-=head4 sql_data_source
-
-C<< $dbh->{sql_data_source} >> can be set to either
-I<DBD::File::DataSource::File>, which is default and provides the
-well known behavior of DBD::File releases prior to 0.41, or
-I<DBD::File::DataSource::Stream>, which reuses already opened
-file-handle for operations.
-
-=head3 Internally private attributes to deal with SQL backends
-
-Do not modify any of these private attributes unless you understand
-the implications of doing so. The behavior of DBD::File and derived
-DBDs might be unpredictable when one or more of those attributes are
-modified.
-
-=head4 sql_nano_version
-
-Contains the version of loaded DBI::SQL::Nano.
-
-=head4 sql_statement_version
-
-Contains the version of loaded SQL::Statement.
-
-=head4 sql_handler
-
-Contains either the text 'SQL::Statement' or 'DBI::SQL::Nano'.
-
-=head4 sql_ram_tables
-
-Contains optionally temporary tables.
-
-=head4 sql_flags
-
-Contains optional flags to instantiate the SQL::Parser parsing engine
-when SQL::Statement is used as SQL engine. See L<SQL::Parser> for valid
-flags.
-
-=head2 Driver private methods
-
-=head3 Default DBI methods
-
-=head4 data_sources
-
-The C<data_sources> method returns a list of subdirectories of the current
-directory in the form "dbi:CSV:f_dir=$dirname".
-
-If you want to read the subdirectories of another directory, use
-
- my ($drh) = DBI->install_driver ("CSV");
- my (@list) = $drh->data_sources (f_dir => "/usr/local/csv_data");
-
-=head3 Additional methods
-
-The following methods are only available via their documented name when
-DBD::File is used directly. Because this is only reasonable for testing
-purposes, the real names must be used instead. Those names can be computed
-by replacing the C<f_> in the method name with the driver prefix.
-
-=head4 f_versions
-
-Signature:
-
- sub f_versions (;$)
- {
- my ($table_name) = @_;
- $table_name ||= ".";
- ...
- }
-
-Returns the versions of the driver, including the DBI version, the Perl
-version, DBI::PurePerl version (if DBI::PurePerl is active) and the version
-of the SQL engine in use.
-
- my $dbh = DBI->connect ("dbi:File:");
- my $f_versions = $dbh->func ("f_versions");
- print "$f_versions\n";
- __END__
- # DBD::File 0.41 using IO::File (1.16)
- # DBI::DBD::SqlEngine 0.05 using SQL::Statement 1.406
- # DBI 1.623
- # OS darwin (12.2.1)
- # Perl 5.017006 (darwin-thread-multi-ld-2level)
-
-Called in list context, f_versions will return an array containing each
-line as single entry.
-
-Some drivers might use the optional (table name) argument and modify
-version information related to the table (e.g. DBD::DBM provides storage
-backend information for the requested table, when it has a table name).
-
-=head1 KNOWN BUGS AND LIMITATIONS
-
-=over 4
-
-=item *
-
-This module uses flock () internally but flock is not available on all
-platforms. On MacOS and Windows 95 there is no locking at all (perhaps
-not so important on MacOS and Windows 95, as there is only a single
-user).
-
-=item *
-
-The module stores details about the handled tables in a private area
-of the driver handle (C<$drh>). This data area is not shared between
-different driver instances, so several C<< DBI->connect () >> calls will
-cause different table instances and private data areas.
-
-This data area is filled for the first time when a table is accessed,
-either via an SQL statement or via C<table_info> and is not
-destroyed until the table is dropped or the driver handle is released.
-Manual destruction is possible via L<f_clear_meta>.
-
-The following attributes are preserved in the data area and will
-evaluated instead of driver globals:
-
-=over 8
-
-=item f_ext
-
-=item f_dir
-
-=item f_dir_search
-
-=item f_lock
-
-=item f_lockfile
-
-=item f_encoding
-
-=item f_schema
-
-=item col_names
-
-=item sql_identifier_case
-
-=back
-
-The following attributes are preserved in the data area only and
-cannot be set globally.
-
-=over 8
-
-=item f_file
-
-=back
-
-The following attributes are preserved in the data area only and are
-computed when initializing the data area:
-
-=over 8
-
-=item f_fqfn
-
-=item f_fqbn
-
-=item f_fqln
-
-=item table_name
-
-=back
-
-For DBD::CSV tables this means, once opened "foo.csv" as table named "foo",
-another table named "foo" accessing the file "foo.txt" cannot be opened.
-Accessing "foo" will always access the file "foo.csv" in memorized
-C<f_dir>, locking C<f_lockfile> via memorized C<f_lock>.
-
-You can use L<f_clear_meta> or the C<f_file> attribute for a specific table
-to work around this.
-
-=item *
-
-When used with SQL::Statement and temporary tables e.g.,
-
- CREATE TEMP TABLE ...
-
-the table data processing bypasses DBD::File::Table. No file system
-calls will be made and there are no clashes with existing (file based)
-tables with the same name. Temporary tables are chosen over file
-tables, but they will not covered by C<table_info>.
-
-=back
-
-=head1 AUTHOR
-
-This module is currently maintained by
-
-H.Merijn Brand < h.m.brand at xs4all.nl > and
-Jens Rehsack < rehsack at googlemail.com >
-
-The original author is Jochen Wiedmann.
-
-=head1 COPYRIGHT AND LICENSE
-
- Copyright (C) 2009-2013 by H.Merijn Brand & Jens Rehsack
- Copyright (C) 2004-2009 by Jeff Zucker
- Copyright (C) 1998-2004 by Jochen Wiedmann
-
-All rights reserved.
-
-You may freely distribute and/or modify this module under the terms of
-either the GNU General Public License (GPL) or the Artistic License, as
-specified in the Perl README file.
-
-=head1 SEE ALSO
-
-L<DBI|DBI>, L<DBD::DBM|DBD::DBM>, L<DBD::CSV|DBD::CSV>, L<Text::CSV|Text::CSV>,
-L<Text::CSV_XS|Text::CSV_XS>, L<SQL::Statement|SQL::Statement>, and
-L<DBI::SQL::Nano|DBI::SQL::Nano>
-
-=cut
+++ /dev/null
-=head1 NAME
-
-DBD::File::Developers - Developers documentation for DBD::File
-
-=head1 SYNOPSIS
-
- package DBD::myDriver;
-
- use base qw( DBD::File );
-
- sub driver
- {
- ...
- my $drh = $proto->SUPER::driver ($attr);
- ...
- return $drh->{class};
- }
-
- sub CLONE { ... }
-
- package DBD::myDriver::dr;
-
- @ISA = qw( DBD::File::dr );
-
- sub data_sources { ... }
- ...
-
- package DBD::myDriver::db;
-
- @ISA = qw( DBD::File::db );
-
- sub init_valid_attributes { ... }
- sub init_default_attributes { ... }
- sub set_versions { ... }
- sub validate_STORE_attr { my ($dbh, $attrib, $value) = @_; ... }
- sub validate_FETCH_attr { my ($dbh, $attrib) = @_; ... }
- sub get_myd_versions { ... }
-
- package DBD::myDriver::st;
-
- @ISA = qw( DBD::File::st );
-
- sub FETCH { ... }
- sub STORE { ... }
-
- package DBD::myDriver::Statement;
-
- @ISA = qw( DBD::File::Statement );
-
- package DBD::myDriver::Table;
-
- @ISA = qw( DBD::File::Table );
-
- my %reset_on_modify = (
- myd_abc => "myd_foo",
- myd_mno => "myd_bar",
- );
- __PACKAGE__->register_reset_on_modify (\%reset_on_modify);
- my %compat_map = (
- abc => 'foo_abc',
- xyz => 'foo_xyz',
- );
- __PACKAGE__->register_compat_map (\%compat_map);
-
- sub bootstrap_table_meta { ... }
- sub init_table_meta { ... }
- sub table_meta_attr_changed { ... }
- sub open_data { ... }
-
- sub fetch_row { ... }
- sub push_row { ... }
- sub push_names { ... }
-
- # optimize the SQL engine by add one or more of
- sub update_current_row { ... }
- # or
- sub update_specific_row { ... }
- # or
- sub update_one_row { ... }
- # or
- sub insert_new_row { ... }
- # or
- sub delete_current_row { ... }
- # or
- sub delete_one_row { ... }
-
-=head1 DESCRIPTION
-
-This document describes how DBD developers can write DBD::File based DBI
-drivers. It supplements L<DBI::DBD> and L<DBI::DBD::SqlEngine::Developers>,
-which you should read first.
-
-=head1 CLASSES
-
-Each DBI driver must provide a package global C<driver> method and three
-DBI related classes:
-
-=over 4
-
-=item DBD::File::dr
-
-Driver package, contains the methods DBI calls indirectly via DBI
-interface:
-
- DBI->connect ('DBI:DBM:', undef, undef, {})
-
- # invokes
- package DBD::DBM::dr;
- @DBD::DBM::dr::ISA = qw( DBD::File::dr );
-
- sub connect ($$;$$$)
- {
- ...
- }
-
-Similar for C<< data_sources >> and C<< disconnect_all >>.
-
-Pure Perl DBI drivers derived from DBD::File do not usually need to
-override any of the methods provided through the DBD::XXX::dr package
-however if you need additional initialization in the connect method
-you may need to.
-
-=item DBD::File::db
-
-Contains the methods which are called through DBI database handles
-(C<< $dbh >>). e.g.,
-
- $sth = $dbh->prepare ("select * from foo");
- # returns the f_encoding setting for table foo
- $dbh->csv_get_meta ("foo", "f_encoding");
-
-DBD::File provides the typical methods required here. Developers who
-write DBI drivers based on DBD::File need to override the methods C<<
-set_versions >> and C<< init_valid_attributes >>.
-
-=item DBD::File::st
-
-Contains the methods to deal with prepared statement handles. e.g.,
-
- $sth->execute () or die $sth->errstr;
-
-=back
-
-=head2 DBD::File
-
-This is the main package containing the routines to initialize
-DBD::File based DBI drivers. Primarily the C<< DBD::File::driver >>
-method is invoked, either directly from DBI when the driver is
-initialized or from the derived class.
-
- package DBD::DBM;
-
- use base qw( DBD::File );
-
- sub driver
- {
- my ($class, $attr) = @_;
- ...
- my $drh = $class->SUPER::driver ($attr);
- ...
- return $drh;
- }
-
-It is not necessary to implement your own driver method as long as
-additional initialization (e.g. installing more private driver
-methods) is not required. You do not need to call C<< setup_driver >>
-as DBD::File takes care of it.
-
-=head2 DBD::File::dr
-
-The driver package contains the methods DBI calls indirectly via the DBI
-interface (see L<DBI/DBI Class Methods>).
-
-DBD::File based DBI drivers usually do not need to implement anything here,
-it is enough to do the basic initialization:
-
- package DBD:XXX::dr;
-
- @DBD::XXX::dr::ISA = qw (DBD::File::dr);
- $DBD::XXX::dr::imp_data_size = 0;
- $DBD::XXX::dr::data_sources_attr = undef;
- $DBD::XXX::ATTRIBUTION = "DBD::XXX $DBD::XXX::VERSION by Hans Mustermann";
-
-=head2 DBD::File::db
-
-This package defines the database methods, which are called via the DBI
-database handle C<< $dbh >>.
-
-Methods provided by DBD::File:
-
-=over 4
-
-=item ping
-
-Simply returns the content of the C<< Active >> attribute. Override
-when your driver needs more complicated actions here.
-
-=item prepare
-
-Prepares a new SQL statement to execute. Returns a statement handle,
-C<< $sth >> - instance of the DBD:XXX::st. It is neither required nor
-recommended to override this method.
-
-=item FETCH
-
-Fetches an attribute of a DBI database object. Private handle attributes
-must have a prefix (this is mandatory). If a requested attribute is
-detected as a private attribute without a valid prefix, the driver prefix
-(written as C<$drv_prefix>) is added.
-
-The driver prefix is extracted from the attribute name and verified against
-C<< $dbh->{$drv_prefix . "valid_attrs"} >> (when it exists). If the
-requested attribute value is not listed as a valid attribute, this method
-croaks. If the attribute is valid and readonly (listed in C<< $dbh->{
-$drv_prefix . "readonly_attrs" } >> when it exists), a real copy of the
-attribute value is returned. So it's not possible to modify
-C<f_valid_attrs> from outside of DBD::File::db or a derived class.
-
-=item STORE
-
-Stores a database private attribute. Private handle attributes must have a
-prefix (this is mandatory). If a requested attribute is detected as a private
-attribute without a valid prefix, the driver prefix (written as
-C<$drv_prefix>) is added. If the database handle has an attribute
-C<${drv_prefix}_valid_attrs> - for attribute names which are not listed in
-that hash, this method croaks. If the database handle has an attribute
-C<${drv_prefix}_readonly_attrs>, only attributes which are not listed there
-can be stored (once they are initialized). Trying to overwrite such an
-immutable attribute forces this method to croak.
-
-An example of a valid attributes list can be found in
-C<< DBD::File::db::init_valid_attributes >>.
-
-=item set_versions
-
-This method sets the attribute C<f_version> with the version of DBD::File.
-
-This method is called at the begin of the C<connect ()> phase.
-
-When overriding this method, do not forget to invoke the superior one.
-
-=item init_valid_attributes
-
-This method is called after the database handle is instantiated as the
-first attribute initialization.
-
-C<< DBD::File::db::init_valid_attributes >> initializes the attributes
-C<f_valid_attrs> and C<f_readonly_attrs>.
-
-When overriding this method, do not forget to invoke the superior one,
-preferably before doing anything else. Compatibility table attribute
-access must be initialized here to allow DBD::File to instantiate the
-map tie:
-
- # for DBD::CSV
- $dbh->{csv_meta} = "csv_tables";
- # for DBD::DBM
- $dbh->{dbm_meta} = "dbm_tables";
- # for DBD::AnyData
- $dbh->{ad_meta} = "ad_tables";
-
-=item init_default_attributes
-
-This method is called after the database handle is instantiated to
-initialize the default attributes.
-
-C<< DBD::File::db::init_default_attributes >> initializes the attributes
-C<f_dir>, C<f_meta>, C<f_meta_map>, C<f_version>.
-
-When the derived implementor class provides the attribute to validate
-attributes (e.g. C<< $dbh->{dbm_valid_attrs} = {...}; >>) or the attribute
-containing the immutable attributes (e.g.
-C<< $dbh->{dbm_readonly_attrs} = {...}; >>), the attributes
-C<drv_valid_attrs>, C<drv_readonly_attrs>, C<drv_version> and C<drv_meta>
-are added (when available) to the list of valid and immutable attributes
-(where C<drv_> is interpreted as the driver prefix).
-
-If C<drv_meta> is set, an attribute with the name in C<drv_meta> is
-initialized providing restricted read/write access to the meta data of the
-tables using C<DBD::File::TieTables> in the first (table) level and
-C<DBD::File::TieMeta> for the meta attribute level. C<DBD::File::TieTables>
-uses C<DBD::DRV::Table::get_table_meta> to initialize the second level
-tied hash on FETCH/STORE. The C<DBD::File::TieMeta> class uses
-C<DBD::DRV::Table::get_table_meta_attr> to FETCH attribute values and
-C<DBD::DRV::Table::set_table_meta_attr> to STORE attribute values. This
-allows it to map meta attributes for compatibility reasons.
-
-=item get_single_table_meta
-
-=item get_file_meta
-
-Retrieve an attribute from a table's meta information. The method
-signature is C<< get_file_meta ($dbh, $table, $attr) >>. This method
-is called by the injected db handle method C<< ${drv_prefix}get_meta >>.
-
-While get_file_meta allows C<$table> or C<$attr> to be a list of tables or
-attributes to retrieve, get_single_table_meta allows only one table name
-and only one attribute name. A table name of C<'.'> (single dot) is
-interpreted as the default table and this will retrieve the appropriate
-attribute globally from the dbh. This has the same restrictions as
-C<< $dbh->{$attrib} >>.
-
-get_file_meta allows C<'+'> and C<'*'> as wildcards for table names and
-C<$table> being a regular expression matching against the table names
-(evaluated without the default table). The table name C<'*'> is
-I<all currently known tables, including the default one>. The table
-name C<'+'> is I<all table names which conform to
-ANSI file name restrictions> (/^[_A-Za-z0-9]+$/).
-
-The table meta information is retrieved using the get_table_meta and
-get_table_meta_attr methods of the table class of the implementation.
-
-=item set_single_table_meta
-
-=item set_file_meta
-
-Sets an attribute in a table's meta information. The method signature is
-C<< set_file_meta ($dbh, $table, $attr, $value) >>. This method is called
-by the injected db handle method C<< ${drv_prefix}set_meta >>.
-
-While set_file_meta allows C<$table> to be a list of tables and C<$attr>
-to be a hash of several attributes to set, set_single_table_meta allows
-only one table name and only one attribute name/value pair.
-
-The wildcard characters for the table name are the same as for
-get_file_meta.
-
-The table meta information is updated using the get_table_meta and
-set_table_meta_attr methods of the table class of the implementation.
-
-=item clear_file_meta
-
-Clears all meta information cached about a table. The method signature is
-C<< clear_file_meta ($dbh, $table) >>. This method is called
-by the injected db handle method C<< ${drv_prefix}clear_meta >>.
-
-=back
-
-=head2 DBD::File::st
-
-Contains the methods to deal with prepared statement handles:
-
-=over 4
-
-=item FETCH
-
-Fetches statement handle attributes. Supported attributes (for full overview
-see L<DBI/Statement Handle Attributes>) are C<NAME>, C<TYPE>, C<PRECISION>
-and C<NULLABLE> in case that SQL::Statement is used as SQL execution engine
-and a statement is successful prepared. When SQL::Statement has additional
-information about a table, those information are returned. Otherwise, the
-same defaults as in L<DBI::DBD::SqlEngine> are used.
-
-This method usually requires extending in a derived implementation.
-See L<DBD::CSV> or L<DBD::DBM> for some example.
-
-=back
-
-=head2 DBD::File::TableSource::FileSystem
-
-Provides data sources and table information on database driver and database
-handle level.
-
- package DBD::File::TableSource::FileSystem;
-
- sub data_sources ($;$)
- {
- my ($class, $drh, $attrs) = @_;
- ...
- }
-
- sub avail_tables
- {
- my ($class, $drh) = @_;
- ...
- }
-
-The C<data_sources> method is called when the user invokes any of the
-following:
-
- @ary = DBI->data_sources ($driver);
- @ary = DBI->data_sources ($driver, \%attr);
-
- @ary = $dbh->data_sources ();
- @ary = $dbh->data_sources (\%attr);
-
-The C<avail_tables> method is called when the user invokes any of the
-following:
-
- @names = $dbh->tables ($catalog, $schema, $table, $type);
-
- $sth = $dbh->table_info ($catalog, $schema, $table, $type);
- $sth = $dbh->table_info ($catalog, $schema, $table, $type, \%attr);
-
- $dbh->func ("list_tables");
-
-Every time where an C<\%attr> argument can be specified, this C<\%attr>
-object's C<sql_table_source> attribute is preferred over the C<$dbh>
-attribute or the driver default.
-
-=head2 DBD::File::DataSource::Stream
-
- package DBD::File::DataSource::Stream;
-
- @DBD::File::DataSource::Stream::ISA = 'DBI::DBD::SqlEngine::DataSource';
-
- sub complete_table_name
- {
- my ($self, $meta, $file, $respect_case) = @_;
- ...
- }
-
-Clears all meta attributes identifying a file: C<f_fqfn>, C<f_fqbn> and
-C<f_fqln>. The table name is set according to C<$respect_case> and
-C<< $meta->{sql_identifier_case} >> (SQL_IC_LOWER, SQL_IC_UPPER).
-
- package DBD::File::DataSource::Stream;
-
- sub apply_encoding
- {
- my ($self, $meta, $fn) = @_;
- ...
- }
-
-Applies the encoding from I<meta information> (C<< $meta->{f_encoding} >>)
-to the file handled opened in C<open_data>.
-
- package DBD::File::DataSource::Stream;
-
- sub open_data
- {
- my ($self, $meta, $attrs, $flags) = @_;
- ...
- }
-
-Opens (C<dup (2)>) the file handle provided in C<< $meta->{f_file} >>.
-
- package DBD::File::DataSource::Stream;
-
- sub can_flock { ... }
-
-Returns whether C<flock (2)> is available or not (avoids retesting in
-subclasses).
-
-=head2 DBD::File::DataSource::File
-
- package DBD::File::DataSource::File;
-
- sub complete_table_name ($$;$)
- {
- my ($self, $meta, $table, $respect_case) = @_;
- ...
- }
-
-The method C<complete_table_name> tries to map a filename to the associated
-table name. It is called with a partially filled meta structure for the
-resulting table containing at least the following attributes:
-C<< f_ext >>, C<< f_dir >>, C<< f_lockfile >> and C<< sql_identifier_case >>.
-
-If a file/table map can be found then this method sets the C<< f_fqfn
->>, C<< f_fqbn >>, C<< f_fqln >> and C<< table_name >> attributes in
-the meta structure. If a map cannot be found the table name will be
-undef.
-
- package DBD::File::DataSource::File;
-
- sub open_data ($)
- {
- my ($self, $meta, $attrs, $flags) = @_;
- ...
- }
-
-Depending on the attributes set in the table's meta data, the
-following steps are performed. Unless C<< f_dontopen >> is set to a
-true value, C<< f_fqfn >> must contain the full qualified file name
-for the table to work on (file2table ensures this). The encoding in
-C<< f_encoding >> is applied if set and the file is opened. If
-C<<f_fqln >> (full qualified lock name) is set, this file is opened,
-too. Depending on the value in C<< f_lock >>, the appropriate lock is
-set on the opened data file or lock file.
-
-=head2 DBD::File::Statement
-
-Derives from DBI::SQL::Nano::Statement to provide following method:
-
-=over 4
-
-=item open_table
-
-Implements the open_table method required by L<SQL::Statement> and
-L<DBI::SQL::Nano>. All the work for opening the file(s) belonging to the
-table is handled and parametrized in DBD::File::Table. Unless you intend
-to add anything to the following implementation, an empty DBD::XXX::Statement
-package satisfies DBD::File.
-
- sub open_table ($$$$$)
- {
- my ($self, $data, $table, $createMode, $lockMode) = @_;
-
- my $class = ref $self;
- $class =~ s/::Statement/::Table/;
-
- my $flags = {
- createMode => $createMode,
- lockMode => $lockMode,
- };
- $self->{command} eq "DROP" and $flags->{dropMode} = 1;
-
- return $class->new ($data, { table => $table }, $flags);
- } # open_table
-
-=back
-
-=head2 DBD::File::Table
-
-Derives from DBI::SQL::Nano::Table and provides physical file access for
-the table data which are stored in the files.
-
-=over 4
-
-=item bootstrap_table_meta
-
-Initializes a table meta structure. Can be safely overridden in a
-derived class, as long as the C<< SUPER >> method is called at the end
-of the overridden method.
-
-It copies the following attributes from the database into the table meta data
-C<< f_dir >>, C<< f_ext >>, C<< f_encoding >>, C<< f_lock >>, C<< f_schema >>
-and C<< f_lockfile >> and makes them sticky to the table.
-
-This method should be called before you attempt to map between file
-name and table name to ensure the correct directory, extension etc. are
-used.
-
-=item init_table_meta
-
-Initializes more attributes of the table meta data - usually more
-expensive ones (e.g. those which require class instantiations) - when
-the file name and the table name could mapped.
-
-=item get_table_meta
-
-Returns the table meta data. If there are none for the required
-table, a new one is initialized. When it fails, nothing is
-returned. On success, the name of the table and the meta data
-structure is returned.
-
-=item get_table_meta_attr
-
-Returns a single attribute from the table meta data. If the attribute
-name appears in C<%compat_map>, the attribute name is updated from
-there.
-
-=item set_table_meta_attr
-
-Sets a single attribute in the table meta data. If the attribute
-name appears in C<%compat_map>, the attribute name is updated from
-there.
-
-=item table_meta_attr_changed
-
-Called when an attribute of the meta data is modified.
-
-If the modified attribute requires to reset a calculated attribute, the
-calculated attribute is reset (deleted from meta data structure) and
-the I<initialized> flag is removed, too. The decision is made based on
-C<%register_reset_on_modify>.
-
-=item register_reset_on_modify
-
-Allows C<set_table_meta_attr> to reset meta attributes when special
-attributes are modified. For DBD::File, modifying one of C<f_file>, C<f_dir>,
-C<f_ext> or C<f_lockfile> will reset C<f_fqfn>. DBD::DBM extends the
-list for C<dbm_type> and C<dbm_mldbm> to reset the value of C<dbm_tietype>.
-
-If your DBD has calculated values in the meta data area, then call
-C<register_reset_on_modify>:
-
- my %reset_on_modify = (xxx_foo => "xxx_bar");
- __PACKAGE__->register_reset_on_modify (\%reset_on_modify);
-
-=item register_compat_map
-
-Allows C<get_table_meta_attr> and C<set_table_meta_attr> to update the
-attribute name to the current favored one:
-
- # from DBD::DBM
- my %compat_map = (dbm_ext => "f_ext");
- __PACKAGE__->register_compat_map (\%compat_map);
-
-=item open_file
-
-Called to open the table's data file.
-
-Depending on the attributes set in the table's meta data, the
-following steps are performed. Unless C<< f_dontopen >> is set to a
-true value, C<< f_fqfn >> must contain the full qualified file name
-for the table to work on (file2table ensures this). The encoding in
-C<< f_encoding >> is applied if set and the file is opened. If
-C<<f_fqln >> (full qualified lock name) is set, this file is opened,
-too. Depending on the value in C<< f_lock >>, the appropriate lock is
-set on the opened data file or lock file.
-
-After this is done, a derived class might add more steps in an overridden
-C<< open_file >> method.
-
-=item new
-
-Instantiates the table. This is done in 3 steps:
-
- 1. get the table meta data
- 2. open the data file
- 3. bless the table data structure using inherited constructor new
-
-It is not recommended to override the constructor of the table class.
-Find a reasonable place to add you extensions in one of the above four
-methods.
-
-=item drop
-
-Implements the abstract table method for the C<< DROP >>
-command. Discards table meta data after all files belonging to the
-table are closed and unlinked.
-
-Overriding this method might be reasonable in very rare cases.
-
-=item seek
-
-Implements the abstract table method used when accessing the table from the
-engine. C<< seek >> is called every time the engine uses dumb algorithms
-for iterating over the table content.
-
-=item truncate
-
-Implements the abstract table method used when dumb table algorithms
-for C<< UPDATE >> or C<< DELETE >> need to truncate the table storage
-after the last written row.
-
-=back
-
-You should consult the documentation of C<< SQL::Eval::Table >> (see
-L<SQL::Eval>) to get more information about the abstract methods of the
-table's base class you have to override and a description of the table
-meta information expected by the SQL engines.
-
-=head1 AUTHOR
-
-The module DBD::File is currently maintained by
-
-H.Merijn Brand < h.m.brand at xs4all.nl > and
-Jens Rehsack < rehsack at googlemail.com >
-
-The original author is Jochen Wiedmann.
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright (C) 2010-2013 by H.Merijn Brand & Jens Rehsack
-
-All rights reserved.
-
-You may freely distribute and/or modify this module under the terms of
-either the GNU General Public License (GPL) or the Artistic License, as
-specified in the Perl README file.
-
-=cut
+++ /dev/null
-=head1 NAME
-
-DBD::File::HowTo - Guide to create DBD::File based driver
-
-=head1 SYNOPSIS
-
- perldoc DBD::File::HowTo
- perldoc DBI
- perldoc DBI::DBD
- perldoc DBD::File::Developers
- perldoc DBI::DBD::SqlEngine::Developers
- perldoc DBI::DBD::SqlEngine
- perldoc SQL::Eval
- perldoc DBI::DBD::SqlEngine::HowTo
- perldoc SQL::Statement::Embed
- perldoc DBD::File
- perldoc DBD::File::HowTo
- perldoc DBD::File::Developers
-
-=head1 DESCRIPTION
-
-This document provides a step-by-step guide, how to create a new
-C<DBD::File> based DBD. It expects that you carefully read the L<DBI>
-documentation and that you're familiar with L<DBI::DBD> and had read and
-understood L<DBD::ExampleP>.
-
-This document addresses experienced developers who are really sure that
-they need to invest time when writing a new DBI Driver. Writing a DBI
-Driver is neither a weekend project nor an easy job for hobby coders
-after work. Expect one or two man-month of time for the first start.
-
-Those who are still reading, should be able to sing the rules of
-L<DBI::DBD/CREATING A NEW DRIVER>.
-
-Of course, DBD::File is a DBI::DBD::SqlEngine and you surely read
-L<DBI::DBD::SqlEngine::HowTo> before continuing here.
-
-=head1 CREATING DRIVER CLASSES
-
-Do you have an entry in DBI's DBD registry? For this guide, a prefix of
-C<foo_> is assumed.
-
-=head2 Sample Skeleton
-
- package DBD::Foo;
-
- use strict;
- use warnings;
- use vars qw(@ISA $VERSION);
- use base qw(DBD::File);
-
- use DBI ();
-
- $VERSION = "0.001";
-
- package DBD::Foo::dr;
-
- use vars qw(@ISA $imp_data_size);
-
- @ISA = qw(DBD::File::dr);
- $imp_data_size = 0;
-
- package DBD::Foo::db;
-
- use vars qw(@ISA $imp_data_size);
-
- @ISA = qw(DBD::File::db);
- $imp_data_size = 0;
-
- package DBD::Foo::st;
-
- use vars qw(@ISA $imp_data_size);
-
- @ISA = qw(DBD::File::st);
- $imp_data_size = 0;
-
- package DBD::Foo::Statement;
-
- use vars qw(@ISA);
-
- @ISA = qw(DBD::File::Statement);
-
- package DBD::Foo::Table;
-
- use vars qw(@ISA);
-
- @ISA = qw(DBD::File::Table);
-
- 1;
-
-Tiny, eh? And all you have now is a DBD named foo which will is able to
-deal with temporary tables, as long as you use L<SQL::Statement>. In
-L<DBI::SQL::Nano> environments, this DBD can do nothing.
-
-=head2 Start over
-
-Based on L<DBI::DBD::SqlEngine::HowTo>, we're now having a driver which
-could do basic things. Of course, it should now derive from DBD::File
-instead of DBI::DBD::SqlEngine, shouldn't it?
-
-DBD::File extends DBI::DBD::SqlEngine to deal with any kind of files.
-In principle, the only extensions required are to the table class:
-
- package DBD::Foo::Table;
-
- sub bootstrap_table_meta
- {
- my ( $self, $dbh, $meta, $table ) = @_;
-
- # initialize all $meta attributes which might be relevant for
- # file2table
-
- return $self->SUPER::bootstrap_table_meta($dbh, $meta, $table);
- }
-
- sub init_table_meta
- {
- my ( $self, $dbh, $meta, $table ) = @_;
-
- # called after $meta contains the results from file2table
- # initialize all missing $meta attributes
-
- $self->SUPER::init_table_meta( $dbh, $meta, $table );
- }
-
-In case C<DBD::File::Table::open_file> doesn't open the files as the driver
-needs that, override it!
-
- sub open_file
- {
- my ( $self, $meta, $attrs, $flags ) = @_;
- # ensure that $meta->{f_dontopen} is set
- $self->SUPER::open_file( $meta, $attrs, $flags );
- # now do what ever needs to be done
- }
-
-Combined with the methods implemented using the L<SQL::Statement::Embed>
-guide, the table is full working and you could try a start over.
-
-=head2 User comfort
-
-C<DBD::File> since C<0.39> consolidates all persistent meta data of a table
-into a single structure stored in C<< $dbh->{f_meta} >>. With C<DBD::File>
-version C<0.41> and C<DBI::DBD::SqlEngine> version C<0.05>, this
-consolidation moves to L<DBI::DBD::SqlEngine>. It's still the
-C<< $dbh->{$drv_prefix . "_meta"} >> attribute which cares, so what you
-learned at this place before, is still valid.
-
- sub init_valid_attributes
- {
- my $dbh = $_[0];
-
- $dbh->SUPER::init_valid_attributes ();
-
- $dbh->{foo_valid_attrs} = { ... };
- $dbh->{foo_readonly_attrs} = { ... };
-
- $dbh->{foo_meta} = "foo_tables";
-
- return $dbh;
- }
-
-See updates at L<DBI::DBD::SqlEngine::HowTo/User comfort>.
-
-=head2 Testing
-
-Now you should have your own DBD::File based driver. Was easy, wasn't it?
-But does it work well? Prove it by writing tests and remember to use
-dbd_edit_mm_attribs from L<DBI::DBD> to ensure testing even rare cases.
-
-=head1 AUTHOR
-
-This guide is written by Jens Rehsack. DBD::File is written by Jochen
-Wiedmann and Jeff Zucker.
-
-The module DBD::File is currently maintained by
-
-H.Merijn Brand < h.m.brand at xs4all.nl > and
-Jens Rehsack < rehsack at googlemail.com >
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright (C) 2010 by H.Merijn Brand & Jens Rehsack
-
-All rights reserved.
-
-You may freely distribute and/or modify this module under the terms of
-either the GNU General Public License (GPL) or the Artistic License, as
-specified in the Perl README file.
-
-=cut
+++ /dev/null
-=head1 NAME
-
-DBD::File::Roadmap - Planned Enhancements for DBD::File and pure Perl DBD's
-
-Jens Rehsack - May 2010
-
-=head1 SYNOPSIS
-
-This document gives a high level overview of the future of the DBD::File DBI
-driver and groundwork for pure Perl DBI drivers.
-
-The planned enhancements cover features, testing, performance, reliability,
-extensibility and more.
-
-=head1 CHANGES AND ENHANCEMENTS
-
-=head2 Features
-
-There are some features missing we would like to add, but there is
-no time plan:
-
-=over 4
-
-=item LOCK TABLE
-
-The newly implemented internal common table meta storage area would allow
-us to implement LOCK TABLE support based on file system C<flock ()>
-support.
-
-=item Transaction support
-
-While DBD::AnyData recommends explicitly committing by importing and
-exporting tables, DBD::File might be enhanced in a future version to allow
-transparent transactions using the temporary tables of SQL::Statement as
-shadow (dirty) tables.
-
-Transaction support will heavily rely on lock table support.
-
-=item Data Dictionary Persistence
-
-SQL::Statement provides dictionary information when a "CREATE TABLE ..."
-statement is executed. This dictionary is preserved for some statement
-handle attribute fetches (as C<NULLABLE> or C<PRECISION>).
-
-It is planned to extend DBD::File to support data dictionaries to work
-on the tables in it. It is not planned to support one table in different
-dictionaries, but you can have several dictionaries in one directory.
-
-=item SQL Engine selecting on connect
-
-Currently the SQL engine selected is chosen during the loading of the module
-L<DBI::SQL::Nano>. Ideally end users should be able to select the engine
-used in C<< DBI->connect () >> with a special DBD::File attribute.
-
-=back
-
-Other points of view to the planned features (and more features for the
-SQL::Statement engine) are shown in L<SQL::Statement::Roadmap>.
-
-=head2 Testing
-
-DBD::File and the dependent DBD::DBM requires a lot more automated tests
-covering API stability and compatibility with optional modules
-like SQL::Statement.
-
-=head2 Performance
-
-Several arguments for support of features like indexes on columns
-and cursors are made for DBD::CSV (which is a DBD::File based driver,
-too). Similar arguments could be made for DBD::DBM, DBD::AnyData,
-DBD::RAM or DBD::PO etc.
-
-To improve the performance of the underlying SQL engines, a clean
-re-implementation seems to be required. Currently both engines are
-prematurely optimized and therefore it is not trivial to provide
-further optimization without the risk of breaking existing features.
-
-Join the DBI developers IRC channel at L<irc://irc.perl.org/dbi> to
-participate or post to the DBI Developers Mailing List.
-
-=head2 Reliability
-
-DBD::File currently lacks the following points:
-
-=over 4
-
-=item duplicate table names
-
-It is currently possible to access a table quoted with a relative path
-(a) and additionally using an absolute path (b). If (a) and (b) are
-the same file that is not recognized (except for
-flock protection handled by the Operating System) and two independent
-tables are handled.
-
-=item invalid table names
-
-The current implementation does not prevent someone choosing a
-directory name as a physical file name for the table to open.
-
-=back
-
-=head2 Extensibility
-
-I (Jens Rehsack) have some (partially for example only) DBD's in mind:
-
-=over 4
-
-=item DBD::Sys
-
-Derive DBD::Sys from a common code base shared with DBD::File which handles
-all the emulation DBI needs (as getinfo, SQL engine handling, ...)
-
-=item DBD::Dir
-
-Provide a DBD::File derived to work with fixed table definitions through the
-file system to demonstrate how DBI / Pure Perl DBDs could handle databases
-with hierarchical structures.
-
-=item DBD::Join
-
-Provide a DBI driver which is able to manage multiple connections to other
-Databases (as DBD::Multiplex), but allow them to point to different data
-sources and allow joins between the tables of them:
-
- # Example
- # Let table 'lsof' being a table in DBD::Sys giving a list of open files using lsof utility
- # Let table 'dir' being a atable from DBD::Dir
- $sth = $dbh->prepare( "select * from dir,lsof where path='/documents' and dir.entry = lsof.filename" )
- $sth->execute(); # gives all open files in '/documents'
- ...
-
- # Let table 'filesys' a DBD::Sys table of known file systems on current host
- # Let table 'applications' a table of your Configuration Management Database
- # where current applications (relocatable, with mountpoints for filesystems)
- # are stored
- $sth = dbh->prepare( "select * from applications,filesys where " .
- "application.mountpoint = filesys.mountpoint and ".
- "filesys.mounted is true" );
- $sth->execute(); # gives all currently mounted applications on this host
-
-=back
-
-=head1 PRIORITIES
-
-Our priorities are focused on current issues. Initially many new test
-cases for DBD::File and DBD::DBM should be added to the DBI test
-suite. After that some additional documentation on how to use the
-DBD::File API will be provided.
-
-Any additional priorities will come later and can be modified by (paying)
-users.
-
-=head1 RESOURCES AND CONTRIBUTIONS
-
-See L<http://dbi.perl.org/contributing> for I<how you can help>.
-
-If your company has benefited from DBI, please consider if
-it could make a donation to The Perl Foundation "DBI Development"
-fund at L<http://dbi.perl.org/donate> to secure future development.
-
-Alternatively, if your company would benefit from a specific new
-DBI feature, please consider sponsoring it's development through
-the options listed in the section "Commercial Support from the Author"
-on L<http://dbi.perl.org/support/>.
-
-Using such targeted financing allows you to contribute to DBI
-development and rapidly get something specific and directly valuable
-to you in return.
-
-My company also offers annual support contracts for the DBI, which
-provide another way to support the DBI and get something specific
-in return. Contact me for details.
-
-Thank you.
-
-=cut
+++ /dev/null
-{
- package DBD::Gofer;
-
- use strict;
-
- require DBI;
- require DBI::Gofer::Request;
- require DBI::Gofer::Response;
- require Carp;
-
- our $VERSION = "0.015327";
-
-# $Id: Gofer.pm 15326 2012-06-06 16:32:38Z Tim $
-#
-# Copyright (c) 2007, Tim Bunce, Ireland
-#
-# You may distribute under the terms of either the GNU General Public
-# License or the Artistic License, as specified in the Perl README file.
-
-
-
- # attributes we'll allow local STORE
- our %xxh_local_store_attrib = map { $_=>1 } qw(
- Active
- CachedKids
- Callbacks
- DbTypeSubclass
- ErrCount Executed
- FetchHashKeyName
- HandleError HandleSetErr
- InactiveDestroy
- AutoInactiveDestroy
- PrintError PrintWarn
- Profile
- RaiseError
- RootClass
- ShowErrorStatement
- Taint TaintIn TaintOut
- TraceLevel
- Warn
- dbi_quote_identifier_cache
- dbi_connect_closure
- dbi_go_execute_unique
- );
- our %xxh_local_store_attrib_if_same_value = map { $_=>1 } qw(
- Username
- dbi_connect_method
- );
-
- our $drh = undef; # holds driver handle once initialized
- our $methods_already_installed;
-
- sub driver{
- return $drh if $drh;
-
- DBI->setup_driver('DBD::Gofer');
-
- unless ($methods_already_installed++) {
- my $opts = { O=> 0x0004 }; # IMA_KEEP_ERR
- DBD::Gofer::db->install_method('go_dbh_method', $opts);
- DBD::Gofer::st->install_method('go_sth_method', $opts);
- DBD::Gofer::st->install_method('go_clone_sth', $opts);
- DBD::Gofer::db->install_method('go_cache', $opts);
- DBD::Gofer::st->install_method('go_cache', $opts);
- }
-
- my($class, $attr) = @_;
- $class .= "::dr";
- ($drh) = DBI::_new_drh($class, {
- 'Name' => 'Gofer',
- 'Version' => $VERSION,
- 'Attribution' => 'DBD Gofer by Tim Bunce',
- });
-
- $drh;
- }
-
-
- sub CLONE {
- undef $drh;
- }
-
-
- sub go_cache {
- my $h = shift;
- $h->{go_cache} = shift if @_;
- # return handle's override go_cache, if it has one
- return $h->{go_cache} if defined $h->{go_cache};
- # or else the transports default go_cache
- return $h->{go_transport}->{go_cache};
- }
-
-
- sub set_err_from_response { # set error/warn/info and propagate warnings
- my $h = shift;
- my $response = shift;
- if (my $warnings = $response->warnings) {
- warn $_ for @$warnings;
- }
- my ($err, $errstr, $state) = $response->err_errstr_state;
- # Only set_err() if there's an error else leave the current values
- # (The current values will normally be set undef by the DBI dispatcher
- # except for methods marked KEEPERR such as ping.)
- $h->set_err($err, $errstr, $state) if defined $err;
- return undef;
- }
-
-
- sub install_methods_proxy {
- my ($installed_methods) = @_;
- while ( my ($full_method, $attr) = each %$installed_methods ) {
- # need to install both a DBI dispatch stub and a proxy stub
- # (the dispatch stub may be already here due to local driver use)
-
- DBI->_install_method($full_method, "", $attr||{})
- unless defined &{$full_method};
-
- # now install proxy stubs on the driver side
- $full_method =~ m/^DBI::(\w\w)::(\w+)$/
- or die "Invalid method name '$full_method' for install_method";
- my ($type, $method) = ($1, $2);
- my $driver_method = "DBD::Gofer::${type}::${method}";
- next if defined &{$driver_method};
- my $sub;
- if ($type eq 'db') {
- $sub = sub { return shift->go_dbh_method(undef, $method, @_) };
- }
- else {
- $sub = sub { shift->set_err($DBI::stderr, "Can't call \$${type}h->$method when using DBD::Gofer"); return; };
- }
- no strict 'refs';
- *$driver_method = $sub;
- }
- }
-}
-
-
-{ package DBD::Gofer::dr; # ====== DRIVER ======
-
- $imp_data_size = 0;
- use strict;
-
- sub connect_cached {
- my ($drh, $dsn, $user, $auth, $attr)= @_;
- $attr ||= {};
- return $drh->SUPER::connect_cached($dsn, $user, $auth, {
- (%$attr),
- go_connect_method => $attr->{go_connect_method} || 'connect_cached',
- });
- }
-
-
- sub connect {
- my($drh, $dsn, $user, $auth, $attr)= @_;
- my $orig_dsn = $dsn;
-
- # first remove dsn= and everything after it
- my $remote_dsn = ($dsn =~ s/;?\bdsn=(.*)$// && $1)
- or return $drh->set_err($DBI::stderr, "No dsn= argument in '$orig_dsn'");
-
- if ($attr->{go_bypass}) { # don't use DBD::Gofer for this connection
- # useful for testing with DBI_AUTOPROXY, e.g., t/03handle.t
- return DBI->connect($remote_dsn, $user, $auth, $attr);
- }
-
- my %go_attr;
- # extract any go_ attributes from the connect() attr arg
- for my $k (grep { /^go_/ } keys %$attr) {
- $go_attr{$k} = delete $attr->{$k};
- }
- # then override those with any attributes embedded in our dsn (not remote_dsn)
- for my $kv (grep /=/, split /;/, $dsn, -1) {
- my ($k, $v) = split /=/, $kv, 2;
- $go_attr{ "go_$k" } = $v;
- }
-
- if (not ref $go_attr{go_policy}) { # if not a policy object already
- my $policy_class = $go_attr{go_policy} || 'classic';
- $policy_class = "DBD::Gofer::Policy::$policy_class"
- unless $policy_class =~ /::/;
- _load_class($policy_class)
- or return $drh->set_err($DBI::stderr, "Can't load $policy_class: $@");
- # replace policy name in %go_attr with policy object
- $go_attr{go_policy} = eval { $policy_class->new(\%go_attr) }
- or return $drh->set_err($DBI::stderr, "Can't instanciate $policy_class: $@");
- }
- # policy object is left in $go_attr{go_policy} so transport can see it
- my $go_policy = $go_attr{go_policy};
-
- if ($go_attr{go_cache} and not ref $go_attr{go_cache}) { # if not a cache object already
- my $cache_class = $go_attr{go_cache};
- $cache_class = "DBI::Util::CacheMemory" if $cache_class eq '1';
- _load_class($cache_class)
- or return $drh->set_err($DBI::stderr, "Can't load $cache_class $@");
- $go_attr{go_cache} = eval { $cache_class->new() }
- or $drh->set_err(0, "Can't instanciate $cache_class: $@"); # warning
- }
-
- # delete any other attributes that don't apply to transport
- my $go_connect_method = delete $go_attr{go_connect_method};
-
- my $transport_class = delete $go_attr{go_transport}
- or return $drh->set_err($DBI::stderr, "No transport= argument in '$orig_dsn'");
- $transport_class = "DBD::Gofer::Transport::$transport_class"
- unless $transport_class =~ /::/;
- _load_class($transport_class)
- or return $drh->set_err($DBI::stderr, "Can't load $transport_class: $@");
- my $go_transport = eval { $transport_class->new(\%go_attr) }
- or return $drh->set_err($DBI::stderr, "Can't instanciate $transport_class: $@");
-
- my $request_class = "DBI::Gofer::Request";
- my $go_request = eval {
- my $go_attr = { %$attr };
- # XXX user/pass of fwd server vs db server ? also impact of autoproxy
- if ($user) {
- $go_attr->{Username} = $user;
- $go_attr->{Password} = $auth;
- }
- # delete any attributes we can't serialize (or don't want to)
- delete @{$go_attr}{qw(Profile HandleError HandleSetErr Callbacks)};
- # delete any attributes that should only apply to the client-side
- delete @{$go_attr}{qw(RootClass DbTypeSubclass)};
-
- $go_connect_method ||= $go_policy->connect_method($remote_dsn, $go_attr) || 'connect';
- $request_class->new({
- dbh_connect_call => [ $go_connect_method, $remote_dsn, $user, $auth, $go_attr ],
- })
- } or return $drh->set_err($DBI::stderr, "Can't instanciate $request_class: $@");
-
- my ($dbh, $dbh_inner) = DBI::_new_dbh($drh, {
- 'Name' => $dsn,
- 'USER' => $user,
- go_transport => $go_transport,
- go_request => $go_request,
- go_policy => $go_policy,
- });
-
- # mark as inactive temporarily for STORE. Active not set until connected() called.
- $dbh->STORE(Active => 0);
-
- # should we ping to check the connection
- # and fetch dbh attributes
- my $skip_connect_check = $go_policy->skip_connect_check($attr, $dbh);
- if (not $skip_connect_check) {
- if (not $dbh->go_dbh_method(undef, 'ping')) {
- return undef if $dbh->err; # error already recorded, typically
- return $dbh->set_err($DBI::stderr, "ping failed");
- }
- }
-
- return $dbh;
- }
-
- sub _load_class { # return true or false+$@
- my $class = shift;
- (my $pm = $class) =~ s{::}{/}g;
- $pm .= ".pm";
- return 1 if eval { require $pm };
- delete $INC{$pm}; # shouldn't be needed (perl bug?) and assigning undef isn't enough
- undef; # error in $@
- }
-
-}
-
-
-{ package DBD::Gofer::db; # ====== DATABASE ======
- $imp_data_size = 0;
- use strict;
- use Carp qw(carp croak);
-
- my %dbh_local_store_attrib = %DBD::Gofer::xxh_local_store_attrib;
-
- sub connected {
- shift->STORE(Active => 1);
- }
-
- sub go_dbh_method {
- my $dbh = shift;
- my $meta = shift;
- # @_ now contains ($method_name, @args)
-
- my $request = $dbh->{go_request};
- $request->init_request([ wantarray, @_ ], $dbh);
- ++$dbh->{go_request_count};
-
- my $go_policy = $dbh->{go_policy};
- my $dbh_attribute_update = $go_policy->dbh_attribute_update();
- $request->dbh_attributes( $go_policy->dbh_attribute_list() )
- if $dbh_attribute_update eq 'every'
- or $dbh->{go_request_count}==1;
-
- $request->dbh_last_insert_id_args($meta->{go_last_insert_id_args})
- if $meta->{go_last_insert_id_args};
-
- my $transport = $dbh->{go_transport}
- or return $dbh->set_err($DBI::stderr, "Not connected (no transport)");
-
- local $transport->{go_cache} = $dbh->{go_cache}
- if defined $dbh->{go_cache};
-
- my ($response, $retransmit_sub) = $transport->transmit_request($request);
- $response ||= $transport->receive_response($request, $retransmit_sub);
- $dbh->{go_response} = $response
- or die "No response object returned by $transport";
-
- die "response '$response' returned by $transport is not a response object"
- unless UNIVERSAL::isa($response,"DBI::Gofer::Response");
-
- if (my $dbh_attributes = $response->dbh_attributes) {
-
- # XXX installed_methods piggybacks on dbh_attributes for now
- if (my $installed_methods = delete $dbh_attributes->{dbi_installed_methods}) {
- DBD::Gofer::install_methods_proxy($installed_methods)
- if $dbh->{go_request_count}==1;
- }
-
- # XXX we don't STORE here, we just stuff the value into the attribute cache
- $dbh->{$_} = $dbh_attributes->{$_}
- for keys %$dbh_attributes;
- }
-
- my $rv = $response->rv;
- if (my $resultset_list = $response->sth_resultsets) {
- # dbh method call returned one or more resultsets
- # (was probably a metadata method like table_info)
- #
- # setup an sth but don't execute/forward it
- my $sth = $dbh->prepare(undef, { go_skip_prepare_check => 1 });
- # set the sth response to our dbh response
- (tied %$sth)->{go_response} = $response;
- # setup the sth with the results in our response
- $sth->more_results;
- # and return that new sth as if it came from original request
- $rv = [ $sth ];
- }
- elsif (!$rv) { # should only occur for major transport-level error
- #carp("no rv in response { @{[ %$response ]} }");
- $rv = [ ];
- }
-
- DBD::Gofer::set_err_from_response($dbh, $response);
-
- return (wantarray) ? @$rv : $rv->[0];
- }
-
-
- # Methods that should be forwarded but can be cached
- for my $method (qw(
- tables table_info column_info primary_key_info foreign_key_info statistics_info
- data_sources type_info_all get_info
- parse_trace_flags parse_trace_flag
- func
- )) {
- my $policy_name = "cache_$method";
- my $super_name = "SUPER::$method";
- my $sub = sub {
- my $dbh = shift;
- my $rv;
-
- # if we know the remote side doesn't override the DBI's default method
- # then we might as well just call the DBI's default method on the client
- # (which may, in turn, call other methods that are forwarded, like get_info)
- if ($dbh->{dbi_default_methods}{$method} && $dbh->{go_policy}->skip_default_methods()) {
- $dbh->trace_msg(" !! $method: using local default as remote method is also default\n");
- return $dbh->$super_name(@_);
- }
-
- my $cache;
- my $cache_key;
- if (my $cache_it = $dbh->{go_policy}->$policy_name(undef, $dbh, @_)) {
- $cache = $dbh->{go_meta_cache} ||= {}; # keep separate from go_cache
- $cache_key = sprintf "%s_wa%d(%s)", $policy_name, wantarray||0,
- join(",\t", map { # XXX basic but sufficient for now
- !ref($_) ? DBI::neat($_,1e6)
- : ref($_) eq 'ARRAY' ? DBI::neat_list($_,1e6,",\001")
- : ref($_) eq 'HASH' ? do { my @k = sort keys %$_; DBI::neat_list([@k,@{$_}{@k}],1e6,",\002") }
- : do { warn "unhandled argument type ($_)"; $_ }
- } @_);
- if ($rv = $cache->{$cache_key}) {
- $dbh->trace_msg("$method(@_) returning previously cached value ($cache_key)\n",4);
- my @cache_rv = @$rv;
- # if it's an sth we have to clone it
- $cache_rv[0] = $cache_rv[0]->go_clone_sth if UNIVERSAL::isa($cache_rv[0],'DBI::st');
- return (wantarray) ? @cache_rv : $cache_rv[0];
- }
- }
-
- $rv = [ (wantarray)
- ? ($dbh->go_dbh_method(undef, $method, @_))
- : scalar $dbh->go_dbh_method(undef, $method, @_)
- ];
-
- if ($cache) {
- $dbh->trace_msg("$method(@_) caching return value ($cache_key)\n",4);
- my @cache_rv = @$rv;
- # if it's an sth we have to clone it
- #$cache_rv[0] = $cache_rv[0]->go_clone_sth
- # if UNIVERSAL::isa($cache_rv[0],'DBI::st');
- $cache->{$cache_key} = \@cache_rv
- unless UNIVERSAL::isa($cache_rv[0],'DBI::st'); # XXX cloning sth not yet done
- }
-
- return (wantarray) ? @$rv : $rv->[0];
- };
- no strict 'refs';
- *$method = $sub;
- }
-
-
- # Methods that can use the DBI defaults for some situations/drivers
- for my $method (qw(
- quote quote_identifier
- )) { # XXX keep DBD::Gofer::Policy::Base in sync
- my $policy_name = "locally_$method";
- my $super_name = "SUPER::$method";
- my $sub = sub {
- my $dbh = shift;
-
- # if we know the remote side doesn't override the DBI's default method
- # then we might as well just call the DBI's default method on the client
- # (which may, in turn, call other methods that are forwarded, like get_info)
- if ($dbh->{dbi_default_methods}{$method} && $dbh->{go_policy}->skip_default_methods()) {
- $dbh->trace_msg(" !! $method: using local default as remote method is also default\n");
- return $dbh->$super_name(@_);
- }
-
- # false: use remote gofer
- # 1: use local DBI default method
- # code ref: use the code ref
- my $locally = $dbh->{go_policy}->$policy_name($dbh, @_);
- if ($locally) {
- return $locally->($dbh, @_) if ref $locally eq 'CODE';
- return $dbh->$super_name(@_);
- }
- return $dbh->go_dbh_method(undef, $method, @_); # propagate context
- };
- no strict 'refs';
- *$method = $sub;
- }
-
-
- # Methods that should always fail
- for my $method (qw(
- begin_work commit rollback
- )) {
- no strict 'refs';
- *$method = sub { return shift->set_err($DBI::stderr, "$method not available with DBD::Gofer") }
- }
-
-
- sub do {
- my ($dbh, $sql, $attr, @args) = @_;
- delete $dbh->{Statement}; # avoid "Modification of non-creatable hash value attempted"
- $dbh->{Statement} = $sql; # for profiling and ShowErrorStatement
- my $meta = { go_last_insert_id_args => $attr->{go_last_insert_id_args} };
- return $dbh->go_dbh_method($meta, 'do', $sql, $attr, @args);
- }
-
- sub ping {
- my $dbh = shift;
- return $dbh->set_err('', "can't ping while not connected") # info
- unless $dbh->SUPER::FETCH('Active');
- my $skip_ping = $dbh->{go_policy}->skip_ping();
- return ($skip_ping) ? 1 : $dbh->go_dbh_method(undef, 'ping', @_);
- }
-
- sub last_insert_id {
- my $dbh = shift;
- my $response = $dbh->{go_response} or return undef;
- return $response->last_insert_id;
- }
-
- sub FETCH {
- my ($dbh, $attrib) = @_;
-
- # FETCH is effectively already cached because the DBI checks the
- # attribute cache in the handle before calling FETCH
- # and this FETCH copies the value into the attribute cache
-
- # forward driver-private attributes (except ours)
- if ($attrib =~ m/^[a-z]/ && $attrib !~ /^go_/) {
- my $value = $dbh->go_dbh_method(undef, 'FETCH', $attrib);
- $dbh->{$attrib} = $value; # XXX forces caching by DBI
- return $dbh->{$attrib} = $value;
- }
-
- # else pass up to DBI to handle
- return $dbh->SUPER::FETCH($attrib);
- }
-
- sub STORE {
- my ($dbh, $attrib, $value) = @_;
- if ($attrib eq 'AutoCommit') {
- croak "Can't enable transactions when using DBD::Gofer" if !$value;
- return $dbh->SUPER::STORE($attrib => ($value) ? -901 : -900);
- }
- return $dbh->SUPER::STORE($attrib => $value)
- # we handle this attribute locally
- if $dbh_local_store_attrib{$attrib}
- # or it's a private_ (application) attribute
- or $attrib =~ /^private_/
- # or not yet connected (ie being called by DBI->connect)
- or not $dbh->FETCH('Active');
-
- return $dbh->SUPER::STORE($attrib => $value)
- if $DBD::Gofer::xxh_local_store_attrib_if_same_value{$attrib}
- && do { # values are the same
- my $crnt = $dbh->FETCH($attrib);
- local $^W;
- (defined($value) ^ defined($crnt))
- ? 0 # definedness differs
- : $value eq $crnt;
- };
-
- # dbh attributes are set at connect-time - see connect()
- carp("Can't alter \$dbh->{$attrib} after handle created with DBD::Gofer") if $dbh->FETCH('Warn');
- return $dbh->set_err($DBI::stderr, "Can't alter \$dbh->{$attrib} after handle created with DBD::Gofer");
- }
-
- sub disconnect {
- my $dbh = shift;
- $dbh->{go_transport} = undef;
- $dbh->STORE(Active => 0);
- }
-
- sub prepare {
- my ($dbh, $statement, $attr)= @_;
-
- return $dbh->set_err($DBI::stderr, "Can't prepare when disconnected")
- unless $dbh->FETCH('Active');
-
- $attr = { %$attr } if $attr; # copy so we can edit
-
- my $policy = delete($attr->{go_policy}) || $dbh->{go_policy};
- my $lii_args = delete $attr->{go_last_insert_id_args};
- my $go_prepare = delete($attr->{go_prepare_method})
- || $dbh->{go_prepare_method}
- || $policy->prepare_method($dbh, $statement, $attr)
- || 'prepare'; # e.g. for code not using placeholders
- my $go_cache = delete $attr->{go_cache};
- # set to undef if there are no attributes left for the actual prepare call
- $attr = undef if $attr and not %$attr;
-
- my ($sth, $sth_inner) = DBI::_new_sth($dbh, {
- Statement => $statement,
- go_prepare_call => [ 0, $go_prepare, $statement, $attr ],
- # go_method_calls => [], # autovivs if needed
- go_request => $dbh->{go_request},
- go_transport => $dbh->{go_transport},
- go_policy => $policy,
- go_last_insert_id_args => $lii_args,
- go_cache => $go_cache,
- });
- $sth->STORE(Active => 0); # XXX needed? It should be the default
-
- my $skip_prepare_check = $policy->skip_prepare_check($attr, $dbh, $statement, $attr, $sth);
- if (not $skip_prepare_check) {
- $sth->go_sth_method() or return undef;
- }
-
- return $sth;
- }
-
- sub prepare_cached {
- my ($dbh, $sql, $attr, $if_active)= @_;
- $attr ||= {};
- return $dbh->SUPER::prepare_cached($sql, {
- %$attr,
- go_prepare_method => $attr->{go_prepare_method} || 'prepare_cached',
- }, $if_active);
- }
-
- *go_cache = \&DBD::Gofer::go_cache;
-}
-
-
-{ package DBD::Gofer::st; # ====== STATEMENT ======
- $imp_data_size = 0;
- use strict;
-
- my %sth_local_store_attrib = (%DBD::Gofer::xxh_local_store_attrib, NUM_OF_FIELDS => 1);
-
- sub go_sth_method {
- my ($sth, $meta) = @_;
-
- if (my $ParamValues = $sth->{ParamValues}) {
- my $ParamAttr = $sth->{ParamAttr};
- # XXX the sort here is a hack to work around a DBD::Sybase bug
- # but only works properly for params 1..9
- # (reverse because of the unshift)
- my @params = reverse sort keys %$ParamValues;
- if (@params > 9 && ($sth->{Database}{go_dsn}||'') =~ /dbi:Sybase/) {
- # if more than 9 then we need to do a proper numeric sort
- # also warn to alert user of this issue
- warn "Sybase param binding order hack in use";
- @params = sort { $b <=> $a } @params;
- }
- for my $p (@params) {
- # unshift to put binds before execute call
- unshift @{ $sth->{go_method_calls} },
- [ 'bind_param', $p, $ParamValues->{$p}, $ParamAttr->{$p} ];
- }
- }
-
- my $dbh = $sth->{Database} or die "panic";
- ++$dbh->{go_request_count};
-
- my $request = $sth->{go_request};
- $request->init_request($sth->{go_prepare_call}, $sth);
- $request->sth_method_calls(delete $sth->{go_method_calls})
- if $sth->{go_method_calls};
- $request->sth_result_attr({}); # (currently) also indicates this is an sth request
-
- $request->dbh_last_insert_id_args($meta->{go_last_insert_id_args})
- if $meta->{go_last_insert_id_args};
-
- my $go_policy = $sth->{go_policy};
- my $dbh_attribute_update = $go_policy->dbh_attribute_update();
- $request->dbh_attributes( $go_policy->dbh_attribute_list() )
- if $dbh_attribute_update eq 'every'
- or $dbh->{go_request_count}==1;
-
- my $transport = $sth->{go_transport}
- or return $sth->set_err($DBI::stderr, "Not connected (no transport)");
-
- local $transport->{go_cache} = $sth->{go_cache}
- if defined $sth->{go_cache};
-
- my ($response, $retransmit_sub) = $transport->transmit_request($request);
- $response ||= $transport->receive_response($request, $retransmit_sub);
- $sth->{go_response} = $response
- or die "No response object returned by $transport";
- $dbh->{go_response} = $response; # mainly for last_insert_id
-
- if (my $dbh_attributes = $response->dbh_attributes) {
- # XXX we don't STORE here, we just stuff the value into the attribute cache
- $dbh->{$_} = $dbh_attributes->{$_}
- for keys %$dbh_attributes;
- # record the values returned, so we know that we have fetched
- # values are which we have fetched (see dbh->FETCH method)
- $dbh->{go_dbh_attributes_fetched} = $dbh_attributes;
- }
-
- my $rv = $response->rv; # may be undef on error
- if ($response->sth_resultsets) {
- # setup first resultset - including sth attributes
- $sth->more_results;
- }
- else {
- $sth->STORE(Active => 0);
- $sth->{go_rows} = $rv;
- }
- # set error/warn/info (after more_results as that'll clear err)
- DBD::Gofer::set_err_from_response($sth, $response);
-
- return $rv;
- }
-
-
- sub bind_param {
- my ($sth, $param, $value, $attr) = @_;
- $sth->{ParamValues}{$param} = $value;
- $sth->{ParamAttr}{$param} = $attr
- if defined $attr; # attr is sticky if not explicitly set
- return 1;
- }
-
-
- sub execute {
- my $sth = shift;
- $sth->bind_param($_, $_[$_-1]) for (1..@_);
- push @{ $sth->{go_method_calls} }, [ 'execute' ];
- my $meta = { go_last_insert_id_args => $sth->{go_last_insert_id_args} };
- return $sth->go_sth_method($meta);
- }
-
-
- sub more_results {
- my $sth = shift;
-
- $sth->finish;
-
- my $response = $sth->{go_response} or do {
- # e.g., we haven't sent a request yet (ie prepare then more_results)
- $sth->trace_msg(" No response object present", 3);
- return;
- };
-
- my $resultset_list = $response->sth_resultsets
- or return $sth->set_err($DBI::stderr, "No sth_resultsets");
-
- my $meta = shift @$resultset_list
- or return undef; # no more result sets
- #warn "more_results: ".Data::Dumper::Dumper($meta);
-
- # pull out the special non-attributes first
- my ($rowset, $err, $errstr, $state)
- = delete @{$meta}{qw(rowset err errstr state)};
-
- # copy meta attributes into attribute cache
- my $NUM_OF_FIELDS = delete $meta->{NUM_OF_FIELDS};
- $sth->STORE('NUM_OF_FIELDS', $NUM_OF_FIELDS);
- # XXX need to use STORE for some?
- $sth->{$_} = $meta->{$_} for keys %$meta;
-
- if (($NUM_OF_FIELDS||0) > 0) {
- $sth->{go_rows} = ($rowset) ? @$rowset : -1;
- $sth->{go_current_rowset} = $rowset;
- $sth->{go_current_rowset_err} = [ $err, $errstr, $state ]
- if defined $err;
- $sth->STORE(Active => 1) if $rowset;
- }
-
- return $sth;
- }
-
-
- sub go_clone_sth {
- my ($sth1) = @_;
- # clone an (un-fetched-from) sth - effectively undoes the initial more_results
- # not 100% so just for use in caching returned sth e.g. table_info
- my $sth2 = $sth1->{Database}->prepare($sth1->{Statement}, { go_skip_prepare_check => 1 });
- $sth2->STORE($_, $sth1->{$_}) for qw(NUM_OF_FIELDS Active);
- my $sth2_inner = tied %$sth2;
- $sth2_inner->{$_} = $sth1->{$_} for qw(NUM_OF_PARAMS FetchHashKeyName);
- die "not fully implemented yet";
- return $sth2;
- }
-
-
- sub fetchrow_arrayref {
- my ($sth) = @_;
- my $resultset = $sth->{go_current_rowset} || do {
- # should only happen if fetch called after execute failed
- my $rowset_err = $sth->{go_current_rowset_err}
- || [ 1, 'no result set (did execute fail)' ];
- return $sth->set_err( @$rowset_err );
- };
- return $sth->_set_fbav(shift @$resultset) if @$resultset;
- $sth->finish; # no more data so finish
- return undef;
- }
- *fetch = \&fetchrow_arrayref; # alias
-
-
- sub fetchall_arrayref {
- my ($sth, $slice, $max_rows) = @_;
- my $resultset = $sth->{go_current_rowset} || do {
- # should only happen if fetch called after execute failed
- my $rowset_err = $sth->{go_current_rowset_err}
- || [ 1, 'no result set (did execute fail)' ];
- return $sth->set_err( @$rowset_err );
- };
- my $mode = ref($slice) || 'ARRAY';
- return $sth->SUPER::fetchall_arrayref($slice, $max_rows)
- if ref($slice) or defined $max_rows;
- $sth->finish; # no more data after this so finish
- return $resultset;
- }
-
-
- sub rows {
- return shift->{go_rows};
- }
-
-
- sub STORE {
- my ($sth, $attrib, $value) = @_;
-
- return $sth->SUPER::STORE($attrib => $value)
- if $sth_local_store_attrib{$attrib} # handle locally
- # or it's a private_ (application) attribute
- or $attrib =~ /^private_/;
-
- # otherwise warn but do it anyway
- # this will probably need refining later
- my $msg = "Altering \$sth->{$attrib} won't affect proxied handle";
- Carp::carp($msg) if $sth->FETCH('Warn');
-
- # XXX could perhaps do
- # push @{ $sth->{go_method_calls} }, [ 'STORE', $attrib, $value ]
- # if not $sth->FETCH('Executed');
- # but how to handle repeat executions? How to we know when an
- # attribute is being set to affect the current resultset or the
- # next execution?
- # Could just always use go_method_calls I guess.
-
- # do the store locally anyway, just in case
- $sth->SUPER::STORE($attrib => $value);
-
- return $sth->set_err($DBI::stderr, $msg);
- }
-
- # sub bind_param_array
- # we use DBI's default, which sets $sth->{ParamArrays}{$param} = $value
- # and calls bind_param($param, undef, $attr) if $attr.
-
- sub execute_array {
- my $sth = shift;
- my $attr = shift;
- $sth->bind_param_array($_, $_[$_-1]) for (1..@_);
- push @{ $sth->{go_method_calls} }, [ 'execute_array', $attr ];
- return $sth->go_sth_method($attr);
- }
-
- *go_cache = \&DBD::Gofer::go_cache;
-}
-
-1;
-
-__END__
-
-=head1 NAME
-
-DBD::Gofer - A stateless-proxy driver for communicating with a remote DBI
-
-=head1 SYNOPSIS
-
- use DBI;
-
- $original_dsn = "dbi:..."; # your original DBI Data Source Name
-
- $dbh = DBI->connect("dbi:Gofer:transport=$transport;...;dsn=$original_dsn",
- $user, $passwd, \%attributes);
-
- ... use $dbh as if it was connected to $original_dsn ...
-
-
-The C<transport=$transport> part specifies the name of the module to use to
-transport the requests to the remote DBI. If $transport doesn't contain any
-double colons then it's prefixed with C<DBD::Gofer::Transport::>.
-
-The C<dsn=$original_dsn> part I<must be the last element> of the DSN because
-everything after C<dsn=> is assumed to be the DSN that the remote DBI should
-use.
-
-The C<...> represents attributes that influence the operation of the Gofer
-driver or transport. These are described below or in the documentation of the
-transport module being used.
-
-=encoding ISO8859-1
-
-=head1 DESCRIPTION
-
-DBD::Gofer is a DBI database driver that forwards requests to another DBI
-driver, usually in a separate process, often on a separate machine. It tries to
-be as transparent as possible so it appears that you are using the remote
-driver directly.
-
-DBD::Gofer is very similar to DBD::Proxy. The major difference is that with
-DBD::Gofer no state is maintained on the remote end. That means every
-request contains all the information needed to create the required state. (So,
-for example, every request includes the DSN to connect to.) Each request can be
-sent to any available server. The server executes the request and returns a
-single response that includes all the data.
-
-This is very similar to the way http works as a stateless protocol for the web.
-Each request from your web browser can be handled by a different web server process.
-
-=head2 Use Cases
-
-This may seem like pointless overhead but there are situations where this is a
-very good thing. Let's consider a specific case.
-
-Imagine using DBD::Gofer with an http transport. Your application calls
-connect(), prepare("select * from table where foo=?"), bind_param(), and execute().
-At this point DBD::Gofer builds a request containing all the information
-about the method calls. It then uses the httpd transport to send that request
-to an apache web server.
-
-This 'dbi execute' web server executes the request (using DBI::Gofer::Execute
-and related modules) and builds a response that contains all the rows of data,
-if the statement returned any, along with all the attributes that describe the
-results, such as $sth->{NAME}. This response is sent back to DBD::Gofer which
-unpacks it and presents it to the application as if it had executed the
-statement itself.
-
-=head2 Advantages
-
-Okay, but you still don't see the point? Well let's consider what we've gained:
-
-=head3 Connection Pooling and Throttling
-
-The 'dbi execute' web server leverages all the functionality of web
-infrastructure in terms of load balancing, high-availability, firewalls, access
-management, proxying, caching.
-
-At its most basic level you get a configurable pool of persistent database connections.
-
-=head3 Simple Scaling
-
-Got thousands of processes all trying to connect to the database? You can use
-DBD::Gofer to connect them to your smaller pool of 'dbi execute' web servers instead.
-
-=head3 Caching
-
-Client-side caching is as simple as adding "C<cache=1>" to the DSN.
-This feature alone can be worth using DBD::Gofer for.
-
-=head3 Fewer Network Round-trips
-
-DBD::Gofer sends as few requests as possible (dependent on the policy being used).
-
-=head3 Thin Clients / Unsupported Platforms
-
-You no longer need drivers for your database on every system. DBD::Gofer is pure perl.
-
-=head1 CONSTRAINTS
-
-There are some natural constraints imposed by the DBD::Gofer 'stateless' approach.
-But not many:
-
-=head2 You can't change database handle attributes after connect()
-
-You can't change database handle attributes after you've connected.
-Use the connect() call to specify all the attribute settings you want.
-
-This is because it's critical that when a request is complete the database
-handle is left in the same state it was when first connected.
-
-An exception is made for attributes with names starting "C<private_>":
-They can be set after connect() but the change is only applied locally.
-
-=head2 You can't change statement handle attributes after prepare()
-
-You can't change statement handle attributes after prepare.
-
-An exception is made for attributes with names starting "C<private_>":
-They can be set after prepare() but the change is only applied locally.
-
-=head2 You can't use transactions
-
-AutoCommit only. Transactions aren't supported.
-
-(In theory transactions could be supported when using a transport that
-maintains a connection, like C<stream> does. If you're interested in this
-please get in touch via dbi-dev@perl.org)
-
-=head2 You can't call driver-private sth methods
-
-But that's rarely needed anyway.
-
-=head1 GENERAL CAVEATS
-
-A few important things to keep in mind when using DBD::Gofer:
-
-=head2 Temporary tables, locks, and other per-connection persistent state
-
-You shouldn't expect any per-session state to persist between requests.
-This includes locks and temporary tables.
-
-Because the server-side may execute your requests via a different
-database connections, you can't rely on any per-connection persistent state,
-such as temporary tables, being available from one request to the next.
-
-This is an easy trap to fall into. A good way to check for this is to test your
-code with a Gofer policy package that sets the C<connect_method> policy to
-'connect' to force a new connection for each request. The C<pedantic> policy does this.
-
-=head2 Driver-private Database Handle Attributes
-
-Some driver-private dbh attributes may not be available if the driver has not
-implemented the private_attribute_info() method (added in DBI 1.54).
-
-=head2 Driver-private Statement Handle Attributes
-
-Driver-private sth attributes can be set in the prepare() call. TODO
-
-Some driver-private sth attributes may not be available if the driver has not
-implemented the private_attribute_info() method (added in DBI 1.54).
-
-=head2 Multiple Resultsets
-
-Multiple resultsets are supported only if the driver supports the more_results() method
-(an exception is made for DBD::Sybase).
-
-=head2 Statement activity that also updates dbh attributes
-
-Some drivers may update one or more dbh attributes after performing activity on
-a child sth. For example, DBD::mysql provides $dbh->{mysql_insertid} in addition to
-$sth->{mysql_insertid}. Currently mysql_insertid is supported via a hack but a
-more general mechanism is needed for other drivers to use.
-
-=head2 Methods that report an error always return undef
-
-With DBD::Gofer, a method that sets an error always return an undef or empty list.
-That shouldn't be a problem in practice because the DBI doesn't define any
-methods that return meaningful values while also reporting an error.
-
-=head2 Subclassing only applies to client-side
-
-The RootClass and DbTypeSubclass attributes are not passed to the Gofer server.
-
-=head1 CAVEATS FOR SPECIFIC METHODS
-
-=head2 last_insert_id
-
-To enable use of last_insert_id you need to indicate to DBD::Gofer that you'd
-like to use it. You do that my adding a C<go_last_insert_id_args> attribute to
-the do() or prepare() method calls. For example:
-
- $dbh->do($sql, { go_last_insert_id_args => [...] });
-
-or
-
- $sth = $dbh->prepare($sql, { go_last_insert_id_args => [...] });
-
-The array reference should contains the args that you want passed to the
-last_insert_id() method.
-
-=head2 execute_for_fetch
-
-The array methods bind_param_array() and execute_array() are supported.
-When execute_array() is called the data is serialized and executed in a single
-round-trip to the Gofer server. This makes it very fast, but requires enough
-memory to store all the serialized data.
-
-The execute_for_fetch() method currently isn't optimised, it uses the DBI
-fallback behaviour of executing each tuple individually.
-(It could be implemented as a wrapper for execute_array() - patches welcome.)
-
-=head1 TRANSPORTS
-
-DBD::Gofer doesn't concern itself with transporting requests and responses to and fro.
-For that it uses special Gofer transport modules.
-
-Gofer transport modules usually come in pairs: one for the 'client' DBD::Gofer
-driver to use and one for the remote 'server' end. They have very similar names:
-
- DBD::Gofer::Transport::<foo>
- DBI::Gofer::Transport::<foo>
-
-Sometimes the transports on the DBD and DBI sides may have different names. For
-example DBD::Gofer::Transport::http is typically used with DBI::Gofer::Transport::mod_perl
-(DBD::Gofer::Transport::http and DBI::Gofer::Transport::mod_perl modules are
-part of the GoferTransport-http distribution).
-
-=head2 Bundled Transports
-
-Several transport modules are provided with DBD::Gofer:
-
-=head3 null
-
-The null transport is the simplest of them all. It doesn't actually transport the request anywhere.
-It just serializes (freezes) the request into a string, then thaws it back into
-a data structure before passing it to DBI::Gofer::Execute to execute. The same
-freeze and thaw is applied to the results.
-
-The null transport is the best way to test if your application will work with Gofer.
-Just set the DBI_AUTOPROXY environment variable to "C<dbi:Gofer:transport=null;policy=pedantic>"
-(see L</Using DBI_AUTOPROXY> below) and run your application, or ideally its test suite, as usual.
-
-It doesn't take any parameters.
-
-=head3 pipeone
-
-The pipeone transport launches a subprocess for each request. It passes in the
-request and reads the response.
-
-The fact that a new subprocess is started for each request ensures that the
-server side is truly stateless. While this does make the transport I<very> slow,
-it is useful as a way to test that your application doesn't depend on
-per-connection state, such as temporary tables, persisting between requests.
-
-It's also useful both as a proof of concept and as a base class for the stream
-driver.
-
-=head3 stream
-
-The stream driver also launches a subprocess and writes requests and reads
-responses, like the pipeone transport. In this case, however, the subprocess
-is expected to handle more that one request. (Though it will be automatically
-restarted if it exits.)
-
-This is the first transport that is truly useful because it can launch the
-subprocess on a remote machine using C<ssh>. This means you can now use DBD::Gofer
-to easily access any databases that's accessible from any system you can login to.
-You also get all the benefits of ssh, including encryption and optional compression.
-
-See L</Using DBI_AUTOPROXY> below for an example.
-
-=head2 Other Transports
-
-Implementing a Gofer transport is I<very> simple, and more transports are very welcome.
-Just take a look at any existing transports that are similar to your needs.
-
-=head3 http
-
-See the GoferTransport-http distribution on CPAN: http://search.cpan.org/dist/GoferTransport-http/
-
-=head3 Gearman
-
-I know Ask Bjørn Hansen has implemented a transport for the C<gearman> distributed
-job system, though it's not on CPAN at the time of writing this.
-
-=head1 CONNECTING
-
-Simply prefix your existing DSN with "C<dbi:Gofer:transport=$transport;dsn=>"
-where $transport is the name of the Gofer transport you want to use (see L</TRANSPORTS>).
-The C<transport> and C<dsn> attributes must be specified and the C<dsn> attributes must be last.
-
-Other attributes can be specified in the DSN to configure DBD::Gofer and/or the
-Gofer transport module being used. The main attributes after C<transport>, are
-C<url> and C<policy>. These and other attributes are described below.
-
-=head2 Using DBI_AUTOPROXY
-
-The simplest way to try out DBD::Gofer is to set the DBI_AUTOPROXY environment variable.
-In this case you don't include the C<dsn=> part. For example:
-
- export DBI_AUTOPROXY="dbi:Gofer:transport=null"
-
-or, for a more useful example, try:
-
- export DBI_AUTOPROXY="dbi:Gofer:transport=stream;url=ssh:user@example.com"
-
-=head2 Connection Attributes
-
-These attributes can be specified in the DSN. They can also be passed in the
-\%attr parameter of the DBI connect method by adding a "C<go_>" prefix to the name.
-
-=head3 transport
-
-Specifies the Gofer transport class to use. Required. See L</TRANSPORTS> above.
-
-If the value does not include C<::> then "C<DBD::Gofer::Transport::>" is prefixed.
-
-The transport object can be accessed via $h->{go_transport}.
-
-=head3 dsn
-
-Specifies the DSN for the remote side to connect to. Required, and must be last.
-
-=head3 url
-
-Used to tell the transport where to connect to. The exact form of the value depends on the transport used.
-
-=head3 policy
-
-Specifies the policy to use. See L</CONFIGURING BEHAVIOUR POLICY>.
-
-If the value does not include C<::> then "C<DBD::Gofer::Policy>" is prefixed.
-
-The policy object can be accessed via $h->{go_policy}.
-
-=head3 timeout
-
-Specifies a timeout, in seconds, to use when waiting for responses from the server side.
-
-=head3 retry_limit
-
-Specifies the number of times a failed request will be retried. Default is 0.
-
-=head3 retry_hook
-
-Specifies a code reference to be called to decide if a failed request should be retried.
-The code reference is called like this:
-
- $transport = $h->{go_transport};
- $retry = $transport->go_retry_hook->($request, $response, $transport);
-
-If it returns true then the request will be retried, up to the C<retry_limit>.
-If it returns a false but defined value then the request will not be retried.
-If it returns undef then the default behaviour will be used, as if C<retry_hook>
-had not been specified.
-
-The default behaviour is to retry requests where $request->is_idempotent is true,
-or the error message matches C</induced by DBI_GOFER_RANDOM/>.
-
-=head3 cache
-
-Specifies that client-side caching should be performed. The value is the name
-of a cache class to use.
-
-Any class implementing get($key) and set($key, $value) methods can be used.
-That includes a great many powerful caching classes on CPAN, including the
-Cache and Cache::Cache distributions.
-
-You can use "C<cache=1>" is a shortcut for "C<cache=DBI::Util::CacheMemory>".
-See L<DBI::Util::CacheMemory> for a description of this simple fast default cache.
-
-The cache object can be accessed via $h->go_cache. For example:
-
- $dbh->go_cache->clear; # free up memory being used by the cache
-
-The cache keys are the frozen (serialized) requests, and the values are the
-frozen responses.
-
-The default behaviour is to only use the cache for requests where
-$request->is_idempotent is true (i.e., the dbh has the ReadOnly attribute set
-or the SQL statement is obviously a SELECT without a FOR UPDATE clause.)
-
-For even more control you can use the C<go_cache> attribute to pass in an
-instantiated cache object. Individual methods, including prepare(), can also
-specify alternative caches via the C<go_cache> attribute. For example, to
-specify no caching for a particular query, you could use
-
- $sth = $dbh->prepare( $sql, { go_cache => 0 } );
-
-This can be used to implement different caching policies for different statements.
-
-It's interesting to note that DBD::Gofer can be used to add client-side caching
-to any (gofer compatible) application, with no code changes and no need for a
-gofer server. Just set the DBI_AUTOPROXY environment variable like this:
-
- DBI_AUTOPROXY='dbi:Gofer:transport=null;cache=1'
-
-=head1 CONFIGURING BEHAVIOUR POLICY
-
-DBD::Gofer supports a 'policy' mechanism that allows you to fine-tune the number of round-trips to the Gofer server.
-The policies are grouped into classes (which may be subclassed) and referenced by the name of the class.
-
-The L<DBD::Gofer::Policy::Base> class is the base class for all the policy
-packages and describes all the available policies.
-
-Three policy packages are supplied with DBD::Gofer:
-
-L<DBD::Gofer::Policy::pedantic> is most 'transparent' but slowest because it
-makes more round-trips to the Gofer server.
-
-L<DBD::Gofer::Policy::classic> is a reasonable compromise - it's the default policy.
-
-L<DBD::Gofer::Policy::rush> is fastest, but may require code changes in your applications.
-
-Generally the default C<classic> policy is fine. When first testing an existing
-application with Gofer it is a good idea to start with the C<pedantic> policy
-first and then switch to C<classic> or a custom policy, for final testing.
-
-
-=head1 AUTHOR
-
-Tim Bunce, L<http://www.tim.bunce.name>
-
-=head1 LICENCE AND COPYRIGHT
-
-Copyright (c) 2007, Tim Bunce, Ireland. All rights reserved.
-
-This module is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself. See L<perlartistic>.
-
-=head1 ACKNOWLEDGEMENTS
-
-The development of DBD::Gofer and related modules was sponsored by
-Shopzilla.com (L<http://Shopzilla.com>), where I currently work.
-
-=head1 SEE ALSO
-
-L<DBI::Gofer::Request>, L<DBI::Gofer::Response>, L<DBI::Gofer::Execute>.
-
-L<DBI::Gofer::Transport::Base>, L<DBD::Gofer::Policy::Base>.
-
-L<DBI>
-
-=head1 Caveats for specific drivers
-
-This section aims to record issues to be aware of when using Gofer with specific drivers.
-It usually only documents issues that are not natural consequences of the limitations
-of the Gofer approach - as documented above.
-
-=head1 TODO
-
-This is just a random brain dump... (There's more in the source of the Changes file, not the pod)
-
-Document policy mechanism
-
-Add mechanism for transports to list config params and for Gofer to apply any that match (and warn if any left over?)
-
-Driver-private sth attributes - set via prepare() - change DBI spec
-
-add hooks into transport base class for checking & updating a result set cache
- ie via a standard cache interface such as:
- http://search.cpan.org/~robm/Cache-FastMmap/FastMmap.pm
- http://search.cpan.org/~bradfitz/Cache-Memcached/lib/Cache/Memcached.pm
- http://search.cpan.org/~dclinton/Cache-Cache/
- http://search.cpan.org/~cleishman/Cache/
-Also caching instructions could be passed through the httpd transport layer
-in such a way that appropriate http cache headers are added to the results
-so that web caches (squid etc) could be used to implement the caching.
-(MUST require the use of GET rather than POST requests.)
-
-Rework handling of installed_methods to not piggyback on dbh_attributes?
-
-Perhaps support transactions for transports where it's possible (ie null and stream)?
-Would make stream transport (ie ssh) more useful to more people.
-
-Make sth_result_attr more like dbh_attributes (using '*' etc)
-
-Add @val = FETCH_many(@names) to DBI in C and use in Gofer/Execute?
-
-Implement _new_sth in C.
-
-=cut
+++ /dev/null
-package DBD::Gofer::Policy::Base;
-
-# $Id: Base.pm 10087 2007-10-16 12:42:37Z Tim $
-#
-# Copyright (c) 2007, Tim Bunce, Ireland
-#
-# You may distribute under the terms of either the GNU General Public
-# License or the Artistic License, as specified in the Perl README file.
-
-use strict;
-use warnings;
-use Carp;
-
-our $VERSION = "0.010088";
-our $AUTOLOAD;
-
-my %policy_defaults = (
- # force connect method (unless overridden by go_connect_method=>'...' attribute)
- # if false: call same method on client as on server
- connect_method => 'connect',
- # force prepare method (unless overridden by go_prepare_method=>'...' attribute)
- # if false: call same method on client as on server
- prepare_method => 'prepare',
- skip_connect_check => 0,
- skip_default_methods => 0,
- skip_prepare_check => 0,
- skip_ping => 0,
- dbh_attribute_update => 'every',
- dbh_attribute_list => ['*'],
- locally_quote => 0,
- locally_quote_identifier => 0,
- cache_parse_trace_flags => 1,
- cache_parse_trace_flag => 1,
- cache_data_sources => 1,
- cache_type_info_all => 1,
- cache_tables => 0,
- cache_table_info => 0,
- cache_column_info => 0,
- cache_primary_key_info => 0,
- cache_foreign_key_info => 0,
- cache_statistics_info => 0,
- cache_get_info => 0,
- cache_func => 0,
-);
-
-my $base_policy_file = $INC{"DBD/Gofer/Policy/Base.pm"};
-
-__PACKAGE__->create_policy_subs(\%policy_defaults);
-
-sub create_policy_subs {
- my ($class, $policy_defaults) = @_;
-
- while ( my ($policy_name, $policy_default) = each %$policy_defaults) {
- my $policy_attr_name = "go_$policy_name";
- my $sub = sub {
- # $policy->foo($attr, ...)
- #carp "$policy_name($_[1],...)";
- # return the policy default value unless an attribute overrides it
- return (ref $_[1] && exists $_[1]->{$policy_attr_name})
- ? $_[1]->{$policy_attr_name}
- : $policy_default;
- };
- no strict 'refs';
- *{$class . '::' . $policy_name} = $sub;
- }
-}
-
-sub AUTOLOAD {
- carp "Unknown policy name $AUTOLOAD used";
- # only warn once
- no strict 'refs';
- *$AUTOLOAD = sub { undef };
- return undef;
-}
-
-sub new {
- my ($class, $args) = @_;
- my $policy = {};
- bless $policy, $class;
-}
-
-sub DESTROY { };
-
-1;
-
-=head1 NAME
-
-DBD::Gofer::Policy::Base - Base class for DBD::Gofer policies
-
-=head1 SYNOPSIS
-
- $dbh = DBI->connect("dbi:Gofer:transport=...;policy=...", ...)
-
-=head1 DESCRIPTION
-
-DBD::Gofer can be configured via a 'policy' mechanism that allows you to
-fine-tune the number of round-trips to the Gofer server. The policies are
-grouped into classes (which may be subclassed) and referenced by the name of
-the class.
-
-The L<DBD::Gofer::Policy::Base> class is the base class for all the policy
-classes and describes all the individual policy items.
-
-The Base policy is not used directly. You should use a policy class derived from it.
-
-=head1 POLICY CLASSES
-
-Three policy classes are supplied with DBD::Gofer:
-
-L<DBD::Gofer::Policy::pedantic> is most 'transparent' but slowest because it
-makes more round-trips to the Gofer server.
-
-L<DBD::Gofer::Policy::classic> is a reasonable compromise - it's the default policy.
-
-L<DBD::Gofer::Policy::rush> is fastest, but may require code changes in your applications.
-
-Generally the default C<classic> policy is fine. When first testing an existing
-application with Gofer it is a good idea to start with the C<pedantic> policy
-first and then switch to C<classic> or a custom policy, for final testing.
-
-=head1 POLICY ITEMS
-
-These are temporary docs: See the source code for list of policies and their defaults.
-
-In a future version the policies and their defaults will be defined in the pod and parsed out at load-time.
-
-See the source code to this module for more details.
-
-=head1 POLICY CUSTOMIZATION
-
-XXX This area of DBD::Gofer is subject to change.
-
-There are three ways to customize policies:
-
-Policy classes are designed to influence the overall behaviour of DBD::Gofer
-with existing, unaltered programs, so they work in a reasonably optimal way
-without requiring code changes. You can implement new policy classes as
-subclasses of existing policies.
-
-In many cases individual policy items can be overridden on a case-by-case basis
-within your application code. You do this by passing a corresponding
-C<<go_<policy_name>>> attribute into DBI methods by your application code.
-This let's you fine-tune the behaviour for special cases.
-
-The policy items are implemented as methods. In many cases the methods are
-passed parameters relating to the DBD::Gofer code being executed. This means
-the policy can implement dynamic behaviour that varies depending on the
-particular circumstances, such as the particular statement being executed.
-
-=head1 AUTHOR
-
-Tim Bunce, L<http://www.tim.bunce.name>
-
-=head1 LICENCE AND COPYRIGHT
-
-Copyright (c) 2007, Tim Bunce, Ireland. All rights reserved.
-
-This module is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself. See L<perlartistic>.
-
-=cut
-
+++ /dev/null
-package DBD::Gofer::Policy::classic;
-
-# $Id: classic.pm 10087 2007-10-16 12:42:37Z Tim $
-#
-# Copyright (c) 2007, Tim Bunce, Ireland
-#
-# You may distribute under the terms of either the GNU General Public
-# License or the Artistic License, as specified in the Perl README file.
-
-use strict;
-use warnings;
-
-our $VERSION = "0.010088";
-
-use base qw(DBD::Gofer::Policy::Base);
-
-__PACKAGE__->create_policy_subs({
-
- # always use connect_cached on server
- connect_method => 'connect_cached',
-
- # use same methods on server as is called on client
- prepare_method => '',
-
- # don't skip the connect check since that also sets dbh attributes
- # although this makes connect more expensive, that's partly offset
- # by skip_ping=>1 below, which makes connect_cached very fast.
- skip_connect_check => 0,
-
- # most code doesn't rely on sth attributes being set after prepare
- skip_prepare_check => 1,
-
- # we're happy to use local method if that's the same as the remote
- skip_default_methods => 1,
-
- # ping is not important for DBD::Gofer and most transports
- skip_ping => 1,
-
- # only update dbh attributes on first contact with server
- dbh_attribute_update => 'first',
-
- # we'd like to set locally_* but can't because drivers differ
-
- # get_info results usually don't change
- cache_get_info => 1,
-});
-
-
-1;
-
-=head1 NAME
-
-DBD::Gofer::Policy::classic - The 'classic' policy for DBD::Gofer
-
-=head1 SYNOPSIS
-
- $dbh = DBI->connect("dbi:Gofer:transport=...;policy=classic", ...)
-
-The C<classic> policy is the default DBD::Gofer policy, so need not be included in the DSN.
-
-=head1 DESCRIPTION
-
-Temporary docs: See the source code for list of policies and their defaults.
-
-In a future version the policies and their defaults will be defined in the pod and parsed out at load-time.
-
-=head1 AUTHOR
-
-Tim Bunce, L<http://www.tim.bunce.name>
-
-=head1 LICENCE AND COPYRIGHT
-
-Copyright (c) 2007, Tim Bunce, Ireland. All rights reserved.
-
-This module is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself. See L<perlartistic>.
-
-=cut
-
+++ /dev/null
-package DBD::Gofer::Policy::pedantic;
-
-# $Id: pedantic.pm 10087 2007-10-16 12:42:37Z Tim $
-#
-# Copyright (c) 2007, Tim Bunce, Ireland
-#
-# You may distribute under the terms of either the GNU General Public
-# License or the Artistic License, as specified in the Perl README file.
-
-use strict;
-use warnings;
-
-our $VERSION = "0.010088";
-
-use base qw(DBD::Gofer::Policy::Base);
-
-# the 'pedantic' policy is the same as the Base policy
-
-1;
-
-=head1 NAME
-
-DBD::Gofer::Policy::pedantic - The 'pedantic' policy for DBD::Gofer
-
-=head1 SYNOPSIS
-
- $dbh = DBI->connect("dbi:Gofer:transport=...;policy=pedantic", ...)
-
-=head1 DESCRIPTION
-
-The C<pedantic> policy tries to be as transparent as possible. To do this it
-makes round-trips to the server for almost every DBI method call.
-
-This is the best policy to use when first testing existing code with Gofer.
-Once it's working well you should consider moving to the C<classic> policy or defining your own policy class.
-
-Temporary docs: See the source code for list of policies and their defaults.
-
-In a future version the policies and their defaults will be defined in the pod and parsed out at load-time.
-
-=head1 AUTHOR
-
-Tim Bunce, L<http://www.tim.bunce.name>
-
-=head1 LICENCE AND COPYRIGHT
-
-Copyright (c) 2007, Tim Bunce, Ireland. All rights reserved.
-
-This module is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself. See L<perlartistic>.
-
-=cut
-
+++ /dev/null
-package DBD::Gofer::Policy::rush;
-
-# $Id: rush.pm 10087 2007-10-16 12:42:37Z Tim $
-#
-# Copyright (c) 2007, Tim Bunce, Ireland
-#
-# You may distribute under the terms of either the GNU General Public
-# License or the Artistic License, as specified in the Perl README file.
-
-use strict;
-use warnings;
-
-our $VERSION = "0.010088";
-
-use base qw(DBD::Gofer::Policy::Base);
-
-__PACKAGE__->create_policy_subs({
-
- # always use connect_cached on server
- connect_method => 'connect_cached',
-
- # use same methods on server as is called on client
- # (because code not using placeholders would bloat the sth cache)
- prepare_method => '',
-
- # Skipping the connect check is fast, but it also skips
- # fetching the remote dbh attributes!
- # Make sure that your application doesn't need access to dbh attributes.
- skip_connect_check => 1,
-
- # most code doesn't rely on sth attributes being set after prepare
- skip_prepare_check => 1,
-
- # we're happy to use local method if that's the same as the remote
- skip_default_methods => 1,
-
- # ping is almost meaningless for DBD::Gofer and most transports anyway
- skip_ping => 1,
-
- # don't update dbh attributes at all
- # XXX actually we currently need dbh_attribute_update for skip_default_methods to work
- # and skip_default_methods is more valuable to us than the cost of dbh_attribute_update
- dbh_attribute_update => 'none', # actually means 'first' currently
- #dbh_attribute_list => undef,
-
- # we'd like to set locally_* but can't because drivers differ
-
- # in a rush assume metadata doesn't change
- cache_tables => 1,
- cache_table_info => 1,
- cache_column_info => 1,
- cache_primary_key_info => 1,
- cache_foreign_key_info => 1,
- cache_statistics_info => 1,
- cache_get_info => 1,
-});
-
-
-1;
-
-=head1 NAME
-
-DBD::Gofer::Policy::rush - The 'rush' policy for DBD::Gofer
-
-=head1 SYNOPSIS
-
- $dbh = DBI->connect("dbi:Gofer:transport=...;policy=rush", ...)
-
-=head1 DESCRIPTION
-
-The C<rush> policy tries to make as few round-trips as possible.
-It's the opposite end of the policy spectrum to the C<pedantic> policy.
-
-Temporary docs: See the source code for list of policies and their defaults.
-
-In a future version the policies and their defaults will be defined in the pod and parsed out at load-time.
-
-=head1 AUTHOR
-
-Tim Bunce, L<http://www.tim.bunce.name>
-
-=head1 LICENCE AND COPYRIGHT
-
-Copyright (c) 2007, Tim Bunce, Ireland. All rights reserved.
-
-This module is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself. See L<perlartistic>.
-
-=cut
-
+++ /dev/null
-package DBD::Gofer::Transport::Base;
-
-# $Id: Base.pm 14120 2010-06-07 19:52:19Z H.Merijn $
-#
-# Copyright (c) 2007, Tim Bunce, Ireland
-#
-# You may distribute under the terms of either the GNU General Public
-# License or the Artistic License, as specified in the Perl README file.
-
-use strict;
-use warnings;
-
-use base qw(DBI::Gofer::Transport::Base);
-
-our $VERSION = "0.014121";
-
-__PACKAGE__->mk_accessors(qw(
- trace
- go_dsn
- go_url
- go_policy
- go_timeout
- go_retry_hook
- go_retry_limit
- go_cache
- cache_hit
- cache_miss
- cache_store
-));
-__PACKAGE__->mk_accessors_using(make_accessor_autoviv_hashref => qw(
- meta
-));
-
-
-sub new {
- my ($class, $args) = @_;
- $args->{$_} = 0 for (qw(cache_hit cache_miss cache_store));
- $args->{keep_meta_frozen} ||= 1 if $args->{go_cache};
- #warn "args @{[ %$args ]}\n";
- return $class->SUPER::new($args);
-}
-
-
-sub _init_trace { $ENV{DBD_GOFER_TRACE} || 0 }
-
-
-sub new_response {
- my $self = shift;
- return DBI::Gofer::Response->new(@_);
-}
-
-
-sub transmit_request {
- my ($self, $request) = @_;
- my $trace = $self->trace;
- my $response;
-
- my ($go_cache, $request_cache_key);
- if ($go_cache = $self->{go_cache}) {
- $request_cache_key
- = $request->{meta}{request_cache_key}
- = $self->get_cache_key_for_request($request);
- if ($request_cache_key) {
- my $frozen_response = eval { $go_cache->get($request_cache_key) };
- if ($frozen_response) {
- $self->_dump("cached response found for ".ref($request), $request)
- if $trace;
- $response = $self->thaw_response($frozen_response);
- $self->trace_msg("transmit_request is returning a response from cache $go_cache\n")
- if $trace;
- ++$self->{cache_hit};
- return $response;
- }
- warn $@ if $@;
- ++$self->{cache_miss};
- $self->trace_msg("transmit_request cache miss\n")
- if $trace;
- }
- }
-
- my $to = $self->go_timeout;
- my $transmit_sub = sub {
- $self->trace_msg("transmit_request\n") if $trace;
- local $SIG{ALRM} = sub { die "TIMEOUT\n" } if $to;
-
- my $response = eval {
- local $SIG{PIPE} = sub {
- my $extra = ($! eq "Broken pipe") ? "" : " ($!)";
- die "Unable to send request: Broken pipe$extra\n";
- };
- alarm($to) if $to;
- $self->transmit_request_by_transport($request);
- };
- alarm(0) if $to;
-
- if ($@) {
- return $self->transport_timedout("transmit_request", $to)
- if $@ eq "TIMEOUT\n";
- return $self->new_response({ err => 1, errstr => $@ });
- }
-
- return $response;
- };
-
- $response = $self->_transmit_request_with_retries($request, $transmit_sub);
-
- if ($response) {
- my $frozen_response = delete $response->{meta}{frozen};
- $self->_store_response_in_cache($frozen_response, $request_cache_key)
- if $request_cache_key;
- }
-
- $self->trace_msg("transmit_request is returning a response itself\n")
- if $trace && $response;
-
- return $response unless wantarray;
- return ($response, $transmit_sub);
-}
-
-
-sub _transmit_request_with_retries {
- my ($self, $request, $transmit_sub) = @_;
- my $response;
- do {
- $response = $transmit_sub->();
- } while ( $response && $self->response_needs_retransmit($request, $response) );
- return $response;
-}
-
-
-sub receive_response {
- my ($self, $request, $retransmit_sub) = @_;
- my $to = $self->go_timeout;
-
- my $receive_sub = sub {
- $self->trace_msg("receive_response\n");
- local $SIG{ALRM} = sub { die "TIMEOUT\n" } if $to;
-
- my $response = eval {
- alarm($to) if $to;
- $self->receive_response_by_transport($request);
- };
- alarm(0) if $to;
-
- if ($@) {
- return $self->transport_timedout("receive_response", $to)
- if $@ eq "TIMEOUT\n";
- return $self->new_response({ err => 1, errstr => $@ });
- }
- return $response;
- };
-
- my $response;
- do {
- $response = $receive_sub->();
- if ($self->response_needs_retransmit($request, $response)) {
- $response = $self->_transmit_request_with_retries($request, $retransmit_sub);
- $response ||= $receive_sub->();
- }
- } while ( $self->response_needs_retransmit($request, $response) );
-
- if ($response) {
- my $frozen_response = delete $response->{meta}{frozen};
- my $request_cache_key = $request->{meta}{request_cache_key};
- $self->_store_response_in_cache($frozen_response, $request_cache_key)
- if $request_cache_key && $self->{go_cache};
- }
-
- return $response;
-}
-
-
-sub response_retry_preference {
- my ($self, $request, $response) = @_;
-
- # give the user a chance to express a preference (or undef for default)
- if (my $go_retry_hook = $self->go_retry_hook) {
- my $retry = $go_retry_hook->($request, $response, $self);
- $self->trace_msg(sprintf "go_retry_hook returned %s\n",
- (defined $retry) ? $retry : 'undef');
- return $retry if defined $retry;
- }
-
- # This is the main decision point. We don't retry requests that got
- # as far as executing because the error is probably from the database
- # (not transport) so retrying is unlikely to help. But note that any
- # severe transport error occurring after execute is likely to return
- # a new response object that doesn't have the execute flag set. Beware!
- return 0 if $response->executed_flag_set;
-
- return 1 if ($response->errstr || '') =~ m/induced by DBI_GOFER_RANDOM/;
-
- return 1 if $request->is_idempotent; # i.e. is SELECT or ReadOnly was set
-
- return undef; # we couldn't make up our mind
-}
-
-
-sub response_needs_retransmit {
- my ($self, $request, $response) = @_;
-
- my $err = $response->err
- or return 0; # nothing went wrong
-
- my $retry = $self->response_retry_preference($request, $response);
-
- if (!$retry) { # false or undef
- $self->trace_msg("response_needs_retransmit: response not suitable for retry\n");
- return 0;
- }
-
- # we'd like to retry but have we retried too much already?
-
- my $retry_limit = $self->go_retry_limit;
- if (!$retry_limit) {
- $self->trace_msg("response_needs_retransmit: retries disabled (retry_limit not set)\n");
- return 0;
- }
-
- my $request_meta = $request->meta;
- my $retry_count = $request_meta->{retry_count} || 0;
- if ($retry_count >= $retry_limit) {
- $self->trace_msg("response_needs_retransmit: $retry_count is too many retries\n");
- # XXX should be possible to disable altering the err
- $response->errstr(sprintf "%s (after %d retries by gofer)", $response->errstr, $retry_count);
- return 0;
- }
-
- # will retry now, do the admin
- ++$retry_count;
- $self->trace_msg("response_needs_retransmit: retry $retry_count\n");
-
- # hook so response_retry_preference can defer some code execution
- # until we've checked retry_count and retry_limit.
- if (ref $retry eq 'CODE') {
- $retry->($retry_count, $retry_limit)
- and warn "should return false"; # protect future use
- }
-
- ++$request_meta->{retry_count}; # update count for this request object
- ++$self->meta->{request_retry_count}; # update cumulative transport stats
-
- return 1;
-}
-
-
-sub transport_timedout {
- my ($self, $method, $timeout) = @_;
- $timeout ||= $self->go_timeout;
- return $self->new_response({ err => 1, errstr => "DBD::Gofer $method timed-out after $timeout seconds" });
-}
-
-
-# return undef if we don't want to cache this request
-# subclasses may use more specialized rules
-sub get_cache_key_for_request {
- my ($self, $request) = @_;
-
- # we only want to cache idempotent requests
- # is_idempotent() is true if GOf_REQUEST_IDEMPOTENT or GOf_REQUEST_READONLY set
- return undef if not $request->is_idempotent;
-
- # XXX would be nice to avoid the extra freeze here
- my $key = $self->freeze_request($request, undef, 1);
-
- #use Digest::MD5; warn "get_cache_key_for_request: ".Digest::MD5::md5_base64($key)."\n";
-
- return $key;
-}
-
-
-sub _store_response_in_cache {
- my ($self, $frozen_response, $request_cache_key) = @_;
- my $go_cache = $self->{go_cache}
- or return;
-
- # new() ensures that enabling go_cache also enables keep_meta_frozen
- warn "No meta frozen in response" if !$frozen_response;
- warn "No request_cache_key" if !$request_cache_key;
-
- if ($frozen_response && $request_cache_key) {
- $self->trace_msg("receive_response added response to cache $go_cache\n");
- eval { $go_cache->set($request_cache_key, $frozen_response) };
- warn $@ if $@;
- ++$self->{cache_store};
- }
-}
-
-1;
-
-__END__
-
-=head1 NAME
-
-DBD::Gofer::Transport::Base - base class for DBD::Gofer client transports
-
-=head1 SYNOPSIS
-
- my $remote_dsn = "..."
- DBI->connect("dbi:Gofer:transport=...;url=...;timeout=...;retry_limit=...;dsn=$remote_dsn",...)
-
-or, enable by setting the DBI_AUTOPROXY environment variable:
-
- export DBI_AUTOPROXY='dbi:Gofer:transport=...;url=...'
-
-which will force I<all> DBI connections to be made via that Gofer server.
-
-=head1 DESCRIPTION
-
-This is the base class for all DBD::Gofer client transports.
-
-=head1 ATTRIBUTES
-
-Gofer transport attributes can be specified either in the attributes parameter
-of the connect() method call, or in the DSN string. When used in the DSN
-string, attribute names don't have the C<go_> prefix.
-
-=head2 go_dsn
-
-The full DBI DSN that the Gofer server should connect to on your behalf.
-
-When used in the DSN it must be the last element in the DSN string.
-
-=head2 go_timeout
-
-A time limit for sending a request and receiving a response. Some drivers may
-implement sending and receiving as separate steps, in which case (currently)
-the timeout applies to each separately.
-
-If a request needs to be resent then the timeout is restarted for each sending
-of a request and receiving of a response.
-
-=head2 go_retry_limit
-
-The maximum number of times an request may be retried. The default is 2.
-
-=head2 go_retry_hook
-
-This subroutine reference is called, if defined, for each response received where $response->err is true.
-
-The subroutine is pass three parameters: the request object, the response object, and the transport object.
-
-If it returns an undefined value then the default retry behaviour is used. See L</RETRY ON ERROR> below.
-
-If it returns a defined but false value then the request is not resent.
-
-If it returns true value then the request is resent, so long as the number of retries does not exceed C<go_retry_limit>.
-
-=head1 RETRY ON ERROR
-
-The default retry on error behaviour is:
-
- - Retry if the error was due to DBI_GOFER_RANDOM. See L<DBI::Gofer::Execute>.
-
- - Retry if $request->is_idempotent returns true. See L<DBI::Gofer::Request>.
-
-A retry won't be allowed if the number of previous retries has reached C<go_retry_limit>.
-
-=head1 TRACING
-
-Tracing of gofer requests and responses can be enabled by setting the
-C<DBD_GOFER_TRACE> environment variable. A value of 1 gives a reasonably
-compact summary of each request and response. A value of 2 or more gives a
-detailed, and voluminous, dump.
-
-The trace is written using DBI->trace_msg() and so is written to the default
-DBI trace output, which is usually STDERR.
-
-=head1 METHODS
-
-I<This section is currently far from complete.>
-
-=head2 response_retry_preference
-
- $retry = $transport->response_retry_preference($request, $response);
-
-The response_retry_preference is called by DBD::Gofer when considering if a
-request should be retried after an error.
-
-Returns true (would like to retry), false (must not retry), undef (no preference).
-
-If a true value is returned in the form of a CODE ref then, if DBD::Gofer does
-decide to retry the request, it calls the code ref passing $retry_count, $retry_limit.
-Can be used for logging and/or to implement exponential backoff behaviour.
-Currently the called code must return using C<return;> to allow for future extensions.
-
-=head1 AUTHOR
-
-Tim Bunce, L<http://www.tim.bunce.name>
-
-=head1 LICENCE AND COPYRIGHT
-
-Copyright (c) 2007-2008, Tim Bunce, Ireland. All rights reserved.
-
-This module is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself. See L<perlartistic>.
-
-=head1 SEE ALSO
-
-L<DBD::Gofer>, L<DBI::Gofer::Request>, L<DBI::Gofer::Response>, L<DBI::Gofer::Execute>.
-
-and some example transports:
-
-L<DBD::Gofer::Transport::stream>
-
-L<DBD::Gofer::Transport::http>
-
-L<DBI::Gofer::Transport::mod_perl>
-
-=cut
+++ /dev/null
-package DBD::Gofer::Transport::corostream;
-
-use strict;
-use warnings;
-
-use Carp;
-
-use Coro::Select; # a slow but coro-aware replacement for CORE::select (global effect!)
-
-use Coro;
-use Coro::Handle;
-
-use base qw(DBD::Gofer::Transport::stream);
-
-# XXX ensure DBI_PUREPERL for parent doesn't pass to child
-sub start_pipe_command {
- local $ENV{DBI_PUREPERL} = $ENV{DBI_PUREPERL_COROCHILD}; # typically undef
- my $connection = shift->SUPER::start_pipe_command(@_);
- return $connection;
-}
-
-
-
-1;
-
-__END__
-
-=head1 NAME
-
-DBD::Gofer::Transport::corostream - Async DBD::Gofer stream transport using Coro and AnyEvent
-
-=head1 SYNOPSIS
-
- DBI_AUTOPROXY="dbi:Gofer:transport=corostream" perl some-perl-script-using-dbi.pl
-
-or
-
- $dsn = ...; # the DSN for the driver and database you want to use
- $dbh = DBI->connect("dbi:Gofer:transport=corostream;dsn=$dsn", ...);
-
-=head1 DESCRIPTION
-
-The I<BIG WIN> from using L<Coro> is that it enables the use of existing
-DBI frameworks like L<DBIx::Class>.
-
-=head1 KNOWN ISSUES AND LIMITATIONS
-
- - Uses Coro::Select so alters CORE::select globally
- Parent class probably needs refactoring to enable a more encapsulated approach.
-
- - Doesn't prevent multiple concurrent requests
- Probably just needs a per-connection semaphore
-
- - Coro has many caveats. Caveat emptor.
-
-=head1 STATUS
-
-THIS IS CURRENTLY JUST A PROOF-OF-CONCEPT IMPLEMENTATION FOR EXPERIMENTATION.
-
-Please note that I have no plans to develop this code further myself.
-I'd very much welcome contributions. Interested? Let me know!
-
-=head1 AUTHOR
-
-Tim Bunce, L<http://www.tim.bunce.name>
-
-=head1 LICENCE AND COPYRIGHT
-
-Copyright (c) 2010, Tim Bunce, Ireland. All rights reserved.
-
-This module is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself. See L<perlartistic>.
-
-=head1 SEE ALSO
-
-L<DBD::Gofer::Transport::stream>
-
-L<DBD::Gofer>
-
-=head1 APPENDIX
-
-Example code:
-
- #!perl
-
- use strict;
- use warnings;
- use Time::HiRes qw(time);
-
- BEGIN { $ENV{PERL_ANYEVENT_STRICT} = 1; $ENV{PERL_ANYEVENT_VERBOSE} = 1; }
-
- use AnyEvent;
-
- BEGIN { $ENV{DBI_TRACE} = 0; $ENV{DBI_GOFER_TRACE} = 0; $ENV{DBD_GOFER_TRACE} = 0; };
-
- use DBI;
-
- $ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=corostream';
-
- my $ticker = AnyEvent->timer( after => 0, interval => 0.1, cb => sub {
- warn sprintf "-tick- %.2f\n", time
- } );
-
- warn "connecting...\n";
- my $dbh = DBI->connect("dbi:NullP:");
- warn "...connected\n";
-
- for (1..3) {
- warn "entering DBI...\n";
- $dbh->do("sleep 0.3"); # pseudo-sql understood by the DBD::NullP driver
- warn "...returned\n";
- }
-
- warn "done.";
-
-Example output:
-
- $ perl corogofer.pl
- connecting...
- -tick- 1293631437.14
- -tick- 1293631437.14
- ...connected
- entering DBI...
- -tick- 1293631437.25
- -tick- 1293631437.35
- -tick- 1293631437.45
- -tick- 1293631437.55
- ...returned
- entering DBI...
- -tick- 1293631437.66
- -tick- 1293631437.76
- -tick- 1293631437.86
- ...returned
- entering DBI...
- -tick- 1293631437.96
- -tick- 1293631438.06
- -tick- 1293631438.16
- ...returned
- done. at corogofer.pl line 39.
-
-You can see that the timer callback is firing while the code 'waits' inside the
-do() method for the response from the database. Normally that would block.
-
-=cut
+++ /dev/null
-package DBD::Gofer::Transport::null;
-
-# $Id: null.pm 10087 2007-10-16 12:42:37Z Tim $
-#
-# Copyright (c) 2007, Tim Bunce, Ireland
-#
-# You may distribute under the terms of either the GNU General Public
-# License or the Artistic License, as specified in the Perl README file.
-
-use strict;
-use warnings;
-
-use base qw(DBD::Gofer::Transport::Base);
-
-use DBI::Gofer::Execute;
-
-our $VERSION = "0.010088";
-
-__PACKAGE__->mk_accessors(qw(
- pending_response
- transmit_count
-));
-
-my $executor = DBI::Gofer::Execute->new();
-
-
-sub transmit_request_by_transport {
- my ($self, $request) = @_;
- $self->transmit_count( ($self->transmit_count()||0) + 1 ); # just for tests
-
- my $frozen_request = $self->freeze_request($request);
-
- # ...
- # the request is magically transported over to ... ourselves
- # ...
-
- my $response = $executor->execute_request( $self->thaw_request($frozen_request, undef, 1) );
-
- # put response 'on the shelf' ready for receive_response()
- $self->pending_response( $response );
-
- return undef;
-}
-
-
-sub receive_response_by_transport {
- my $self = shift;
-
- my $response = $self->pending_response;
-
- my $frozen_response = $self->freeze_response($response, undef, 1);
-
- # ...
- # the response is magically transported back to ... ourselves
- # ...
-
- return $self->thaw_response($frozen_response);
-}
-
-
-1;
-__END__
-
-=head1 NAME
-
-DBD::Gofer::Transport::null - DBD::Gofer client transport for testing
-
-=head1 SYNOPSIS
-
- my $original_dsn = "..."
- DBI->connect("dbi:Gofer:transport=null;dsn=$original_dsn",...)
-
-or, enable by setting the DBI_AUTOPROXY environment variable:
-
- export DBI_AUTOPROXY="dbi:Gofer:transport=null"
-
-=head1 DESCRIPTION
-
-Connect via DBD::Gofer but execute the requests within the same process.
-
-This is a quick and simple way to test applications for compatibility with the
-(few) restrictions that DBD::Gofer imposes.
-
-It also provides a simple, portable way for the DBI test suite to be used to
-test DBD::Gofer on all platforms with no setup.
-
-Also, by measuring the difference in performance between normal connections and
-connections via C<dbi:Gofer:transport=null> the basic cost of using DBD::Gofer
-can be measured. Furthermore, the additional cost of more advanced transports can be
-isolated by comparing their performance with the null transport.
-
-The C<t/85gofer.t> script in the DBI distribution includes a comparative benchmark.
-
-=head1 AUTHOR
-
-Tim Bunce, L<http://www.tim.bunce.name>
-
-=head1 LICENCE AND COPYRIGHT
-
-Copyright (c) 2007, Tim Bunce, Ireland. All rights reserved.
-
-This module is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself. See L<perlartistic>.
-
-=head1 SEE ALSO
-
-L<DBD::Gofer::Transport::Base>
-
-L<DBD::Gofer>
-
-=cut
+++ /dev/null
-package DBD::Gofer::Transport::pipeone;
-
-# $Id: pipeone.pm 10087 2007-10-16 12:42:37Z Tim $
-#
-# Copyright (c) 2007, Tim Bunce, Ireland
-#
-# You may distribute under the terms of either the GNU General Public
-# License or the Artistic License, as specified in the Perl README file.
-
-use strict;
-use warnings;
-
-use Carp;
-use Fcntl;
-use IO::Select;
-use IPC::Open3 qw(open3);
-use Symbol qw(gensym);
-
-use base qw(DBD::Gofer::Transport::Base);
-
-our $VERSION = "0.010088";
-
-__PACKAGE__->mk_accessors(qw(
- connection_info
- go_perl
-));
-
-
-sub new {
- my ($self, $args) = @_;
- $args->{go_perl} ||= do {
- ($INC{"blib.pm"}) ? [ $^X, '-Mblib' ] : [ $^X ];
- };
- if (not ref $args->{go_perl}) {
- # user can override the perl to be used, either with an array ref
- # containing the command name and args to use, or with a string
- # (ie via the DSN) in which case, to enable args to be passed,
- # we split on two or more consecutive spaces (otherwise the path
- # to perl couldn't contain a space itself).
- $args->{go_perl} = [ split /\s{2,}/, $args->{go_perl} ];
- }
- return $self->SUPER::new($args);
-}
-
-
-# nonblock($fh) puts filehandle into nonblocking mode
-sub nonblock {
- my $fh = shift;
- my $flags = fcntl($fh, F_GETFL, 0)
- or croak "Can't get flags for filehandle $fh: $!";
- fcntl($fh, F_SETFL, $flags | O_NONBLOCK)
- or croak "Can't make filehandle $fh nonblocking: $!";
-}
-
-
-sub start_pipe_command {
- my ($self, $cmd) = @_;
- $cmd = [ $cmd ] unless ref $cmd eq 'ARRAY';
-
- # if it's important that the subprocess uses the same
- # (versions of) modules as us then the caller should
- # set PERL5LIB itself.
-
- # limit various forms of insanity, for now
- local $ENV{DBI_TRACE}; # use DBI_GOFER_TRACE instead
- local $ENV{DBI_AUTOPROXY};
- local $ENV{DBI_PROFILE};
-
- my ($wfh, $rfh, $efh) = (gensym, gensym, gensym);
- my $pid = open3($wfh, $rfh, $efh, @$cmd)
- or die "error starting @$cmd: $!\n";
- if ($self->trace) {
- $self->trace_msg(sprintf("Started pid $pid: @$cmd {fd: w%d r%d e%d, ppid=$$}\n", fileno $wfh, fileno $rfh, fileno $efh),0);
- }
- nonblock($rfh);
- nonblock($efh);
- my $ios = IO::Select->new($rfh, $efh);
-
- return {
- cmd=>$cmd,
- pid=>$pid,
- wfh=>$wfh, rfh=>$rfh, efh=>$efh,
- ios=>$ios,
- };
-}
-
-
-sub cmd_as_string {
- my $self = shift;
- # XXX meant to return a properly shell-escaped string suitable for system
- # but its only for debugging so that can wait
- my $connection_info = $self->connection_info;
- return join " ", map { (m/^[-:\w]*$/) ? $_ : "'$_'" } @{$connection_info->{cmd}};
-}
-
-
-sub transmit_request_by_transport {
- my ($self, $request) = @_;
-
- my $frozen_request = $self->freeze_request($request);
-
- my $cmd = [ @{$self->go_perl}, qw(-MDBI::Gofer::Transport::pipeone -e run_one_stdio)];
- my $info = $self->start_pipe_command($cmd);
-
- my $wfh = delete $info->{wfh};
- # send frozen request
- local $\;
- print $wfh $frozen_request
- or warn "error writing to @$cmd: $!\n";
- # indicate that there's no more
- close $wfh
- or die "error closing pipe to @$cmd: $!\n";
-
- $self->connection_info( $info );
- return;
-}
-
-
-sub read_response_from_fh {
- my ($self, $fh_actions) = @_;
- my $trace = $self->trace;
-
- my $info = $self->connection_info || die;
- my ($ios) = @{$info}{qw(ios)};
- my $errors = 0;
- my $complete;
-
- die "No handles to read response from" unless $ios->count;
-
- while ($ios->count) {
- my @readable = $ios->can_read();
- for my $fh (@readable) {
- local $_;
- my $actions = $fh_actions->{$fh} || die "panic: no action for $fh";
- my $rv = sysread($fh, $_='', 1024*31); # to fit in 32KB slab
- unless ($rv) { # error (undef) or end of file (0)
- my $action;
- unless (defined $rv) { # was an error
- $self->trace_msg("error on handle $fh: $!\n") if $trace >= 4;
- $action = $actions->{error} || $actions->{eof};
- ++$errors;
- # XXX an error may be a permenent condition of the handle
- # if so we'll loop here - not good
- }
- else {
- $action = $actions->{eof};
- $self->trace_msg("eof on handle $fh\n") if $trace >= 4;
- }
- if ($action->($fh)) {
- $self->trace_msg("removing $fh from handle set\n") if $trace >= 4;
- $ios->remove($fh);
- }
- next;
- }
- # action returns true if the response is now complete
- # (we finish all handles
- $actions->{read}->($fh) && ++$complete;
- }
- last if $complete;
- }
- return $errors;
-}
-
-
-sub receive_response_by_transport {
- my $self = shift;
-
- my $info = $self->connection_info || die;
- my ($pid, $rfh, $efh, $ios, $cmd) = @{$info}{qw(pid rfh efh ios cmd)};
-
- my $frozen_response;
- my $stderr_msg;
-
- $self->read_response_from_fh( {
- $efh => {
- error => sub { warn "error reading response stderr: $!"; 1 },
- eof => sub { warn "eof on stderr" if 0; 1 },
- read => sub { $stderr_msg .= $_; 0 },
- },
- $rfh => {
- error => sub { warn "error reading response: $!"; 1 },
- eof => sub { warn "eof on stdout" if 0; 1 },
- read => sub { $frozen_response .= $_; 0 },
- },
- });
-
- waitpid $info->{pid}, 0
- or warn "waitpid: $!"; # XXX do something more useful?
-
- die ref($self)." command (@$cmd) failed: $stderr_msg"
- if not $frozen_response; # no output on stdout at all
-
- # XXX need to be able to detect and deal with corruption
- my $response = $self->thaw_response($frozen_response);
-
- if ($stderr_msg) {
- # add stderr messages as warnings (for PrintWarn)
- $response->add_err(0, $stderr_msg, undef, $self->trace)
- # but ignore warning from old version of blib
- unless $stderr_msg =~ /^Using .*blib/ && "@$cmd" =~ /-Mblib/;
- }
-
- return $response;
-}
-
-
-1;
-
-__END__
-
-=head1 NAME
-
-DBD::Gofer::Transport::pipeone - DBD::Gofer client transport for testing
-
-=head1 SYNOPSIS
-
- $original_dsn = "...";
- DBI->connect("dbi:Gofer:transport=pipeone;dsn=$original_dsn",...)
-
-or, enable by setting the DBI_AUTOPROXY environment variable:
-
- export DBI_AUTOPROXY="dbi:Gofer:transport=pipeone"
-
-=head1 DESCRIPTION
-
-Connect via DBD::Gofer and execute each request by starting executing a subprocess.
-
-This is, as you might imagine, spectacularly inefficient!
-
-It's only intended for testing. Specifically it demonstrates that the server
-side is completely stateless.
-
-It also provides a base class for the much more useful L<DBD::Gofer::Transport::stream>
-transport.
-
-=head1 AUTHOR
-
-Tim Bunce, L<http://www.tim.bunce.name>
-
-=head1 LICENCE AND COPYRIGHT
-
-Copyright (c) 2007, Tim Bunce, Ireland. All rights reserved.
-
-This module is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself. See L<perlartistic>.
-
-=head1 SEE ALSO
-
-L<DBD::Gofer::Transport::Base>
-
-L<DBD::Gofer>
-
-=cut
+++ /dev/null
-package DBD::Gofer::Transport::stream;
-
-# $Id: stream.pm 14598 2010-12-21 22:53:25Z Tim $
-#
-# Copyright (c) 2007, Tim Bunce, Ireland
-#
-# You may distribute under the terms of either the GNU General Public
-# License or the Artistic License, as specified in the Perl README file.
-
-use strict;
-use warnings;
-
-use Carp;
-
-use base qw(DBD::Gofer::Transport::pipeone);
-
-our $VERSION = "0.014599";
-
-__PACKAGE__->mk_accessors(qw(
- go_persist
-));
-
-my $persist_all = 5;
-my %persist;
-
-
-sub _connection_key {
- my ($self) = @_;
- return join "~", $self->go_url||"", @{ $self->go_perl || [] };
-}
-
-
-sub _connection_get {
- my ($self) = @_;
-
- my $persist = $self->go_persist; # = 0 can force non-caching
- $persist = $persist_all if not defined $persist;
- my $key = ($persist) ? $self->_connection_key : '';
- if ($persist{$key} && $self->_connection_check($persist{$key})) {
- $self->trace_msg("reusing persistent connection $key\n",0) if $self->trace >= 1;
- return $persist{$key};
- }
-
- my $connection = $self->_make_connection;
-
- if ($key) {
- %persist = () if keys %persist > $persist_all; # XXX quick hack to limit subprocesses
- $persist{$key} = $connection;
- }
-
- return $connection;
-}
-
-
-sub _connection_check {
- my ($self, $connection) = @_;
- $connection ||= $self->connection_info;
- my $pid = $connection->{pid};
- my $ok = (kill 0, $pid);
- $self->trace_msg("_connection_check: $ok (pid $$)\n",0) if $self->trace;
- return $ok;
-}
-
-
-sub _connection_kill {
- my ($self) = @_;
- my $connection = $self->connection_info;
- my ($pid, $wfh, $rfh, $efh) = @{$connection}{qw(pid wfh rfh efh)};
- $self->trace_msg("_connection_kill: closing write handle\n",0) if $self->trace;
- # closing the write file handle should be enough, generally
- close $wfh;
- # in future we may want to be more aggressive
- #close $rfh; close $efh; kill 15, $pid
- # but deleting from the persist cache...
- delete $persist{ $self->_connection_key };
- # ... and removing the connection_info should suffice
- $self->connection_info( undef );
- return;
-}
-
-
-sub _make_connection {
- my ($self) = @_;
-
- my $go_perl = $self->go_perl;
- my $cmd = [ @$go_perl, qw(-MDBI::Gofer::Transport::stream -e run_stdio_hex)];
-
- #push @$cmd, "DBI_TRACE=2=/tmp/goferstream.log", "sh", "-c";
- if (my $url = $self->go_url) {
- die "Only 'ssh:user\@host' style url supported by this transport"
- unless $url =~ s/^ssh://;
- my $ssh = $url;
- my $setup_env = join "||", map { "source $_ 2>/dev/null" } qw(.bash_profile .bash_login .profile);
- my $setup = $setup_env.q{; exec "$@"};
- # don't use $^X on remote system by default as it's possibly wrong
- $cmd->[0] = 'perl' if "@$go_perl" eq $^X;
- # -x not only 'Disables X11 forwarding' but also makes connections *much* faster
- unshift @$cmd, qw(ssh -xq), split(' ', $ssh), qw(bash -c), $setup;
- }
-
- $self->trace_msg("new connection: @$cmd\n",0) if $self->trace;
-
- # XXX add a handshake - some message from DBI::Gofer::Transport::stream that's
- # sent as soon as it starts that we can wait for to report success - and soak up
- # and report useful warnings etc from ssh before we get it? Increases latency though.
- my $connection = $self->start_pipe_command($cmd);
- return $connection;
-}
-
-
-sub transmit_request_by_transport {
- my ($self, $request) = @_;
- my $trace = $self->trace;
-
- my $connection = $self->connection_info || do {
- my $con = $self->_connection_get;
- $self->connection_info( $con );
- $con;
- };
-
- my $encoded_request = unpack("H*", $self->freeze_request($request));
- $encoded_request .= "\015\012";
-
- my $wfh = $connection->{wfh};
- $self->trace_msg(sprintf("transmit_request_by_transport: to fh %s fd%d\n", $wfh, fileno($wfh)),0)
- if $trace >= 4;
-
- # send frozen request
- local $\;
- $wfh->print($encoded_request) # autoflush enabled
- or do {
- my $err = $!;
- # XXX could/should make new connection and retry
- $self->_connection_kill;
- die "Error sending request: $err";
- };
- $self->trace_msg("Request sent: $encoded_request\n",0) if $trace >= 4;
-
- return undef; # indicate no response yet (so caller calls receive_response_by_transport)
-}
-
-
-sub receive_response_by_transport {
- my $self = shift;
- my $trace = $self->trace;
-
- $self->trace_msg("receive_response_by_transport: awaiting response\n",0) if $trace >= 4;
- my $connection = $self->connection_info || die;
- my ($pid, $rfh, $efh, $cmd) = @{$connection}{qw(pid rfh efh cmd)};
-
- my $errno = 0;
- my $encoded_response;
- my $stderr_msg;
-
- $self->read_response_from_fh( {
- $efh => {
- error => sub { warn "error reading response stderr: $!"; $errno||=$!; 1 },
- eof => sub { warn "eof reading efh" if $trace >= 4; 1 },
- read => sub { $stderr_msg .= $_; 0 },
- },
- $rfh => {
- error => sub { warn "error reading response: $!"; $errno||=$!; 1 },
- eof => sub { warn "eof reading rfh" if $trace >= 4; 1 },
- read => sub { $encoded_response .= $_; ($encoded_response=~s/\015\012$//) ? 1 : 0 },
- },
- });
-
- # if we got no output on stdout at all then the command has
- # probably exited, possibly with an error to stderr.
- # Turn this situation into a reasonably useful DBI error.
- if (not $encoded_response) {
- my @msg;
- push @msg, "error while reading response: $errno" if $errno;
- if ($stderr_msg) {
- chomp $stderr_msg;
- push @msg, sprintf "error reported by \"%s\" (pid %d%s): %s",
- $self->cmd_as_string,
- $pid, ((kill 0, $pid) ? "" : ", exited"),
- $stderr_msg;
- }
- die join(", ", "No response received", @msg)."\n";
- }
-
- $self->trace_msg("Response received: $encoded_response\n",0)
- if $trace >= 4;
-
- $self->trace_msg("Gofer stream stderr message: $stderr_msg\n",0)
- if $stderr_msg && $trace;
-
- my $frozen_response = pack("H*", $encoded_response);
-
- # XXX need to be able to detect and deal with corruption
- my $response = $self->thaw_response($frozen_response);
-
- if ($stderr_msg) {
- # add stderr messages as warnings (for PrintWarn)
- $response->add_err(0, $stderr_msg, undef, $trace)
- # but ignore warning from old version of blib
- unless $stderr_msg =~ /^Using .*blib/ && "@$cmd" =~ /-Mblib/;
- }
-
- return $response;
-}
-
-sub transport_timedout {
- my $self = shift;
- $self->_connection_kill;
- return $self->SUPER::transport_timedout(@_);
-}
-
-1;
-
-__END__
-
-=head1 NAME
-
-DBD::Gofer::Transport::stream - DBD::Gofer transport for stdio streaming
-
-=head1 SYNOPSIS
-
- DBI->connect('dbi:Gofer:transport=stream;url=ssh:username@host.example.com;dsn=dbi:...',...)
-
-or, enable by setting the DBI_AUTOPROXY environment variable:
-
- export DBI_AUTOPROXY='dbi:Gofer:transport=stream;url=ssh:username@host.example.com'
-
-=head1 DESCRIPTION
-
-Without the C<url=> parameter it launches a subprocess as
-
- perl -MDBI::Gofer::Transport::stream -e run_stdio_hex
-
-and feeds requests into it and reads responses from it. But that's not very useful.
-
-With a C<url=ssh:username@host.example.com> parameter it uses ssh to launch the subprocess
-on a remote system. That's much more useful!
-
-It gives you secure remote access to DBI databases on any system you can login to.
-Using ssh also gives you optional compression and many other features (see the
-ssh manual for how to configure that and many other options via ~/.ssh/config file).
-
-The actual command invoked is something like:
-
- ssh -xq ssh:username@host.example.com bash -c $setup $run
-
-where $run is the command shown above, and $command is
-
- . .bash_profile 2>/dev/null || . .bash_login 2>/dev/null || . .profile 2>/dev/null; exec "$@"
-
-which is trying (in a limited and fairly unportable way) to setup the environment
-(PATH, PERL5LIB etc) as it would be if you had logged in to that system.
-
-The "C<perl>" used in the command will default to the value of $^X when not using ssh.
-On most systems that's the full path to the perl that's currently executing.
-
-
-=head1 PERSISTENCE
-
-Currently gofer stream connections persist (remain connected) after all
-database handles have been disconnected. This makes later connections in the
-same process very fast.
-
-Currently up to 5 different gofer stream connections (based on url) can
-persist. If more than 5 are in the cache when a new connection is made then
-the cache is cleared before adding the new connection. Simple but effective.
-
-=head1 TO DO
-
-Document go_perl attribute
-
-Automatically reconnect (within reason) if there's a transport error.
-
-Decide on default for persistent connection - on or off? limits? ttl?
-
-=head1 AUTHOR
-
-Tim Bunce, L<http://www.tim.bunce.name>
-
-=head1 LICENCE AND COPYRIGHT
-
-Copyright (c) 2007, Tim Bunce, Ireland. All rights reserved.
-
-This module is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself. See L<perlartistic>.
-
-=head1 SEE ALSO
-
-L<DBD::Gofer::Transport::Base>
-
-L<DBD::Gofer>
-
-=cut
+++ /dev/null
-# -*- perl -*-
-#
-# DBD::Mem - A DBI driver for in-memory tables
-#
-# This module is currently maintained by
-#
-# Jens Rehsack
-#
-# Copyright (C) 2016,2017 by Jens Rehsack
-#
-# All rights reserved.
-#
-# You may distribute this module under the terms of either the GNU
-# General Public License or the Artistic License, as specified in
-# the Perl README file.
-
-require 5.008;
-use strict;
-
-#################
-package DBD::Mem;
-#################
-use base qw( DBI::DBD::SqlEngine );
-use vars qw($VERSION $ATTRIBUTION $drh);
-$VERSION = '0.001';
-$ATTRIBUTION = 'DBD::Mem by Jens Rehsack';
-
-# no need to have driver() unless you need private methods
-#
-sub driver ($;$)
-{
- my ( $class, $attr ) = @_;
- return $drh if ($drh);
-
- # do the real work in DBI::DBD::SqlEngine
- #
- $attr->{Attribution} = 'DBD::Mem by Jens Rehsack';
- $drh = $class->SUPER::driver($attr);
-
- return $drh;
-}
-
-sub CLONE
-{
- undef $drh;
-}
-
-#####################
-package DBD::Mem::dr;
-#####################
-$DBD::Mem::dr::imp_data_size = 0;
-@DBD::Mem::dr::ISA = qw(DBI::DBD::SqlEngine::dr);
-
-# you could put some :dr private methods here
-
-# you may need to over-ride some DBI::DBD::SqlEngine::dr methods here
-# but you can probably get away with just letting it do the work
-# in most cases
-
-#####################
-package DBD::Mem::db;
-#####################
-$DBD::Mem::db::imp_data_size = 0;
-@DBD::Mem::db::ISA = qw(DBI::DBD::SqlEngine::db);
-
-use Carp qw/carp/;
-
-sub set_versions
-{
- my $this = $_[0];
- $this->{mem_version} = $DBD::Mem::VERSION;
- return $this->SUPER::set_versions();
-}
-
-sub init_valid_attributes
-{
- my $dbh = shift;
-
- # define valid private attributes
- #
- # attempts to set non-valid attrs in connect() or
- # with $dbh->{attr} will throw errors
- #
- # the attrs here *must* start with mem_ or foo_
- #
- # see the STORE methods below for how to check these attrs
- #
- $dbh->{mem_valid_attrs} = {
- mem_version => 1, # verbose DBD::Mem version
- mem_valid_attrs => 1, # DBD::Mem::db valid attrs
- mem_readonly_attrs => 1, # DBD::Mem::db r/o attrs
- mem_meta => 1, # DBD::Mem public access for f_meta
- mem_tables => 1, # DBD::Mem public access for f_meta
- };
- $dbh->{mem_readonly_attrs} = {
- mem_version => 1, # verbose DBD::Mem version
- mem_valid_attrs => 1, # DBD::Mem::db valid attrs
- mem_readonly_attrs => 1, # DBD::Mem::db r/o attrs
- mem_meta => 1, # DBD::Mem public access for f_meta
- };
-
- $dbh->{mem_meta} = "mem_tables";
-
- return $dbh->SUPER::init_valid_attributes();
-}
-
-sub get_mem_versions
-{
- my ( $dbh, $table ) = @_;
- $table ||= '';
-
- my $meta;
- my $class = $dbh->{ImplementorClass};
- $class =~ s/::db$/::Table/;
- $table and ( undef, $meta ) = $class->get_table_meta( $dbh, $table, 1 );
- $meta or ( $meta = {} and $class->bootstrap_table_meta( $dbh, $meta, $table ) );
-
- return sprintf( "%s using %s", $dbh->{mem_version}, $AnyData2::VERSION );
-}
-
-package DBD::Mem::st;
-
-use strict;
-use warnings;
-
-our $imp_data_size = 0;
-our @ISA = qw(DBI::DBD::SqlEngine::st);
-
-############################
-package DBD::Mem::Statement;
-############################
-
-@DBD::Mem::Statement::ISA = qw(DBI::DBD::SqlEngine::Statement);
-
-
-sub open_table ($$$$$)
-{
- my ( $self, $data, $table, $createMode, $lockMode ) = @_;
-
- my $class = ref $self;
- $class =~ s/::Statement/::Table/;
-
- my $flags = {
- createMode => $createMode,
- lockMode => $lockMode,
- };
- if( defined( $data->{Database}->{mem_table_data}->{$table} ) && $data->{Database}->{mem_table_data}->{$table})
- {
- my $t = $data->{Database}->{mem_tables}->{$table};
- $t->seek( $data, 0, 0 );
- return $t;
- }
-
- return $self->SUPER::open_table($data, $table, $createMode, $lockMode);
-}
-
-# ====== DataSource ============================================================
-
-package DBD::Mem::DataSource;
-
-use strict;
-use warnings;
-
-use Carp;
-
-@DBD::Mem::DataSource::ISA = "DBI::DBD::SqlEngine::DataSource";
-
-sub complete_table_name ($$;$)
-{
- my ( $self, $meta, $table, $respect_case ) = @_;
- $table;
-}
-
-sub open_data ($)
-{
- my ( $self, $meta, $attrs, $flags ) = @_;
- defined $meta->{data_tbl} or $meta->{data_tbl} = [];
-}
-
-########################
-package DBD::Mem::Table;
-########################
-
-# shamelessly stolen from SQL::Statement::RAM
-
-use Carp qw/croak/;
-
-@DBD::Mem::Table::ISA = qw(DBI::DBD::SqlEngine::Table);
-
-use Carp qw(croak);
-
-sub new
-{
- #my ( $class, $tname, $col_names, $data_tbl ) = @_;
- my ( $class, $data, $attrs, $flags ) = @_;
- my $self = $class->SUPER::new($data, $attrs, $flags);
-
- my $meta = $self->{meta};
- $self->{records} = $meta->{data_tbl};
- $self->{index} = 0;
-
- $self;
-}
-
-sub bootstrap_table_meta
-{
- my ( $self, $dbh, $meta, $table ) = @_;
-
- defined $meta->{sql_data_source} or $meta->{sql_data_source} = "DBD::Mem::DataSource";
-
- $meta;
-}
-
-sub fetch_row
-{
- my ( $self, $data ) = @_;
-
- return $self->{row} =
- ( $self->{records} and ( $self->{index} < scalar( @{ $self->{records} } ) ) )
- ? [ @{ $self->{records}->[ $self->{index}++ ] } ]
- : undef;
-}
-
-sub push_row
-{
- my ( $self, $data, $fields ) = @_;
- my $currentRow = $self->{index};
- $self->{index} = $currentRow + 1;
- $self->{records}->[$currentRow] = $fields;
- return 1;
-}
-
-sub truncate
-{
- my $self = shift;
- return splice @{ $self->{records} }, $self->{index}, 1;
-}
-
-sub push_names
-{
- my ( $self, $data, $names ) = @_;
- my $meta = $self->{meta};
- $meta->{col_names} = $self->{col_names} = $names;
- $self->{org_col_names} = [ @{$names} ];
- $self->{col_nums} = {};
- $self->{col_nums}{ $names->[$_] } = $_ for ( 0 .. scalar @$names - 1 );
-}
-
-sub drop ($)
-{
- my ($self, $data) = @_;
- delete $data->{Database}{sql_meta}{$self->{table}};
- return 1;
-} # drop
-
-sub seek
-{
- my ( $self, $data, $pos, $whence ) = @_;
- return unless defined $self->{records};
-
- my ($currentRow) = $self->{index};
- if ( $whence == 0 )
- {
- $currentRow = $pos;
- }
- elsif ( $whence == 1 )
- {
- $currentRow += $pos;
- }
- elsif ( $whence == 2 )
- {
- $currentRow = @{ $self->{records} } + $pos;
- }
- else
- {
- croak $self . "->seek: Illegal whence argument ($whence)";
- }
-
- $currentRow < 0 and
- croak "Illegal row number: $currentRow";
- $self->{index} = $currentRow;
-}
-
-1;
-
-=head1 NAME
-
-DBD::Mem - a DBI driver for Mem & MLMem files
-
-=head1 SYNOPSIS
-
- use DBI;
- $dbh = DBI->connect('dbi:Mem:', undef, undef, {});
- $dbh = DBI->connect('dbi:Mem:', undef, undef, {RaiseError => 1});
-
- # or
- $dbh = DBI->connect('dbi:Mem:');
- $dbh = DBI->connect('DBI:Mem(RaiseError=1):');
-
-and other variations on connect() as shown in the L<DBI> docs and
-<DBI::DBD::SqlEngine metadata|DBI::DBD::SqlEngine/Metadata>.
-
-Use standard DBI prepare, execute, fetch, placeholders, etc.,
-see L<QUICK START> for an example.
-
-=head1 DESCRIPTION
-
-DBD::Mem is a database management system that works right out of the box.
-If you have a standard installation of Perl and DBI you can begin creating,
-accessing, and modifying simple database tables without any further modules.
-You can add other modules (e.g., SQL::Statement) for improved functionality.
-
-DBD::Mem doesn't store any data persistently - all data has the lifetime of
-the instantiated C<$dbh>. The main reason to use DBD::Mem is to use extended
-features of L<SQL::Statement> where temporary tables are required. One can
-use DBD::Mem to simulate C<VIEWS> or sub-queries.
-
-Bundling C<DBD::Mem> with L<DBI> will allow us further compatibility checks
-of L<DBI::DBD::SqlEngine> beyond the capabilities of L<DBD::File> and
-L<DBD::DBM>. This will ensure DBI provided basis for drivers like
-L<DBD::AnyData2> or L<DBD::Amazon> are better prepared and tested for
-not-file based backends.
-
-=head2 Metadata
-
-There're no new meta data introduced by C<DBD::Mem>. See
-L<DBI::DBD::SqlEngine/Metadata> for full description.
-
-=head1 GETTING HELP, MAKING SUGGESTIONS, AND REPORTING BUGS
-
-If you need help installing or using DBD::Mem, please write to the DBI
-users mailing list at L<mailto:dbi-users@perl.org> or to the
-comp.lang.perl.modules newsgroup on usenet. I cannot always answer
-every question quickly but there are many on the mailing list or in
-the newsgroup who can.
-
-DBD developers for DBD's which rely on DBI::DBD::SqlEngine or DBD::Mem or
-use one of them as an example are suggested to join the DBI developers
-mailing list at L<mailto:dbi-dev@perl.org> and strongly encouraged to join our
-IRC channel at L<irc://irc.perl.org/dbi>.
-
-If you have suggestions, ideas for improvements, or bugs to report, please
-report a bug as described in DBI. Do not mail any of the authors directly,
-you might not get an answer.
-
-When reporting bugs, please send the output of C<< $dbh->mem_versions($table) >>
-for a table that exhibits the bug and as small a sample as you can make of
-the code that produces the bug. And of course, patches are welcome, too
-:-).
-
-If you need enhancements quickly, you can get commercial support as
-described at L<http://dbi.perl.org/support/> or you can contact Jens Rehsack
-at rehsack@cpan.org for commercial support.
-
-=head1 AUTHOR AND COPYRIGHT
-
-This module is written by Jens Rehsack < rehsack AT cpan.org >.
-
- Copyright (c) 2016- by Jens Rehsack, all rights reserved.
-
-You may freely distribute and/or modify this module under the terms of
-either the GNU General Public License (GPL) or the Artistic License, as
-specified in the Perl README file.
-
-=head1 SEE ALSO
-
-L<DBI> for the Database interface of the Perl Programming Language.
-
-L<SQL::Statement> and L<DBI::SQL::Nano> for the available SQL engines.
-
-L<SQL::Statement::RAM> where the implementation is shamelessly stolen from
-to allow DBI bundled Pure-Perl drivers increase the test coverage.
-
-L<DBD::SQLite> using C<dbname=:memory:> for an incredible fast in-memory database engine.
-
-=cut
+++ /dev/null
-use strict;
-{
- package DBD::NullP;
-
- require DBI;
- require Carp;
-
- our @EXPORT = qw(); # Do NOT @EXPORT anything.
- our $VERSION = "12.014715";
-
-# $Id: NullP.pm 14714 2011-02-22 17:27:07Z Tim $
-#
-# Copyright (c) 1994-2007 Tim Bunce
-#
-# You may distribute under the terms of either the GNU General Public
-# License or the Artistic License, as specified in the Perl README file.
-
- our $drh = undef; # holds driver handle once initialised
-
- sub driver{
- return $drh if $drh;
- my($class, $attr) = @_;
- $class .= "::dr";
- ($drh) = DBI::_new_drh($class, {
- 'Name' => 'NullP',
- 'Version' => $VERSION,
- 'Attribution' => 'DBD Example Null Perl stub by Tim Bunce',
- }, [ qw'example implementors private data']);
- $drh;
- }
-
- sub CLONE {
- undef $drh;
- }
-}
-
-
-{ package DBD::NullP::dr; # ====== DRIVER ======
- our $imp_data_size = 0;
- use strict;
-
- sub connect { # normally overridden, but a handy default
- my $dbh = shift->SUPER::connect(@_)
- or return;
- $dbh->STORE(Active => 1);
- $dbh;
- }
-
-
- sub DESTROY { undef }
-}
-
-
-{ package DBD::NullP::db; # ====== DATABASE ======
- our $imp_data_size = 0;
- use strict;
- use Carp qw(croak);
-
- # Added get_info to support tests in 10examp.t
- sub get_info {
- my ($dbh, $type) = @_;
-
- if ($type == 29) { # identifier quote
- return '"';
- }
- return;
- }
-
- # Added table_info to support tests in 10examp.t
- sub table_info {
- my ($dbh, $catalog, $schema, $table, $type) = @_;
-
- my ($outer, $sth) = DBI::_new_sth($dbh, {
- 'Statement' => 'tables',
- });
- if (defined($type) && $type eq '%' && # special case for tables('','','','%')
- grep {defined($_) && $_ eq ''} ($catalog, $schema, $table)) {
- $outer->{dbd_nullp_data} = [[undef, undef, undef, 'TABLE', undef],
- [undef, undef, undef, 'VIEW', undef],
- [undef, undef, undef, 'ALIAS', undef]];
- } elsif (defined($catalog) && $catalog eq '%' && # special case for tables('%','','')
- grep {defined($_) && $_ eq ''} ($schema, $table)) {
- $outer->{dbd_nullp_data} = [['catalog1', undef, undef, undef, undef],
- ['catalog2', undef, undef, undef, undef]];
- } else {
- $outer->{dbd_nullp_data} = [['catalog', 'schema', 'table1', 'TABLE']];
- $outer->{dbd_nullp_data} = [['catalog', 'schema', 'table2', 'TABLE']];
- $outer->{dbd_nullp_data} = [['catalog', 'schema', 'table3', 'TABLE']];
- }
- $outer->STORE(NUM_OF_FIELDS => 5);
- $sth->STORE(Active => 1);
- return $outer;
- }
-
- sub prepare {
- my ($dbh, $statement)= @_;
-
- my ($outer, $sth) = DBI::_new_sth($dbh, {
- 'Statement' => $statement,
- });
-
- return $outer;
- }
-
- sub FETCH {
- my ($dbh, $attrib) = @_;
- # In reality this would interrogate the database engine to
- # either return dynamic values that cannot be precomputed
- # or fetch and cache attribute values too expensive to prefetch.
- return $dbh->SUPER::FETCH($attrib);
- }
-
- sub STORE {
- my ($dbh, $attrib, $value) = @_;
- # would normally validate and only store known attributes
- # else pass up to DBI to handle
- if ($attrib eq 'AutoCommit') {
- Carp::croak("Can't disable AutoCommit") unless $value;
- # convert AutoCommit values to magic ones to let DBI
- # know that the driver has 'handled' the AutoCommit attribute
- $value = ($value) ? -901 : -900;
- } elsif ($attrib eq 'nullp_set_err') {
- # a fake attribute to produce a test case where STORE issues a warning
- $dbh->set_err($value, $value);
- }
- return $dbh->SUPER::STORE($attrib, $value);
- }
-
- sub ping { 1 }
-
- sub disconnect {
- shift->STORE(Active => 0);
- }
-
-}
-
-
-{ package DBD::NullP::st; # ====== STATEMENT ======
- our $imp_data_size = 0;
- use strict;
-
- sub bind_param {
- my ($sth, $param, $value, $attr) = @_;
- $sth->{ParamValues}{$param} = $value;
- $sth->{ParamAttr}{$param} = $attr
- if defined $attr; # attr is sticky if not explicitly set
- return 1;
- }
-
- sub execute {
- my $sth = shift;
- $sth->bind_param($_, $_[$_-1]) for (1..@_);
- if ($sth->{Statement} =~ m/^ \s* SELECT \s+/xmsi) {
- $sth->STORE(NUM_OF_FIELDS => 1);
- $sth->{NAME} = [ "fieldname" ];
- # just for the sake of returning something, we return the params
- my $params = $sth->{ParamValues} || {};
- $sth->{dbd_nullp_data} = [ @{$params}{ sort keys %$params } ];
- $sth->STORE(Active => 1);
- }
- # force a sleep - handy for testing
- elsif ($sth->{Statement} =~ m/^ \s* SLEEP \s+ (\S+) /xmsi) {
- my $secs = $1;
- if (eval { require Time::HiRes; defined &Time::HiRes::sleep }) {
- Time::HiRes::sleep($secs);
- }
- else {
- sleep $secs;
- }
- }
- # force an error - handy for testing
- elsif ($sth->{Statement} =~ m/^ \s* ERROR \s+ (\d+) \s* (.*) /xmsi) {
- return $sth->set_err($1, $2);
- }
- # anything else is silently ignored, successfully
- 1;
- }
-
- sub fetchrow_arrayref {
- my $sth = shift;
- my $data = shift @{$sth->{dbd_nullp_data}};
- if (!$data || !@$data) {
- $sth->finish; # no more data so finish
- return undef;
- }
- return $sth->_set_fbav($data);
- }
- *fetch = \&fetchrow_arrayref; # alias
-
- sub FETCH {
- my ($sth, $attrib) = @_;
- # would normally validate and only fetch known attributes
- # else pass up to DBI to handle
- return $sth->SUPER::FETCH($attrib);
- }
-
- sub STORE {
- my ($sth, $attrib, $value) = @_;
- # would normally validate and only store known attributes
- # else pass up to DBI to handle
- return $sth->SUPER::STORE($attrib, $value);
- }
-
-}
-
-1;
+++ /dev/null
-# -*- perl -*-
-#
-#
-# DBD::Proxy - DBI Proxy driver
-#
-#
-# Copyright (c) 1997,1998 Jochen Wiedmann
-#
-# The DBD::Proxy module is free software; you can redistribute it and/or
-# modify it under the same terms as Perl itself. In particular permission
-# is granted to Tim Bunce for distributing this as a part of the DBI.
-#
-#
-# Author: Jochen Wiedmann
-# Am Eisteich 9
-# 72555 Metzingen
-# Germany
-#
-# Email: joe@ispsoft.de
-# Phone: +49 7123 14881
-#
-
-use strict;
-use Carp;
-
-require DBI;
-DBI->require_version(1.0201);
-
-use RPC::PlClient 0.2000; # XXX change to 0.2017 once it's released
-
-{ package DBD::Proxy::RPC::PlClient;
- @DBD::Proxy::RPC::PlClient::ISA = qw(RPC::PlClient);
- sub Call {
- my $self = shift;
- if ($self->{debug}) {
- my ($rpcmeth, $obj, $method, @args) = @_;
- local $^W; # silence undefs
- Carp::carp("Server $rpcmeth $method(@args)");
- }
- return $self->SUPER::Call(@_);
- }
-}
-
-
-package DBD::Proxy;
-
-use vars qw($VERSION $drh %ATTR);
-
-$VERSION = "0.2004";
-
-$drh = undef; # holds driver handle once initialised
-
-%ATTR = ( # common to db & st, see also %ATTR in DBD::Proxy::db & ::st
- 'Warn' => 'local',
- 'Active' => 'local',
- 'Kids' => 'local',
- 'CachedKids' => 'local',
- 'PrintError' => 'local',
- 'RaiseError' => 'local',
- 'HandleError' => 'local',
- 'TraceLevel' => 'cached',
- 'CompatMode' => 'local',
-);
-
-sub driver ($$) {
- if (!$drh) {
- my($class, $attr) = @_;
-
- $class .= "::dr";
-
- $drh = DBI::_new_drh($class, {
- 'Name' => 'Proxy',
- 'Version' => $VERSION,
- 'Attribution' => 'DBD::Proxy by Jochen Wiedmann',
- });
- $drh->STORE(CompatMode => 1); # disable DBI dispatcher attribute cache (for FETCH)
- }
- $drh;
-}
-
-sub CLONE {
- undef $drh;
-}
-
-sub proxy_set_err {
- my ($h,$errmsg) = @_;
- my ($err, $state) = ($errmsg =~ s/ \[err=(.*?),state=(.*?)\]//)
- ? ($1, $2) : (1, ' ' x 5);
- return $h->set_err($err, $errmsg, $state);
-}
-
-package DBD::Proxy::dr; # ====== DRIVER ======
-
-$DBD::Proxy::dr::imp_data_size = 0;
-
-sub connect ($$;$$) {
- my($drh, $dsn, $user, $auth, $attr)= @_;
- my($dsnOrig) = $dsn;
-
- my %attr = %$attr;
- my ($var, $val);
- while (length($dsn)) {
- if ($dsn =~ /^dsn=(.*)/) {
- $attr{'dsn'} = $1;
- last;
- }
- if ($dsn =~ /^(.*?);(.*)/) {
- $var = $1;
- $dsn = $2;
- } else {
- $var = $dsn;
- $dsn = '';
- }
- if ($var =~ /^(.*?)=(.*)/) {
- $var = $1;
- $val = $2;
- $attr{$var} = $val;
- }
- }
-
- my $err = '';
- if (!defined($attr{'hostname'})) { $err .= " Missing hostname."; }
- if (!defined($attr{'port'})) { $err .= " Missing port."; }
- if (!defined($attr{'dsn'})) { $err .= " Missing remote dsn."; }
-
- # Create a cipher object, if requested
- my $cipherRef = undef;
- if ($attr{'cipher'}) {
- $cipherRef = eval { $attr{'cipher'}->new(pack('H*',
- $attr{'key'})) };
- if ($@) { $err .= " Cannot create cipher object: $@."; }
- }
- my $userCipherRef = undef;
- if ($attr{'userkey'}) {
- my $cipher = $attr{'usercipher'} || $attr{'cipher'};
- $userCipherRef = eval { $cipher->new(pack('H*', $attr{'userkey'})) };
- if ($@) { $err .= " Cannot create usercipher object: $@."; }
- }
-
- return DBD::Proxy::proxy_set_err($drh, $err) if $err; # Returns undef
-
- my %client_opts = (
- 'peeraddr' => $attr{'hostname'},
- 'peerport' => $attr{'port'},
- 'socket_proto' => 'tcp',
- 'application' => $attr{dsn},
- 'user' => $user || '',
- 'password' => $auth || '',
- 'version' => $DBD::Proxy::VERSION,
- 'cipher' => $cipherRef,
- 'debug' => $attr{debug} || 0,
- 'timeout' => $attr{timeout} || undef,
- 'logfile' => $attr{logfile} || undef
- );
- # Options starting with 'proxy_rpc_' are forwarded to the RPC layer after
- # stripping the prefix.
- while (my($var,$val) = each %attr) {
- if ($var =~ s/^proxy_rpc_//) {
- $client_opts{$var} = $val;
- }
- }
- # Create an RPC::PlClient object.
- my($client, $msg) = eval { DBD::Proxy::RPC::PlClient->new(%client_opts) };
-
- return DBD::Proxy::proxy_set_err($drh, "Cannot log in to DBI::ProxyServer: $@")
- if $@; # Returns undef
- return DBD::Proxy::proxy_set_err($drh, "Constructor didn't return a handle: $msg")
- unless ($msg =~ /^((?:\w+|\:\:)+)=(\w+)/); # Returns undef
-
- $msg = RPC::PlClient::Object->new($1, $client, $msg);
-
- my $max_proto_ver;
- my ($server_ver_str) = eval { $client->Call('Version') };
- if ( $@ ) {
- # Server denies call, assume legacy protocol.
- $max_proto_ver = 1;
- } else {
- # Parse proxy server version.
- my ($server_ver_num) = $server_ver_str =~ /^DBI::ProxyServer\s+([\d\.]+)/;
- $max_proto_ver = $server_ver_num >= 0.3 ? 2 : 1;
- }
- my $req_proto_ver;
- if ( exists $attr{proxy_lazy_prepare} ) {
- $req_proto_ver = ($attr{proxy_lazy_prepare} == 0) ? 2 : 1;
- return DBD::Proxy::proxy_set_err($drh,
- "DBI::ProxyServer does not support synchronous statement preparation.")
- if $max_proto_ver < $req_proto_ver;
- }
-
- # Switch to user specific encryption mode, if desired
- if ($userCipherRef) {
- $client->{'cipher'} = $userCipherRef;
- }
-
- # create a 'blank' dbh
- my $this = DBI::_new_dbh($drh, {
- 'Name' => $dsnOrig,
- 'proxy_dbh' => $msg,
- 'proxy_client' => $client,
- 'RowCacheSize' => $attr{'RowCacheSize'} || 20,
- 'proxy_proto_ver' => $req_proto_ver || 1
- });
-
- foreach $var (keys %attr) {
- if ($var =~ /proxy_/) {
- $this->{$var} = $attr{$var};
- }
- }
- $this->SUPER::STORE('Active' => 1);
-
- $this;
-}
-
-
-sub DESTROY { undef }
-
-
-package DBD::Proxy::db; # ====== DATABASE ======
-
-$DBD::Proxy::db::imp_data_size = 0;
-
-# XXX probably many more methods need to be added here
-# in order to trigger our AUTOLOAD to redirect them to the server.
-# (Unless the sub is declared it's bypassed by perl method lookup.)
-# See notes in ToDo about method metadata
-# The question is whether to add all the methods in %DBI::DBI_methods
-# to the corresponding classes (::db, ::st etc)
-# Also need to consider methods that, if proxied, would change the server state
-# in a way that might not be visible on the client, ie begin_work -> AutoCommit.
-
-sub commit;
-sub rollback;
-sub ping;
-
-use vars qw(%ATTR $AUTOLOAD);
-
-# inherited: STORE / FETCH against this class.
-# local: STORE / FETCH against parent class.
-# cached: STORE to remote and local objects, FETCH from local.
-# remote: STORE / FETCH against remote object only (default).
-#
-# Note: Attribute names starting with 'proxy_' always treated as 'inherited'.
-#
-%ATTR = ( # see also %ATTR in DBD::Proxy::st
- %DBD::Proxy::ATTR,
- RowCacheSize => 'inherited',
- #AutoCommit => 'cached',
- 'FetchHashKeyName' => 'cached',
- Statement => 'local',
- Driver => 'local',
- dbi_connect_closure => 'local',
- Username => 'local',
-);
-
-sub AUTOLOAD {
- my $method = $AUTOLOAD;
- $method =~ s/(.*::(.*)):://;
- my $class = $1;
- my $type = $2;
- #warn "AUTOLOAD of $method (class=$class, type=$type)";
- my %expand = (
- 'method' => $method,
- 'class' => $class,
- 'type' => $type,
- 'call' => "$method(\@_)",
- # XXX was trying to be smart but was tripping up over the DBI's own
- # smartness. Disabled, but left here in case there are issues.
- # 'call' => (UNIVERSAL::can("DBI::_::$type", $method)) ? "$method(\@_)" : "func(\@_, '$method')",
- );
-
- my $method_code = q{
- package ~class~;
- sub ~method~ {
- my $h = shift;
- local $@;
- my @result = wantarray
- ? eval { $h->{'proxy_~type~h'}->~call~ }
- : eval { scalar $h->{'proxy_~type~h'}->~call~ };
- return DBD::Proxy::proxy_set_err($h, $@) if $@;
- return wantarray ? @result : $result[0];
- }
- };
- $method_code =~ s/\~(\w+)\~/$expand{$1}/eg;
- local $SIG{__DIE__} = 'DEFAULT';
- my $err = do { local $@; eval $method_code.2; $@ };
- die $err if $err;
- goto &$AUTOLOAD;
-}
-
-sub DESTROY {
- my $dbh = shift;
- local $@ if $@; # protect $@
- $dbh->disconnect if $dbh->SUPER::FETCH('Active');
-}
-
-
-sub connected { } # client-side not server-side, RT#75868
-
-sub disconnect ($) {
- my ($dbh) = @_;
-
- # Sadly the Proxy too-often disagrees with the backend database
- # on the subject of 'Active'. In the short term, I'd like the
- # Proxy to ease up and let me decide when it's proper to go over
- # the wire. This ultimately applies to finish() as well.
- #return unless $dbh->SUPER::FETCH('Active');
-
- # Drop database connection at remote end
- my $rdbh = $dbh->{'proxy_dbh'};
- if ( $rdbh ) {
- local $SIG{__DIE__} = 'DEFAULT';
- local $@;
- eval { $rdbh->disconnect() } ;
- DBD::Proxy::proxy_set_err($dbh, $@) if $@;
- }
-
- # Close TCP connect to remote
- # XXX possibly best left till DESTROY? Add a config attribute to choose?
- #$dbh->{proxy_client}->Disconnect(); # Disconnect method requires newer PlRPC module
- $dbh->{proxy_client}->{socket} = undef; # hack
-
- $dbh->SUPER::STORE('Active' => 0);
- 1;
-}
-
-
-sub STORE ($$$) {
- my($dbh, $attr, $val) = @_;
- my $type = $ATTR{$attr} || 'remote';
-
- if ($attr eq 'TraceLevel') {
- warn("TraceLevel $val");
- my $pc = $dbh->{proxy_client} || die;
- $pc->{logfile} ||= 1; # XXX hack
- $pc->{debug} = ($val && $val >= 4);
- $pc->Debug("$pc debug enabled") if $pc->{debug};
- }
-
- if ($attr =~ /^proxy_/ || $type eq 'inherited') {
- $dbh->{$attr} = $val;
- return 1;
- }
-
- if ($type eq 'remote' || $type eq 'cached') {
- local $SIG{__DIE__} = 'DEFAULT';
- local $@;
- my $result = eval { $dbh->{'proxy_dbh'}->STORE($attr => $val) };
- return DBD::Proxy::proxy_set_err($dbh, $@) if $@; # returns undef
- $dbh->SUPER::STORE($attr => $val) if $type eq 'cached';
- return $result;
- }
- return $dbh->SUPER::STORE($attr => $val);
-}
-
-sub FETCH ($$) {
- my($dbh, $attr) = @_;
- # we only get here for cached attribute values if the handle is in CompatMode
- # otherwise the DBI dispatcher handles the FETCH itself from the attribute cache.
- my $type = $ATTR{$attr} || 'remote';
-
- if ($attr =~ /^proxy_/ || $type eq 'inherited' || $type eq 'cached') {
- return $dbh->{$attr};
- }
-
- return $dbh->SUPER::FETCH($attr) unless $type eq 'remote';
-
- local $SIG{__DIE__} = 'DEFAULT';
- local $@;
- my $result = eval { $dbh->{'proxy_dbh'}->FETCH($attr) };
- return DBD::Proxy::proxy_set_err($dbh, $@) if $@;
- return $result;
-}
-
-sub prepare ($$;$) {
- my($dbh, $stmt, $attr) = @_;
- my $sth = DBI::_new_sth($dbh, {
- 'Statement' => $stmt,
- 'proxy_attr' => $attr,
- 'proxy_cache_only' => 0,
- 'proxy_params' => [],
- }
- );
- my $proto_ver = $dbh->{'proxy_proto_ver'};
- if ( $proto_ver > 1 ) {
- $sth->{'proxy_attr_cache'} = {cache_filled => 0};
- my $rdbh = $dbh->{'proxy_dbh'};
- local $SIG{__DIE__} = 'DEFAULT';
- local $@;
- my $rsth = eval { $rdbh->prepare($sth->{'Statement'}, $sth->{'proxy_attr'}, undef, $proto_ver) };
- return DBD::Proxy::proxy_set_err($sth, $@) if $@;
- return DBD::Proxy::proxy_set_err($sth, "Constructor didn't return a handle: $rsth")
- unless ($rsth =~ /^((?:\w+|\:\:)+)=(\w+)/);
-
- my $client = $dbh->{'proxy_client'};
- $rsth = RPC::PlClient::Object->new($1, $client, $rsth);
-
- $sth->{'proxy_sth'} = $rsth;
- # If statement is a positioned update we do not want any readahead.
- $sth->{'RowCacheSize'} = 1 if $stmt =~ /\bfor\s+update\b/i;
- # Since resources are used by prepared remote handle, mark us active.
- $sth->SUPER::STORE(Active => 1);
- }
- $sth;
-}
-
-sub quote {
- my $dbh = shift;
- my $proxy_quote = $dbh->{proxy_quote} || 'remote';
-
- return $dbh->SUPER::quote(@_)
- if $proxy_quote eq 'local' && @_ == 1;
-
- # For the common case of only a single argument
- # (no $data_type) we could learn and cache the behaviour.
- # Or we could probe the driver with a few test cases.
- # Or we could add a way to ask the DBI::ProxyServer
- # if $dbh->can('quote') == \&DBI::_::db::quote.
- # Tim
- #
- # Sounds all *very* smart to me. I'd rather suggest to
- # implement some of the typical quote possibilities
- # and let the user set
- # $dbh->{'proxy_quote'} = 'backslash_escaped';
- # for example.
- # Jochen
- local $SIG{__DIE__} = 'DEFAULT';
- local $@;
- my $result = eval { $dbh->{'proxy_dbh'}->quote(@_) };
- return DBD::Proxy::proxy_set_err($dbh, $@) if $@;
- return $result;
-}
-
-sub table_info {
- my $dbh = shift;
- my $rdbh = $dbh->{'proxy_dbh'};
- #warn "table_info(@_)";
- local $SIG{__DIE__} = 'DEFAULT';
- local $@;
- my($numFields, $names, $types, @rows) = eval { $rdbh->table_info(@_) };
- return DBD::Proxy::proxy_set_err($dbh, $@) if $@;
- my ($sth, $inner) = DBI::_new_sth($dbh, {
- 'Statement' => "SHOW TABLES",
- 'proxy_params' => [],
- 'proxy_data' => \@rows,
- 'proxy_attr_cache' => {
- 'NUM_OF_PARAMS' => 0,
- 'NUM_OF_FIELDS' => $numFields,
- 'NAME' => $names,
- 'TYPE' => $types,
- 'cache_filled' => 1
- },
- 'proxy_cache_only' => 1,
- });
- $sth->SUPER::STORE('NUM_OF_FIELDS' => $numFields);
- $inner->{NAME} = $names;
- $inner->{TYPE} = $types;
- $sth->SUPER::STORE('Active' => 1); # already execute()'d
- $sth->{'proxy_rows'} = @rows;
- return $sth;
-}
-
-sub tables {
- my $dbh = shift;
- #warn "tables(@_)";
- return $dbh->SUPER::tables(@_);
-}
-
-
-sub type_info_all {
- my $dbh = shift;
- local $SIG{__DIE__} = 'DEFAULT';
- local $@;
- my $result = eval { $dbh->{'proxy_dbh'}->type_info_all(@_) };
- return DBD::Proxy::proxy_set_err($dbh, $@) if $@;
- return $result;
-}
-
-
-package DBD::Proxy::st; # ====== STATEMENT ======
-
-$DBD::Proxy::st::imp_data_size = 0;
-
-use vars qw(%ATTR);
-
-# inherited: STORE to current object. FETCH from current if exists, else call up
-# to the (proxy) database object.
-# local: STORE / FETCH against parent class.
-# cache_only: STORE noop (read-only). FETCH from private_* if exists, else call
-# remote and cache the result.
-# remote: STORE / FETCH against remote object only (default).
-#
-# Note: Attribute names starting with 'proxy_' always treated as 'inherited'.
-#
-%ATTR = ( # see also %ATTR in DBD::Proxy::db
- %DBD::Proxy::ATTR,
- 'Database' => 'local',
- 'RowsInCache' => 'local',
- 'RowCacheSize' => 'inherited',
- 'NULLABLE' => 'cache_only',
- 'NAME' => 'cache_only',
- 'TYPE' => 'cache_only',
- 'PRECISION' => 'cache_only',
- 'SCALE' => 'cache_only',
- 'NUM_OF_FIELDS' => 'cache_only',
- 'NUM_OF_PARAMS' => 'cache_only'
-);
-
-*AUTOLOAD = \&DBD::Proxy::db::AUTOLOAD;
-
-sub execute ($@) {
- my $sth = shift;
- my $params = @_ ? \@_ : $sth->{'proxy_params'};
-
- # new execute, so delete any cached rows from previous execute
- undef $sth->{'proxy_data'};
- undef $sth->{'proxy_rows'};
-
- my $rsth = $sth->{proxy_sth};
- my $dbh = $sth->FETCH('Database');
- my $proto_ver = $dbh->{proxy_proto_ver};
-
- my ($numRows, @outData);
-
- local $SIG{__DIE__} = 'DEFAULT';
- local $@;
- if ( $proto_ver > 1 ) {
- ($numRows, @outData) = eval { $rsth->execute($params, $proto_ver) };
- return DBD::Proxy::proxy_set_err($sth, $@) if $@;
-
- # Attributes passed back only on the first execute() of a statement.
- unless ($sth->{proxy_attr_cache}->{cache_filled}) {
- my ($numFields, $numParams, $names, $types) = splice(@outData, 0, 4);
- $sth->{'proxy_attr_cache'} = {
- 'NUM_OF_FIELDS' => $numFields,
- 'NUM_OF_PARAMS' => $numParams,
- 'NAME' => $names,
- 'cache_filled' => 1
- };
- $sth->SUPER::STORE('NUM_OF_FIELDS' => $numFields);
- $sth->SUPER::STORE('NUM_OF_PARAMS' => $numParams);
- }
-
- }
- else {
- if ($rsth) {
- ($numRows, @outData) = eval { $rsth->execute($params, $proto_ver) };
- return DBD::Proxy::proxy_set_err($sth, $@) if $@;
-
- }
- else {
- my $rdbh = $dbh->{'proxy_dbh'};
-
- # Legacy prepare is actually prepare + first execute on the server.
- ($rsth, @outData) =
- eval { $rdbh->prepare($sth->{'Statement'},
- $sth->{'proxy_attr'}, $params, $proto_ver) };
- return DBD::Proxy::proxy_set_err($sth, $@) if $@;
- return DBD::Proxy::proxy_set_err($sth, "Constructor didn't return a handle: $rsth")
- unless ($rsth =~ /^((?:\w+|\:\:)+)=(\w+)/);
-
- my $client = $dbh->{'proxy_client'};
- $rsth = RPC::PlClient::Object->new($1, $client, $rsth);
-
- my ($numFields, $numParams, $names, $types) = splice(@outData, 0, 4);
- $sth->{'proxy_sth'} = $rsth;
- $sth->{'proxy_attr_cache'} = {
- 'NUM_OF_FIELDS' => $numFields,
- 'NUM_OF_PARAMS' => $numParams,
- 'NAME' => $names
- };
- $sth->SUPER::STORE('NUM_OF_FIELDS' => $numFields);
- $sth->SUPER::STORE('NUM_OF_PARAMS' => $numParams);
- $numRows = shift @outData;
- }
- }
- # Always condition active flag.
- $sth->SUPER::STORE('Active' => 1) if $sth->FETCH('NUM_OF_FIELDS'); # is SELECT
- $sth->{'proxy_rows'} = $numRows;
- # Any remaining items are output params.
- if (@outData) {
- foreach my $p (@$params) {
- if (ref($p->[0])) {
- my $ref = shift @outData;
- ${$p->[0]} = $$ref;
- }
- }
- }
-
- $sth->{'proxy_rows'} || '0E0';
-}
-
-sub fetch ($) {
- my $sth = shift;
-
- my $data = $sth->{'proxy_data'};
-
- $sth->{'proxy_rows'} = 0 unless defined $sth->{'proxy_rows'};
-
- if(!$data || !@$data) {
- return undef unless $sth->SUPER::FETCH('Active');
-
- my $rsth = $sth->{'proxy_sth'};
- if (!$rsth) {
- die "Attempt to fetch row without execute";
- }
- my $num_rows = $sth->FETCH('RowCacheSize') || 20;
- local $SIG{__DIE__} = 'DEFAULT';
- local $@;
- my @rows = eval { $rsth->fetch($num_rows) };
- return DBD::Proxy::proxy_set_err($sth, $@) if $@;
- unless (@rows == $num_rows) {
- undef $sth->{'proxy_data'};
- # server side has already called finish
- $sth->SUPER::STORE(Active => 0);
- }
- return undef unless @rows;
- $sth->{'proxy_data'} = $data = [@rows];
- }
- my $row = shift @$data;
-
- $sth->SUPER::STORE(Active => 0) if ( $sth->{proxy_cache_only} and !@$data );
- $sth->{'proxy_rows'}++;
- return $sth->_set_fbav($row);
-}
-*fetchrow_arrayref = \&fetch;
-
-sub rows ($) {
- my $rows = shift->{'proxy_rows'};
- return (defined $rows) ? $rows : -1;
-}
-
-sub finish ($) {
- my($sth) = @_;
- return 1 unless $sth->SUPER::FETCH('Active');
- my $rsth = $sth->{'proxy_sth'};
- $sth->SUPER::STORE('Active' => 0);
- return 0 unless $rsth; # Something's out of sync
- my $no_finish = exists($sth->{'proxy_no_finish'})
- ? $sth->{'proxy_no_finish'}
- : $sth->FETCH('Database')->{'proxy_no_finish'};
- unless ($no_finish) {
- local $SIG{__DIE__} = 'DEFAULT';
- local $@;
- my $result = eval { $rsth->finish() };
- return DBD::Proxy::proxy_set_err($sth, $@) if $@;
- return $result;
- }
- 1;
-}
-
-sub STORE ($$$) {
- my($sth, $attr, $val) = @_;
- my $type = $ATTR{$attr} || 'remote';
-
- if ($attr =~ /^proxy_/ || $type eq 'inherited') {
- $sth->{$attr} = $val;
- return 1;
- }
-
- if ($type eq 'cache_only') {
- return 0;
- }
-
- if ($type eq 'remote' || $type eq 'cached') {
- my $rsth = $sth->{'proxy_sth'} or return undef;
- local $SIG{__DIE__} = 'DEFAULT';
- local $@;
- my $result = eval { $rsth->STORE($attr => $val) };
- return DBD::Proxy::proxy_set_err($sth, $@) if ($@);
- return $result if $type eq 'remote'; # else fall through to cache locally
- }
- return $sth->SUPER::STORE($attr => $val);
-}
-
-sub FETCH ($$) {
- my($sth, $attr) = @_;
-
- if ($attr =~ /^proxy_/) {
- return $sth->{$attr};
- }
-
- my $type = $ATTR{$attr} || 'remote';
- if ($type eq 'inherited') {
- if (exists($sth->{$attr})) {
- return $sth->{$attr};
- }
- return $sth->FETCH('Database')->{$attr};
- }
-
- if ($type eq 'cache_only' &&
- exists($sth->{'proxy_attr_cache'}->{$attr})) {
- return $sth->{'proxy_attr_cache'}->{$attr};
- }
-
- if ($type ne 'local') {
- my $rsth = $sth->{'proxy_sth'} or return undef;
- local $SIG{__DIE__} = 'DEFAULT';
- local $@;
- my $result = eval { $rsth->FETCH($attr) };
- return DBD::Proxy::proxy_set_err($sth, $@) if $@;
- return $result;
- }
- elsif ($attr eq 'RowsInCache') {
- my $data = $sth->{'proxy_data'};
- $data ? @$data : 0;
- }
- else {
- $sth->SUPER::FETCH($attr);
- }
-}
-
-sub bind_param ($$$@) {
- my $sth = shift; my $param = shift;
- $sth->{'proxy_params'}->[$param-1] = [@_];
-}
-*bind_param_inout = \&bind_param;
-
-sub DESTROY {
- my $sth = shift;
- $sth->finish if $sth->SUPER::FETCH('Active');
-}
-
-
-1;
-
-
-__END__
-
-=head1 NAME
-
-DBD::Proxy - A proxy driver for the DBI
-
-=head1 SYNOPSIS
-
- use DBI;
-
- $dbh = DBI->connect("dbi:Proxy:hostname=$host;port=$port;dsn=$db",
- $user, $passwd);
-
- # See the DBI module documentation for full details
-
-=head1 DESCRIPTION
-
-DBD::Proxy is a Perl module for connecting to a database via a remote
-DBI driver. See L<DBD::Gofer> for an alternative with different trade-offs.
-
-This is of course not needed for DBI drivers which already
-support connecting to a remote database, but there are engines which
-don't offer network connectivity.
-
-Another application is offering database access through a firewall, as
-the driver offers query based restrictions. For example you can
-restrict queries to exactly those that are used in a given CGI
-application.
-
-Speaking of CGI, another application is (or rather, will be) to reduce
-the database connect/disconnect overhead from CGI scripts by using
-proxying the connect_cached method. The proxy server will hold the
-database connections open in a cache. The CGI script then trades the
-database connect/disconnect overhead for the DBD::Proxy
-connect/disconnect overhead which is typically much less.
-
-
-=head1 CONNECTING TO THE DATABASE
-
-Before connecting to a remote database, you must ensure, that a Proxy
-server is running on the remote machine. There's no default port, so
-you have to ask your system administrator for the port number. See
-L<DBI::ProxyServer> for details.
-
-Say, your Proxy server is running on machine "alpha", port 3334, and
-you'd like to connect to an ODBC database called "mydb" as user "joe"
-with password "hello". When using DBD::ODBC directly, you'd do a
-
- $dbh = DBI->connect("DBI:ODBC:mydb", "joe", "hello");
-
-With DBD::Proxy this becomes
-
- $dsn = "DBI:Proxy:hostname=alpha;port=3334;dsn=DBI:ODBC:mydb";
- $dbh = DBI->connect($dsn, "joe", "hello");
-
-You see, this is mainly the same. The DBD::Proxy module will create a
-connection to the Proxy server on "alpha" which in turn will connect
-to the ODBC database.
-
-Refer to the L<DBI> documentation on the C<connect> method for a way
-to automatically use DBD::Proxy without having to change your code.
-
-DBD::Proxy's DSN string has the format
-
- $dsn = "DBI:Proxy:key1=val1; ... ;keyN=valN;dsn=valDSN";
-
-In other words, it is a collection of key/value pairs. The following
-keys are recognized:
-
-=over 4
-
-=item hostname
-
-=item port
-
-Hostname and port of the Proxy server; these keys must be present,
-no defaults. Example:
-
- hostname=alpha;port=3334
-
-=item dsn
-
-The value of this attribute will be used as a dsn name by the Proxy
-server. Thus it must have the format C<DBI:driver:...>, in particular
-it will contain colons. The I<dsn> value may contain semicolons, hence
-this key *must* be the last and it's value will be the complete
-remaining part of the dsn. Example:
-
- dsn=DBI:ODBC:mydb
-
-=item cipher
-
-=item key
-
-=item usercipher
-
-=item userkey
-
-By using these fields you can enable encryption. If you set,
-for example,
-
- cipher=$class;key=$key
-
-(note the semicolon) then DBD::Proxy will create a new cipher object
-by executing
-
- $cipherRef = $class->new(pack("H*", $key));
-
-and pass this object to the RPC::PlClient module when creating a
-client. See L<RPC::PlClient>. Example:
-
- cipher=IDEA;key=97cd2375efa329aceef2098babdc9721
-
-The usercipher/userkey attributes allow you to use two phase encryption:
-The cipher/key encryption will be used in the login and authorisation
-phase. Once the client is authorised, he will change to usercipher/userkey
-encryption. Thus the cipher/key pair is a B<host> based secret, typically
-less secure than the usercipher/userkey secret and readable by anyone.
-The usercipher/userkey secret is B<your> private secret.
-
-Of course encryption requires an appropriately configured server. See
-L<DBD::ProxyServer/CONFIGURATION FILE>.
-
-=item debug
-
-Turn on debugging mode
-
-=item stderr
-
-This attribute will set the corresponding attribute of the RPC::PlClient
-object, thus logging will not use syslog(), but redirected to stderr.
-This is the default under Windows.
-
- stderr=1
-
-=item logfile
-
-Similar to the stderr attribute, but output will be redirected to the
-given file.
-
- logfile=/dev/null
-
-=item RowCacheSize
-
-The DBD::Proxy driver supports this attribute (which is DBI standard,
-as of DBI 1.02). It's used to reduce network round-trips by fetching
-multiple rows in one go. The current default value is 20, but this may
-change.
-
-
-=item proxy_no_finish
-
-This attribute can be used to reduce network traffic: If the
-application is calling $sth->finish() then the proxy tells the server
-to finish the remote statement handle. Of course this slows down things
-quite a lot, but is perfectly good for reducing memory usage with
-persistent connections.
-
-However, if you set the I<proxy_no_finish> attribute to a TRUE value,
-either in the database handle or in the statement handle, then finish()
-calls will be suppressed. This is what you want, for example, in small
-and fast CGI applications.
-
-=item proxy_quote
-
-This attribute can be used to reduce network traffic: By default calls
-to $dbh->quote() are passed to the remote driver. Of course this slows
-down things quite a lot, but is the safest default behaviour.
-
-However, if you set the I<proxy_quote> attribute to the value 'C<local>'
-either in the database handle or in the statement handle, and the call
-to quote has only one parameter, then the local default DBI quote
-method will be used (which will be faster but may be wrong).
-
-=back
-
-=head1 KNOWN ISSUES
-
-=head2 Unproxied method calls
-
-If a method isn't being proxied, try declaring a stub sub in the appropriate
-package (DBD::Proxy::db for a dbh method, and DBD::Proxy::st for an sth method).
-For example:
-
- sub DBD::Proxy::db::selectall_arrayref;
-
-That will enable selectall_arrayref to be proxied.
-
-Currently many methods aren't explicitly proxied and so you get the DBI's
-default methods executed on the client.
-
-Some of those methods, like selectall_arrayref, may then call other methods
-that are proxied (selectall_arrayref calls fetchall_arrayref which calls fetch
-which is proxied). So things may appear to work but operate more slowly than
-the could.
-
-This may all change in a later version.
-
-=head2 Complex handle attributes
-
-Sometimes handles are having complex attributes like hash refs or
-array refs and not simple strings or integers. For example, with
-DBD::CSV, you would like to write something like
-
- $dbh->{"csv_tables"}->{"passwd"} =
- { "sep_char" => ":", "eol" => "\n";
-
-The above example would advice the CSV driver to assume the file
-"passwd" to be in the format of the /etc/passwd file: Colons as
-separators and a line feed without carriage return as line
-terminator.
-
-Surprisingly this example doesn't work with the proxy driver. To understand
-the reasons, you should consider the following: The Perl compiler is
-executing the above example in two steps:
-
-=over
-
-=item 1
-
-The first step is fetching the value of the key "csv_tables" in the
-handle $dbh. The value returned is complex, a hash ref.
-
-=item 2
-
-The second step is storing some value (the right hand side of the
-assignment) as the key "passwd" in the hash ref from step 1.
-
-=back
-
-This becomes a little bit clearer, if we rewrite the above code:
-
- $tables = $dbh->{"csv_tables"};
- $tables->{"passwd"} = { "sep_char" => ":", "eol" => "\n";
-
-While the examples work fine without the proxy, the fail due to a
-subtle difference in step 1: By DBI magic, the hash ref
-$dbh->{'csv_tables'} is returned from the server to the client.
-The client creates a local copy. This local copy is the result of
-step 1. In other words, step 2 modifies a local copy of the hash ref,
-but not the server's hash ref.
-
-The workaround is storing the modified local copy back to the server:
-
- $tables = $dbh->{"csv_tables"};
- $tables->{"passwd"} = { "sep_char" => ":", "eol" => "\n";
- $dbh->{"csv_tables"} = $tables;
-
-
-=head1 SECURITY WARNING
-
-L<RPC::PlClient> used underneath is not secure due to serializing and
-deserializing data with L<Storable> module. Use the proxy driver only in
-trusted environment.
-
-
-=head1 AUTHOR AND COPYRIGHT
-
-This module is Copyright (c) 1997, 1998
-
- Jochen Wiedmann
- Am Eisteich 9
- 72555 Metzingen
- Germany
-
- Email: joe@ispsoft.de
- Phone: +49 7123 14887
-
-The DBD::Proxy module is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself. In particular permission
-is granted to Tim Bunce for distributing this as a part of the DBI.
-
-
-=head1 SEE ALSO
-
-L<DBI>, L<RPC::PlClient>, L<Storable>
-
-=cut
+++ /dev/null
-use strict;
-{
- package DBD::Sponge;
-
- require DBI;
- require Carp;
-
- our @EXPORT = qw(); # Do NOT @EXPORT anything.
- our $VERSION = "12.010003";
-
-# $Id: Sponge.pm 10002 2007-09-26 21:03:25Z Tim $
-#
-# Copyright (c) 1994-2003 Tim Bunce Ireland
-#
-# You may distribute under the terms of either the GNU General Public
-# License or the Artistic License, as specified in the Perl README file.
-
- our $drh = undef; # holds driver handle once initialised
- my $methods_already_installed;
-
- sub driver{
- return $drh if $drh;
-
- DBD::Sponge::db->install_method("sponge_test_installed_method")
- unless $methods_already_installed++;
-
- my($class, $attr) = @_;
- $class .= "::dr";
- ($drh) = DBI::_new_drh($class, {
- 'Name' => 'Sponge',
- 'Version' => $VERSION,
- 'Attribution' => "DBD::Sponge $VERSION (fake cursor driver) by Tim Bunce",
- });
- $drh;
- }
-
- sub CLONE {
- undef $drh;
- }
-}
-
-
-{ package DBD::Sponge::dr; # ====== DRIVER ======
- our $imp_data_size = 0;
- # we use default (dummy) connect method
-}
-
-
-{ package DBD::Sponge::db; # ====== DATABASE ======
- our $imp_data_size = 0;
- use strict;
-
- sub prepare {
- my($dbh, $statement, $attribs) = @_;
- my $rows = delete $attribs->{'rows'}
- or return $dbh->set_err($DBI::stderr,"No rows attribute supplied to prepare");
- my ($outer, $sth) = DBI::_new_sth($dbh, {
- 'Statement' => $statement,
- 'rows' => $rows,
- (map { exists $attribs->{$_} ? ($_=>$attribs->{$_}) : () }
- qw(execute_hook)
- ),
- });
- if (my $behave_like = $attribs->{behave_like}) {
- $outer->{$_} = $behave_like->{$_}
- foreach (qw(RaiseError PrintError HandleError ShowErrorStatement));
- }
-
- if ($statement =~ /^\s*insert\b/) { # very basic, just for testing execute_array()
- $sth->{is_insert} = 1;
- my $NUM_OF_PARAMS = $attribs->{NUM_OF_PARAMS}
- or return $dbh->set_err($DBI::stderr,"NUM_OF_PARAMS not specified for INSERT statement");
- $sth->STORE('NUM_OF_PARAMS' => $attribs->{NUM_OF_PARAMS} );
- }
- else { #assume select
-
- # we need to set NUM_OF_FIELDS
- my $numFields;
- if ($attribs->{'NUM_OF_FIELDS'}) {
- $numFields = $attribs->{'NUM_OF_FIELDS'};
- } elsif ($attribs->{'NAME'}) {
- $numFields = @{$attribs->{NAME}};
- } elsif ($attribs->{'TYPE'}) {
- $numFields = @{$attribs->{TYPE}};
- } elsif (my $firstrow = $rows->[0]) {
- $numFields = scalar @$firstrow;
- } else {
- return $dbh->set_err($DBI::stderr, 'Cannot determine NUM_OF_FIELDS');
- }
- $sth->STORE('NUM_OF_FIELDS' => $numFields);
- $sth->{NAME} = $attribs->{NAME}
- || [ map { "col$_" } 1..$numFields ];
- $sth->{TYPE} = $attribs->{TYPE}
- || [ (DBI::SQL_VARCHAR()) x $numFields ];
- $sth->{PRECISION} = $attribs->{PRECISION}
- || [ map { length($sth->{NAME}->[$_]) } 0..$numFields -1 ];
- $sth->{SCALE} = $attribs->{SCALE}
- || [ (0) x $numFields ];
- $sth->{NULLABLE} = $attribs->{NULLABLE}
- || [ (2) x $numFields ];
- }
-
- $outer;
- }
-
- sub type_info_all {
- my ($dbh) = @_;
- my $ti = [
- { TYPE_NAME => 0,
- DATA_TYPE => 1,
- PRECISION => 2,
- LITERAL_PREFIX => 3,
- LITERAL_SUFFIX => 4,
- CREATE_PARAMS => 5,
- NULLABLE => 6,
- CASE_SENSITIVE => 7,
- SEARCHABLE => 8,
- UNSIGNED_ATTRIBUTE=> 9,
- MONEY => 10,
- AUTO_INCREMENT => 11,
- LOCAL_TYPE_NAME => 12,
- MINIMUM_SCALE => 13,
- MAXIMUM_SCALE => 14,
- },
- [ 'VARCHAR', DBI::SQL_VARCHAR(), undef, "'","'", undef, 0, 1, 1, 0, 0,0,undef,0,0 ],
- ];
- return $ti;
- }
-
- sub FETCH {
- my ($dbh, $attrib) = @_;
- # In reality this would interrogate the database engine to
- # either return dynamic values that cannot be precomputed
- # or fetch and cache attribute values too expensive to prefetch.
- return 1 if $attrib eq 'AutoCommit';
- # else pass up to DBI to handle
- return $dbh->SUPER::FETCH($attrib);
- }
-
- sub STORE {
- my ($dbh, $attrib, $value) = @_;
- # would normally validate and only store known attributes
- # else pass up to DBI to handle
- if ($attrib eq 'AutoCommit') {
- return 1 if $value; # is already set
- Carp::croak("Can't disable AutoCommit");
- }
- return $dbh->SUPER::STORE($attrib, $value);
- }
-
- sub sponge_test_installed_method {
- my ($dbh, @args) = @_;
- return $dbh->set_err(42, "not enough parameters") unless @args >= 2;
- return \@args;
- }
-}
-
-
-{ package DBD::Sponge::st; # ====== STATEMENT ======
- our $imp_data_size = 0;
- use strict;
-
- sub execute {
- my $sth = shift;
-
- # hack to support ParamValues (when not using bind_param)
- $sth->{ParamValues} = (@_) ? { map { $_ => $_[$_-1] } 1..@_ } : undef;
-
- if (my $hook = $sth->{execute_hook}) {
- &$hook($sth, @_) or return;
- }
-
- if ($sth->{is_insert}) {
- my $row;
- $row = (@_) ? [ @_ ] : die "bind_param not supported yet" ;
- my $NUM_OF_PARAMS = $sth->{NUM_OF_PARAMS};
- return $sth->set_err($DBI::stderr, @$row." values bound (@$row) but $NUM_OF_PARAMS expected")
- if @$row != $NUM_OF_PARAMS;
- { local $^W; $sth->trace_msg("inserting (@$row)\n"); }
- push @{ $sth->{rows} }, $row;
- }
- else { # mark select sth as Active
- $sth->STORE(Active => 1);
- }
- # else do nothing for select as data is already in $sth->{rows}
- return 1;
- }
-
- sub fetch {
- my ($sth) = @_;
- my $row = shift @{$sth->{'rows'}};
- unless ($row) {
- $sth->STORE(Active => 0);
- return undef;
- }
- return $sth->_set_fbav($row);
- }
- *fetchrow_arrayref = \&fetch;
-
- sub FETCH {
- my ($sth, $attrib) = @_;
- # would normally validate and only fetch known attributes
- # else pass up to DBI to handle
- return $sth->SUPER::FETCH($attrib);
- }
-
- sub STORE {
- my ($sth, $attrib, $value) = @_;
- # would normally validate and only store known attributes
- # else pass up to DBI to handle
- return $sth->SUPER::STORE($attrib, $value);
- }
-}
-
-1;
-
-__END__
-
-=pod
-
-=head1 NAME
-
-DBD::Sponge - Create a DBI statement handle from Perl data
-
-=head1 SYNOPSIS
-
- my $sponge = DBI->connect("dbi:Sponge:","","",{ RaiseError => 1 });
- my $sth = $sponge->prepare($statement, {
- rows => $data,
- NAME => $names,
- %attr
- }
- );
-
-=head1 DESCRIPTION
-
-DBD::Sponge is useful for making a Perl data structure accessible through a
-standard DBI statement handle. This may be useful to DBD module authors who
-need to transform data in this way.
-
-=head1 METHODS
-
-=head2 connect()
-
- my $sponge = DBI->connect("dbi:Sponge:","","",{ RaiseError => 1 });
-
-Here's a sample syntax for creating a database handle for the Sponge driver.
-No username and password are needed.
-
-=head2 prepare()
-
- my $sth = $sponge->prepare($statement, {
- rows => $data,
- NAME => $names,
- %attr
- }
- );
-
-=over 4
-
-=item *
-
-The C<$statement> here is an arbitrary statement or name you want
-to provide as identity of your data. If you're using DBI::Profile
-it will appear in the profile data.
-
-Generally it's expected that you are preparing a statement handle
-as if a C<select> statement happened.
-
-=item *
-
-C<$data> is a reference to the data you are providing, given as an array of arrays.
-
-=item *
-
-C<$names> is a reference an array of column names for the C<$data> you are providing.
-The number and order should match the number and ordering of the C<$data> columns.
-
-=item *
-
-C<%attr> is a hash of other standard DBI attributes that you might pass to a prepare statement.
-
-Currently only NAME, TYPE, and PRECISION are supported.
-
-=back
-
-=head1 BUGS
-
-Using this module to prepare INSERT-like statements is not currently documented.
-
-=head1 AUTHOR AND COPYRIGHT
-
-This module is Copyright (c) 2003 Tim Bunce
-
-Documentation initially written by Mark Stosberg
-
-The DBD::Sponge module is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself. In particular permission
-is granted to Tim Bunce for distributing this as a part of the DBI.
-
-=head1 SEE ALSO
-
-L<DBI>
-
-=cut
+++ /dev/null
-# $Id$
-# vim: ts=8:sw=4:et
-#
-# Copyright (c) 1994-2012 Tim Bunce Ireland
-#
-# See COPYRIGHT section in pod text below for usage and distribution rights.
-#
-
-package DBI;
-
-require 5.008_001;
-
-BEGIN {
-our $XS_VERSION = our $VERSION = "1.641"; # ==> ALSO update the version in the pod text below!
-$VERSION = eval $VERSION;
-}
-
-=head1 NAME
-
-DBI - Database independent interface for Perl
-
-=head1 SYNOPSIS
-
- use DBI;
-
- @driver_names = DBI->available_drivers;
- %drivers = DBI->installed_drivers;
- @data_sources = DBI->data_sources($driver_name, \%attr);
-
- $dbh = DBI->connect($data_source, $username, $auth, \%attr);
-
- $rv = $dbh->do($statement);
- $rv = $dbh->do($statement, \%attr);
- $rv = $dbh->do($statement, \%attr, @bind_values);
-
- $ary_ref = $dbh->selectall_arrayref($statement);
- $hash_ref = $dbh->selectall_hashref($statement, $key_field);
-
- $ary_ref = $dbh->selectcol_arrayref($statement);
- $ary_ref = $dbh->selectcol_arrayref($statement, \%attr);
-
- @row_ary = $dbh->selectrow_array($statement);
- $ary_ref = $dbh->selectrow_arrayref($statement);
- $hash_ref = $dbh->selectrow_hashref($statement);
-
- $sth = $dbh->prepare($statement);
- $sth = $dbh->prepare_cached($statement);
-
- $rc = $sth->bind_param($p_num, $bind_value);
- $rc = $sth->bind_param($p_num, $bind_value, $bind_type);
- $rc = $sth->bind_param($p_num, $bind_value, \%attr);
-
- $rv = $sth->execute;
- $rv = $sth->execute(@bind_values);
- $rv = $sth->execute_array(\%attr, ...);
-
- $rc = $sth->bind_col($col_num, \$col_variable);
- $rc = $sth->bind_columns(@list_of_refs_to_vars_to_bind);
-
- @row_ary = $sth->fetchrow_array;
- $ary_ref = $sth->fetchrow_arrayref;
- $hash_ref = $sth->fetchrow_hashref;
-
- $ary_ref = $sth->fetchall_arrayref;
- $ary_ref = $sth->fetchall_arrayref( $slice, $max_rows );
-
- $hash_ref = $sth->fetchall_hashref( $key_field );
-
- $rv = $sth->rows;
-
- $rc = $dbh->begin_work;
- $rc = $dbh->commit;
- $rc = $dbh->rollback;
-
- $quoted_string = $dbh->quote($string);
-
- $rc = $h->err;
- $str = $h->errstr;
- $rv = $h->state;
-
- $rc = $dbh->disconnect;
-
-I<The synopsis above only lists the major methods and parameters.>
-
-
-=head2 GETTING HELP
-
-=head3 General
-
-Before asking any questions, reread this document, consult the
-archives and read the DBI FAQ. The archives are listed
-at the end of this document and on the DBI home page L<http://dbi.perl.org/support/>
-
-You might also like to read the Advanced DBI Tutorial at
-L<http://www.slideshare.net/Tim.Bunce/dbi-advanced-tutorial-2007>
-
-To help you make the best use of the dbi-users mailing list,
-and any other lists or forums you may use, I recommend that you read
-"Getting Answers" by Mike Ash: L<http://mikeash.com/getting_answers.html>.
-
-=head3 Mailing Lists
-
-If you have questions about DBI, or DBD driver modules, you can get
-help from the I<dbi-users@perl.org> mailing list. This is the best way to get
-help. You don't have to subscribe to the list in order to post, though I'd
-recommend it. You can get help on subscribing and using the list by emailing
-I<dbi-users-help@perl.org>.
-
-Please note that Tim Bunce does not maintain the mailing lists or the
-web pages (generous volunteers do that). So please don't send mail
-directly to him; he just doesn't have the time to answer questions
-personally. The I<dbi-users> mailing list has lots of experienced
-people who should be able to help you if you need it. If you do email
-Tim he is very likely to just forward it to the mailing list.
-
-=head3 IRC
-
-DBI IRC Channel: #dbi on irc.perl.org (L<irc://irc.perl.org/#dbi>)
-
-=for html <a href="http://chat.mibbit.com/#dbi@irc.perl.org">(click for instant chatroom login)</a>
-
-=head3 Online
-
-StackOverflow has a DBI tag L<http://stackoverflow.com/questions/tagged/dbi>
-with over 800 questions.
-
-The DBI home page at L<http://dbi.perl.org/> and the DBI FAQ
-at L<http://faq.dbi-support.com/> may be worth a visit.
-They include links to other resources, but I<are rather out-dated>.
-
-=head3 Reporting a Bug
-
-If you think you've found a bug then please read
-"How to Report Bugs Effectively" by Simon Tatham:
-L<http://www.chiark.greenend.org.uk/~sgtatham/bugs.html>.
-
-If you think you've found a memory leak then read L</Memory Leaks>.
-
-Your problem is most likely related to the specific DBD driver module you're
-using. If that's the case then click on the 'Bugs' link on the L<http://metacpan.org>
-page for your driver. Only submit a bug report against the DBI itself if you're
-sure that your issue isn't related to the driver you're using.
-
-=head2 NOTES
-
-This is the DBI specification that corresponds to DBI version 1.641
-(see L<DBI::Changes> for details).
-
-The DBI is evolving at a steady pace, so it's good to check that
-you have the latest copy.
-
-The significant user-visible changes in each release are documented
-in the L<DBI::Changes> module so you can read them by executing
-C<perldoc DBI::Changes>.
-
-Some DBI changes require changes in the drivers, but the drivers
-can take some time to catch up. Newer versions of the DBI have
-added features that may not yet be supported by the drivers you
-use. Talk to the authors of your drivers if you need a new feature
-that is not yet supported.
-
-Features added after DBI 1.21 (February 2002) are marked in the
-text with the version number of the DBI release they first appeared in.
-
-Extensions to the DBI API often use the C<DBIx::*> namespace.
-See L</Naming Conventions and Name Space>. DBI extension modules
-can be found at L<https://metacpan.org/search?q=DBIx>. And all modules
-related to the DBI can be found at L<https://metacpan.org/search?q=DBI>.
-
-=cut
-
-# The POD text continues at the end of the file.
-
-use Scalar::Util ();
-use Carp();
-use DynaLoader ();
-use Exporter ();
-
-BEGIN {
-@ISA = qw(Exporter DynaLoader);
-
-# Make some utility functions available if asked for
-@EXPORT = (); # we export nothing by default
-@EXPORT_OK = qw(%DBI %DBI_methods hash); # also populated by export_ok_tags:
-%EXPORT_TAGS = (
- sql_types => [ qw(
- SQL_GUID
- SQL_WLONGVARCHAR
- SQL_WVARCHAR
- SQL_WCHAR
- SQL_BIGINT
- SQL_BIT
- SQL_TINYINT
- SQL_LONGVARBINARY
- SQL_VARBINARY
- SQL_BINARY
- SQL_LONGVARCHAR
- SQL_UNKNOWN_TYPE
- SQL_ALL_TYPES
- SQL_CHAR
- SQL_NUMERIC
- SQL_DECIMAL
- SQL_INTEGER
- SQL_SMALLINT
- SQL_FLOAT
- SQL_REAL
- SQL_DOUBLE
- SQL_DATETIME
- SQL_DATE
- SQL_INTERVAL
- SQL_TIME
- SQL_TIMESTAMP
- SQL_VARCHAR
- SQL_BOOLEAN
- SQL_UDT
- SQL_UDT_LOCATOR
- SQL_ROW
- SQL_REF
- SQL_BLOB
- SQL_BLOB_LOCATOR
- SQL_CLOB
- SQL_CLOB_LOCATOR
- SQL_ARRAY
- SQL_ARRAY_LOCATOR
- SQL_MULTISET
- SQL_MULTISET_LOCATOR
- SQL_TYPE_DATE
- SQL_TYPE_TIME
- SQL_TYPE_TIMESTAMP
- SQL_TYPE_TIME_WITH_TIMEZONE
- SQL_TYPE_TIMESTAMP_WITH_TIMEZONE
- SQL_INTERVAL_YEAR
- SQL_INTERVAL_MONTH
- SQL_INTERVAL_DAY
- SQL_INTERVAL_HOUR
- SQL_INTERVAL_MINUTE
- SQL_INTERVAL_SECOND
- SQL_INTERVAL_YEAR_TO_MONTH
- SQL_INTERVAL_DAY_TO_HOUR
- SQL_INTERVAL_DAY_TO_MINUTE
- SQL_INTERVAL_DAY_TO_SECOND
- SQL_INTERVAL_HOUR_TO_MINUTE
- SQL_INTERVAL_HOUR_TO_SECOND
- SQL_INTERVAL_MINUTE_TO_SECOND
- ) ],
- sql_cursor_types => [ qw(
- SQL_CURSOR_FORWARD_ONLY
- SQL_CURSOR_KEYSET_DRIVEN
- SQL_CURSOR_DYNAMIC
- SQL_CURSOR_STATIC
- SQL_CURSOR_TYPE_DEFAULT
- ) ], # for ODBC cursor types
- utils => [ qw(
- neat neat_list $neat_maxlen dump_results looks_like_number
- data_string_diff data_string_desc data_diff sql_type_cast
- DBIstcf_DISCARD_STRING
- DBIstcf_STRICT
- ) ],
- profile => [ qw(
- dbi_profile dbi_profile_merge dbi_profile_merge_nodes dbi_time
- ) ], # notionally "in" DBI::Profile and normally imported from there
-);
-
-$DBI::dbi_debug = 0; # mixture of bit fields and int sub-fields
-$DBI::neat_maxlen = 1000;
-$DBI::stderr = 2_000_000_000; # a very round number below 2**31
-
-# If you get an error here like "Can't find loadable object ..."
-# then you haven't installed the DBI correctly. Read the README
-# then install it again.
-if ( $ENV{DBI_PUREPERL} ) {
- eval { bootstrap DBI $XS_VERSION } if $ENV{DBI_PUREPERL} == 1;
- require DBI::PurePerl if $@ or $ENV{DBI_PUREPERL} >= 2;
- $DBI::PurePerl ||= 0; # just to silence "only used once" warnings
-}
-else {
- bootstrap DBI $XS_VERSION;
-}
-
-$EXPORT_TAGS{preparse_flags} = [ grep { /^DBIpp_\w\w_/ } keys %{__PACKAGE__."::"} ];
-
-Exporter::export_ok_tags(keys %EXPORT_TAGS);
-
-}
-
-# Alias some handle methods to also be DBI class methods
-for (qw(trace_msg set_err parse_trace_flag parse_trace_flags)) {
- no strict;
- *$_ = \&{"DBD::_::common::$_"};
-}
-
-use strict;
-
-DBI->trace(split /=/, $ENV{DBI_TRACE}, 2) if $ENV{DBI_TRACE};
-
-$DBI::connect_via ||= "connect";
-
-# check if user wants a persistent database connection ( Apache + mod_perl )
-if ($INC{'Apache/DBI.pm'} && $ENV{MOD_PERL}) {
- $DBI::connect_via = "Apache::DBI::connect";
- DBI->trace_msg("DBI connect via $DBI::connect_via in $INC{'Apache/DBI.pm'}\n");
-}
-
-%DBI::installed_drh = (); # maps driver names to installed driver handles
-sub installed_drivers { %DBI::installed_drh }
-%DBI::installed_methods = (); # XXX undocumented, may change
-sub installed_methods { %DBI::installed_methods }
-
-# Setup special DBI dynamic variables. See DBI::var::FETCH for details.
-# These are dynamically associated with the last handle used.
-tie $DBI::err, 'DBI::var', '*err'; # special case: referenced via IHA list
-tie $DBI::state, 'DBI::var', '"state'; # special case: referenced via IHA list
-tie $DBI::lasth, 'DBI::var', '!lasth'; # special case: return boolean
-tie $DBI::errstr, 'DBI::var', '&errstr'; # call &errstr in last used pkg
-tie $DBI::rows, 'DBI::var', '&rows'; # call &rows in last used pkg
-sub DBI::var::TIESCALAR{ my $var = $_[1]; bless \$var, 'DBI::var'; }
-sub DBI::var::STORE { Carp::croak("Can't modify \$DBI::${$_[0]} special variable") }
-
-# --- Driver Specific Prefix Registry ---
-
-my $dbd_prefix_registry = {
- ad_ => { class => 'DBD::AnyData', },
- ad2_ => { class => 'DBD::AnyData2', },
- ado_ => { class => 'DBD::ADO', },
- amzn_ => { class => 'DBD::Amazon', },
- best_ => { class => 'DBD::BestWins', },
- csv_ => { class => 'DBD::CSV', },
- cubrid_ => { class => 'DBD::cubrid', },
- db2_ => { class => 'DBD::DB2', },
- dbi_ => { class => 'DBI', },
- dbm_ => { class => 'DBD::DBM', },
- df_ => { class => 'DBD::DF', },
- examplep_ => { class => 'DBD::ExampleP', },
- f_ => { class => 'DBD::File', },
- file_ => { class => 'DBD::TextFile', },
- go_ => { class => 'DBD::Gofer', },
- ib_ => { class => 'DBD::InterBase', },
- ing_ => { class => 'DBD::Ingres', },
- ix_ => { class => 'DBD::Informix', },
- jdbc_ => { class => 'DBD::JDBC', },
- mariadb_ => { class => 'DBD::MariaDB', },
- mem_ => { class => 'DBD::Mem', },
- mo_ => { class => 'DBD::MO', },
- monetdb_ => { class => 'DBD::monetdb', },
- msql_ => { class => 'DBD::mSQL', },
- mvsftp_ => { class => 'DBD::MVS_FTPSQL', },
- mysql_ => { class => 'DBD::mysql', },
- multi_ => { class => 'DBD::Multi' },
- mx_ => { class => 'DBD::Multiplex', },
- neo_ => { class => 'DBD::Neo4p', },
- nullp_ => { class => 'DBD::NullP', },
- odbc_ => { class => 'DBD::ODBC', },
- ora_ => { class => 'DBD::Oracle', },
- pg_ => { class => 'DBD::Pg', },
- pgpp_ => { class => 'DBD::PgPP', },
- plb_ => { class => 'DBD::Plibdata', },
- po_ => { class => 'DBD::PO', },
- proxy_ => { class => 'DBD::Proxy', },
- ram_ => { class => 'DBD::RAM', },
- rdb_ => { class => 'DBD::RDB', },
- sapdb_ => { class => 'DBD::SAP_DB', },
- snmp_ => { class => 'DBD::SNMP', },
- solid_ => { class => 'DBD::Solid', },
- spatialite_ => { class => 'DBD::Spatialite', },
- sponge_ => { class => 'DBD::Sponge', },
- sql_ => { class => 'DBI::DBD::SqlEngine', },
- sqlite_ => { class => 'DBD::SQLite', },
- syb_ => { class => 'DBD::Sybase', },
- sys_ => { class => 'DBD::Sys', },
- tdat_ => { class => 'DBD::Teradata', },
- tmpl_ => { class => 'DBD::Template', },
- tmplss_ => { class => 'DBD::TemplateSS', },
- tree_ => { class => 'DBD::TreeData', },
- tuber_ => { class => 'DBD::Tuber', },
- uni_ => { class => 'DBD::Unify', },
- vt_ => { class => 'DBD::Vt', },
- wmi_ => { class => 'DBD::WMI', },
- x_ => { }, # for private use
- xbase_ => { class => 'DBD::XBase', },
- xmlsimple_ => { class => 'DBD::XMLSimple', },
- xl_ => { class => 'DBD::Excel', },
- yaswi_ => { class => 'DBD::Yaswi', },
-};
-
-my %dbd_class_registry = map { $dbd_prefix_registry->{$_}->{class} => { prefix => $_ } }
- grep { exists $dbd_prefix_registry->{$_}->{class} }
- keys %{$dbd_prefix_registry};
-
-sub dump_dbd_registry {
- require Data::Dumper;
- local $Data::Dumper::Sortkeys=1;
- local $Data::Dumper::Indent=1;
- print Data::Dumper->Dump([$dbd_prefix_registry], [qw($dbd_prefix_registry)]);
-}
-
-# --- Dynamically create the DBI Standard Interface
-
-my $keeperr = { O=>0x0004 };
-
-%DBI::DBI_methods = ( # Define the DBI interface methods per class:
-
- common => { # Interface methods common to all DBI handle classes
- 'DESTROY' => { O=>0x004|0x10000 },
- 'CLEAR' => $keeperr,
- 'EXISTS' => $keeperr,
- 'FETCH' => { O=>0x0404 },
- 'FETCH_many' => { O=>0x0404 },
- 'FIRSTKEY' => $keeperr,
- 'NEXTKEY' => $keeperr,
- 'STORE' => { O=>0x0418 | 0x4 },
- 'DELETE' => { O=>0x0404 },
- can => { O=>0x0100 }, # special case, see dispatch
- debug => { U =>[1,2,'[$debug_level]'], O=>0x0004 }, # old name for trace
- dump_handle => { U =>[1,3,'[$message [, $level]]'], O=>0x0004 },
- err => $keeperr,
- errstr => $keeperr,
- state => $keeperr,
- func => { O=>0x0006 },
- parse_trace_flag => { U =>[2,2,'$name'], O=>0x0404, T=>8 },
- parse_trace_flags => { U =>[2,2,'$flags'], O=>0x0404, T=>8 },
- private_data => { U =>[1,1], O=>0x0004 },
- set_err => { U =>[3,6,'$err, $errmsg [, $state, $method, $rv]'], O=>0x0010 },
- trace => { U =>[1,3,'[$trace_level, [$filename]]'], O=>0x0004 },
- trace_msg => { U =>[2,3,'$message_text [, $min_level ]' ], O=>0x0004, T=>8 },
- swap_inner_handle => { U =>[2,3,'$h [, $allow_reparent ]'] },
- private_attribute_info => { },
- visit_child_handles => { U => [2,3,'$coderef [, $info ]'], O=>0x0404, T=>4 },
- },
- dr => { # Database Driver Interface
- 'connect' => { U =>[1,5,'[$db [,$user [,$passwd [,\%attr]]]]'], H=>3, O=>0x8000, T=>0x200 },
- 'connect_cached'=>{U=>[1,5,'[$db [,$user [,$passwd [,\%attr]]]]'], H=>3, O=>0x8000, T=>0x200 },
- 'disconnect_all'=>{ U =>[1,1], O=>0x0800, T=>0x200 },
- data_sources => { U =>[1,2,'[\%attr]' ], O=>0x0800, T=>0x200 },
- default_user => { U =>[3,4,'$user, $pass [, \%attr]' ], T=>0x200 },
- dbixs_revision => $keeperr,
- },
- db => { # Database Session Class Interface
- data_sources => { U =>[1,2,'[\%attr]' ], O=>0x0200 },
- take_imp_data => { U =>[1,1], O=>0x10000 },
- clone => { U =>[1,2,'[\%attr]'], T=>0x200 },
- connected => { U =>[1,0], O => 0x0004, T=>0x200, H=>3 },
- begin_work => { U =>[1,2,'[ \%attr ]'], O=>0x0400, T=>0x1000 },
- commit => { U =>[1,1], O=>0x0480|0x0800, T=>0x1000 },
- rollback => { U =>[1,1], O=>0x0480|0x0800, T=>0x1000 },
- 'do' => { U =>[2,0,'$statement [, \%attr [, @bind_params ] ]'], O=>0x3200 },
- last_insert_id => { U =>[5,6,'$catalog, $schema, $table_name, $field_name [, \%attr ]'], O=>0x2800 },
- preparse => { }, # XXX
- prepare => { U =>[2,3,'$statement [, \%attr]'], O=>0xA200 },
- prepare_cached => { U =>[2,4,'$statement [, \%attr [, $if_active ] ]'], O=>0xA200 },
- selectrow_array => { U =>[2,0,'$statement [, \%attr [, @bind_params ] ]'], O=>0x2000 },
- selectrow_arrayref=>{U =>[2,0,'$statement [, \%attr [, @bind_params ] ]'], O=>0x2000 },
- selectrow_hashref=>{ U =>[2,0,'$statement [, \%attr [, @bind_params ] ]'], O=>0x2000 },
- selectall_arrayref=>{U =>[2,0,'$statement [, \%attr [, @bind_params ] ]'], O=>0x2000 },
- selectall_array =>{U =>[2,0,'$statement [, \%attr [, @bind_params ] ]'], O=>0x2000 },
- selectall_hashref=>{ U =>[3,0,'$statement, $keyfield [, \%attr [, @bind_params ] ]'], O=>0x2000 },
- selectcol_arrayref=>{U =>[2,0,'$statement [, \%attr [, @bind_params ] ]'], O=>0x2000 },
- ping => { U =>[1,1], O=>0x0404 },
- disconnect => { U =>[1,1], O=>0x0400|0x0800|0x10000, T=>0x200 },
- quote => { U =>[2,3, '$string [, $data_type ]' ], O=>0x0430, T=>2 },
- quote_identifier=> { U =>[2,6, '$name [, ...] [, \%attr ]' ], O=>0x0430, T=>2 },
- rows => $keeperr,
-
- tables => { U =>[1,6,'$catalog, $schema, $table, $type [, \%attr ]' ], O=>0x2200 },
- table_info => { U =>[1,6,'$catalog, $schema, $table, $type [, \%attr ]' ], O=>0x2200|0x8800 },
- column_info => { U =>[5,6,'$catalog, $schema, $table, $column [, \%attr ]'],O=>0x2200|0x8800 },
- primary_key_info=> { U =>[4,5,'$catalog, $schema, $table [, \%attr ]' ], O=>0x2200|0x8800 },
- primary_key => { U =>[4,5,'$catalog, $schema, $table [, \%attr ]' ], O=>0x2200 },
- foreign_key_info=> { U =>[7,8,'$pk_catalog, $pk_schema, $pk_table, $fk_catalog, $fk_schema, $fk_table [, \%attr ]' ], O=>0x2200|0x8800 },
- statistics_info => { U =>[6,7,'$catalog, $schema, $table, $unique_only, $quick, [, \%attr ]' ], O=>0x2200|0x8800 },
- type_info_all => { U =>[1,1], O=>0x2200|0x0800 },
- type_info => { U =>[1,2,'$data_type'], O=>0x2200 },
- get_info => { U =>[2,2,'$info_type'], O=>0x2200|0x0800 },
- },
- st => { # Statement Class Interface
- bind_col => { U =>[3,4,'$column, \\$var [, \%attr]'] },
- bind_columns => { U =>[2,0,'\\$var1 [, \\$var2, ...]'] },
- bind_param => { U =>[3,4,'$parameter, $var [, \%attr]'] },
- bind_param_inout=> { U =>[4,5,'$parameter, \\$var, $maxlen, [, \%attr]'] },
- execute => { U =>[1,0,'[@args]'], O=>0x1040 },
-
- bind_param_array => { U =>[3,4,'$parameter, $var [, \%attr]'] },
- bind_param_inout_array => { U =>[4,5,'$parameter, \\@var, $maxlen, [, \%attr]'] },
- execute_array => { U =>[2,0,'\\%attribs [, @args]'], O=>0x1040|0x4000 },
- execute_for_fetch => { U =>[2,3,'$fetch_sub [, $tuple_status]'], O=>0x1040|0x4000 },
-
- fetch => undef, # alias for fetchrow_arrayref
- fetchrow_arrayref => undef,
- fetchrow_hashref => undef,
- fetchrow_array => undef,
- fetchrow => undef, # old alias for fetchrow_array
-
- fetchall_arrayref => { U =>[1,3, '[ $slice [, $max_rows]]'] },
- fetchall_hashref => { U =>[2,2,'$key_field'] },
-
- blob_read => { U =>[4,5,'$field, $offset, $len [, \\$buf [, $bufoffset]]'] },
- blob_copy_to_file => { U =>[3,3,'$field, $filename_or_handleref'] },
- dump_results => { U =>[1,5,'$maxfieldlen, $linesep, $fieldsep, $filehandle'] },
- more_results => { U =>[1,1] },
- finish => { U =>[1,1] },
- cancel => { U =>[1,1], O=>0x0800 },
- rows => $keeperr,
-
- _get_fbav => undef,
- _set_fbav => { T=>6 },
- },
-);
-
-while ( my ($class, $meths) = each %DBI::DBI_methods ) {
- my $ima_trace = 0+($ENV{DBI_IMA_TRACE}||0);
- while ( my ($method, $info) = each %$meths ) {
- my $fullmeth = "DBI::${class}::$method";
- if (($DBI::dbi_debug & 0xF) == 15) { # quick hack to list DBI methods
- # and optionally filter by IMA flags
- my $O = $info->{O}||0;
- printf "0x%04x %-20s\n", $O, $fullmeth
- unless $ima_trace && !($O & $ima_trace);
- }
- DBI->_install_method($fullmeth, 'DBI.pm', $info);
- }
-}
-
-{
- package DBI::common;
- @DBI::dr::ISA = ('DBI::common');
- @DBI::db::ISA = ('DBI::common');
- @DBI::st::ISA = ('DBI::common');
-}
-
-# End of init code
-
-END {
- return unless defined &DBI::trace_msg; # return unless bootstrap'd ok
- local ($!,$?);
- DBI->trace_msg(sprintf(" -- DBI::END (\$\@: %s, \$!: %s)\n", $@||'', $!||''), 2);
- # Let drivers know why we are calling disconnect_all:
- $DBI::PERL_ENDING = $DBI::PERL_ENDING = 1; # avoid typo warning
- DBI->disconnect_all() if %DBI::installed_drh;
-}
-
-
-sub CLONE {
- _clone_dbis() unless $DBI::PurePerl; # clone the DBIS structure
- DBI->trace_msg("CLONE DBI for new thread\n");
- while ( my ($driver, $drh) = each %DBI::installed_drh) {
- no strict 'refs';
- next if defined &{"DBD::${driver}::CLONE"};
- warn("$driver has no driver CLONE() function so is unsafe threaded\n");
- }
- %DBI::installed_drh = (); # clear loaded drivers so they have a chance to reinitialize
-}
-
-sub parse_dsn {
- my ($class, $dsn) = @_;
- $dsn =~ s/^(dbi):(\w*?)(?:\((.*?)\))?://i or return;
- my ($scheme, $driver, $attr, $attr_hash) = (lc($1), $2, $3);
- $driver ||= $ENV{DBI_DRIVER} || '';
- $attr_hash = { split /\s*=>?\s*|\s*,\s*/, $attr, -1 } if $attr;
- return ($scheme, $driver, $attr, $attr_hash, $dsn);
-}
-
-sub visit_handles {
- my ($class, $code, $outer_info) = @_;
- $outer_info = {} if not defined $outer_info;
- my %drh = DBI->installed_drivers;
- for my $h (values %drh) {
- my $child_info = $code->($h, $outer_info)
- or next;
- $h->visit_child_handles($code, $child_info);
- }
- return $outer_info;
-}
-
-
-# --- The DBI->connect Front Door methods
-
-sub connect_cached {
- # For library code using connect_cached() with mod_perl
- # we redirect those calls to Apache::DBI::connect() as well
- my ($class, $dsn, $user, $pass, $attr) = @_;
- my $dbi_connect_method = ($DBI::connect_via eq "Apache::DBI::connect")
- ? 'Apache::DBI::connect' : 'connect_cached';
- $attr = {
- $attr ? %$attr : (), # clone, don't modify callers data
- dbi_connect_method => $dbi_connect_method,
- };
- return $class->connect($dsn, $user, $pass, $attr);
-}
-
-sub connect {
- my $class = shift;
- my ($dsn, $user, $pass, $attr, $old_driver) = my @orig_args = @_;
- my $driver;
-
- if ($attr and !ref($attr)) { # switch $old_driver<->$attr if called in old style
- Carp::carp("DBI->connect using 'old-style' syntax is deprecated and will be an error in future versions");
- ($old_driver, $attr) = ($attr, $old_driver);
- }
-
- my $connect_meth = $attr->{dbi_connect_method};
- $connect_meth ||= $DBI::connect_via; # fallback to default
-
- $dsn ||= $ENV{DBI_DSN} || $ENV{DBI_DBNAME} || '' unless $old_driver;
-
- if ($DBI::dbi_debug) {
- local $^W = 0;
- pop @_ if $connect_meth ne 'connect';
- my @args = @_; $args[2] = '****'; # hide password
- DBI->trace_msg(" -> $class->$connect_meth(".join(", ",@args).")\n");
- }
- Carp::croak('Usage: $class->connect([$dsn [,$user [,$passwd [,\%attr]]]])')
- if (ref $old_driver or ($attr and not ref $attr) or
- (ref $pass and not defined Scalar::Util::blessed($pass)));
-
- # extract dbi:driver prefix from $dsn into $1
- $dsn =~ s/^dbi:(\w*?)(?:\((.*?)\))?://i
- or '' =~ /()/; # ensure $1 etc are empty if match fails
- my $driver_attrib_spec = $2 || '';
-
- # Set $driver. Old style driver, if specified, overrides new dsn style.
- $driver = $old_driver || $1 || $ENV{DBI_DRIVER}
- or Carp::croak("Can't connect to data source '$dsn' "
- ."because I can't work out what driver to use "
- ."(it doesn't seem to contain a 'dbi:driver:' prefix "
- ."and the DBI_DRIVER env var is not set)");
-
- my $proxy;
- if ($ENV{DBI_AUTOPROXY} && $driver ne 'Proxy' && $driver ne 'Sponge' && $driver ne 'Switch') {
- my $dbi_autoproxy = $ENV{DBI_AUTOPROXY};
- $proxy = 'Proxy';
- if ($dbi_autoproxy =~ s/^dbi:(\w*?)(?:\((.*?)\))?://i) {
- $proxy = $1;
- $driver_attrib_spec = join ",",
- ($driver_attrib_spec) ? $driver_attrib_spec : (),
- ($2 ) ? $2 : ();
- }
- $dsn = "$dbi_autoproxy;dsn=dbi:$driver:$dsn";
- $driver = $proxy;
- DBI->trace_msg(" DBI_AUTOPROXY: dbi:$driver($driver_attrib_spec):$dsn\n");
- }
- # avoid recursion if proxy calls DBI->connect itself
- local $ENV{DBI_AUTOPROXY} if $ENV{DBI_AUTOPROXY};
-
- my %attributes; # take a copy we can delete from
- if ($old_driver) {
- %attributes = %$attr if $attr;
- }
- else { # new-style connect so new default semantics
- %attributes = (
- PrintError => 1,
- AutoCommit => 1,
- ref $attr ? %$attr : (),
- # attributes in DSN take precedence over \%attr connect parameter
- $driver_attrib_spec ? (split /\s*=>?\s*|\s*,\s*/, $driver_attrib_spec, -1) : (),
- );
- }
- $attr = \%attributes; # now set $attr to refer to our local copy
-
- my $drh = $DBI::installed_drh{$driver} || $class->install_driver($driver)
- or die "panic: $class->install_driver($driver) failed";
-
- # attributes in DSN take precedence over \%attr connect parameter
- $user = $attr->{Username} if defined $attr->{Username};
- $pass = $attr->{Password} if defined $attr->{Password};
- delete $attr->{Password}; # always delete Password as closure stores it securely
- if ( !(defined $user && defined $pass) ) {
- ($user, $pass) = $drh->default_user($user, $pass, $attr);
- }
- $attr->{Username} = $user; # force the Username to be the actual one used
-
- my $connect_closure = sub {
- my ($old_dbh, $override_attr) = @_;
-
- #use Data::Dumper;
- #warn "connect_closure: ".Data::Dumper::Dumper([$attr,\%attributes, $override_attr]);
-
- my $dbh;
- unless ($dbh = $drh->$connect_meth($dsn, $user, $pass, $attr)) {
- $user = '' if !defined $user;
- $dsn = '' if !defined $dsn;
- # $drh->errstr isn't safe here because $dbh->DESTROY may not have
- # been called yet and so the dbh errstr would not have been copied
- # up to the drh errstr. Certainly true for connect_cached!
- my $errstr = $DBI::errstr;
- # Getting '(no error string)' here is a symptom of a ref loop
- $errstr = '(no error string)' if !defined $errstr;
- my $msg = "$class connect('$dsn','$user',...) failed: $errstr";
- DBI->trace_msg(" $msg\n");
- # XXX HandleWarn
- unless ($attr->{HandleError} && $attr->{HandleError}->($msg, $drh, $dbh)) {
- Carp::croak($msg) if $attr->{RaiseError};
- Carp::carp ($msg) if $attr->{PrintError};
- }
- $! = 0; # for the daft people who do DBI->connect(...) || die "$!";
- return $dbh; # normally undef, but HandleError could change it
- }
-
- # merge any attribute overrides but don't change $attr itself (for closure)
- my $apply = { ($override_attr) ? (%$attr, %$override_attr ) : %$attr };
-
- # handle basic RootClass subclassing:
- my $rebless_class = $apply->{RootClass} || ($class ne 'DBI' ? $class : '');
- if ($rebless_class) {
- no strict 'refs';
- if ($apply->{RootClass}) { # explicit attribute (ie not static method call class)
- delete $apply->{RootClass};
- DBI::_load_class($rebless_class, 0);
- }
- unless (@{"$rebless_class\::db::ISA"} && @{"$rebless_class\::st::ISA"}) {
- Carp::carp("DBI subclasses '$rebless_class\::db' and ::st are not setup, RootClass ignored");
- $rebless_class = undef;
- $class = 'DBI';
- }
- else {
- $dbh->{RootClass} = $rebless_class; # $dbh->STORE called via plain DBI::db
- DBI::_set_isa([$rebless_class], 'DBI'); # sets up both '::db' and '::st'
- DBI::_rebless($dbh, $rebless_class); # appends '::db'
- }
- }
-
- if (%$apply) {
-
- if ($apply->{DbTypeSubclass}) {
- my $DbTypeSubclass = delete $apply->{DbTypeSubclass};
- DBI::_rebless_dbtype_subclass($dbh, $rebless_class||$class, $DbTypeSubclass);
- }
- my $a;
- foreach $a (qw(Profile RaiseError PrintError AutoCommit)) { # do these first
- next unless exists $apply->{$a};
- $dbh->{$a} = delete $apply->{$a};
- }
- while ( my ($a, $v) = each %$apply) {
- eval { $dbh->{$a} = $v }; # assign in void context to avoid re-FETCH
- warn $@ if $@;
- }
- }
-
- # confirm to driver (ie if subclassed) that we've connected successfully
- # and finished the attribute setup. pass in the original arguments
- $dbh->connected(@orig_args); #if ref $dbh ne 'DBI::db' or $proxy;
-
- DBI->trace_msg(" <- connect= $dbh\n") if $DBI::dbi_debug & 0xF;
-
- return $dbh;
- };
-
- my $dbh = &$connect_closure(undef, undef);
-
- $dbh->{dbi_connect_closure} = $connect_closure if $dbh;
-
- return $dbh;
-}
-
-
-sub disconnect_all {
- keys %DBI::installed_drh; # reset iterator
- while ( my ($name, $drh) = each %DBI::installed_drh ) {
- $drh->disconnect_all() if ref $drh;
- }
-}
-
-
-sub disconnect { # a regular beginners bug
- Carp::croak("DBI->disconnect is not a DBI method (read the DBI manual)");
-}
-
-
-sub install_driver { # croaks on failure
- my $class = shift;
- my($driver, $attr) = @_;
- my $drh;
-
- $driver ||= $ENV{DBI_DRIVER} || '';
-
- # allow driver to be specified as a 'dbi:driver:' string
- $driver = $1 if $driver =~ s/^DBI:(.*?)://i;
-
- Carp::croak("usage: $class->install_driver(\$driver [, \%attr])")
- unless ($driver and @_<=3);
-
- # already installed
- return $drh if $drh = $DBI::installed_drh{$driver};
-
- $class->trace_msg(" -> $class->install_driver($driver"
- .") for $^O perl=$] pid=$$ ruid=$< euid=$>\n")
- if $DBI::dbi_debug & 0xF;
-
- # --- load the code
- my $driver_class = "DBD::$driver";
- eval qq{package # hide from PAUSE
- DBI::_firesafe; # just in case
- require $driver_class; # load the driver
- };
- if ($@) {
- my $err = $@;
- my $advice = "";
- if ($err =~ /Can't find loadable object/) {
- $advice = "Perhaps DBD::$driver was statically linked into a new perl binary."
- ."\nIn which case you need to use that new perl binary."
- ."\nOr perhaps only the .pm file was installed but not the shared object file."
- }
- elsif ($err =~ /Can't locate.*?DBD\/$driver\.pm in \@INC/) {
- my @drv = $class->available_drivers(1);
- $advice = "Perhaps the DBD::$driver perl module hasn't been fully installed,\n"
- ."or perhaps the capitalisation of '$driver' isn't right.\n"
- ."Available drivers: ".join(", ", @drv).".";
- }
- elsif ($err =~ /Can't load .*? for module DBD::/) {
- $advice = "Perhaps a required shared library or dll isn't installed where expected";
- }
- elsif ($err =~ /Can't locate .*? in \@INC/) {
- $advice = "Perhaps a module that DBD::$driver requires hasn't been fully installed";
- }
- Carp::croak("install_driver($driver) failed: $err$advice\n");
- }
- if ($DBI::dbi_debug & 0xF) {
- no strict 'refs';
- (my $driver_file = $driver_class) =~ s/::/\//g;
- my $dbd_ver = ${"$driver_class\::VERSION"} || "undef";
- $class->trace_msg(" install_driver: $driver_class version $dbd_ver"
- ." loaded from $INC{qq($driver_file.pm)}\n");
- }
-
- # --- do some behind-the-scenes checks and setups on the driver
- $class->setup_driver($driver_class);
-
- # --- run the driver function
- $drh = eval { $driver_class->driver($attr || {}) };
- unless ($drh && ref $drh && !$@) {
- my $advice = "";
- $@ ||= "$driver_class->driver didn't return a handle";
- # catch people on case in-sensitive systems using the wrong case
- $advice = "\nPerhaps the capitalisation of DBD '$driver' isn't right."
- if $@ =~ /locate object method/;
- Carp::croak("$driver_class initialisation failed: $@$advice");
- }
-
- $DBI::installed_drh{$driver} = $drh;
- $class->trace_msg(" <- install_driver= $drh\n") if $DBI::dbi_debug & 0xF;
- $drh;
-}
-
-*driver = \&install_driver; # currently an alias, may change
-
-
-sub setup_driver {
- my ($class, $driver_class) = @_;
- my $h_type;
- foreach $h_type (qw(dr db st)){
- my $h_class = $driver_class."::$h_type";
- no strict 'refs';
- push @{"${h_class}::ISA"}, "DBD::_::$h_type"
- unless UNIVERSAL::isa($h_class, "DBD::_::$h_type");
- # The _mem class stuff is (IIRC) a crufty hack for global destruction
- # timing issues in early versions of perl5 and possibly no longer needed.
- my $mem_class = "DBD::_mem::$h_type";
- push @{"${h_class}_mem::ISA"}, $mem_class
- unless UNIVERSAL::isa("${h_class}_mem", $mem_class)
- or $DBI::PurePerl;
- }
-}
-
-
-sub _rebless {
- my $dbh = shift;
- my ($outer, $inner) = DBI::_handles($dbh);
- my $class = shift(@_).'::db';
- bless $inner => $class;
- bless $outer => $class; # outer last for return
-}
-
-
-sub _set_isa {
- my ($classes, $topclass) = @_;
- my $trace = DBI->trace_msg(" _set_isa([@$classes])\n");
- foreach my $suffix ('::db','::st') {
- my $previous = $topclass || 'DBI'; # trees are rooted here
- foreach my $class (@$classes) {
- my $base_class = $previous.$suffix;
- my $sub_class = $class.$suffix;
- my $sub_class_isa = "${sub_class}::ISA";
- no strict 'refs';
- if (@$sub_class_isa) {
- DBI->trace_msg(" $sub_class_isa skipped (already set to @$sub_class_isa)\n")
- if $trace;
- }
- else {
- @$sub_class_isa = ($base_class) unless @$sub_class_isa;
- DBI->trace_msg(" $sub_class_isa = $base_class\n")
- if $trace;
- }
- $previous = $class;
- }
- }
-}
-
-
-sub _rebless_dbtype_subclass {
- my ($dbh, $rootclass, $DbTypeSubclass) = @_;
- # determine the db type names for class hierarchy
- my @hierarchy = DBI::_dbtype_names($dbh, $DbTypeSubclass);
- # add the rootclass prefix to each ('DBI::' or 'MyDBI::' etc)
- $_ = $rootclass.'::'.$_ foreach (@hierarchy);
- # load the modules from the 'top down'
- DBI::_load_class($_, 1) foreach (reverse @hierarchy);
- # setup class hierarchy if needed, does both '::db' and '::st'
- DBI::_set_isa(\@hierarchy, $rootclass);
- # finally bless the handle into the subclass
- DBI::_rebless($dbh, $hierarchy[0]);
-}
-
-
-sub _dbtype_names { # list dbtypes for hierarchy, ie Informix=>ADO=>ODBC
- my ($dbh, $DbTypeSubclass) = @_;
-
- if ($DbTypeSubclass && $DbTypeSubclass ne '1' && ref $DbTypeSubclass ne 'CODE') {
- # treat $DbTypeSubclass as a comma separated list of names
- my @dbtypes = split /\s*,\s*/, $DbTypeSubclass;
- $dbh->trace_msg(" DbTypeSubclass($DbTypeSubclass)=@dbtypes (explicit)\n");
- return @dbtypes;
- }
-
- # XXX will call $dbh->get_info(17) (=SQL_DBMS_NAME) in future?
-
- my $driver = $dbh->{Driver}->{Name};
- if ( $driver eq 'Proxy' ) {
- # XXX Looking into the internals of DBD::Proxy is questionable!
- ($driver) = $dbh->{proxy_client}->{application} =~ /^DBI:(.+?):/i
- or die "Can't determine driver name from proxy";
- }
-
- my @dbtypes = (ucfirst($driver));
- if ($driver eq 'ODBC' || $driver eq 'ADO') {
- # XXX will move these out and make extensible later:
- my $_dbtype_name_regexp = 'Oracle'; # eg 'Oracle|Foo|Bar'
- my %_dbtype_name_map = (
- 'Microsoft SQL Server' => 'MSSQL',
- 'SQL Server' => 'Sybase',
- 'Adaptive Server Anywhere' => 'ASAny',
- 'ADABAS D' => 'AdabasD',
- );
-
- my $name;
- $name = $dbh->func(17, 'GetInfo') # SQL_DBMS_NAME
- if $driver eq 'ODBC';
- $name = $dbh->{ado_conn}->Properties->Item('DBMS Name')->Value
- if $driver eq 'ADO';
- die "Can't determine driver name! ($DBI::errstr)\n"
- unless $name;
-
- my $dbtype;
- if ($_dbtype_name_map{$name}) {
- $dbtype = $_dbtype_name_map{$name};
- }
- else {
- if ($name =~ /($_dbtype_name_regexp)/) {
- $dbtype = lc($1);
- }
- else { # generic mangling for other names:
- $dbtype = lc($name);
- }
- $dbtype =~ s/\b(\w)/\U$1/g;
- $dbtype =~ s/\W+/_/g;
- }
- # add ODBC 'behind' ADO
- push @dbtypes, 'ODBC' if $driver eq 'ADO';
- # add discovered dbtype in front of ADO/ODBC
- unshift @dbtypes, $dbtype;
- }
- @dbtypes = &$DbTypeSubclass($dbh, \@dbtypes)
- if (ref $DbTypeSubclass eq 'CODE');
- $dbh->trace_msg(" DbTypeSubclass($DbTypeSubclass)=@dbtypes\n");
- return @dbtypes;
-}
-
-sub _load_class {
- my ($load_class, $missing_ok) = @_;
- DBI->trace_msg(" _load_class($load_class, $missing_ok)\n", 2);
- no strict 'refs';
- return 1 if @{"$load_class\::ISA"}; # already loaded/exists
- (my $module = $load_class) =~ s!::!/!g;
- DBI->trace_msg(" _load_class require $module\n", 2);
- eval { require "$module.pm"; };
- return 1 unless $@;
- return 0 if $missing_ok && $@ =~ /^Can't locate \Q$module.pm\E/;
- die $@;
-}
-
-
-sub init_rootclass { # deprecated
- return 1;
-}
-
-
-*internal = \&DBD::Switch::dr::driver;
-
-sub driver_prefix {
- my ($class, $driver) = @_;
- return $dbd_class_registry{$driver}->{prefix} if exists $dbd_class_registry{$driver};
- return;
-}
-
-sub available_drivers {
- my($quiet) = @_;
- my(@drivers, $d, $f);
- local(*DBI::DIR, $@);
- my(%seen_dir, %seen_dbd);
- my $haveFileSpec = eval { require File::Spec };
- foreach $d (@INC){
- chomp($d); # Perl 5 beta 3 bug in #!./perl -Ilib from Test::Harness
- my $dbd_dir =
- ($haveFileSpec ? File::Spec->catdir($d, 'DBD') : "$d/DBD");
- next unless -d $dbd_dir;
- next if $seen_dir{$d};
- $seen_dir{$d} = 1;
- # XXX we have a problem here with case insensitive file systems
- # XXX since we can't tell what case must be used when loading.
- opendir(DBI::DIR, $dbd_dir) || Carp::carp "opendir $dbd_dir: $!\n";
- foreach $f (readdir(DBI::DIR)){
- next unless $f =~ s/\.pm$//;
- next if $f eq 'NullP';
- if ($seen_dbd{$f}){
- Carp::carp "DBD::$f in $d is hidden by DBD::$f in $seen_dbd{$f}\n"
- unless $quiet;
- } else {
- push(@drivers, $f);
- }
- $seen_dbd{$f} = $d;
- }
- closedir(DBI::DIR);
- }
-
- # "return sort @drivers" will not DWIM in scalar context.
- return wantarray ? sort @drivers : @drivers;
-}
-
-sub installed_versions {
- my ($class, $quiet) = @_;
- my %error;
- my %version;
- for my $driver ($class->available_drivers($quiet)) {
- next if $DBI::PurePerl && grep { -d "$_/auto/DBD/$driver" } @INC;
- my $drh = eval {
- local $SIG{__WARN__} = sub {};
- $class->install_driver($driver);
- };
- ($error{"DBD::$driver"}=$@),next if $@;
- no strict 'refs';
- my $vers = ${"DBD::$driver" . '::VERSION'};
- $version{"DBD::$driver"} = $vers || '?';
- }
- if (wantarray) {
- return map { m/^DBD::(\w+)/ ? ($1) : () } sort keys %version;
- }
- $version{"DBI"} = $DBI::VERSION;
- $version{"DBI::PurePerl"} = $DBI::PurePerl::VERSION if $DBI::PurePerl;
- if (!defined wantarray) { # void context
- require Config; # add more detail
- $version{OS} = "$^O\t($Config::Config{osvers})";
- $version{Perl} = "$]\t($Config::Config{archname})";
- $version{$_} = (($error{$_} =~ s/ \(\@INC.*//s),$error{$_})
- for keys %error;
- printf " %-16s: %s\n",$_,$version{$_}
- for reverse sort keys %version;
- }
- return \%version;
-}
-
-
-sub data_sources {
- my ($class, $driver, @other) = @_;
- my $drh = $class->install_driver($driver);
- my @ds = $drh->data_sources(@other);
- return @ds;
-}
-
-
-sub neat_list {
- my ($listref, $maxlen, $sep) = @_;
- $maxlen = 0 unless defined $maxlen; # 0 == use internal default
- $sep = ", " unless defined $sep;
- join($sep, map { neat($_,$maxlen) } @$listref);
-}
-
-
-sub dump_results { # also aliased as a method in DBD::_::st
- my ($sth, $maxlen, $lsep, $fsep, $fh) = @_;
- return 0 unless $sth;
- $maxlen ||= 35;
- $lsep ||= "\n";
- $fh ||= \*STDOUT;
- my $rows = 0;
- my $ref;
- while($ref = $sth->fetch) {
- print $fh $lsep if $rows++ and $lsep;
- my $str = neat_list($ref,$maxlen,$fsep);
- print $fh $str; # done on two lines to avoid 5.003 errors
- }
- print $fh "\n$rows rows".($DBI::err ? " ($DBI::err: $DBI::errstr)" : "")."\n";
- $rows;
-}
-
-
-sub data_diff {
- my ($a, $b, $logical) = @_;
-
- my $diff = data_string_diff($a, $b);
- return "" if $logical and !$diff;
-
- my $a_desc = data_string_desc($a);
- my $b_desc = data_string_desc($b);
- return "" if !$diff and $a_desc eq $b_desc;
-
- $diff ||= "Strings contain the same sequence of characters"
- if length($a);
- $diff .= "\n" if $diff;
- return "a: $a_desc\nb: $b_desc\n$diff";
-}
-
-
-sub data_string_diff {
- # Compares 'logical' characters, not bytes, so a latin1 string and an
- # an equivalent Unicode string will compare as equal even though their
- # byte encodings are different.
- my ($a, $b) = @_;
- unless (defined $a and defined $b) { # one undef
- return ""
- if !defined $a and !defined $b;
- return "String a is undef, string b has ".length($b)." characters"
- if !defined $a;
- return "String b is undef, string a has ".length($a)." characters"
- if !defined $b;
- }
-
- require utf8;
- # hack to cater for perl 5.6
- *utf8::is_utf8 = sub { (DBI::neat(shift)=~/^"/) } unless defined &utf8::is_utf8;
-
- my @a_chars = (utf8::is_utf8($a)) ? unpack("U*", $a) : unpack("C*", $a);
- my @b_chars = (utf8::is_utf8($b)) ? unpack("U*", $b) : unpack("C*", $b);
- my $i = 0;
- while (@a_chars && @b_chars) {
- ++$i, shift(@a_chars), shift(@b_chars), next
- if $a_chars[0] == $b_chars[0];# compare ordinal values
- my @desc = map {
- $_ > 255 ? # if wide character...
- sprintf("\\x{%04X}", $_) : # \x{...}
- chr($_) =~ /[[:cntrl:]]/ ? # else if control character ...
- sprintf("\\x%02X", $_) : # \x..
- chr($_) # else as themselves
- } ($a_chars[0], $b_chars[0]);
- # highlight probable double-encoding?
- foreach my $c ( @desc ) {
- next unless $c =~ m/\\x\{08(..)}/;
- $c .= "='" .chr(hex($1)) ."'"
- }
- return sprintf "Strings differ at index $i: a[$i]=$desc[0], b[$i]=$desc[1]";
- }
- return "String a truncated after $i characters" if @b_chars;
- return "String b truncated after $i characters" if @a_chars;
- return "";
-}
-
-
-sub data_string_desc { # describe a data string
- my ($a) = @_;
- require bytes;
- require utf8;
-
- # hacks to cater for perl 5.6
- *utf8::is_utf8 = sub { (DBI::neat(shift)=~/^"/) } unless defined &utf8::is_utf8;
- *utf8::valid = sub { 1 } unless defined &utf8::valid;
-
- # Give sufficient info to help diagnose at least these kinds of situations:
- # - valid UTF8 byte sequence but UTF8 flag not set
- # (might be ascii so also need to check for hibit to make it worthwhile)
- # - UTF8 flag set but invalid UTF8 byte sequence
- # could do better here, but this'll do for now
- my $utf8 = sprintf "UTF8 %s%s",
- utf8::is_utf8($a) ? "on" : "off",
- utf8::valid($a||'') ? "" : " but INVALID encoding";
- return "$utf8, undef" unless defined $a;
- my $is_ascii = $a =~ m/^[\000-\177]*$/;
- return sprintf "%s, %s, %d characters %d bytes",
- $utf8, $is_ascii ? "ASCII" : "non-ASCII",
- length($a), bytes::length($a);
-}
-
-
-sub connect_test_perf {
- my($class, $dsn,$dbuser,$dbpass, $attr) = @_;
- Carp::croak("connect_test_perf needs hash ref as fourth arg") unless ref $attr;
- # these are non standard attributes just for this special method
- my $loops ||= $attr->{dbi_loops} || 5;
- my $par ||= $attr->{dbi_par} || 1; # parallelism
- my $verb ||= $attr->{dbi_verb} || 1;
- my $meth ||= $attr->{dbi_meth} || 'connect';
- print "$dsn: testing $loops sets of $par connections:\n";
- require "FileHandle.pm"; # don't let toke.c create empty FileHandle package
- local $| = 1;
- my $drh = $class->install_driver($dsn) or Carp::croak("Can't install $dsn driver\n");
- # test the connection and warm up caches etc
- $drh->connect($dsn,$dbuser,$dbpass) or Carp::croak("connect failed: $DBI::errstr");
- my $t1 = dbi_time();
- my $loop;
- for $loop (1..$loops) {
- my @cons;
- print "Connecting... " if $verb;
- for (1..$par) {
- print "$_ ";
- push @cons, ($drh->connect($dsn,$dbuser,$dbpass)
- or Carp::croak("connect failed: $DBI::errstr\n"));
- }
- print "\nDisconnecting...\n" if $verb;
- for (@cons) {
- $_->disconnect or warn "disconnect failed: $DBI::errstr"
- }
- }
- my $t2 = dbi_time();
- my $td = $t2 - $t1;
- printf "$meth %d and disconnect them, %d times: %.4fs / %d = %.4fs\n",
- $par, $loops, $td, $loops*$par, $td/($loops*$par);
- return $td;
-}
-
-
-# Help people doing DBI->errstr, might even document it one day
-# XXX probably best moved to cheaper XS code if this gets documented
-sub err { $DBI::err }
-sub errstr { $DBI::errstr }
-
-
-# --- Private Internal Function for Creating New DBI Handles
-
-# XXX move to PurePerl?
-*DBI::dr::TIEHASH = \&DBI::st::TIEHASH;
-*DBI::db::TIEHASH = \&DBI::st::TIEHASH;
-
-
-# These three special constructors are called by the drivers
-# The way they are called is likely to change.
-
-our $shared_profile;
-
-sub _new_drh { # called by DBD::<drivername>::driver()
- my ($class, $initial_attr, $imp_data) = @_;
- # Provide default storage for State,Err and Errstr.
- # Note that these are shared by all child handles by default! XXX
- # State must be undef to get automatic faking in DBI::var::FETCH
- my ($h_state_store, $h_err_store, $h_errstr_store) = (undef, undef, '');
- my $attr = {
- # these attributes get copied down to child handles by default
- 'State' => \$h_state_store, # Holder for DBI::state
- 'Err' => \$h_err_store, # Holder for DBI::err
- 'Errstr' => \$h_errstr_store, # Holder for DBI::errstr
- 'TraceLevel' => 0,
- FetchHashKeyName=> 'NAME',
- %$initial_attr,
- };
- my ($h, $i) = _new_handle('DBI::dr', '', $attr, $imp_data, $class);
-
- # XXX DBI_PROFILE unless DBI::PurePerl because for some reason
- # it kills the t/zz_*_pp.t tests (they silently exit early)
- if (($ENV{DBI_PROFILE} && !$DBI::PurePerl) || $shared_profile) {
- # The profile object created here when the first driver is loaded
- # is shared by all drivers so we end up with just one set of profile
- # data and thus the 'total time in DBI' is really the true total.
- if (!$shared_profile) { # first time
- $h->{Profile} = $ENV{DBI_PROFILE}; # write string
- $shared_profile = $h->{Profile}; # read and record object
- }
- else {
- $h->{Profile} = $shared_profile;
- }
- }
- return $h unless wantarray;
- ($h, $i);
-}
-
-sub _new_dbh { # called by DBD::<drivername>::dr::connect()
- my ($drh, $attr, $imp_data) = @_;
- my $imp_class = $drh->{ImplementorClass}
- or Carp::croak("DBI _new_dbh: $drh has no ImplementorClass");
- substr($imp_class,-4,4) = '::db';
- my $app_class = ref $drh;
- substr($app_class,-4,4) = '::db';
- $attr->{Err} ||= \my $err;
- $attr->{Errstr} ||= \my $errstr;
- $attr->{State} ||= \my $state;
- _new_handle($app_class, $drh, $attr, $imp_data, $imp_class);
-}
-
-sub _new_sth { # called by DBD::<drivername>::db::prepare)
- my ($dbh, $attr, $imp_data) = @_;
- my $imp_class = $dbh->{ImplementorClass}
- or Carp::croak("DBI _new_sth: $dbh has no ImplementorClass");
- substr($imp_class,-4,4) = '::st';
- my $app_class = ref $dbh;
- substr($app_class,-4,4) = '::st';
- _new_handle($app_class, $dbh, $attr, $imp_data, $imp_class);
-}
-
-
-# end of DBI package
-
-
-
-# --------------------------------------------------------------------
-# === The internal DBI Switch pseudo 'driver' class ===
-
-{ package # hide from PAUSE
- DBD::Switch::dr;
- DBI->setup_driver('DBD::Switch'); # sets up @ISA
-
- $DBD::Switch::dr::imp_data_size = 0;
- $DBD::Switch::dr::imp_data_size = 0; # avoid typo warning
- my $drh;
-
- sub driver {
- return $drh if $drh; # a package global
-
- my $inner;
- ($drh, $inner) = DBI::_new_drh('DBD::Switch::dr', {
- 'Name' => 'Switch',
- 'Version' => $DBI::VERSION,
- 'Attribution' => "DBI $DBI::VERSION by Tim Bunce",
- });
- Carp::croak("DBD::Switch init failed!") unless ($drh && $inner);
- return $drh;
- }
- sub CLONE {
- undef $drh;
- }
-
- sub FETCH {
- my($drh, $key) = @_;
- return DBI->trace if $key eq 'DebugDispatch';
- return undef if $key eq 'DebugLog'; # not worth fetching, sorry
- return $drh->DBD::_::dr::FETCH($key);
- undef;
- }
- sub STORE {
- my($drh, $key, $value) = @_;
- if ($key eq 'DebugDispatch') {
- DBI->trace($value);
- } elsif ($key eq 'DebugLog') {
- DBI->trace(-1, $value);
- } else {
- $drh->DBD::_::dr::STORE($key, $value);
- }
- }
-}
-
-
-# --------------------------------------------------------------------
-# === OPTIONAL MINIMAL BASE CLASSES FOR DBI SUBCLASSES ===
-
-# We only define default methods for harmless functions.
-# We don't, for example, define a DBD::_::st::prepare()
-
-{ package # hide from PAUSE
- DBD::_::common; # ====== Common base class methods ======
- use strict;
-
- # methods common to all handle types:
-
- # generic TIEHASH default methods:
- sub FIRSTKEY { }
- sub NEXTKEY { }
- sub EXISTS { defined($_[0]->FETCH($_[1])) } # XXX undef?
- sub CLEAR { Carp::carp "Can't CLEAR $_[0] (DBI)" }
-
- sub FETCH_many { # XXX should move to C one day
- my $h = shift;
- # scalar is needed to workaround drivers that return an empty list
- # for some attributes
- return map { scalar $h->FETCH($_) } @_;
- }
-
- *dump_handle = \&DBI::dump_handle;
-
- sub install_method {
- # special class method called directly by apps and/or drivers
- # to install new methods into the DBI dispatcher
- # DBD::Foo::db->install_method("foo_mumble", { usage => [...], options => '...' });
- my ($class, $method, $attr) = @_;
- Carp::croak("Class '$class' must begin with DBD:: and end with ::db or ::st")
- unless $class =~ /^DBD::(\w+)::(dr|db|st)$/;
- my ($driver, $subtype) = ($1, $2);
- Carp::croak("invalid method name '$method'")
- unless $method =~ m/^([a-z][a-z0-9]*_)\w+$/;
- my $prefix = $1;
- my $reg_info = $dbd_prefix_registry->{$prefix};
- Carp::carp("method name prefix '$prefix' is not associated with a registered driver") unless $reg_info;
-
- my $full_method = "DBI::${subtype}::$method";
- $DBI::installed_methods{$full_method} = $attr;
-
- my (undef, $filename, $line) = caller;
- # XXX reformat $attr as needed for _install_method
- my %attr = %{$attr||{}}; # copy so we can edit
- DBI->_install_method("DBI::${subtype}::$method", "$filename at line $line", \%attr);
- }
-
- sub parse_trace_flags {
- my ($h, $spec) = @_;
- my $level = 0;
- my $flags = 0;
- my @unknown;
- for my $word (split /\s*[|&,]\s*/, $spec) {
- if (DBI::looks_like_number($word) && $word <= 0xF && $word >= 0) {
- $level = $word;
- } elsif ($word eq 'ALL') {
- $flags = 0x7FFFFFFF; # XXX last bit causes negative headaches
- last;
- } elsif (my $flag = $h->parse_trace_flag($word)) {
- $flags |= $flag;
- }
- else {
- push @unknown, $word;
- }
- }
- if (@unknown && (ref $h ? $h->FETCH('Warn') : 1)) {
- Carp::carp("$h->parse_trace_flags($spec) ignored unknown trace flags: ".
- join(" ", map { DBI::neat($_) } @unknown));
- }
- $flags |= $level;
- return $flags;
- }
-
- sub parse_trace_flag {
- my ($h, $name) = @_;
- # 0xddDDDDrL (driver, DBI, reserved, Level)
- return 0x00000100 if $name eq 'SQL';
- return 0x00000200 if $name eq 'CON';
- return 0x00000400 if $name eq 'ENC';
- return 0x00000800 if $name eq 'DBD';
- return 0x00001000 if $name eq 'TXN';
- return;
- }
-
- sub private_attribute_info {
- return undef;
- }
-
- sub visit_child_handles {
- my ($h, $code, $info) = @_;
- $info = {} if not defined $info;
- for my $ch (@{ $h->{ChildHandles} || []}) {
- next unless $ch;
- my $child_info = $code->($ch, $info)
- or next;
- $ch->visit_child_handles($code, $child_info);
- }
- return $info;
- }
-}
-
-
-{ package # hide from PAUSE
- DBD::_::dr; # ====== DRIVER ======
- @DBD::_::dr::ISA = qw(DBD::_::common);
- use strict;
-
- sub default_user {
- my ($drh, $user, $pass, $attr) = @_;
- $user = $ENV{DBI_USER} unless defined $user;
- $pass = $ENV{DBI_PASS} unless defined $pass;
- return ($user, $pass);
- }
-
- sub connect { # normally overridden, but a handy default
- my ($drh, $dsn, $user, $auth) = @_;
- my ($this) = DBI::_new_dbh($drh, {
- 'Name' => $dsn,
- });
- # XXX debatable as there's no "server side" here
- # (and now many uses would trigger warnings on DESTROY)
- # $this->STORE(Active => 1);
- # so drivers should set it in their own connect
- $this;
- }
-
-
- sub connect_cached {
- my $drh = shift;
- my ($dsn, $user, $auth, $attr) = @_;
-
- my $cache = $drh->{CachedKids} ||= {};
- my $key = do { local $^W;
- join "!\001", $dsn, $user, $auth, DBI::_concat_hash_sorted($attr, "=\001", ",\001", 0, 0)
- };
- my $dbh = $cache->{$key};
- $drh->trace_msg(sprintf(" connect_cached: key '$key', cached dbh $dbh\n", DBI::neat($key), DBI::neat($dbh)))
- if (($DBI::dbi_debug & 0xF) >= 4);
-
- my $cb = $attr->{Callbacks}; # take care not to autovivify
- if ($dbh && $dbh->FETCH('Active') && eval { $dbh->ping }) {
- # If the caller has provided a callback then call it
- if ($cb and $cb = $cb->{"connect_cached.reused"}) {
- local $_ = "connect_cached.reused";
- $cb->($dbh, $dsn, $user, $auth, $attr);
- }
- return $dbh;
- }
-
- # If the caller has provided a callback then call it
- if ($cb and (my $new_cb = $cb->{"connect_cached.new"})) {
- local $_ = "connect_cached.new";
- $new_cb->($dbh, $dsn, $user, $auth, $attr); # $dbh is dead or undef
- }
-
- $dbh = $drh->connect(@_);
- $cache->{$key} = $dbh; # replace prev entry, even if connect failed
- if ($cb and (my $conn_cb = $cb->{"connect_cached.connected"})) {
- local $_ = "connect_cached.connected";
- $conn_cb->($dbh, $dsn, $user, $auth, $attr);
- }
- return $dbh;
- }
-
-}
-
-
-{ package # hide from PAUSE
- DBD::_::db; # ====== DATABASE ======
- @DBD::_::db::ISA = qw(DBD::_::common);
- use strict;
-
- sub clone {
- my ($old_dbh, $attr) = @_;
-
- my $closure = $old_dbh->{dbi_connect_closure}
- or return $old_dbh->set_err($DBI::stderr, "Can't clone handle");
-
- unless ($attr) { # XXX deprecated, caller should always pass a hash ref
- # copy attributes visible in the attribute cache
- keys %$old_dbh; # reset iterator
- while ( my ($k, $v) = each %$old_dbh ) {
- # ignore non-code refs, i.e., caches, handles, Err etc
- next if ref $v && ref $v ne 'CODE'; # HandleError etc
- $attr->{$k} = $v;
- }
- # explicitly set attributes which are unlikely to be in the
- # attribute cache, i.e., boolean's and some others
- $attr->{$_} = $old_dbh->FETCH($_) for (qw(
- AutoCommit ChopBlanks InactiveDestroy AutoInactiveDestroy
- LongTruncOk PrintError PrintWarn Profile RaiseError
- ShowErrorStatement TaintIn TaintOut
- ));
- }
-
- # use Data::Dumper; warn Dumper([$old_dbh, $attr]);
- my $new_dbh = &$closure($old_dbh, $attr);
- unless ($new_dbh) {
- # need to copy err/errstr from driver back into $old_dbh
- my $drh = $old_dbh->{Driver};
- return $old_dbh->set_err($drh->err, $drh->errstr, $drh->state);
- }
- $new_dbh->{dbi_connect_closure} = $closure;
- return $new_dbh;
- }
-
- sub quote_identifier {
- my ($dbh, @id) = @_;
- my $attr = (@id > 3 && ref($id[-1])) ? pop @id : undef;
-
- my $info = $dbh->{dbi_quote_identifier_cache} ||= [
- $dbh->get_info(29) || '"', # SQL_IDENTIFIER_QUOTE_CHAR
- $dbh->get_info(41) || '.', # SQL_CATALOG_NAME_SEPARATOR
- $dbh->get_info(114) || 1, # SQL_CATALOG_LOCATION
- ];
-
- my $quote = $info->[0];
- foreach (@id) { # quote the elements
- next unless defined;
- s/$quote/$quote$quote/g; # escape embedded quotes
- $_ = qq{$quote$_$quote};
- }
-
- # strip out catalog if present for special handling
- my $catalog = (@id >= 3) ? shift @id : undef;
-
- # join the dots, ignoring any null/undef elements (ie schema)
- my $quoted_id = join '.', grep { defined } @id;
-
- if ($catalog) { # add catalog correctly
- if ($quoted_id) {
- $quoted_id = ($info->[2] == 2) # SQL_CL_END
- ? $quoted_id . $info->[1] . $catalog
- : $catalog . $info->[1] . $quoted_id;
- } else {
- $quoted_id = $catalog;
- }
- }
- return $quoted_id;
- }
-
- sub quote {
- my ($dbh, $str, $data_type) = @_;
-
- return "NULL" unless defined $str;
- unless ($data_type) {
- $str =~ s/'/''/g; # ISO SQL2
- return "'$str'";
- }
-
- my $dbi_literal_quote_cache = $dbh->{'dbi_literal_quote_cache'} ||= [ {} , {} ];
- my ($prefixes, $suffixes) = @$dbi_literal_quote_cache;
-
- my $lp = $prefixes->{$data_type};
- my $ls = $suffixes->{$data_type};
-
- if ( ! defined $lp || ! defined $ls ) {
- my $ti = $dbh->type_info($data_type);
- $lp = $prefixes->{$data_type} = $ti ? $ti->{LITERAL_PREFIX} || "" : "'";
- $ls = $suffixes->{$data_type} = $ti ? $ti->{LITERAL_SUFFIX} || "" : "'";
- }
- return $str unless $lp || $ls; # no quoting required
-
- # XXX don't know what the standard says about escaping
- # in the 'general case' (where $lp != "'").
- # So we just do this and hope:
- $str =~ s/$lp/$lp$lp/g
- if $lp && $lp eq $ls && ($lp eq "'" || $lp eq '"');
- return "$lp$str$ls";
- }
-
- sub rows { -1 } # here so $DBI::rows 'works' after using $dbh
-
- sub do {
- my($dbh, $statement, $attr, @params) = @_;
- my $sth = $dbh->prepare($statement, $attr) or return undef;
- $sth->execute(@params) or return undef;
- my $rows = $sth->rows;
- ($rows == 0) ? "0E0" : $rows;
- }
-
- sub _do_selectrow {
- my ($method, $dbh, $stmt, $attr, @bind) = @_;
- my $sth = ((ref $stmt) ? $stmt : $dbh->prepare($stmt, $attr))
- or return undef;
- $sth->execute(@bind)
- or return undef;
- my $row = $sth->$method()
- and $sth->finish;
- return $row;
- }
-
- sub selectrow_hashref { return _do_selectrow('fetchrow_hashref', @_); }
-
- # XXX selectrow_array/ref also have C implementations in Driver.xst
- sub selectrow_arrayref { return _do_selectrow('fetchrow_arrayref', @_); }
- sub selectrow_array {
- my $row = _do_selectrow('fetchrow_arrayref', @_) or return;
- return $row->[0] unless wantarray;
- return @$row;
- }
-
- sub selectall_array {
- return @{ shift->selectall_arrayref(@_) || [] };
- }
-
- # XXX selectall_arrayref also has C implementation in Driver.xst
- # which fallsback to this if a slice is given
- sub selectall_arrayref {
- my ($dbh, $stmt, $attr, @bind) = @_;
- my $sth = (ref $stmt) ? $stmt : $dbh->prepare($stmt, $attr)
- or return;
- $sth->execute(@bind) || return;
- my $slice = $attr->{Slice}; # typically undef, else hash or array ref
- if (!$slice and $slice=$attr->{Columns}) {
- if (ref $slice eq 'ARRAY') { # map col idx to perl array idx
- $slice = [ @{$attr->{Columns}} ]; # take a copy
- for (@$slice) { $_-- }
- }
- }
- my $rows = $sth->fetchall_arrayref($slice, my $MaxRows = $attr->{MaxRows});
- $sth->finish if defined $MaxRows;
- return $rows;
- }
-
- sub selectall_hashref {
- my ($dbh, $stmt, $key_field, $attr, @bind) = @_;
- my $sth = (ref $stmt) ? $stmt : $dbh->prepare($stmt, $attr);
- return unless $sth;
- $sth->execute(@bind) || return;
- return $sth->fetchall_hashref($key_field);
- }
-
- sub selectcol_arrayref {
- my ($dbh, $stmt, $attr, @bind) = @_;
- my $sth = (ref $stmt) ? $stmt : $dbh->prepare($stmt, $attr);
- return unless $sth;
- $sth->execute(@bind) || return;
- my @columns = ($attr->{Columns}) ? @{$attr->{Columns}} : (1);
- my @values = (undef) x @columns;
- my $idx = 0;
- for (@columns) {
- $sth->bind_col($_, \$values[$idx++]) || return;
- }
- my @col;
- if (my $max = $attr->{MaxRows}) {
- push @col, @values while 0 < $max-- && $sth->fetch;
- }
- else {
- push @col, @values while $sth->fetch;
- }
- return \@col;
- }
-
- sub prepare_cached {
- my ($dbh, $statement, $attr, $if_active) = @_;
-
- # Needs support at dbh level to clear cache before complaining about
- # active children. The XS template code does this. Drivers not using
- # the template must handle clearing the cache themselves.
- my $cache = $dbh->{CachedKids} ||= {};
- my $key = do { local $^W;
- join "!\001", $statement, DBI::_concat_hash_sorted($attr, "=\001", ",\001", 0, 0)
- };
- my $sth = $cache->{$key};
-
- if ($sth) {
- return $sth unless $sth->FETCH('Active');
- Carp::carp("prepare_cached($statement) statement handle $sth still Active")
- unless ($if_active ||= 0);
- $sth->finish if $if_active <= 1;
- return $sth if $if_active <= 2;
- }
-
- $sth = $dbh->prepare($statement, $attr);
- $cache->{$key} = $sth if $sth;
-
- return $sth;
- }
-
- sub ping {
- my $dbh = shift;
- # "0 but true" is a special kind of true 0 that is used here so
- # applications can check if the ping was a real ping or not
- ($dbh->FETCH('Active')) ? "0 but true" : 0;
- }
-
- sub begin_work {
- my $dbh = shift;
- return $dbh->set_err($DBI::stderr, "Already in a transaction")
- unless $dbh->FETCH('AutoCommit');
- $dbh->STORE('AutoCommit', 0); # will croak if driver doesn't support it
- $dbh->STORE('BegunWork', 1); # trigger post commit/rollback action
- return 1;
- }
-
- sub primary_key {
- my ($dbh, @args) = @_;
- my $sth = $dbh->primary_key_info(@args) or return;
- my ($row, @col);
- push @col, $row->[3] while ($row = $sth->fetch);
- Carp::croak("primary_key method not called in list context")
- unless wantarray; # leave us some elbow room
- return @col;
- }
-
- sub tables {
- my ($dbh, @args) = @_;
- my $sth = $dbh->table_info(@args[0,1,2,3,4]) or return;
- my $tables = $sth->fetchall_arrayref or return;
- my @tables;
- if (defined($args[3]) && $args[3] eq '%' # special case for tables('','','','%')
- && grep {defined($_) && $_ eq ''} @args[0,1,2]
- ) {
- @tables = map { $_->[3] } @$tables;
- } elsif ($dbh->get_info(29)) { # SQL_IDENTIFIER_QUOTE_CHAR
- @tables = map { $dbh->quote_identifier( @{$_}[0,1,2] ) } @$tables;
- }
- else { # temporary old style hack (yeach)
- @tables = map {
- my $name = $_->[2];
- if ($_->[1]) {
- my $schema = $_->[1];
- # a sad hack (mostly for Informix I recall)
- my $quote = ($schema eq uc($schema)) ? '' : '"';
- $name = "$quote$schema$quote.$name"
- }
- $name;
- } @$tables;
- }
- return @tables;
- }
-
- sub type_info { # this should be sufficient for all drivers
- my ($dbh, $data_type) = @_;
- my $idx_hash;
- my $tia = $dbh->{dbi_type_info_row_cache};
- if ($tia) {
- $idx_hash = $dbh->{dbi_type_info_idx_cache};
- }
- else {
- my $temp = $dbh->type_info_all;
- return unless $temp && @$temp;
- # we cache here because type_info_all may be expensive to call
- # (and we take a copy so the following shift can't corrupt
- # the data that may be returned by future calls to type_info_all)
- $tia = $dbh->{dbi_type_info_row_cache} = [ @$temp ];
- $idx_hash = $dbh->{dbi_type_info_idx_cache} = shift @$tia;
- }
-
- my $dt_idx = $idx_hash->{DATA_TYPE} || $idx_hash->{data_type};
- Carp::croak("type_info_all returned non-standard DATA_TYPE index value ($dt_idx != 1)")
- if $dt_idx && $dt_idx != 1;
-
- # --- simple DATA_TYPE match filter
- my @ti;
- my @data_type_list = (ref $data_type) ? @$data_type : ($data_type);
- foreach $data_type (@data_type_list) {
- if (defined($data_type) && $data_type != DBI::SQL_ALL_TYPES()) {
- push @ti, grep { $_->[$dt_idx] == $data_type } @$tia;
- }
- else { # SQL_ALL_TYPES
- push @ti, @$tia;
- }
- last if @ti; # found at least one match
- }
-
- # --- format results into list of hash refs
- my $idx_fields = keys %$idx_hash;
- my @idx_names = map { uc($_) } keys %$idx_hash;
- my @idx_values = values %$idx_hash;
- Carp::croak "type_info_all result has $idx_fields keys but ".(@{$ti[0]})." fields"
- if @ti && @{$ti[0]} != $idx_fields;
- my @out = map {
- my %h; @h{@idx_names} = @{$_}[ @idx_values ]; \%h;
- } @ti;
- return $out[0] unless wantarray;
- return @out;
- }
-
- sub data_sources {
- my ($dbh, @other) = @_;
- my $drh = $dbh->{Driver}; # XXX proxy issues?
- return $drh->data_sources(@other);
- }
-
-}
-
-
-{ package # hide from PAUSE
- DBD::_::st; # ====== STATEMENT ======
- @DBD::_::st::ISA = qw(DBD::_::common);
- use strict;
-
- sub bind_param { Carp::croak("Can't bind_param, not implement by driver") }
-
-#
-# ********************************************************
-#
-# BEGIN ARRAY BINDING
-#
-# Array binding support for drivers which don't support
-# array binding, but have sufficient interfaces to fake it.
-# NOTE: mixing scalars and arrayrefs requires using bind_param_array
-# for *all* params...unless we modify bind_param for the default
-# case...
-#
-# 2002-Apr-10 D. Arnold
-
- sub bind_param_array {
- my $sth = shift;
- my ($p_id, $value_array, $attr) = @_;
-
- return $sth->set_err($DBI::stderr, "Value for parameter $p_id must be a scalar or an arrayref, not a ".ref($value_array))
- if defined $value_array and ref $value_array and ref $value_array ne 'ARRAY';
-
- return $sth->set_err($DBI::stderr, "Can't use named placeholder '$p_id' for non-driver supported bind_param_array")
- unless DBI::looks_like_number($p_id); # because we rely on execute(@ary) here
-
- return $sth->set_err($DBI::stderr, "Placeholder '$p_id' is out of range")
- if $p_id <= 0; # can't easily/reliably test for too big
-
- # get/create arrayref to hold params
- my $hash_of_arrays = $sth->{ParamArrays} ||= { };
-
- # If the bind has attribs then we rely on the driver conforming to
- # the DBI spec in that a single bind_param() call with those attribs
- # makes them 'sticky' and apply to all later execute(@values) calls.
- # Since we only call bind_param() if we're given attribs then
- # applications using drivers that don't support bind_param can still
- # use bind_param_array() so long as they don't pass any attribs.
-
- $$hash_of_arrays{$p_id} = $value_array;
- return $sth->bind_param($p_id, undef, $attr)
- if $attr;
- 1;
- }
-
- sub bind_param_inout_array {
- my $sth = shift;
- # XXX not supported so we just call bind_param_array instead
- # and then return an error
- my ($p_num, $value_array, $attr) = @_;
- $sth->bind_param_array($p_num, $value_array, $attr);
- return $sth->set_err($DBI::stderr, "bind_param_inout_array not supported");
- }
-
- sub bind_columns {
- my $sth = shift;
- my $fields = $sth->FETCH('NUM_OF_FIELDS') || 0;
- if ($fields <= 0 && !$sth->{Active}) {
- return $sth->set_err($DBI::stderr, "Statement has no result columns to bind"
- ." (perhaps you need to successfully call execute first, or again)");
- }
- # Backwards compatibility for old-style call with attribute hash
- # ref as first arg. Skip arg if undef or a hash ref.
- my $attr;
- $attr = shift if !defined $_[0] or ref($_[0]) eq 'HASH';
-
- my $idx = 0;
- $sth->bind_col(++$idx, shift, $attr) or return
- while (@_ and $idx < $fields);
-
- return $sth->set_err($DBI::stderr, "bind_columns called with ".($idx+@_)." values but $fields are needed")
- if @_ or $idx != $fields;
-
- return 1;
- }
-
- sub execute_array {
- my $sth = shift;
- my ($attr, @array_of_arrays) = @_;
- my $NUM_OF_PARAMS = $sth->FETCH('NUM_OF_PARAMS'); # may be undef at this point
-
- # get tuple status array or hash attribute
- my $tuple_sts = $attr->{ArrayTupleStatus};
- return $sth->set_err($DBI::stderr, "ArrayTupleStatus attribute must be an arrayref")
- if $tuple_sts and ref $tuple_sts ne 'ARRAY';
-
- # bind all supplied arrays
- if (@array_of_arrays) {
- $sth->{ParamArrays} = { }; # clear out old params
- return $sth->set_err($DBI::stderr,
- @array_of_arrays." bind values supplied but $NUM_OF_PARAMS expected")
- if defined ($NUM_OF_PARAMS) && @array_of_arrays != $NUM_OF_PARAMS;
- $sth->bind_param_array($_, $array_of_arrays[$_-1]) or return
- foreach (1..@array_of_arrays);
- }
-
- my $fetch_tuple_sub;
-
- if ($fetch_tuple_sub = $attr->{ArrayTupleFetch}) { # fetch on demand
-
- return $sth->set_err($DBI::stderr,
- "Can't use both ArrayTupleFetch and explicit bind values")
- if @array_of_arrays; # previous bind_param_array calls will simply be ignored
-
- if (UNIVERSAL::isa($fetch_tuple_sub,'DBI::st')) {
- my $fetch_sth = $fetch_tuple_sub;
- return $sth->set_err($DBI::stderr,
- "ArrayTupleFetch sth is not Active, need to execute() it first")
- unless $fetch_sth->{Active};
- # check column count match to give more friendly message
- my $NUM_OF_FIELDS = $fetch_sth->{NUM_OF_FIELDS};
- return $sth->set_err($DBI::stderr,
- "$NUM_OF_FIELDS columns from ArrayTupleFetch sth but $NUM_OF_PARAMS expected")
- if defined($NUM_OF_FIELDS) && defined($NUM_OF_PARAMS)
- && $NUM_OF_FIELDS != $NUM_OF_PARAMS;
- $fetch_tuple_sub = sub { $fetch_sth->fetchrow_arrayref };
- }
- elsif (!UNIVERSAL::isa($fetch_tuple_sub,'CODE')) {
- return $sth->set_err($DBI::stderr, "ArrayTupleFetch '$fetch_tuple_sub' is not a code ref or statement handle");
- }
-
- }
- else {
- my $NUM_OF_PARAMS_given = keys %{ $sth->{ParamArrays} || {} };
- return $sth->set_err($DBI::stderr,
- "$NUM_OF_PARAMS_given bind values supplied but $NUM_OF_PARAMS expected")
- if defined($NUM_OF_PARAMS) && $NUM_OF_PARAMS != $NUM_OF_PARAMS_given;
-
- # get the length of a bound array
- my $maxlen;
- my %hash_of_arrays = %{$sth->{ParamArrays}};
- foreach (keys(%hash_of_arrays)) {
- my $ary = $hash_of_arrays{$_};
- next unless ref $ary eq 'ARRAY';
- $maxlen = @$ary if !$maxlen || @$ary > $maxlen;
- }
- # if there are no arrays then execute scalars once
- $maxlen = 1 unless defined $maxlen;
- my @bind_ids = 1..keys(%hash_of_arrays);
-
- my $tuple_idx = 0;
- $fetch_tuple_sub = sub {
- return if $tuple_idx >= $maxlen;
- my @tuple = map {
- my $a = $hash_of_arrays{$_};
- ref($a) ? $a->[$tuple_idx] : $a
- } @bind_ids;
- ++$tuple_idx;
- return \@tuple;
- };
- }
- # pass thru the callers scalar or list context
- return $sth->execute_for_fetch($fetch_tuple_sub, $tuple_sts);
- }
-
- sub execute_for_fetch {
- my ($sth, $fetch_tuple_sub, $tuple_status) = @_;
- # start with empty status array
- ($tuple_status) ? @$tuple_status = () : $tuple_status = [];
-
- my $rc_total = 0;
- my $err_count;
- while ( my $tuple = &$fetch_tuple_sub() ) {
- if ( my $rc = $sth->execute(@$tuple) ) {
- push @$tuple_status, $rc;
- $rc_total = ($rc >= 0 && $rc_total >= 0) ? $rc_total + $rc : -1;
- }
- else {
- $err_count++;
- push @$tuple_status, [ $sth->err, $sth->errstr, $sth->state ];
- # XXX drivers implementing execute_for_fetch could opt to "last;" here
- # if they know the error code means no further executes will work.
- }
- }
- my $tuples = @$tuple_status;
- return $sth->set_err($DBI::stderr, "executing $tuples generated $err_count errors")
- if $err_count;
- $tuples ||= "0E0";
- return $tuples unless wantarray;
- return ($tuples, $rc_total);
- }
-
-
- sub fetchall_arrayref { # ALSO IN Driver.xst
- my ($sth, $slice, $max_rows) = @_;
-
- # when batch fetching with $max_rows were very likely to try to
- # fetch the 'next batch' after the previous batch returned
- # <=$max_rows. So don't treat that as an error.
- return undef if $max_rows and not $sth->FETCH('Active');
-
- my $mode = ref($slice) || 'ARRAY';
- my @rows;
-
- if ($mode eq 'ARRAY') {
- my $row;
- # we copy the array here because fetch (currently) always
- # returns the same array ref. XXX
- if ($slice && @$slice) {
- $max_rows = -1 unless defined $max_rows;
- push @rows, [ @{$row}[ @$slice] ]
- while($max_rows-- and $row = $sth->fetch);
- }
- elsif (defined $max_rows) {
- push @rows, [ @$row ]
- while($max_rows-- and $row = $sth->fetch);
- }
- else {
- push @rows, [ @$row ] while($row = $sth->fetch);
- }
- return \@rows
- }
-
- my %row;
- if ($mode eq 'REF' && ref($$slice) eq 'HASH') { # \{ $idx => $name }
- keys %$$slice; # reset the iterator
- while ( my ($idx, $name) = each %$$slice ) {
- $sth->bind_col($idx+1, \$row{$name});
- }
- }
- elsif ($mode eq 'HASH') {
- if (keys %$slice) { # resets the iterator
- my $name2idx = $sth->FETCH('NAME_lc_hash');
- while ( my ($name, $unused) = each %$slice ) {
- my $idx = $name2idx->{lc $name};
- return $sth->set_err($DBI::stderr, "Invalid column name '$name' for slice")
- if not defined $idx;
- $sth->bind_col($idx+1, \$row{$name});
- }
- }
- else {
- my @column_names = @{ $sth->FETCH($sth->FETCH('FetchHashKeyName')) };
- return [] if !@column_names;
-
- $sth->bind_columns( \( @row{@column_names} ) );
- }
- }
- else {
- return $sth->set_err($DBI::stderr, "fetchall_arrayref($mode) invalid");
- }
-
- if (not defined $max_rows) {
- push @rows, { %row } while ($sth->fetch); # full speed ahead!
- }
- else {
- push @rows, { %row } while ($max_rows-- and $sth->fetch);
- }
-
- return \@rows;
- }
-
- sub fetchall_hashref {
- my ($sth, $key_field) = @_;
-
- my $hash_key_name = $sth->{FetchHashKeyName} || 'NAME';
- my $names_hash = $sth->FETCH("${hash_key_name}_hash");
- my @key_fields = (ref $key_field) ? @$key_field : ($key_field);
- my @key_indexes;
- my $num_of_fields = $sth->FETCH('NUM_OF_FIELDS');
- foreach (@key_fields) {
- my $index = $names_hash->{$_}; # perl index not column
- $index = $_ - 1 if !defined $index && DBI::looks_like_number($_) && $_>=1 && $_ <= $num_of_fields;
- return $sth->set_err($DBI::stderr, "Field '$_' does not exist (not one of @{[keys %$names_hash]})")
- unless defined $index;
- push @key_indexes, $index;
- }
- my $rows = {};
- my $NAME = $sth->FETCH($hash_key_name);
- my @row = (undef) x $num_of_fields;
- $sth->bind_columns(\(@row));
- while ($sth->fetch) {
- my $ref = $rows;
- $ref = $ref->{$row[$_]} ||= {} for @key_indexes;
- @{$ref}{@$NAME} = @row;
- }
- return $rows;
- }
-
- *dump_results = \&DBI::dump_results;
-
- sub blob_copy_to_file { # returns length or undef on error
- my($self, $field, $filename_or_handleref, $blocksize) = @_;
- my $fh = $filename_or_handleref;
- my($len, $buf) = (0, "");
- $blocksize ||= 512; # not too ambitious
- local(*FH);
- unless(ref $fh) {
- open(FH, ">$fh") || return undef;
- $fh = \*FH;
- }
- while(defined($self->blob_read($field, $len, $blocksize, \$buf))) {
- print $fh $buf;
- $len += length $buf;
- }
- close(FH);
- $len;
- }
-
- sub more_results {
- shift->{syb_more_results}; # handy grandfathering
- }
-
-}
-
-unless ($DBI::PurePerl) { # See install_driver
- { @DBD::_mem::dr::ISA = qw(DBD::_mem::common); }
- { @DBD::_mem::db::ISA = qw(DBD::_mem::common); }
- { @DBD::_mem::st::ISA = qw(DBD::_mem::common); }
- # DBD::_mem::common::DESTROY is implemented in DBI.xs
-}
-
-1;
-__END__
-
-=head1 DESCRIPTION
-
-The DBI is a database access module for the Perl programming language. It defines
-a set of methods, variables, and conventions that provide a consistent
-database interface, independent of the actual database being used.
-
-It is important to remember that the DBI is just an interface.
-The DBI is a layer
-of "glue" between an application and one or more database I<driver>
-modules. It is the driver modules which do most of the real work. The DBI
-provides a standard interface and framework for the drivers to operate
-within.
-
-This document often uses terms like I<references>, I<objects>,
-I<methods>. If you're not familiar with those terms then it would
-be a good idea to read at least the following perl manuals first:
-L<perlreftut>, L<perldsc>, L<perllol>, and L<perlboot>.
-
-
-=head2 Architecture of a DBI Application
-
- |<- Scope of DBI ->|
- .-. .--------------. .-------------.
- .-------. | |---| XYZ Driver |---| XYZ Engine |
- | Perl | | | `--------------' `-------------'
- | script| |A| |D| .--------------. .-------------.
- | using |--|P|--|B|---|Oracle Driver |---|Oracle Engine|
- | DBI | |I| |I| `--------------' `-------------'
- | API | | |...
- |methods| | |... Other drivers
- `-------' | |...
- `-'
-
-The API, or Application Programming Interface, defines the
-call interface and variables for Perl scripts to use. The API
-is implemented by the Perl DBI extension.
-
-The DBI "dispatches" the method calls to the appropriate driver for
-actual execution. The DBI is also responsible for the dynamic loading
-of drivers, error checking and handling, providing default
-implementations for methods, and many other non-database specific duties.
-
-Each driver
-contains implementations of the DBI methods using the
-private interface functions of the corresponding database engine. Only authors
-of sophisticated/multi-database applications or generic library
-functions need be concerned with drivers.
-
-=head2 Notation and Conventions
-
-The following conventions are used in this document:
-
- $dbh Database handle object
- $sth Statement handle object
- $drh Driver handle object (rarely seen or used in applications)
- $h Any of the handle types above ($dbh, $sth, or $drh)
- $rc General Return Code (boolean: true=ok, false=error)
- $rv General Return Value (typically an integer)
- @ary List of values returned from the database, typically a row of data
- $rows Number of rows processed (if available, else -1)
- $fh A filehandle
- undef NULL values are represented by undefined values in Perl
- \%attr Reference to a hash of attribute values passed to methods
-
-Note that Perl will automatically destroy database and statement handle objects
-if all references to them are deleted.
-
-
-=head2 Outline Usage
-
-To use DBI,
-first you need to load the DBI module:
-
- use DBI;
- use strict;
-
-(The C<use strict;> isn't required but is strongly recommended.)
-
-Then you need to L</connect> to your data source and get a I<handle> for that
-connection:
-
- $dbh = DBI->connect($dsn, $user, $password,
- { RaiseError => 1, AutoCommit => 0 });
-
-Since connecting can be expensive, you generally just connect at the
-start of your program and disconnect at the end.
-
-Explicitly defining the required C<AutoCommit> behaviour is strongly
-recommended and may become mandatory in a later version. This
-determines whether changes are automatically committed to the
-database when executed, or need to be explicitly committed later.
-
-The DBI allows an application to "prepare" statements for later
-execution. A prepared statement is identified by a statement handle
-held in a Perl variable.
-We'll call the Perl variable C<$sth> in our examples.
-
-The typical method call sequence for a C<SELECT> statement is:
-
- prepare,
- execute, fetch, fetch, ...
- execute, fetch, fetch, ...
- execute, fetch, fetch, ...
-
-for example:
-
- $sth = $dbh->prepare("SELECT foo, bar FROM table WHERE baz=?");
-
- $sth->execute( $baz );
-
- while ( @row = $sth->fetchrow_array ) {
- print "@row\n";
- }
-
-The typical method call sequence for a I<non>-C<SELECT> statement is:
-
- prepare,
- execute,
- execute,
- execute.
-
-for example:
-
- $sth = $dbh->prepare("INSERT INTO table(foo,bar,baz) VALUES (?,?,?)");
-
- while(<CSV>) {
- chomp;
- my ($foo,$bar,$baz) = split /,/;
- $sth->execute( $foo, $bar, $baz );
- }
-
-The C<do()> method can be used for non repeated I<non>-C<SELECT> statement
-(or with drivers that don't support placeholders):
-
- $rows_affected = $dbh->do("UPDATE your_table SET foo = foo + 1");
-
-To commit your changes to the database (when L</AutoCommit> is off):
-
- $dbh->commit; # or call $dbh->rollback; to undo changes
-
-Finally, when you have finished working with the data source, you should
-L</disconnect> from it:
-
- $dbh->disconnect;
-
-
-=head2 General Interface Rules & Caveats
-
-The DBI does not have a concept of a "current session". Every session
-has a handle object (i.e., a C<$dbh>) returned from the C<connect> method.
-That handle object is used to invoke database related methods.
-
-Most data is returned to the Perl script as strings. (Null values are
-returned as C<undef>.) This allows arbitrary precision numeric data to be
-handled without loss of accuracy. Beware that Perl may not preserve
-the same accuracy when the string is used as a number.
-
-Dates and times are returned as character strings in the current
-default format of the corresponding database engine. Time zone effects
-are database/driver dependent.
-
-Perl supports binary data in Perl strings, and the DBI will pass binary
-data to and from the driver without change. It is up to the driver
-implementors to decide how they wish to handle such binary data.
-
-Perl supports two kinds of strings: Unicode (utf8 internally) and non-Unicode
-(defaults to iso-8859-1 if forced to assume an encoding). Drivers should
-accept both kinds of strings and, if required, convert them to the character
-set of the database being used. Similarly, when fetching from the database
-character data that isn't iso-8859-1 the driver should convert it into utf8.
-
-Multiple SQL statements may not be combined in a single statement
-handle (C<$sth>), although some databases and drivers do support this
-(notably Sybase and SQL Server).
-
-Non-sequential record reads are not supported in this version of the DBI.
-In other words, records can only be fetched in the order that the
-database returned them, and once fetched they are forgotten.
-
-Positioned updates and deletes are not directly supported by the DBI.
-See the description of the C<CursorName> attribute for an alternative.
-
-Individual driver implementors are free to provide any private
-functions and/or handle attributes that they feel are useful.
-Private driver functions can be invoked using the DBI C<func()> method.
-Private driver attributes are accessed just like standard attributes.
-
-Many methods have an optional C<\%attr> parameter which can be used to
-pass information to the driver implementing the method. Except where
-specifically documented, the C<\%attr> parameter can only be used to pass
-driver specific hints. In general, you can ignore C<\%attr> parameters
-or pass it as C<undef>.
-
-
-=head2 Naming Conventions and Name Space
-
-The DBI package and all packages below it (C<DBI::*>) are reserved for
-use by the DBI. Extensions and related modules use the C<DBIx::>
-namespace (see L<http://www.perl.com/CPAN/modules/by-module/DBIx/>).
-Package names beginning with C<DBD::> are reserved for use
-by DBI database drivers. All environment variables used by the DBI
-or by individual DBDs begin with "C<DBI_>" or "C<DBD_>".
-
-The letter case used for attribute names is significant and plays an
-important part in the portability of DBI scripts. The case of the
-attribute name is used to signify who defined the meaning of that name
-and its values.
-
- Case of name Has a meaning defined by
- ------------ ------------------------
- UPPER_CASE Standards, e.g., X/Open, ISO SQL92 etc (portable)
- MixedCase DBI API (portable), underscores are not used.
- lower_case Driver or database engine specific (non-portable)
-
-It is of the utmost importance that Driver developers only use
-lowercase attribute names when defining private attributes. Private
-attribute names must be prefixed with the driver name or suitable
-abbreviation (e.g., "C<ora_>" for Oracle, "C<ing_>" for Ingres, etc).
-
-
-=head2 SQL - A Query Language
-
-Most DBI drivers require applications to use a dialect of SQL
-(Structured Query Language) to interact with the database engine.
-The L</"Standards Reference Information"> section provides links
-to useful information about SQL.
-
-The DBI itself does not mandate or require any particular language to
-be used; it is language independent. In ODBC terms, the DBI is in
-"pass-thru" mode, although individual drivers might not be. The only requirement
-is that queries and other statements must be expressed as a single
-string of characters passed as the first argument to the L</prepare> or
-L</do> methods.
-
-For an interesting diversion on the I<real> history of RDBMS and SQL,
-from the people who made it happen, see:
-
- http://www.mcjones.org/System_R/SQL_Reunion_95/sqlr95.html
-
-Follow the "Full Contents" then "Intergalactic dataspeak" links for the
-SQL history.
-
-=head2 Placeholders and Bind Values
-
-Some drivers support placeholders and bind values.
-I<Placeholders>, also called parameter markers, are used to indicate
-values in a database statement that will be supplied later,
-before the prepared statement is executed. For example, an application
-might use the following to insert a row of data into the SALES table:
-
- INSERT INTO sales (product_code, qty, price) VALUES (?, ?, ?)
-
-or the following, to select the description for a product:
-
- SELECT description FROM products WHERE product_code = ?
-
-The C<?> characters are the placeholders. The association of actual
-values with placeholders is known as I<binding>, and the values are
-referred to as I<bind values>.
-Note that the C<?> is not enclosed in quotation marks, even when the
-placeholder represents a string.
-
-Some drivers also allow placeholders like C<:>I<name> and C<:>I<N> (e.g.,
-C<:1>, C<:2>, and so on) in addition to C<?>, but their use is not portable.
-
-If the C<:>I<N> form of placeholder is supported by the driver you're using,
-then you should be able to use either L</bind_param> or L</execute> to bind
-values. Check your driver documentation.
-
-Some drivers allow you to prevent the recognition of a placeholder by placing a
-single backslash character (C<\>) immediately before it. The driver will remove
-the backslash character and ignore the placeholder, passing it unchanged to the
-backend. If the driver supports this then L</get_info>(9000) will return true.
-
-With most drivers, placeholders can't be used for any element of a
-statement that would prevent the database server from validating the
-statement and creating a query execution plan for it. For example:
-
- "SELECT name, age FROM ?" # wrong (will probably fail)
- "SELECT name, ? FROM people" # wrong (but may not 'fail')
-
-Also, placeholders can only represent single scalar values.
-For example, the following
-statement won't work as expected for more than one value:
-
- "SELECT name, age FROM people WHERE name IN (?)" # wrong
- "SELECT name, age FROM people WHERE name IN (?,?)" # two names
-
-When using placeholders with the SQL C<LIKE> qualifier, you must
-remember that the placeholder substitutes for the whole string.
-So you should use "C<... LIKE ? ...>" and include any wildcard
-characters in the value that you bind to the placeholder.
-
-B<NULL Values>
-
-Undefined values, or C<undef>, are used to indicate NULL values.
-You can insert and update columns with a NULL value as you would a
-non-NULL value. These examples insert and update the column
-C<age> with a NULL value:
-
- $sth = $dbh->prepare(qq{
- INSERT INTO people (fullname, age) VALUES (?, ?)
- });
- $sth->execute("Joe Bloggs", undef);
-
- $sth = $dbh->prepare(qq{
- UPDATE people SET age = ? WHERE fullname = ?
- });
- $sth->execute(undef, "Joe Bloggs");
-
-However, care must be taken when trying to use NULL values in a
-C<WHERE> clause. Consider:
-
- SELECT fullname FROM people WHERE age = ?
-
-Binding an C<undef> (NULL) to the placeholder will I<not> select rows
-which have a NULL C<age>! At least for database engines that
-conform to the SQL standard. Refer to the SQL manual for your database
-engine or any SQL book for the reasons for this. To explicitly select
-NULLs you have to say "C<WHERE age IS NULL>".
-
-A common issue is to have a code fragment handle a value that could be
-either C<defined> or C<undef> (non-NULL or NULL) at runtime.
-A simple technique is to prepare the appropriate statement as needed,
-and substitute the placeholder for non-NULL cases:
-
- $sql_clause = defined $age? "age = ?" : "age IS NULL";
- $sth = $dbh->prepare(qq{
- SELECT fullname FROM people WHERE $sql_clause
- });
- $sth->execute(defined $age ? $age : ());
-
-The following technique illustrates qualifying a C<WHERE> clause with
-several columns, whose associated values (C<defined> or C<undef>) are
-in a hash %h:
-
- for my $col ("age", "phone", "email") {
- if (defined $h{$col}) {
- push @sql_qual, "$col = ?";
- push @sql_bind, $h{$col};
- }
- else {
- push @sql_qual, "$col IS NULL";
- }
- }
- $sql_clause = join(" AND ", @sql_qual);
- $sth = $dbh->prepare(qq{
- SELECT fullname FROM people WHERE $sql_clause
- });
- $sth->execute(@sql_bind);
-
-The techniques above call prepare for the SQL statement with each call to
-execute. Because calls to prepare() can be expensive, performance
-can suffer when an application iterates many times over statements
-like the above.
-
-A better solution is a single C<WHERE> clause that supports both
-NULL and non-NULL comparisons. Its SQL statement would need to be
-prepared only once for all cases, thus improving performance.
-Several examples of C<WHERE> clauses that support this are presented
-below. But each example lacks portability, robustness, or simplicity.
-Whether an example is supported on your database engine depends on
-what SQL extensions it provides, and where it supports the C<?>
-placeholder in a statement.
-
- 0) age = ?
- 1) NVL(age, xx) = NVL(?, xx)
- 2) ISNULL(age, xx) = ISNULL(?, xx)
- 3) DECODE(age, ?, 1, 0) = 1
- 4) age = ? OR (age IS NULL AND ? IS NULL)
- 5) age = ? OR (age IS NULL AND SP_ISNULL(?) = 1)
- 6) age = ? OR (age IS NULL AND ? = 1)
-
-Statements formed with the above C<WHERE> clauses require execute
-statements as follows. The arguments are required, whether their
-values are C<defined> or C<undef>.
-
- 0,1,2,3) $sth->execute($age);
- 4,5) $sth->execute($age, $age);
- 6) $sth->execute($age, defined($age) ? 0 : 1);
-
-Example 0 should not work (as mentioned earlier), but may work on
-a few database engines anyway (e.g. Sybase). Example 0 is part
-of examples 4, 5, and 6, so if example 0 works, these other
-examples may work, even if the engine does not properly support
-the right hand side of the C<OR> expression.
-
-Examples 1 and 2 are not robust: they require that you provide a
-valid column value xx (e.g. '~') which is not present in any row.
-That means you must have some notion of what data won't be stored
-in the column, and expect clients to adhere to that.
-
-Example 5 requires that you provide a stored procedure (SP_ISNULL
-in this example) that acts as a function: it checks whether a value
-is null, and returns 1 if it is, or 0 if not.
-
-Example 6, the least simple, is probably the most portable, i.e., it
-should work with most, if not all, database engines.
-
-Here is a table that indicates which examples above are known to
-work on various database engines:
-
- -----Examples------
- 0 1 2 3 4 5 6
- - - - - - - -
- Oracle 9 N Y N Y Y ? Y
- Informix IDS 9 N N N Y N Y Y
- MS SQL N N Y N Y ? Y
- Sybase Y N N N N N Y
- AnyData,DBM,CSV Y N N N Y Y* Y
- SQLite 3.3 N N N N Y N N
- MSAccess N N N N Y N Y
-
-* Works only because Example 0 works.
-
-DBI provides a sample perl script that will test the examples above
-on your database engine and tell you which ones work. It is located
-in the F<ex/> subdirectory of the DBI source distribution, or here:
-L<https://github.com/perl5-dbi/dbi/blob/master/ex/perl_dbi_nulls_test.pl>
-Please use the script to help us fill-in and maintain this table.
-
-B<Performance>
-
-Without using placeholders, the insert statement shown previously would have to
-contain the literal values to be inserted and would have to be
-re-prepared and re-executed for each row. With placeholders, the insert
-statement only needs to be prepared once. The bind values for each row
-can be given to the C<execute> method each time it's called. By avoiding
-the need to re-prepare the statement for each row, the application
-typically runs many times faster. Here's an example:
-
- my $sth = $dbh->prepare(q{
- INSERT INTO sales (product_code, qty, price) VALUES (?, ?, ?)
- }) or die $dbh->errstr;
- while (<>) {
- chomp;
- my ($product_code, $qty, $price) = split /,/;
- $sth->execute($product_code, $qty, $price) or die $dbh->errstr;
- }
- $dbh->commit or die $dbh->errstr;
-
-See L</execute> and L</bind_param> for more details.
-
-The C<q{...}> style quoting used in this example avoids clashing with
-quotes that may be used in the SQL statement. Use the double-quote like
-C<qq{...}> operator if you want to interpolate variables into the string.
-See L<perlop/"Quote and Quote-like Operators"> for more details.
-
-See also the L</bind_columns> method, which is used to associate Perl
-variables with the output columns of a C<SELECT> statement.
-
-=head1 THE DBI PACKAGE AND CLASS
-
-In this section, we cover the DBI class methods, utility functions,
-and the dynamic attributes associated with generic DBI handles.
-
-=head2 DBI Constants
-
-Constants representing the values of the SQL standard types can be
-imported individually by name, or all together by importing the
-special C<:sql_types> tag.
-
-The names and values of all the defined SQL standard types can be
-produced like this:
-
- foreach (@{ $DBI::EXPORT_TAGS{sql_types} }) {
- printf "%s=%d\n", $_, &{"DBI::$_"};
- }
-
-These constants are defined by SQL/CLI, ODBC or both.
-C<SQL_BIGINT> has conflicting codes in SQL/CLI and ODBC,
-DBI uses the ODBC one.
-
-See the L</type_info>, L</type_info_all>, and L</bind_param> methods
-for possible uses.
-
-Note that just because the DBI defines a named constant for a given
-data type doesn't mean that drivers will support that data type.
-
-
-=head2 DBI Class Methods
-
-The following methods are provided by the DBI class:
-
-=head3 C<parse_dsn>
-
- ($scheme, $driver, $attr_string, $attr_hash, $driver_dsn) = DBI->parse_dsn($dsn)
- or die "Can't parse DBI DSN '$dsn'";
-
-Breaks apart a DBI Data Source Name (DSN) and returns the individual
-parts. If $dsn doesn't contain a valid DSN then parse_dsn() returns
-an empty list.
-
-$scheme is the first part of the DSN and is currently always 'dbi'.
-$driver is the driver name, possibly defaulted to $ENV{DBI_DRIVER},
-and may be undefined. $attr_string is the contents of the optional attribute
-string, which may be undefined. If $attr_string is not empty then $attr_hash
-is a reference to a hash containing the parsed attribute names and values.
-$driver_dsn is the last part of the DBI DSN string. For example:
-
- ($scheme, $driver, $attr_string, $attr_hash, $driver_dsn)
- = DBI->parse_dsn("dbi:MyDriver(RaiseError=>1):db=test;port=42");
- $scheme = 'dbi';
- $driver = 'MyDriver';
- $attr_string = 'RaiseError=>1';
- $attr_hash = { 'RaiseError' => '1' };
- $driver_dsn = 'db=test;port=42';
-
-The parse_dsn() method was added in DBI 1.43.
-
-=head3 C<connect>
-
- $dbh = DBI->connect($data_source, $username, $password)
- or die $DBI::errstr;
- $dbh = DBI->connect($data_source, $username, $password, \%attr)
- or die $DBI::errstr;
-
-Establishes a database connection, or session, to the requested C<$data_source>.
-Returns a database handle object if the connection succeeds. Use
-C<$dbh-E<gt>disconnect> to terminate the connection.
-
-If the connect fails (see below), it returns C<undef> and sets both C<$DBI::err>
-and C<$DBI::errstr>. (It does I<not> explicitly set C<$!>.) You should generally
-test the return status of C<connect> and C<print $DBI::errstr> if it has failed.
-
-Multiple simultaneous connections to multiple databases through multiple
-drivers can be made via the DBI. Simply make one C<connect> call for each
-database and keep a copy of each returned database handle.
-
-The C<$data_source> value must begin with "C<dbi:>I<driver_name>C<:>".
-The I<driver_name> specifies the driver that will be used to make the
-connection. (Letter case is significant.)
-
-As a convenience, if the C<$data_source> parameter is undefined or empty,
-the DBI will substitute the value of the environment variable C<DBI_DSN>.
-If just the I<driver_name> part is empty (i.e., the C<$data_source>
-prefix is "C<dbi::>"), the environment variable C<DBI_DRIVER> is
-used. If neither variable is set, then C<connect> dies.
-
-Examples of C<$data_source> values are:
-
- dbi:DriverName:database_name
- dbi:DriverName:database_name@hostname:port
- dbi:DriverName:database=database_name;host=hostname;port=port
-
-There is I<no standard> for the text following the driver name. Each
-driver is free to use whatever syntax it wants. The only requirement the
-DBI makes is that all the information is supplied in a single string.
-You must consult the documentation for the drivers you are using for a
-description of the syntax they require.
-
-It is recommended that drivers support the ODBC style, shown in the
-last example above. It is also recommended that they support the
-three common names 'C<host>', 'C<port>', and 'C<database>' (plus 'C<db>'
-as an alias for C<database>). This simplifies automatic construction
-of basic DSNs: C<"dbi:$driver:database=$db;host=$host;port=$port">.
-Drivers should aim to 'do something reasonable' when given a DSN
-in this form, but if any part is meaningless for that driver (such
-as 'port' for Informix) it should generate an error if that part
-is not empty.
-
-If the environment variable C<DBI_AUTOPROXY> is defined (and the
-driver in C<$data_source> is not "C<Proxy>") then the connect request
-will automatically be changed to:
-
- $ENV{DBI_AUTOPROXY};dsn=$data_source
-
-C<DBI_AUTOPROXY> is typically set as "C<dbi:Proxy:hostname=...;port=...>".
-If $ENV{DBI_AUTOPROXY} doesn't begin with 'C<dbi:>' then "dbi:Proxy:"
-will be prepended to it first. See the DBD::Proxy documentation
-for more details.
-
-If C<$username> or C<$password> are undefined (rather than just empty),
-then the DBI will substitute the values of the C<DBI_USER> and C<DBI_PASS>
-environment variables, respectively. The DBI will warn if the
-environment variables are not defined. However, the everyday use
-of these environment variables is not recommended for security
-reasons. The mechanism is primarily intended to simplify testing.
-See below for alternative way to specify the username and password.
-
-C<DBI-E<gt>connect> automatically installs the driver if it has not been
-installed yet. Driver installation either returns a valid driver
-handle, or it I<dies> with an error message that includes the string
-"C<install_driver>" and the underlying problem. So C<DBI-E<gt>connect>
-will die
-on a driver installation failure and will only return C<undef> on a
-connect failure, in which case C<$DBI::errstr> will hold the error message.
-Use C<eval> if you need to catch the "C<install_driver>" error.
-
-The C<$data_source> argument (with the "C<dbi:...:>" prefix removed) and the
-C<$username> and C<$password> arguments are then passed to the driver for
-processing. The DBI does not define any interpretation for the
-contents of these fields. The driver is free to interpret the
-C<$data_source>, C<$username>, and C<$password> fields in any way, and supply
-whatever defaults are appropriate for the engine being accessed.
-(Oracle, for example, uses the ORACLE_SID and TWO_TASK environment
-variables if no C<$data_source> is specified.)
-
-The C<AutoCommit> and C<PrintError> attributes for each connection
-default to "on". (See L</AutoCommit> and L</PrintError> for more information.)
-However, it is strongly recommended that you explicitly define C<AutoCommit>
-rather than rely on the default. The C<PrintWarn> attribute defaults to true.
-
-The C<\%attr> parameter can be used to alter the default settings of
-C<PrintError>, C<RaiseError>, C<AutoCommit>, and other attributes. For example:
-
- $dbh = DBI->connect($data_source, $user, $pass, {
- PrintError => 0,
- AutoCommit => 0
- });
-
-The username and password can also be specified using the attributes
-C<Username> and C<Password>, in which case they take precedence
-over the C<$username> and C<$password> parameters.
-
-You can also define connection attribute values within the C<$data_source>
-parameter. For example:
-
- dbi:DriverName(PrintWarn=>0,PrintError=>0,Taint=>1):...
-
-Individual attributes values specified in this way take precedence over
-any conflicting values specified via the C<\%attr> parameter to C<connect>.
-
-The C<dbi_connect_method> attribute can be used to specify which driver
-method should be called to establish the connection. The only useful
-values are 'connect', 'connect_cached', or some specialized case like
-'Apache::DBI::connect' (which is automatically the default when running
-within Apache).
-
-Where possible, each session (C<$dbh>) is independent from the transactions
-in other sessions. This is useful when you need to hold cursors open
-across transactions--for example, if you use one session for your long lifespan
-cursors (typically read-only) and another for your short update
-transactions.
-
-For compatibility with old DBI scripts, the driver can be specified by
-passing its name as the fourth argument to C<connect> (instead of C<\%attr>):
-
- $dbh = DBI->connect($data_source, $user, $pass, $driver);
-
-In this "old-style" form of C<connect>, the C<$data_source> should not start
-with "C<dbi:driver_name:>". (If it does, the embedded driver_name
-will be ignored). Also note that in this older form of C<connect>,
-the C<$dbh-E<gt>{AutoCommit}> attribute is I<undefined>, the
-C<$dbh-E<gt>{PrintError}> attribute is off, and the old C<DBI_DBNAME>
-environment variable is
-checked if C<DBI_DSN> is not defined. Beware that this "old-style"
-C<connect> will soon be withdrawn in a future version of DBI.
-
-=head3 C<connect_cached>
-
- $dbh = DBI->connect_cached($data_source, $username, $password)
- or die $DBI::errstr;
- $dbh = DBI->connect_cached($data_source, $username, $password, \%attr)
- or die $DBI::errstr;
-
-C<connect_cached> is like L</connect>, except that the database handle
-returned is also
-stored in a hash associated with the given parameters. If another call
-is made to C<connect_cached> with the same parameter values, then the
-corresponding cached C<$dbh> will be returned if it is still valid.
-The cached database handle is replaced with a new connection if it
-has been disconnected or if the C<ping> method fails.
-
-Note that the behaviour of this method differs in several respects from the
-behaviour of persistent connections implemented by Apache::DBI.
-However, if Apache::DBI is loaded then C<connect_cached> will use it.
-
-Caching connections can be useful in some applications, but it can
-also cause problems, such as too many connections, and so should
-be used with care. In particular, avoid changing the attributes of
-a database handle created via connect_cached() because it will affect
-other code that may be using the same handle. When connect_cached()
-returns a handle the attributes will be reset to their initial values.
-This can cause problems, especially with the C<AutoCommit> attribute.
-
-Also, to ensure that the attributes passed are always the same, avoid passing
-references inline. For example, the C<Callbacks> attribute is specified as a
-hash reference. Be sure to declare it external to the call to
-connect_cached(), such that the hash reference is not re-created on every
-call. A package-level lexical works well:
-
- package MyDBH;
- my $cb = {
- 'connect_cached.reused' => sub { delete $_[4]->{AutoCommit} },
- };
-
- sub dbh {
- DBI->connect_cached( $dsn, $username, $auth, { Callbacks => $cb });
- }
-
-Where multiple separate parts of a program are using connect_cached()
-to connect to the same database with the same (initial) attributes
-it is a good idea to add a private attribute to the connect_cached()
-call to effectively limit the scope of the caching. For example:
-
- DBI->connect_cached(..., { private_foo_cachekey => "Bar", ... });
-
-Handles returned from that connect_cached() call will only be returned
-by other connect_cached() call elsewhere in the code if those other
-calls also pass in the same attribute values, including the private one.
-(I've used C<private_foo_cachekey> here as an example, you can use
-any attribute name with a C<private_> prefix.)
-
-Taking that one step further, you can limit a particular connect_cached()
-call to return handles unique to that one place in the code by setting the
-private attribute to a unique value for that place:
-
- DBI->connect_cached(..., { private_foo_cachekey => __FILE__.__LINE__, ... });
-
-By using a private attribute you still get connection caching for
-the individual calls to connect_cached() but, by making separate
-database connections for separate parts of the code, the database
-handles are isolated from any attribute changes made to other handles.
-
-The cache can be accessed (and cleared) via the L</CachedKids> attribute:
-
- my $CachedKids_hashref = $dbh->{Driver}->{CachedKids};
- %$CachedKids_hashref = () if $CachedKids_hashref;
-
-
-=head3 C<available_drivers>
-
- @ary = DBI->available_drivers;
- @ary = DBI->available_drivers($quiet);
-
-Returns a list of all available drivers by searching for C<DBD::*> modules
-through the directories in C<@INC>. By default, a warning is given if
-some drivers are hidden by others of the same name in earlier
-directories. Passing a true value for C<$quiet> will inhibit the warning.
-
-=head3 C<installed_drivers>
-
- %drivers = DBI->installed_drivers();
-
-Returns a list of driver name and driver handle pairs for all drivers
-'installed' (loaded) into the current process. The driver name does not
-include the 'DBD::' prefix.
-
-To get a list of all drivers available in your perl installation you can use
-L</available_drivers>.
-
-Added in DBI 1.49.
-
-=head3 C<installed_versions>
-
- DBI->installed_versions;
- @ary = DBI->installed_versions;
- $hash = DBI->installed_versions;
-
-Calls available_drivers() and attempts to load each of them in turn
-using install_driver(). For each load that succeeds the driver
-name and version number are added to a hash. When running under
-L<DBI::PurePerl> drivers which appear not be pure-perl are ignored.
-
-When called in array context the list of successfully loaded drivers
-is returned (without the 'DBD::' prefix).
-
-When called in scalar context an extra entry for the C<DBI> is added (and
-C<DBI::PurePerl> if appropriate) and a reference to the hash is returned.
-
-When called in a void context the installed_versions() method will
-print out a formatted list of the hash contents, one per line, along with some
-other information about the DBI version and OS.
-
-Due to the potentially high memory cost and unknown risks of loading
-in an unknown number of drivers that just happen to be installed
-on the system, this method is not recommended for general use.
-Use available_drivers() instead.
-
-The installed_versions() method is primarily intended as a quick
-way to see from the command line what's installed. For example:
-
- perl -MDBI -e 'DBI->installed_versions'
-
-The installed_versions() method was added in DBI 1.38.
-
-=head3 C<data_sources>
-
- @ary = DBI->data_sources($driver);
- @ary = DBI->data_sources($driver, \%attr);
-
-Returns a list of data sources (databases) available via the named
-driver. If C<$driver> is empty or C<undef>, then the value of the
-C<DBI_DRIVER> environment variable is used.
-
-The driver will be loaded if it hasn't been already. Note that if the
-driver loading fails then data_sources() I<dies> with an error message
-that includes the string "C<install_driver>" and the underlying problem.
-
-Data sources are returned in a form suitable for passing to the
-L</connect> method (that is, they will include the "C<dbi:$driver:>" prefix).
-
-Note that many drivers have no way of knowing what data sources might
-be available for it. These drivers return an empty or incomplete list
-or may require driver-specific attributes.
-
-There is also a data_sources() method defined for database handles.
-
-
-=head3 C<trace>
-
- DBI->trace($trace_setting)
- DBI->trace($trace_setting, $trace_filename)
- DBI->trace($trace_setting, $trace_filehandle)
- $trace_setting = DBI->trace;
-
-The C<DBI-E<gt>trace> method sets the I<global default> trace
-settings and returns the I<previous> trace settings. It can also
-be used to change where the trace output is sent.
-
-There's a similar method, C<$h-E<gt>trace>, which sets the trace
-settings for the specific handle it's called on.
-
-See the L</TRACING> section for full details about the DBI's powerful
-tracing facilities.
-
-
-=head3 C<visit_handles>
-
- DBI->visit_handles( $coderef );
- DBI->visit_handles( $coderef, $info );
-
-Where $coderef is a reference to a subroutine and $info is an arbitrary value
-which, if undefined, defaults to a reference to an empty hash. Returns $info.
-
-For each installed driver handle, if any, $coderef is invoked as:
-
- $coderef->($driver_handle, $info);
-
-If the execution of $coderef returns a true value then L</visit_child_handles>
-is called on that child handle and passed the returned value as $info.
-
-For example:
-
- my $info = $dbh->{Driver}->visit_child_handles(sub {
- my ($h, $info) = @_;
- ++$info->{ $h->{Type} }; # count types of handles (dr/db/st)
- return $info; # visit kids
- });
-
-See also L</visit_child_handles>.
-
-=head2 DBI Utility Functions
-
-In addition to the DBI methods listed in the previous section,
-the DBI package also provides several utility functions.
-
-These can be imported into your code by listing them in
-the C<use> statement. For example:
-
- use DBI qw(neat data_diff);
-
-Alternatively, all these utility functions (except hash) can be
-imported using the C<:utils> import tag. For example:
-
- use DBI qw(:utils);
-
-=head3 C<data_string_desc>
-
- $description = data_string_desc($string);
-
-Returns an informal description of the string. For example:
-
- UTF8 off, ASCII, 42 characters 42 bytes
- UTF8 off, non-ASCII, 42 characters 42 bytes
- UTF8 on, non-ASCII, 4 characters 6 bytes
- UTF8 on but INVALID encoding, non-ASCII, 4 characters 6 bytes
- UTF8 off, undef
-
-The initial C<UTF8> on/off refers to Perl's internal SvUTF8 flag.
-If $string has the SvUTF8 flag set but the sequence of bytes it
-contains are not a valid UTF-8 encoding then data_string_desc()
-will report C<UTF8 on but INVALID encoding>.
-
-The C<ASCII> vs C<non-ASCII> portion shows C<ASCII> if I<all> the
-characters in the string are ASCII (have code points <= 127).
-
-The data_string_desc() function was added in DBI 1.46.
-
-=head3 C<data_string_diff>
-
- $diff = data_string_diff($a, $b);
-
-Returns an informal description of the first character difference
-between the strings. If both $a and $b contain the same sequence
-of characters then data_string_diff() returns an empty string.
-For example:
-
- Params a & b Result
- ------------ ------
- 'aaa', 'aaa' ''
- 'aaa', 'abc' 'Strings differ at index 2: a[2]=a, b[2]=b'
- 'aaa', undef 'String b is undef, string a has 3 characters'
- 'aaa', 'aa' 'String b truncated after 2 characters'
-
-Unicode characters are reported in C<\x{XXXX}> format. Unicode
-code points in the range U+0800 to U+08FF are unassigned and most
-likely to occur due to double-encoding. Characters in this range
-are reported as C<\x{08XX}='C'> where C<C> is the corresponding
-latin-1 character.
-
-The data_string_diff() function only considers logical I<characters>
-and not the underlying encoding. See L</data_diff> for an alternative.
-
-The data_string_diff() function was added in DBI 1.46.
-
-=head3 C<data_diff>
-
- $diff = data_diff($a, $b);
- $diff = data_diff($a, $b, $logical);
-
-Returns an informal description of the difference between two strings.
-It calls L</data_string_desc> and L</data_string_diff>
-and returns the combined results as a multi-line string.
-
-For example, C<data_diff("abc", "ab\x{263a}")> will return:
-
- a: UTF8 off, ASCII, 3 characters 3 bytes
- b: UTF8 on, non-ASCII, 3 characters 5 bytes
- Strings differ at index 2: a[2]=c, b[2]=\x{263A}
-
-If $a and $b are identical in both the characters they contain I<and>
-their physical encoding then data_diff() returns an empty string.
-If $logical is true then physical encoding differences are ignored
-(but are still reported if there is a difference in the characters).
-
-The data_diff() function was added in DBI 1.46.
-
-=head3 C<neat>
-
- $str = neat($value);
- $str = neat($value, $maxlen);
-
-Return a string containing a neat (and tidy) representation of the
-supplied value.
-
-Strings will be quoted, although internal quotes will I<not> be escaped.
-Values known to be numeric will be unquoted. Undefined (NULL) values
-will be shown as C<undef> (without quotes).
-
-If the string is flagged internally as utf8 then double quotes will
-be used, otherwise single quotes are used and unprintable characters
-will be replaced by dot (.).
-
-For result strings longer than C<$maxlen> the result string will be
-truncated to C<$maxlen-4> and "C<...'>" will be appended. If C<$maxlen> is 0
-or C<undef>, it defaults to C<$DBI::neat_maxlen> which, in turn, defaults to 400.
-
-This function is designed to format values for human consumption.
-It is used internally by the DBI for L</trace> output. It should
-typically I<not> be used for formatting values for database use.
-(See also L</quote>.)
-
-=head3 C<neat_list>
-
- $str = neat_list(\@listref, $maxlen, $field_sep);
-
-Calls C<neat> on each element of the list and returns a string
-containing the results joined with C<$field_sep>. C<$field_sep> defaults
-to C<", ">.
-
-=head3 C<looks_like_number>
-
- @bool = looks_like_number(@array);
-
-Returns true for each element that looks like a number.
-Returns false for each element that does not look like a number.
-Returns C<undef> for each element that is undefined or empty.
-
-=head3 C<hash>
-
- $hash_value = DBI::hash($buffer, $type);
-
-Return a 32-bit integer 'hash' value corresponding to the contents of $buffer.
-The $type parameter selects which kind of hash algorithm should be used.
-
-For the technically curious, type 0 (which is the default if $type
-isn't specified) is based on the Perl 5.1 hash except that the value
-is forced to be negative (for obscure historical reasons).
-Type 1 is the better "Fowler / Noll / Vo" (FNV) hash. See
-L<http://www.isthe.com/chongo/tech/comp/fnv/> for more information.
-Both types are implemented in C and are very fast.
-
-This function doesn't have much to do with databases, except that
-it can sometimes be handy to store such values in a database.
-It also doesn't have much to do with perl hashes, like %foo.
-
-=head3 C<sql_type_cast>
-
- $sts = DBI::sql_type_cast($sv, $sql_type, $flags);
-
-sql_type_cast attempts to cast C<$sv> to the SQL type (see L<DBI
-Constants>) specified in C<$sql_type>. At present only the SQL types
-C<SQL_INTEGER>, C<SQL_DOUBLE> and C<SQL_NUMERIC> are supported.
-
-For C<SQL_INTEGER> the effect is similar to using the value in an expression
-that requires an integer. It gives the perl scalar an 'integer aspect'.
-(Technically the value gains an IV, or possibly a UV or NV if the value is too
-large for an IV.)
-
-For C<SQL_DOUBLE> the effect is similar to using the value in an expression
-that requires a general numeric value. It gives the perl scalar a 'numeric
-aspect'. (Technically the value gains an NV.)
-
-C<SQL_NUMERIC> is similar to C<SQL_INTEGER> or C<SQL_DOUBLE> but more
-general and more cautious. It will look at the string first and if it
-looks like an integer (that will fit in an IV or UV) it will act like
-C<SQL_INTEGER>, if it looks like a floating point value it will act
-like C<SQL_DOUBLE>, if it looks like neither then it will do nothing -
-and thereby avoid the warnings that would be generated by
-C<SQL_INTEGER> and C<SQL_DOUBLE> when given non-numeric data.
-
-C<$flags> may be:
-
-=over 4
-
-=item C<DBIstcf_DISCARD_STRING>
-
-If this flag is specified then when the driver successfully casts the
-bound perl scalar to a non-string type then the string portion of the
-scalar will be discarded.
-
-=item C<DBIstcf_STRICT>
-
-If C<$sv> cannot be cast to the requested C<$sql_type> then by default
-it is left untouched and no error is generated. If you specify
-C<DBIstcf_STRICT> and the cast fails, this will generate an error.
-
-=back
-
-The returned C<$sts> value is:
-
- -2 sql_type is not handled
- -1 sv is undef so unchanged
- 0 sv could not be cast cleanly and DBIstcf_STRICT was used
- 1 sv could not be cast and DBIstcf_STRICT was not used
- 2 sv was cast successfully
-
-This method is exported by the :utils tag and was introduced in DBI
-1.611.
-
-=head2 DBI Dynamic Attributes
-
-Dynamic attributes are always associated with the I<last handle used>
-(that handle is represented by C<$h> in the descriptions below).
-
-Where an attribute is equivalent to a method call, then refer to
-the method call for all related documentation.
-
-Warning: these attributes are provided as a convenience but they
-do have limitations. Specifically, they have a short lifespan:
-because they are associated with
-the last handle used, they should only be used I<immediately> after
-calling the method that "sets" them.
-If in any doubt, use the corresponding method call.
-
-=head3 C<$DBI::err>
-
-Equivalent to C<$h-E<gt>err>.
-
-=head3 C<$DBI::errstr>
-
-Equivalent to C<$h-E<gt>errstr>.
-
-=head3 C<$DBI::state>
-
-Equivalent to C<$h-E<gt>state>.
-
-=head3 C<$DBI::rows>
-
-Equivalent to C<$h-E<gt>rows>. Please refer to the documentation
-for the L</rows> method.
-
-=head3 C<$DBI::lasth>
-
-Returns the DBI object handle used for the most recent DBI method call.
-If the last DBI method call was a DESTROY then $DBI::lasth will return
-the handle of the parent of the destroyed handle, if there is one.
-
-
-=head1 METHODS COMMON TO ALL HANDLES
-
-The following methods can be used by all types of DBI handles.
-
-=head3 C<err>
-
- $rv = $h->err;
-
-Returns the I<native> database engine error code from the last driver
-method called. The code is typically an integer but you should not
-assume that.
-
-The DBI resets $h->err to undef before almost all DBI method calls, so the
-value only has a short lifespan. Also, for most drivers, the statement
-handles share the same error variable as the parent database handle,
-so calling a method on one handle may reset the error on the
-related handles.
-
-(Methods which don't reset err before being called include err() and errstr(),
-obviously, state(), rows(), func(), trace(), trace_msg(), ping(), and the
-tied hash attribute FETCH() and STORE() methods.)
-
-If you need to test for specific error conditions I<and> have your program be
-portable to different database engines, then you'll need to determine what the
-corresponding error codes are for all those engines and test for all of them.
-
-The DBI uses the value of $DBI::stderr as the C<err> value for internal errors.
-Drivers should also do likewise. The default value for $DBI::stderr is 2000000000.
-
-A driver may return C<0> from err() to indicate a warning condition
-after a method call. Similarly, a driver may return an empty string
-to indicate a 'success with information' condition. In both these
-cases the value is false but not undef. The errstr() and state()
-methods may be used to retrieve extra information in these cases.
-
-See L</set_err> for more information.
-
-=head3 C<errstr>
-
- $str = $h->errstr;
-
-Returns the native database engine error message from the last DBI
-method called. This has the same lifespan issues as the L</err> method
-described above.
-
-The returned string may contain multiple messages separated by
-newline characters.
-
-The errstr() method should not be used to test for errors, use err()
-for that, because drivers may return 'success with information' or
-warning messages via errstr() for methods that have not 'failed'.
-
-See L</set_err> for more information.
-
-=head3 C<state>
-
- $str = $h->state;
-
-Returns a state code in the standard SQLSTATE five character format.
-Note that the specific success code C<00000> is translated to any empty string
-(false). If the driver does not support SQLSTATE (and most don't),
-then state() will return C<S1000> (General Error) for all errors.
-
-The driver is free to return any value via C<state>, e.g., warning
-codes, even if it has not declared an error by returning a true value
-via the L</err> method described above.
-
-The state() method should not be used to test for errors, use err()
-for that, because drivers may return a 'success with information' or
-warning state code via state() for methods that have not 'failed'.
-
-=head3 C<set_err>
-
- $rv = $h->set_err($err, $errstr);
- $rv = $h->set_err($err, $errstr, $state);
- $rv = $h->set_err($err, $errstr, $state, $method);
- $rv = $h->set_err($err, $errstr, $state, $method, $rv);
-
-Set the C<err>, C<errstr>, and C<state> values for the handle.
-This method is typically only used by DBI drivers and DBI subclasses.
-
-If the L</HandleSetErr> attribute holds a reference to a subroutine
-it is called first. The subroutine can alter the $err, $errstr, $state,
-and $method values. See L</HandleSetErr> for full details.
-If the subroutine returns a true value then the handle C<err>,
-C<errstr>, and C<state> values are not altered and set_err() returns
-an empty list (it normally returns $rv which defaults to undef, see below).
-
-Setting C<err> to a I<true> value indicates an error and will trigger
-the normal DBI error handling mechanisms, such as C<RaiseError> and
-C<HandleError>, if they are enabled, when execution returns from
-the DBI back to the application.
-
-Setting C<err> to C<""> indicates an 'information' state, and setting
-it to C<"0"> indicates a 'warning' state. Setting C<err> to C<undef>
-also sets C<errstr> to undef, and C<state> to C<"">, irrespective
-of the values of the $errstr and $state parameters.
-
-The $method parameter provides an alternate method name for the
-C<RaiseError>/C<PrintError>/C<PrintWarn> error string instead of
-the fairly unhelpful 'C<set_err>'.
-
-The C<set_err> method normally returns undef. The $rv parameter
-provides an alternate return value.
-
-Some special rules apply if the C<err> or C<errstr>
-values for the handle are I<already> set...
-
-If C<errstr> is true then: "C< [err was %s now %s]>" is appended if $err is
-true and C<err> is already true and the new err value differs from the original
-one. Similarly "C< [state was %s now %s]>" is appended if $state is true and C<state> is
-already true and the new state value differs from the original one. Finally
-"C<\n>" and the new $errstr are appended if $errstr differs from the existing
-errstr value. Obviously the C<%s>'s above are replaced by the corresponding values.
-
-The handle C<err> value is set to $err if: $err is true; or handle
-C<err> value is undef; or $err is defined and the length is greater
-than the handle C<err> length. The effect is that an 'information'
-state only overrides undef; a 'warning' overrides undef or 'information',
-and an 'error' state overrides anything.
-
-The handle C<state> value is set to $state if $state is true and
-the handle C<err> value was set (by the rules above).
-
-Support for warning and information states was added in DBI 1.41.
-
-=head3 C<trace>
-
- $h->trace($trace_settings);
- $h->trace($trace_settings, $trace_filename);
- $trace_settings = $h->trace;
-
-The trace() method is used to alter the trace settings for a handle
-(and any future children of that handle). It can also be used to
-change where the trace output is sent.
-
-There's a similar method, C<DBI-E<gt>trace>, which sets the global
-default trace settings.
-
-See the L</TRACING> section for full details about the DBI's powerful
-tracing facilities.
-
-=head3 C<trace_msg>
-
- $h->trace_msg($message_text);
- $h->trace_msg($message_text, $min_level);
-
-Writes C<$message_text> to the trace file if the trace level is
-greater than or equal to $min_level (which defaults to 1).
-Can also be called as C<DBI-E<gt>trace_msg($msg)>.
-
-See L</TRACING> for more details.
-
-=head3 C<func>
-
- $h->func(@func_arguments, $func_name) or die ...;
-
-The C<func> method can be used to call private non-standard and
-non-portable methods implemented by the driver. Note that the function
-name is given as the I<last> argument.
-
-It's also important to note that the func() method does not clear
-a previous error ($DBI::err etc.) and it does not trigger automatic
-error detection (RaiseError etc.) so you must check the return
-status and/or $h->err to detect errors.
-
-(This method is not directly related to calling stored procedures.
-Calling stored procedures is currently not defined by the DBI.
-Some drivers, such as DBD::Oracle, support it in non-portable ways.
-See driver documentation for more details.)
-
-See also install_method() in L<DBI::DBD> for how you can avoid needing to
-use func() and gain direct access to driver-private methods.
-
-=head3 C<can>
-
- $is_implemented = $h->can($method_name);
-
-Returns true if $method_name is implemented by the driver or a
-default method is provided by the DBI's driver base class.
-It returns false where a driver hasn't implemented a method and the
-default method is provided by the DBI's driver base class is just an empty stub.
-
-=head3 C<parse_trace_flags>
-
- $trace_settings_integer = $h->parse_trace_flags($trace_settings);
-
-Parses a string containing trace settings and returns the corresponding
-integer value used internally by the DBI and drivers.
-
-The $trace_settings argument is a string containing a trace level
-between 0 and 15 and/or trace flag names separated by vertical bar
-("C<|>") or comma ("C<,>") characters. For example: C<"SQL|3|foo">.
-
-It uses the parse_trace_flag() method, described below, to process
-the individual trace flag names.
-
-The parse_trace_flags() method was added in DBI 1.42.
-
-=head3 C<parse_trace_flag>
-
- $bit_flag = $h->parse_trace_flag($trace_flag_name);
-
-Returns the bit flag corresponding to the trace flag name in
-$trace_flag_name. Drivers are expected to override this method and
-check if $trace_flag_name is a driver specific trace flags and, if
-not, then call the DBI's default parse_trace_flag().
-
-The parse_trace_flag() method was added in DBI 1.42.
-
-=head3 C<private_attribute_info>
-
- $hash_ref = $h->private_attribute_info();
-
-Returns a reference to a hash whose keys are the names of driver-private
-handle attributes available for the kind of handle (driver, database, statement)
-that the method was called on.
-
-For example, the return value when called with a DBD::Sybase $dbh could look like this:
-
- {
- syb_dynamic_supported => undef,
- syb_oc_version => undef,
- syb_server_version => undef,
- syb_server_version_string => undef,
- }
-
-and when called with a DBD::Sybase $sth they could look like this:
-
- {
- syb_types => undef,
- syb_proc_status => undef,
- syb_result_type => undef,
- }
-
-The values should be undef. Meanings may be assigned to particular values in future.
-
-=head3 C<swap_inner_handle>
-
- $rc = $h1->swap_inner_handle( $h2 );
- $rc = $h1->swap_inner_handle( $h2, $allow_reparent );
-
-Brain transplants for handles. You don't need to know about this
-unless you want to become a handle surgeon.
-
-A DBI handle is a reference to a tied hash. A tied hash has an
-I<inner> hash that actually holds the contents. The swap_inner_handle()
-method swaps the inner hashes between two handles. The $h1 and $h2
-handles still point to the same tied hashes, but what those hashes
-are tied to has been swapped. In effect $h1 I<becomes> $h2 and
-vice-versa. This is powerful stuff, expect problems. Use with care.
-
-As a small safety measure, the two handles, $h1 and $h2, have to
-share the same parent unless $allow_reparent is true.
-
-The swap_inner_handle() method was added in DBI 1.44.
-
-Here's a quick kind of 'diagram' as a worked example to help think about what's
-happening:
-
- Original state:
- dbh1o -> dbh1i
- sthAo -> sthAi(dbh1i)
- dbh2o -> dbh2i
-
- swap_inner_handle dbh1o with dbh2o:
- dbh2o -> dbh1i
- sthAo -> sthAi(dbh1i)
- dbh1o -> dbh2i
-
- create new sth from dbh1o:
- dbh2o -> dbh1i
- sthAo -> sthAi(dbh1i)
- dbh1o -> dbh2i
- sthBo -> sthBi(dbh2i)
-
- swap_inner_handle sthAo with sthBo:
- dbh2o -> dbh1i
- sthBo -> sthAi(dbh1i)
- dbh1o -> dbh2i
- sthAo -> sthBi(dbh2i)
-
-=head3 C<visit_child_handles>
-
- $h->visit_child_handles( $coderef );
- $h->visit_child_handles( $coderef, $info );
-
-Where $coderef is a reference to a subroutine and $info is an arbitrary value
-which, if undefined, defaults to a reference to an empty hash. Returns $info.
-
-For each child handle of $h, if any, $coderef is invoked as:
-
- $coderef->($child_handle, $info);
-
-If the execution of $coderef returns a true value then C<visit_child_handles>
-is called on that child handle and passed the returned value as $info.
-
-For example:
-
- # count database connections with names (DSN) matching a pattern
- my $connections = 0;
- $dbh->{Driver}->visit_child_handles(sub {
- my ($h, $info) = @_;
- ++$connections if $h->{Name} =~ /foo/;
- return 0; # don't visit kids
- })
-
-See also L</visit_handles>.
-
-=head1 ATTRIBUTES COMMON TO ALL HANDLES
-
-These attributes are common to all types of DBI handles.
-
-Some attributes are inherited by child handles. That is, the value
-of an inherited attribute in a newly created statement handle is the
-same as the value in the parent database handle. Changes to attributes
-in the new statement handle do not affect the parent database handle
-and changes to the database handle do not affect existing statement
-handles, only future ones.
-
-Attempting to set or get the value of an unknown attribute generates a warning,
-except for private driver specific attributes (which all have names
-starting with a lowercase letter).
-
-Example:
-
- $h->{AttributeName} = ...; # set/write
- ... = $h->{AttributeName}; # get/read
-
-=head3 C<Warn>
-
-Type: boolean, inherited
-
-The C<Warn> attribute enables useful warnings for certain bad
-practices. It is enabled by default and should only be disabled in
-rare circumstances. Since warnings are generated using the Perl
-C<warn> function, they can be intercepted using the Perl C<$SIG{__WARN__}>
-hook.
-
-The C<Warn> attribute is not related to the C<PrintWarn> attribute.
-
-=head3 C<Active>
-
-Type: boolean, read-only
-
-The C<Active> attribute is true if the handle object is "active". This is rarely used in
-applications. The exact meaning of active is somewhat vague at the
-moment. For a database handle it typically means that the handle is
-connected to a database (C<$dbh-E<gt>disconnect> sets C<Active> off). For
-a statement handle it typically means that the handle is a C<SELECT>
-that may have more data to fetch. (Fetching all the data or calling C<$sth-E<gt>finish>
-sets C<Active> off.)
-
-=head3 C<Executed>
-
-Type: boolean
-
-The C<Executed> attribute is true if the handle object has been "executed".
-Currently only the $dbh do() method and the $sth execute(), execute_array(),
-and execute_for_fetch() methods set the C<Executed> attribute.
-
-When it's set on a handle it is also set on the parent handle at the
-same time. So calling execute() on a $sth also sets the C<Executed>
-attribute on the parent $dbh.
-
-The C<Executed> attribute for a database handle is cleared by the commit() and
-rollback() methods (even if they fail). The C<Executed> attribute of a
-statement handle is not cleared by the DBI under any circumstances and so acts
-as a permanent record of whether the statement handle was ever used.
-
-The C<Executed> attribute was added in DBI 1.41.
-
-=head3 C<Kids>
-
-Type: integer, read-only
-
-For a driver handle, C<Kids> is the number of currently existing database
-handles that were created from that driver handle. For a database
-handle, C<Kids> is the number of currently existing statement handles that
-were created from that database handle.
-For a statement handle, the value is zero.
-
-=head3 C<ActiveKids>
-
-Type: integer, read-only
-
-Like C<Kids>, but only counting those that are C<Active> (as above).
-
-=head3 C<CachedKids>
-
-Type: hash ref
-
-For a database handle, C<CachedKids> returns a reference to the cache (hash) of
-statement handles created by the L</prepare_cached> method. For a
-driver handle, returns a reference to the cache (hash) of
-database handles created by the L</connect_cached> method.
-
-=head3 C<Type>
-
-Type: scalar, read-only
-
-The C<Type> attribute identifies the type of a DBI handle. Returns
-"dr" for driver handles, "db" for database handles and "st" for
-statement handles.
-
-=head3 C<ChildHandles>
-
-Type: array ref
-
-The ChildHandles attribute contains a reference to an array of all the
-handles created by this handle which are still accessible. The
-contents of the array are weak-refs and will become undef when the
-handle goes out of scope. (They're cleared out occasionally.)
-
-C<ChildHandles> returns undef if your perl version does not support weak
-references (check the L<Scalar::Util|Scalar::Util> module). The referenced
-array returned should be treated as read-only.
-
-For example, to enumerate all driver handles, database handles and
-statement handles:
-
- sub show_child_handles {
- my ($h, $level) = @_;
- printf "%sh %s %s\n", $h->{Type}, "\t" x $level, $h;
- show_child_handles($_, $level + 1)
- for (grep { defined } @{$h->{ChildHandles}});
- }
-
- my %drivers = DBI->installed_drivers();
- show_child_handles($_, 0) for (values %drivers);
-
-=head3 C<CompatMode>
-
-Type: boolean, inherited
-
-The C<CompatMode> attribute is used by emulation layers (such as
-Oraperl) to enable compatible behaviour in the underlying driver
-(e.g., DBD::Oracle) for this handle. Not normally set by application code.
-
-It also has the effect of disabling the 'quick FETCH' of attribute
-values from the handles attribute cache. So all attribute values
-are handled by the drivers own FETCH method. This makes them slightly
-slower but is useful for special-purpose drivers like DBD::Multiplex.
-
-=head3 C<InactiveDestroy>
-
-Type: boolean
-
-The default value, false, means a handle will be fully destroyed
-as normal when the last reference to it is removed, just as you'd expect.
-
-If set true then the handle will be treated by the DESTROY as if it was no
-longer Active, and so the I<database engine> related effects of DESTROYing a
-handle will be skipped. Think of the name as meaning 'treat the handle as
-not-Active in the DESTROY method'.
-
-For a database handle, this attribute does not disable an I<explicit>
-call to the disconnect method, only the implicit call from DESTROY
-that happens if the handle is still marked as C<Active>.
-
-This attribute is specifically designed for use in Unix applications
-that "fork" child processes. For some drivers, when the child process exits
-the destruction of inherited handles cause the corresponding handles in the
-parent process to cease working.
-
-Either the parent or the child process, but not both, should set
-C<InactiveDestroy> true on all their shared handles. Alternatively, and
-preferably, the L</AutoInactiveDestroy> can be set in the parent on connect.
-
-To help tracing applications using fork the process id is shown in
-the trace log whenever a DBI or handle trace() method is called.
-The process id also shown for I<every> method call if the DBI trace
-level (not handle trace level) is set high enough to show the trace
-from the DBI's method dispatcher, e.g. >= 9.
-
-=head3 C<AutoInactiveDestroy>
-
-Type: boolean, inherited
-
-The L</InactiveDestroy> attribute, described above, needs to be explicitly set
-in the child process after a fork(), on every active database and statement handle.
-This is a problem if the code that performs the fork() is not under your
-control, perhaps in a third-party module. Use C<AutoInactiveDestroy> to get
-around this situation.
-
-If set true, the DESTROY method will check the process id of the handle and, if
-different from the current process id, it will set the I<InactiveDestroy> attribute.
-It is strongly recommended that C<AutoInactiveDestroy> is enabled on all new code
-(it's only not enabled by default to avoid backwards compatibility problems).
-
-This is the example it's designed to deal with:
-
- my $dbh = DBI->connect(...);
- some_code_that_forks(); # Perhaps without your knowledge
- # Child process dies, destroying the inherited dbh
- $dbh->do(...); # Breaks because parent $dbh is now broken
-
-The C<AutoInactiveDestroy> attribute was added in DBI 1.614.
-
-=head3 C<PrintWarn>
-
-Type: boolean, inherited
-
-The C<PrintWarn> attribute controls the printing of warnings recorded
-by the driver. When set to a true value (the default) the DBI will check method
-calls to see if a warning condition has been set. If so, the DBI
-will effectively do a C<warn("$class $method warning: $DBI::errstr")>
-where C<$class> is the driver class and C<$method> is the name of
-the method which failed. E.g.,
-
- DBD::Oracle::db execute warning: ... warning text here ...
-
-If desired, the warnings can be caught and processed using a C<$SIG{__WARN__}>
-handler or modules like CGI::Carp and CGI::ErrorWrap.
-
-See also L</set_err> for how warnings are recorded and L</HandleSetErr>
-for how to influence it.
-
-Fetching the full details of warnings can require an extra round-trip
-to the database server for some drivers. In which case the driver
-may opt to only fetch the full details of warnings if the C<PrintWarn>
-attribute is true. If C<PrintWarn> is false then these drivers should
-still indicate the fact that there were warnings by setting the
-warning string to, for example: "3 warnings".
-
-=head3 C<PrintError>
-
-Type: boolean, inherited
-
-The C<PrintError> attribute can be used to force errors to generate warnings (using
-C<warn>) in addition to returning error codes in the normal way. When set
-"on", any method which results in an error occurring will cause the DBI to
-effectively do a C<warn("$class $method failed: $DBI::errstr")> where C<$class>
-is the driver class and C<$method> is the name of the method which failed. E.g.,
-
- DBD::Oracle::db prepare failed: ... error text here ...
-
-By default, C<DBI-E<gt>connect> sets C<PrintError> "on".
-
-If desired, the warnings can be caught and processed using a C<$SIG{__WARN__}>
-handler or modules like CGI::Carp and CGI::ErrorWrap.
-
-=head3 C<RaiseError>
-
-Type: boolean, inherited
-
-The C<RaiseError> attribute can be used to force errors to raise exceptions rather
-than simply return error codes in the normal way. It is "off" by default.
-When set "on", any method which results in an error will cause
-the DBI to effectively do a C<die("$class $method failed: $DBI::errstr")>,
-where C<$class> is the driver class and C<$method> is the name of the method
-that failed. E.g.,
-
- DBD::Oracle::db prepare failed: ... error text here ...
-
-If you turn C<RaiseError> on then you'd normally turn C<PrintError> off.
-If C<PrintError> is also on, then the C<PrintError> is done first (naturally).
-
-Typically C<RaiseError> is used in conjunction with C<eval>,
-or a module like L<Try::Tiny> or L<TryCatch>,
-to catch the exception that's been thrown and handle it.
-For example:
-
- use Try::Tiny;
-
- try {
- ...
- $sth->execute();
- ...
- } catch {
- # $sth->err and $DBI::err will be true if error was from DBI
- warn $_; # print the error (which Try::Tiny puts into $_)
- ... # do whatever you need to deal with the error
- };
-
-In the catch block the $DBI::lasth variable can be useful for
-diagnosis and reporting if you can't be sure which handle triggered
-the error. For example, $DBI::lasth->{Type} and $DBI::lasth->{Statement}.
-
-See also L</Transactions>.
-
-If you want to temporarily turn C<RaiseError> off (inside a library function
-that is likely to fail, for example), the recommended way is like this:
-
- {
- local $h->{RaiseError}; # localize and turn off for this block
- ...
- }
-
-The original value will automatically and reliably be restored by Perl,
-regardless of how the block is exited.
-The same logic applies to other attributes, including C<PrintError>.
-
-=head3 C<HandleError>
-
-Type: code ref, inherited
-
-The C<HandleError> attribute can be used to provide your own alternative behaviour
-in case of errors. If set to a reference to a subroutine then that
-subroutine is called when an error is detected (at the same point that
-C<RaiseError> and C<PrintError> are handled).
-
-The subroutine is called with three parameters: the error message
-string that C<RaiseError> and C<PrintError> would use,
-the DBI handle being used, and the first value being returned by
-the method that failed (typically undef).
-
-If the subroutine returns a false value then the C<RaiseError>
-and/or C<PrintError> attributes are checked and acted upon as normal.
-
-For example, to C<die> with a full stack trace for any error:
-
- use Carp;
- $h->{HandleError} = sub { confess(shift) };
-
-Or to turn errors into exceptions:
-
- use Exception; # or your own favourite exception module
- $h->{HandleError} = sub { Exception->new('DBI')->raise($_[0]) };
-
-It is possible to 'stack' multiple HandleError handlers by using
-closures:
-
- sub your_subroutine {
- my $previous_handler = $h->{HandleError};
- $h->{HandleError} = sub {
- return 1 if $previous_handler and &$previous_handler(@_);
- ... your code here ...
- };
- }
-
-Using a C<my> inside a subroutine to store the previous C<HandleError>
-value is important. See L<perlsub> and L<perlref> for more information
-about I<closures>.
-
-It is possible for C<HandleError> to alter the error message that
-will be used by C<RaiseError> and C<PrintError> if it returns false.
-It can do that by altering the value of $_[0]. This example appends
-a stack trace to all errors and, unlike the previous example using
-Carp::confess, this will work C<PrintError> as well as C<RaiseError>:
-
- $h->{HandleError} = sub { $_[0]=Carp::longmess($_[0]); 0; };
-
-It is also possible for C<HandleError> to hide an error, to a limited
-degree, by using L</set_err> to reset $DBI::err and $DBI::errstr,
-and altering the return value of the failed method. For example:
-
- $h->{HandleError} = sub {
- return 0 unless $_[0] =~ /^\S+ fetchrow_arrayref failed:/;
- return 0 unless $_[1]->err == 1234; # the error to 'hide'
- $h->set_err(undef,undef); # turn off the error
- $_[2] = [ ... ]; # supply alternative return value
- return 1;
- };
-
-This only works for methods which return a single value and is hard
-to make reliable (avoiding infinite loops, for example) and so isn't
-recommended for general use! If you find a I<good> use for it then
-please let me know.
-
-=head3 C<HandleSetErr>
-
-Type: code ref, inherited
-
-The C<HandleSetErr> attribute can be used to intercept
-the setting of handle C<err>, C<errstr>, and C<state> values.
-If set to a reference to a subroutine then that subroutine is called
-whenever set_err() is called, typically by the driver or a subclass.
-
-The subroutine is called with five arguments, the first five that
-were passed to set_err(): the handle, the C<err>, C<errstr>, and
-C<state> values being set, and the method name. These can be altered
-by changing the values in the @_ array. The return value affects
-set_err() behaviour, see L</set_err> for details.
-
-It is possible to 'stack' multiple HandleSetErr handlers by using
-closures. See L</HandleError> for an example.
-
-The C<HandleSetErr> and C<HandleError> subroutines differ in subtle
-but significant ways. HandleError is only invoked at the point where
-the DBI is about to return to the application with C<err> set true.
-It's not invoked by the failure of a method that's been called by
-another DBI method. HandleSetErr, on the other hand, is called
-whenever set_err() is called with a defined C<err> value, even if false.
-So it's not just for errors, despite the name, but also warn and info states.
-The set_err() method, and thus HandleSetErr, may be called multiple
-times within a method and is usually invoked from deep within driver code.
-
-In theory a driver can use the return value from HandleSetErr via
-set_err() to decide whether to continue or not. If set_err() returns
-an empty list, indicating that the HandleSetErr code has 'handled'
-the 'error', the driver could then continue instead of failing (if
-that's a reasonable thing to do). This isn't excepted to be
-common and any such cases should be clearly marked in the driver
-documentation and discussed on the dbi-dev mailing list.
-
-The C<HandleSetErr> attribute was added in DBI 1.41.
-
-=head3 C<ErrCount>
-
-Type: unsigned integer
-
-The C<ErrCount> attribute is incremented whenever the set_err()
-method records an error. It isn't incremented by warnings or
-information states. It is not reset by the DBI at any time.
-
-The C<ErrCount> attribute was added in DBI 1.41. Older drivers may
-not have been updated to use set_err() to record errors and so this
-attribute may not be incremented when using them.
-
-
-=head3 C<ShowErrorStatement>
-
-Type: boolean, inherited
-
-The C<ShowErrorStatement> attribute can be used to cause the relevant
-Statement text to be appended to the error messages generated by
-the C<RaiseError>, C<PrintError>, and C<PrintWarn> attributes.
-Only applies to errors on statement handles
-plus the prepare(), do(), and the various C<select*()> database handle methods.
-(The exact format of the appended text is subject to change.)
-
-If C<$h-E<gt>{ParamValues}> returns a hash reference of parameter
-(placeholder) values then those are formatted and appended to the
-end of the Statement text in the error message.
-
-=head3 C<TraceLevel>
-
-Type: integer, inherited
-
-The C<TraceLevel> attribute can be used as an alternative to the
-L</trace> method to set the DBI trace level and trace flags for a
-specific handle. See L</TRACING> for more details.
-
-The C<TraceLevel> attribute is especially useful combined with
-C<local> to alter the trace settings for just a single block of code.
-
-=head3 C<FetchHashKeyName>
-
-Type: string, inherited
-
-The C<FetchHashKeyName> attribute is used to specify whether the fetchrow_hashref()
-method should perform case conversion on the field names used for
-the hash keys. For historical reasons it defaults to 'C<NAME>' but
-it is recommended to set it to 'C<NAME_lc>' (convert to lower case)
-or 'C<NAME_uc>' (convert to upper case) according to your preference.
-It can only be set for driver and database handles. For statement
-handles the value is frozen when prepare() is called.
-
-
-=head3 C<ChopBlanks>
-
-Type: boolean, inherited
-
-The C<ChopBlanks> attribute can be used to control the trimming of trailing space
-characters from fixed width character (CHAR) fields. No other field
-types are affected, even where field values have trailing spaces.
-
-The default is false (although it is possible that the default may change).
-Applications that need specific behaviour should set the attribute as
-needed.
-
-Drivers are not required to support this attribute, but any driver which
-does not support it must arrange to return C<undef> as the attribute value.
-
-
-=head3 C<LongReadLen>
-
-Type: unsigned integer, inherited
-
-The C<LongReadLen> attribute may be used to control the maximum
-length of 'long' type fields (LONG, BLOB, CLOB, MEMO, etc.) which the driver will
-read from the database automatically when it fetches each row of data.
-
-The C<LongReadLen> attribute only relates to fetching and reading
-long values; it is not involved in inserting or updating them.
-
-A value of 0 means not to automatically fetch any long data.
-Drivers may return undef or an empty string for long fields when
-C<LongReadLen> is 0.
-
-The default is typically 0 (zero) or 80 bytes but may vary between drivers.
-Applications fetching long fields should set this value to slightly
-larger than the longest long field value to be fetched.
-
-Some databases return some long types encoded as pairs of hex digits.
-For these types, C<LongReadLen> relates to the underlying data
-length and not the doubled-up length of the encoded string.
-
-Changing the value of C<LongReadLen> for a statement handle after it
-has been C<prepare>'d will typically have no effect, so it's common to
-set C<LongReadLen> on the C<$dbh> before calling C<prepare>.
-
-For most drivers the value used here has a direct effect on the
-memory used by the statement handle while it's active, so don't be
-too generous. If you can't be sure what value to use you could
-execute an extra select statement to determine the longest value.
-For example:
-
- $dbh->{LongReadLen} = $dbh->selectrow_array(qq{
- SELECT MAX(OCTET_LENGTH(long_column_name))
- FROM table WHERE ...
- });
- $sth = $dbh->prepare(qq{
- SELECT long_column_name, ... FROM table WHERE ...
- });
-
-You may need to take extra care if the table can be modified between
-the first select and the second being executed. You may also need to
-use a different function if OCTET_LENGTH() does not work for long
-types in your database. For example, for Sybase use DATALENGTH() and
-for Oracle use LENGTHB().
-
-See also L</LongTruncOk> for information on truncation of long types.
-
-=head3 C<LongTruncOk>
-
-Type: boolean, inherited
-
-The C<LongTruncOk> attribute may be used to control the effect of
-fetching a long field value which has been truncated (typically
-because it's longer than the value of the C<LongReadLen> attribute).
-
-By default, C<LongTruncOk> is false and so fetching a long value that
-needs to be truncated will cause the fetch to fail.
-(Applications should always be sure to
-check for errors after a fetch loop in case an error, such as a divide
-by zero or long field truncation, caused the fetch to terminate
-prematurely.)
-
-If a fetch fails due to a long field truncation when C<LongTruncOk> is
-false, many drivers will allow you to continue fetching further rows.
-
-See also L</LongReadLen>.
-
-=head3 C<TaintIn>
-
-Type: boolean, inherited
-
-If the C<TaintIn> attribute is set to a true value I<and> Perl is running in
-taint mode (e.g., started with the C<-T> option), then all the arguments
-to most DBI method calls are checked for being tainted. I<This may change.>
-
-The attribute defaults to off, even if Perl is in taint mode.
-See L<perlsec> for more about taint mode. If Perl is not
-running in taint mode, this attribute has no effect.
-
-When fetching data that you trust you can turn off the TaintIn attribute,
-for that statement handle, for the duration of the fetch loop.
-
-The C<TaintIn> attribute was added in DBI 1.31.
-
-=head3 C<TaintOut>
-
-Type: boolean, inherited
-
-If the C<TaintOut> attribute is set to a true value I<and> Perl is running in
-taint mode (e.g., started with the C<-T> option), then most data fetched
-from the database is considered tainted. I<This may change.>
-
-The attribute defaults to off, even if Perl is in taint mode.
-See L<perlsec> for more about taint mode. If Perl is not
-running in taint mode, this attribute has no effect.
-
-When fetching data that you trust you can turn off the TaintOut attribute,
-for that statement handle, for the duration of the fetch loop.
-
-Currently only fetched data is tainted. It is possible that the results
-of other DBI method calls, and the value of fetched attributes, may
-also be tainted in future versions. That change may well break your
-applications unless you take great care now. If you use DBI Taint mode,
-please report your experience and any suggestions for changes.
-
-The C<TaintOut> attribute was added in DBI 1.31.
-
-=head3 C<Taint>
-
-Type: boolean, inherited
-
-The C<Taint> attribute is a shortcut for L</TaintIn> and L</TaintOut> (it is also present
-for backwards compatibility).
-
-Setting this attribute sets both L</TaintIn> and L</TaintOut>, and retrieving
-it returns a true value if and only if L</TaintIn> and L</TaintOut> are
-both set to true values.
-
-=head3 C<Profile>
-
-Type: inherited
-
-The C<Profile> attribute enables the collection and reporting of
-method call timing statistics. See the L<DBI::Profile> module
-documentation for I<much> more detail.
-
-The C<Profile> attribute was added in DBI 1.24.
-
-=head3 C<ReadOnly>
-
-Type: boolean, inherited
-
-An application can set the C<ReadOnly> attribute of a handle to a true value to
-indicate that it will not be attempting to make any changes using that handle
-or any children of it.
-
-Note that the exact definition of 'read only' is rather fuzzy.
-For more details see the documentation for the driver you're using.
-
-If the driver can make the handle truly read-only then it should
-(unless doing so would have unpleasant side effect, like changing the
-consistency level from per-statement to per-session).
-Otherwise the attribute is simply advisory.
-
-A driver can set the C<ReadOnly> attribute itself to indicate that the data it
-is connected to cannot be changed for some reason.
-
-If the driver cannot ensure the C<ReadOnly> attribute is adhered to it
-will record a warning. In this case reading the C<ReadOnly> attribute
-back after it is set true will return true even if the underlying
-driver cannot ensure this (so any application knows the application
-declared itself ReadOnly).
-
-Library modules and proxy drivers can use the attribute to influence
-their behavior. For example, the DBD::Gofer driver considers the
-C<ReadOnly> attribute when making a decision about whether to retry an
-operation that failed.
-
-The attribute should be set to 1 or 0 (or undef). Other values are reserved.
-
-=head3 C<Callbacks>
-
-Type: hash ref
-
-The DBI callback mechanism lets you intercept, and optionally replace, any
-method call on a DBI handle. At the extreme, it lets you become a puppet
-master, deceiving the application in any way you want.
-
-The C<Callbacks> attribute is a hash reference where the keys are DBI method
-names and the values are code references. For each key naming a method, the
-DBI will execute the associated code reference before executing the method.
-
-The arguments to the code reference will be the same as to the method,
-including the invocant (a database handle or statement handle). For example,
-say that to callback to some code on a call to C<prepare()>:
-
- $dbh->{Callbacks} = {
- prepare => sub {
- my ($dbh, $query, $attrs) = @_;
- print "Preparing q{$query}\n"
- },
- };
-
-The callback would then be executed when you called the C<prepare()> method:
-
- $dbh->prepare('SELECT 1');
-
-And the output of course would be:
-
- Preparing q{SELECT 1}
-
-Because callbacks are executed I<before> the methods
-they're associated with, you can modify the arguments before they're passed on
-to the method call. For example, to make sure that all calls to C<prepare()>
-are immediately prepared by L<DBD::Pg>, add a callback that makes sure that
-the C<pg_prepare_now> attribute is always set:
-
- my $dbh = DBI->connect($dsn, $username, $auth, {
- Callbacks => {
- prepare => sub {
- $_[2] ||= {};
- $_[2]->{pg_prepare_now} = 1;
- return; # must return nothing
- },
- }
- });
-
-Note that we are editing the contents of C<@_> directly. In this case we've
-created the attributes hash if it's not passed to the C<prepare> call.
-
-You can also prevent the associated method from ever executing. While a
-callback executes, C<$_> holds the method name. (This allows multiple callbacks
-to share the same code reference and still know what method was called.)
-To prevent the method from
-executing, simply C<undef $_>. For example, if you wanted to disable calls to
-C<ping()>, you could do this:
-
- $dbh->{Callbacks} = {
- ping => sub {
- # tell dispatch to not call the method:
- undef $_;
- # return this value instead:
- return "42 bells";
- }
- };
-
-As with other attributes, Callbacks can be specified on a handle or via the
-attributes to C<connect()>. Callbacks can also be applied to a statement
-methods on a statement handle. For example:
-
- $sth->{Callbacks} = {
- execute => sub {
- print "Executing ", shift->{Statement}, "\n";
- }
- };
-
-The C<Callbacks> attribute of a database handle isn't copied to any statement
-handles it creates. So setting callbacks for a statement handle requires you to
-set the C<Callbacks> attribute on the statement handle yourself, as in the
-example above, or use the special C<ChildCallbacks> key described below.
-
-B<Special Keys in Callbacks Attribute>
-
-In addition to DBI handle method names, the C<Callbacks> hash reference
-supports four additional keys.
-
-The first is the C<ChildCallbacks> key. When a statement handle is created from
-a database handle the C<ChildCallbacks> key of the database handle's
-C<Callbacks> attribute, if any, becomes the new C<Callbacks> attribute of the
-statement handle.
-This allows you to define callbacks for all statement handles created from a
-database handle. For example, if you wanted to count how many times C<execute>
-was called in your application, you could write:
-
- my $exec_count = 0;
- my $dbh = DBI->connect( $dsn, $username, $auth, {
- Callbacks => {
- ChildCallbacks => {
- execute => sub { $exec_count++; return; }
- }
- }
- });
-
- END {
- print "The execute method was called $exec_count times\n";
- }
-
-The other three special keys are C<connect_cached.new>,
-C<connect_cached.connected>, and C<connect_cached.reused>. These keys define
-callbacks that are called when C<connect_cached()> is called, but allow
-different behaviors depending on whether a new handle is created or a handle
-is returned. The callback is invoked with these arguments:
-C<$dbh, $dsn, $user, $auth, $attr>.
-
-For example, some applications uses C<connect_cached()> to connect with
-C<AutoCommit> enabled and then disable C<AutoCommit> temporarily for
-transactions. If C<connect_cached()> is called during a transaction, perhaps in
-a utility method, then it might select the same cached handle and then force
-C<AutoCommit> on, forcing a commit of the transaction. See the L</connect_cached>
-documentation for one way to deal with that. Here we'll describe an alternative
-approach using a callback.
-
-Because the C<connect_cached.new> and C<connect_cached.reused> callbacks are
-invoked before C<connect_cached()> has applied the connect attributes, you can
-use them to edit the attributes that will be applied. To prevent a cached
-handle from having its transactions committed before it's returned, you can
-eliminate the C<AutoCommit> attribute in a C<connect_cached.reused> callback,
-like so:
-
- my $cb = {
- 'connect_cached.reused' => sub { delete $_[4]->{AutoCommit} },
- };
-
- sub dbh {
- my $self = shift;
- DBI->connect_cached( $dsn, $username, $auth, {
- PrintError => 0,
- RaiseError => 1,
- AutoCommit => 1,
- Callbacks => $cb,
- });
- }
-
-The upshot is that new database handles are created with C<AutoCommit>
-enabled, while cached database handles are left in whatever transaction state
-they happened to be in when retrieved from the cache.
-
-Note that we've also used a lexical for the callbacks hash reference. This is
-because C<connect_cached()> returns a new database handle if any of the
-attributes passed to is have changed. If we used an inline hash reference,
-C<connect_cached()> would return a new database handle every time. Which would
-rather defeat the purpose.
-
-A more common application for callbacks is setting connection state only when
-a new connection is made (by connect() or connect_cached()). Adding a callback
-to the connected method (when using C<connect>) or via
-C<connect_cached.connected> (when useing connect_cached()>) makes this easy.
-The connected() method is a no-op by default (unless you subclass the DBI and
-change it). The DBI calls it to indicate that a new connection has been made
-and the connection attributes have all been set. You can give it a bit of
-added functionality by applying a callback to it. For example, to make sure
-that MySQL understands your application's ANSI-compliant SQL, set it up like
-so:
-
- my $dbh = DBI->connect($dsn, $username, $auth, {
- Callbacks => {
- connected => sub {
- shift->do(q{
- SET SESSION sql_mode='ansi,strict_trans_tables,no_auto_value_on_zero';
- });
- return;
- },
- }
- });
-
-If you're using C<connect_cached()>, use the C<connect_cached.connected>
-callback, instead. This is because C<connected()> is called for both new and
-reused database handles, but you want to execute a callback only the when a
-new database handle is returned. For example, to set the time zone on
-connection to a PostgreSQL database, try this:
-
- my $cb = {
- 'connect_cached.connected' => sub {
- shift->do('SET timezone = UTC');
- }
- };
-
- sub dbh {
- my $self = shift;
- DBI->connect_cached( $dsn, $username, $auth, { Callbacks => $cb });
- }
-
-One significant limitation with callbacks is that there can only be one per
-method per handle. This means it's easy for one use of callbacks to interfere
-with, or typically simply overwrite, another use of callbacks. For this reason
-modules using callbacks should document the fact clearly so application authors
-can tell if use of callbacks by the module will clash with use of callbacks by
-the application.
-
-You might be able to work around this issue by taking a copy of the original
-callback and calling it within your own. For example:
-
- my $prev_cb = $h->{Callbacks}{method_name};
- $h->{Callbacks}{method_name} = sub {
- if ($prev_cb) {
- my @result = $prev_cb->(@_);
- return @result if not $_; # $prev_cb vetoed call
- }
- ... your callback logic here ...
- };
-
-=head3 C<private_your_module_name_*>
-
-The DBI provides a way to store extra information in a DBI handle as
-"private" attributes. The DBI will allow you to store and retrieve any
-attribute which has a name starting with "C<private_>".
-
-It is I<strongly> recommended that you use just I<one> private
-attribute (e.g., use a hash ref) I<and> give it a long and unambiguous
-name that includes the module or application name that the attribute
-relates to (e.g., "C<private_YourFullModuleName_thingy>").
-
-Because of the way the Perl tie mechanism works you cannot reliably
-use the C<||=> operator directly to initialise the attribute, like this:
-
- my $foo = $dbh->{private_yourmodname_foo} ||= { ... }; # WRONG
-
-you should use a two step approach like this:
-
- my $foo = $dbh->{private_yourmodname_foo};
- $foo ||= $dbh->{private_yourmodname_foo} = { ... };
-
-This attribute is primarily of interest to people sub-classing DBI,
-or for applications to piggy-back extra information onto DBI handles.
-
-=head1 DBI DATABASE HANDLE OBJECTS
-
-This section covers the methods and attributes associated with
-database handles.
-
-=head2 Database Handle Methods
-
-The following methods are specified for DBI database handles:
-
-=head3 C<clone>
-
- $new_dbh = $dbh->clone(\%attr);
-
-The C<clone> method duplicates the $dbh connection by connecting
-with the same parameters ($dsn, $user, $password) as originally used.
-
-The attributes for the cloned connect are the same as those used
-for the I<original> connect, with any other attributes in C<\%attr>
-merged over them. Effectively the same as doing:
-
- %attributes_used = ( %original_attributes, %attr );
-
-If \%attr is not given then it defaults to a hash containing all
-the attributes in the attribute cache of $dbh excluding any non-code
-references, plus the main boolean attributes (RaiseError, PrintError,
-AutoCommit, etc.). I<This behaviour is unreliable and so use of clone without
-an argument is deprecated and may cause a warning in a future release.>
-
-The clone method can be used even if the database handle is disconnected.
-
-The C<clone> method was added in DBI 1.33.
-
-=head3 C<data_sources>
-
- @ary = $dbh->data_sources();
- @ary = $dbh->data_sources(\%attr);
-
-Returns a list of data sources (databases) available via the $dbh
-driver's data_sources() method, plus any extra data sources that
-the driver can discover via the connected $dbh. Typically the extra
-data sources are other databases managed by the same server process
-that the $dbh is connected to.
-
-Data sources are returned in a form suitable for passing to the
-L</connect> method (that is, they will include the "C<dbi:$driver:>" prefix).
-
-The data_sources() method, for a $dbh, was added in DBI 1.38.
-
-=head3 C<do>
-
- $rows = $dbh->do($statement) or die $dbh->errstr;
- $rows = $dbh->do($statement, \%attr) or die $dbh->errstr;
- $rows = $dbh->do($statement, \%attr, @bind_values) or die ...
-
-Prepare and execute a single statement. Returns the number of rows
-affected or C<undef> on error. A return value of C<-1> means the
-number of rows is not known, not applicable, or not available.
-
-This method is typically most useful for I<non>-C<SELECT> statements that
-either cannot be prepared in advance (due to a limitation of the
-driver) or do not need to be executed repeatedly. It should not
-be used for C<SELECT> statements because it does not return a statement
-handle (so you can't fetch any data).
-
-The default C<do> method is logically similar to:
-
- sub do {
- my($dbh, $statement, $attr, @bind_values) = @_;
- my $sth = $dbh->prepare($statement, $attr) or return undef;
- $sth->execute(@bind_values) or return undef;
- my $rows = $sth->rows;
- ($rows == 0) ? "0E0" : $rows; # always return true if no error
- }
-
-For example:
-
- my $rows_deleted = $dbh->do(q{
- DELETE FROM table
- WHERE status = ?
- }, undef, 'DONE') or die $dbh->errstr;
-
-Using placeholders and C<@bind_values> with the C<do> method can be
-useful because it avoids the need to correctly quote any variables
-in the C<$statement>. But if you'll be executing the statement many
-times then it's more efficient to C<prepare> it once and call
-C<execute> many times instead.
-
-The C<q{...}> style quoting used in this example avoids clashing with
-quotes that may be used in the SQL statement. Use the double-quote-like
-C<qq{...}> operator if you want to interpolate variables into the string.
-See L<perlop/"Quote and Quote-like Operators"> for more details.
-
-Note drivers are free to avoid the overhead of creating an DBI
-statement handle for do(), especially if there are no parameters. In
-this case error handlers, if invoked during do(), will be passed the
-database handle.
-
-=head3 C<last_insert_id>
-
- $rv = $dbh->last_insert_id($catalog, $schema, $table, $field);
- $rv = $dbh->last_insert_id($catalog, $schema, $table, $field, \%attr);
-
-Returns a value 'identifying' the row just inserted, if possible.
-Typically this would be a value assigned by the database server
-to a column with an I<auto_increment> or I<serial> type.
-Returns undef if the driver does not support the method or can't
-determine the value.
-
-The $catalog, $schema, $table, and $field parameters may be required
-for some drivers (see below). If you don't know the parameter values
-and your driver does not need them, then use C<undef> for each.
-
-There are several caveats to be aware of with this method if you want
-to use it for portable applications:
-
-B<*> For some drivers the value may only available immediately after
-the insert statement has executed (e.g., mysql, Informix).
-
-B<*> For some drivers the $catalog, $schema, $table, and $field parameters
-are required, for others they are ignored (e.g., mysql).
-
-B<*> Drivers may return an indeterminate value if no insert has
-been performed yet.
-
-B<*> For some drivers the value may only be available if placeholders
-have I<not> been used (e.g., Sybase, MS SQL). In this case the value
-returned would be from the last non-placeholder insert statement.
-
-B<*> Some drivers may need driver-specific hints about how to get
-the value. For example, being told the name of the database 'sequence'
-object that holds the value. Any such hints are passed as driver-specific
-attributes in the \%attr parameter.
-
-B<*> If the underlying database offers nothing better, then some
-drivers may attempt to implement this method by executing
-"C<select max($field) from $table>". Drivers using any approach
-like this should issue a warning if C<AutoCommit> is true because
-it is generally unsafe - another process may have modified the table
-between your insert and the select. For situations where you know
-it is safe, such as when you have locked the table, you can silence
-the warning by passing C<Warn> => 0 in \%attr.
-
-B<*> If no insert has been performed yet, or the last insert failed,
-then the value is implementation defined.
-
-Given all the caveats above, it's clear that this method must be
-used with care.
-
-The C<last_insert_id> method was added in DBI 1.38.
-
-=head3 C<selectrow_array>
-
- @row_ary = $dbh->selectrow_array($statement);
- @row_ary = $dbh->selectrow_array($statement, \%attr);
- @row_ary = $dbh->selectrow_array($statement, \%attr, @bind_values);
-
-This utility method combines L</prepare>, L</execute> and
-L</fetchrow_array> into a single call. If called in a list context, it
-returns the first row of data from the statement. The C<$statement>
-parameter can be a previously prepared statement handle, in which case
-the C<prepare> is skipped.
-
-If any method fails, and L</RaiseError> is not set, C<selectrow_array>
-will return an empty list.
-
-If called in a scalar context for a statement handle that has more
-than one column, it is undefined whether the driver will return
-the value of the first column or the last. So don't do that.
-Also, in a scalar context, an C<undef> is returned if there are no
-more rows or if an error occurred. That C<undef> can't be distinguished
-from an C<undef> returned because the first field value was NULL.
-For these reasons you should exercise some caution if you use
-C<selectrow_array> in a scalar context, or just don't do that.
-
-
-=head3 C<selectrow_arrayref>
-
- $ary_ref = $dbh->selectrow_arrayref($statement);
- $ary_ref = $dbh->selectrow_arrayref($statement, \%attr);
- $ary_ref = $dbh->selectrow_arrayref($statement, \%attr, @bind_values);
-
-This utility method combines L</prepare>, L</execute> and
-L</fetchrow_arrayref> into a single call. It returns the first row of
-data from the statement. The C<$statement> parameter can be a previously
-prepared statement handle, in which case the C<prepare> is skipped.
-
-If any method fails, and L</RaiseError> is not set, C<selectrow_arrayref>
-will return undef.
-
-
-=head3 C<selectrow_hashref>
-
- $hash_ref = $dbh->selectrow_hashref($statement);
- $hash_ref = $dbh->selectrow_hashref($statement, \%attr);
- $hash_ref = $dbh->selectrow_hashref($statement, \%attr, @bind_values);
-
-This utility method combines L</prepare>, L</execute> and
-L</fetchrow_hashref> into a single call. It returns the first row of
-data from the statement. The C<$statement> parameter can be a previously
-prepared statement handle, in which case the C<prepare> is skipped.
-
-If any method fails, and L</RaiseError> is not set, C<selectrow_hashref>
-will return undef.
-
-
-=head3 C<selectall_arrayref>
-
- $ary_ref = $dbh->selectall_arrayref($statement);
- $ary_ref = $dbh->selectall_arrayref($statement, \%attr);
- $ary_ref = $dbh->selectall_arrayref($statement, \%attr, @bind_values);
-
-This utility method combines L</prepare>, L</execute> and
-L</fetchall_arrayref> into a single call. It returns a reference to an
-array containing a reference to an array (or hash, see below) for each row of
-data fetched.
-
-The C<$statement> parameter can be a previously prepared statement handle,
-in which case the C<prepare> is skipped. This is recommended if the
-statement is going to be executed many times.
-
-If L</RaiseError> is not set and any method except C<fetchall_arrayref>
-fails then C<selectall_arrayref> will return C<undef>; if
-C<fetchall_arrayref> fails then it will return with whatever data
-has been fetched thus far. You should check C<$dbh-E<gt>err>
-afterwards (or use the C<RaiseError> attribute) to discover if the data is
-complete or was truncated due to an error.
-
-The L</fetchall_arrayref> method called by C<selectall_arrayref>
-supports a $max_rows parameter. You can specify a value for $max_rows
-by including a 'C<MaxRows>' attribute in \%attr. In which case finish()
-is called for you after fetchall_arrayref() returns.
-
-The L</fetchall_arrayref> method called by C<selectall_arrayref>
-also supports a $slice parameter. You can specify a value for $slice by
-including a 'C<Slice>' or 'C<Columns>' attribute in \%attr. The only
-difference between the two is that if C<Slice> is not defined and
-C<Columns> is an array ref, then the array is assumed to contain column
-index values (which count from 1), rather than perl array index values.
-In which case the array is copied and each value decremented before
-passing to C</fetchall_arrayref>.
-
-You may often want to fetch an array of rows where each row is stored as a
-hash. That can be done simply using:
-
- my $emps = $dbh->selectall_arrayref(
- "SELECT ename FROM emp ORDER BY ename",
- { Slice => {} }
- );
- foreach my $emp ( @$emps ) {
- print "Employee: $emp->{ename}\n";
- }
-
-Or, to fetch into an array instead of an array ref:
-
- @result = @{ $dbh->selectall_arrayref($sql, { Slice => {} }) };
-
-See L</fetchall_arrayref> method for more details.
-
-=head3 C<selectall_array>
-
- @ary = $dbh->selectall_array($statement);
- @ary = $dbh->selectall_array($statement, \%attr);
- @ary = $dbh->selectall_array($statement, \%attr, @bind_values);
-
-This is a convenience wrapper around L<selectall_arrayref> that returns
-the rows directly as a list, rather than a reference to an array of rows.
-
-Note that if L</RaiseError> is not set then you can't tell the difference
-between returning no rows and an error. Using RaiseError is best practice.
-
-=head3 C<selectall_hashref>
-
- $hash_ref = $dbh->selectall_hashref($statement, $key_field);
- $hash_ref = $dbh->selectall_hashref($statement, $key_field, \%attr);
- $hash_ref = $dbh->selectall_hashref($statement, $key_field, \%attr, @bind_values);
-
-This utility method combines L</prepare>, L</execute> and
-L</fetchall_hashref> into a single call. It returns a reference to a
-hash containing one entry, at most, for each row, as returned by fetchall_hashref().
-
-The C<$statement> parameter can be a previously prepared statement handle,
-in which case the C<prepare> is skipped. This is recommended if the
-statement is going to be executed many times.
-
-The C<$key_field> parameter defines which column, or columns, are used as keys
-in the returned hash. It can either be the name of a single field, or a
-reference to an array containing multiple field names. Using multiple names
-yields a tree of nested hashes.
-
-If a row has the same key as an earlier row then it replaces the earlier row.
-
-If any method except C<fetchrow_hashref> fails, and L</RaiseError> is not set,
-C<selectall_hashref> will return C<undef>. If C<fetchrow_hashref> fails and
-L</RaiseError> is not set, then it will return with whatever data it
-has fetched thus far. $DBI::err should be checked to catch that.
-
-See fetchall_hashref() for more details.
-
-=head3 C<selectcol_arrayref>
-
- $ary_ref = $dbh->selectcol_arrayref($statement);
- $ary_ref = $dbh->selectcol_arrayref($statement, \%attr);
- $ary_ref = $dbh->selectcol_arrayref($statement, \%attr, @bind_values);
-
-This utility method combines L</prepare>, L</execute>, and fetching one
-column from all the rows, into a single call. It returns a reference to
-an array containing the values of the first column from each row.
-
-The C<$statement> parameter can be a previously prepared statement handle,
-in which case the C<prepare> is skipped. This is recommended if the
-statement is going to be executed many times.
-
-If any method except C<fetch> fails, and L</RaiseError> is not set,
-C<selectcol_arrayref> will return C<undef>. If C<fetch> fails and
-L</RaiseError> is not set, then it will return with whatever data it
-has fetched thus far. $DBI::err should be checked to catch that.
-
-The C<selectcol_arrayref> method defaults to pushing a single column
-value (the first) from each row into the result array. However, it can
-also push another column, or even multiple columns per row, into the
-result array. This behaviour can be specified via a 'C<Columns>'
-attribute which must be a ref to an array containing the column number
-or numbers to use. For example:
-
- # get array of id and name pairs:
- my $ary_ref = $dbh->selectcol_arrayref("select id, name from table", { Columns=>[1,2] });
- my %hash = @$ary_ref; # build hash from key-value pairs so $hash{$id} => name
-
-You can specify a maximum number of rows to fetch by including a
-'C<MaxRows>' attribute in \%attr.
-
-=head3 C<prepare>
-
- $sth = $dbh->prepare($statement) or die $dbh->errstr;
- $sth = $dbh->prepare($statement, \%attr) or die $dbh->errstr;
-
-Prepares a statement for later execution by the database
-engine and returns a reference to a statement handle object.
-
-The returned statement handle can be used to get attributes of the
-statement and invoke the L</execute> method. See L</Statement Handle Methods>.
-
-Drivers for engines without the concept of preparing a
-statement will typically just store the statement in the returned
-handle and process it when C<$sth-E<gt>execute> is called. Such drivers are
-unlikely to give much useful information about the
-statement, such as C<$sth-E<gt>{NUM_OF_FIELDS}>, until after C<$sth-E<gt>execute>
-has been called. Portable applications should take this into account.
-
-In general, DBI drivers do not parse the contents of the statement
-(other than simply counting any L<Placeholders|/Placeholders and Bind Values>).
-The statement is
-passed directly to the database engine, sometimes known as pass-thru
-mode. This has advantages and disadvantages. On the plus side, you can
-access all the functionality of the engine being used. On the downside,
-you're limited if you're using a simple engine, and you need to take extra care if
-writing applications intended to be portable between engines.
-
-Portable applications should not assume that a new statement can be
-prepared and/or executed while still fetching results from a previous
-statement.
-
-Some command-line SQL tools use statement terminators, like a semicolon,
-to indicate the end of a statement. Such terminators should not normally
-be used with the DBI.
-
-
-=head3 C<prepare_cached>
-
- $sth = $dbh->prepare_cached($statement)
- $sth = $dbh->prepare_cached($statement, \%attr)
- $sth = $dbh->prepare_cached($statement, \%attr, $if_active)
-
-Like L</prepare> except that the statement handle returned will be
-stored in a hash associated with the C<$dbh>. If another call is made to
-C<prepare_cached> with the same C<$statement> and C<%attr> parameter values,
-then the corresponding cached C<$sth> will be returned without contacting the
-database server. Be sure to understand the cautions and caveats noted below.
-
-The C<$if_active> parameter lets you adjust the behaviour if an
-already cached statement handle is still Active. There are several
-alternatives:
-
-=over 4
-
-=item B<0>: A warning will be generated, and finish() will be called on
-the statement handle before it is returned. This is the default
-behaviour if $if_active is not passed.
-
-=item B<1>: finish() will be called on the statement handle, but the
-warning is suppressed.
-
-=item B<2>: Disables any checking.
-
-=item B<3>: The existing active statement handle will be removed from the
-cache and a new statement handle prepared and cached in its place.
-This is the safest option because it doesn't affect the state of the
-old handle, it just removes it from the cache. [Added in DBI 1.40]
-
-=back
-
-Here are some examples of C<prepare_cached>:
-
- sub insert_hash {
- my ($table, $field_values) = @_;
- # sort to keep field order, and thus sql, stable for prepare_cached
- my @fields = sort keys %$field_values;
- my @values = @{$field_values}{@fields};
- my $sql = sprintf "insert into %s (%s) values (%s)",
- $table, join(",", @fields), join(",", ("?")x@fields);
- my $sth = $dbh->prepare_cached($sql);
- return $sth->execute(@values);
- }
-
- sub search_hash {
- my ($table, $field_values) = @_;
- # sort to keep field order, and thus sql, stable for prepare_cached
- my @fields = sort keys %$field_values;
- my @values = @{$field_values}{@fields};
- my $qualifier = "";
- $qualifier = "where ".join(" and ", map { "$_=?" } @fields) if @fields;
- $sth = $dbh->prepare_cached("SELECT * FROM $table $qualifier");
- return $dbh->selectall_arrayref($sth, {}, @values);
- }
-
-I<Caveat emptor:> This caching can be useful in some applications,
-but it can also cause problems and should be used with care. Here
-is a contrived case where caching would cause a significant problem:
-
- my $sth = $dbh->prepare_cached('SELECT * FROM foo WHERE bar=?');
- $sth->execute(...);
- while (my $data = $sth->fetchrow_hashref) {
-
- # later, in some other code called within the loop...
- my $sth2 = $dbh->prepare_cached('SELECT * FROM foo WHERE bar=?');
- $sth2->execute(...);
- while (my $data2 = $sth2->fetchrow_arrayref) {
- do_stuff(...);
- }
- }
-
-In this example, since both handles are preparing the exact same statement,
-C<$sth2> will not be its own statement handle, but a duplicate of C<$sth>
-returned from the cache. The results will certainly not be what you expect.
-Typically the inner fetch loop will work normally, fetching all
-the records and terminating when there are no more, but now that $sth
-is the same as $sth2 the outer fetch loop will also terminate.
-
-You'll know if you run into this problem because prepare_cached()
-will generate a warning by default (when $if_active is false).
-
-The cache used by prepare_cached() is keyed by both the statement
-and any attributes so you can also avoid this issue by doing something
-like:
-
- $sth = $dbh->prepare_cached("...", { dbi_dummy => __FILE__.__LINE__ });
-
-which will ensure that prepare_cached only returns statements cached
-by that line of code in that source file.
-
-Also, to ensure the attributes passed are always the same, avoid passing
-references inline. For example, the Slice attribute is specified as a
-reference. Be sure to declare it external to the call to prepare_cached(), such
-that a new hash reference is not created on every call. See L</connect_cached>
-for more details and examples.
-
-If you'd like the cache to managed intelligently, you can tie the
-hashref returned by C<CachedKids> to an appropriate caching module,
-such as L<Tie::Cache::LRU>:
-
- my $cache;
- tie %$cache, 'Tie::Cache::LRU', 500;
- $dbh->{CachedKids} = $cache;
-
-=head3 C<commit>
-
- $rc = $dbh->commit or die $dbh->errstr;
-
-Commit (make permanent) the most recent series of database changes
-if the database supports transactions and AutoCommit is off.
-
-If C<AutoCommit> is on, then calling
-C<commit> will issue a "commit ineffective with AutoCommit" warning.
-
-See also L</Transactions> in the L</FURTHER INFORMATION> section below.
-
-=head3 C<rollback>
-
- $rc = $dbh->rollback or die $dbh->errstr;
-
-Rollback (undo) the most recent series of uncommitted database
-changes if the database supports transactions and AutoCommit is off.
-
-If C<AutoCommit> is on, then calling
-C<rollback> will issue a "rollback ineffective with AutoCommit" warning.
-
-See also L</Transactions> in the L</FURTHER INFORMATION> section below.
-
-=head3 C<begin_work>
-
- $rc = $dbh->begin_work or die $dbh->errstr;
-
-Enable transactions (by turning C<AutoCommit> off) until the next call
-to C<commit> or C<rollback>. After the next C<commit> or C<rollback>,
-C<AutoCommit> will automatically be turned on again.
-
-If C<AutoCommit> is already off when C<begin_work> is called then
-it does nothing except return an error. If the driver does not support
-transactions then when C<begin_work> attempts to set C<AutoCommit> off
-the driver will trigger a fatal error.
-
-See also L</Transactions> in the L</FURTHER INFORMATION> section below.
-
-
-=head3 C<disconnect>
-
- $rc = $dbh->disconnect or warn $dbh->errstr;
-
-Disconnects the database from the database handle. C<disconnect> is typically only used
-before exiting the program. The handle is of little use after disconnecting.
-
-The transaction behaviour of the C<disconnect> method is, sadly,
-undefined. Some database systems (such as Oracle and Ingres) will
-automatically commit any outstanding changes, but others (such as
-Informix) will rollback any outstanding changes. Applications not
-using C<AutoCommit> should explicitly call C<commit> or C<rollback> before
-calling C<disconnect>.
-
-The database is automatically disconnected by the C<DESTROY> method if
-still connected when there are no longer any references to the handle.
-The C<DESTROY> method for each driver should implicitly call C<rollback> to
-undo any uncommitted changes. This is vital behaviour to ensure that
-incomplete transactions don't get committed simply because Perl calls
-C<DESTROY> on every object before exiting. Also, do not rely on the order
-of object destruction during "global destruction", as it is undefined.
-
-Generally, if you want your changes to be committed or rolled back when
-you disconnect, then you should explicitly call L</commit> or L</rollback>
-before disconnecting.
-
-If you disconnect from a database while you still have active
-statement handles (e.g., SELECT statement handles that may have
-more data to fetch), you will get a warning. The warning may indicate
-that a fetch loop terminated early, perhaps due to an uncaught error.
-To avoid the warning call the C<finish> method on the active handles.
-
-
-=head3 C<ping>
-
- $rc = $dbh->ping;
-
-Attempts to determine, in a reasonably efficient way, if the database
-server is still running and the connection to it is still working.
-Individual drivers should implement this function in the most suitable
-manner for their database engine.
-
-The current I<default> implementation always returns true without
-actually doing anything. Actually, it returns "C<0 but true>" which is
-true but zero. That way you can tell if the return value is genuine or
-just the default. Drivers should override this method with one that
-does the right thing for their type of database.
-
-Few applications would have direct use for this method. See the specialized
-Apache::DBI module for one example usage.
-
-
-=head3 C<get_info>
-
- $value = $dbh->get_info( $info_type );
-
-Returns information about the implementation, i.e. driver and data
-source capabilities, restrictions etc. It returns C<undef> for
-unknown or unimplemented information types. For example:
-
- $database_version = $dbh->get_info( 18 ); # SQL_DBMS_VER
- $max_select_tables = $dbh->get_info( 106 ); # SQL_MAXIMUM_TABLES_IN_SELECT
-
-See L</"Standards Reference Information"> for more detailed information
-about the information types and their meanings and possible return values.
-
-The L<DBI::Const::GetInfoType> module exports a %GetInfoType hash that
-can be used to map info type names to numbers. For example:
-
- $database_version = $dbh->get_info( $GetInfoType{SQL_DBMS_VER} );
-
-The names are a merging of the ANSI and ODBC standards (which differ
-in some cases). See L<DBI::Const::GetInfoType> for more details.
-
-Because some DBI methods make use of get_info(), drivers are strongly
-encouraged to support I<at least> the following very minimal set
-of information types to ensure the DBI itself works properly:
-
- Type Name Example A Example B
- ---- -------------------------- ------------ ----------------
- 17 SQL_DBMS_NAME 'ACCESS' 'Oracle'
- 18 SQL_DBMS_VER '03.50.0000' '08.01.0721 ...'
- 29 SQL_IDENTIFIER_QUOTE_CHAR '`' '"'
- 41 SQL_CATALOG_NAME_SEPARATOR '.' '@'
- 114 SQL_CATALOG_LOCATION 1 2
-
-Values from 9000 to 9999 for get_info are officially reserved for use by Perl DBI.
-Values in that range which have been assigned a meaning are defined here:
-
-C<9000>: true if a backslash character (C<\>) before placeholder-like text
-(e.g. C<?>, C<:foo>) will prevent it being treated as a placeholder by the driver.
-The backslash will be removed before the text is passed to the backend.
-
-=head3 C<table_info>
-
- $sth = $dbh->table_info( $catalog, $schema, $table, $type );
- $sth = $dbh->table_info( $catalog, $schema, $table, $type, \%attr );
-
- # then $sth->fetchall_arrayref or $sth->fetchall_hashref etc
-
-Returns an active statement handle that can be used to fetch
-information about tables and views that exist in the database.
-
-The arguments $catalog, $schema and $table may accept search patterns
-according to the database/driver, for example: $table = '%FOO%';
-Remember that the underscore character ('C<_>') is a search pattern
-that means match any character, so 'FOO_%' is the same as 'FOO%'
-and 'FOO_BAR%' will match names like 'FOO1BAR'.
-
-The value of $type is a comma-separated list of one or more types of
-tables to be returned in the result set. Each value may optionally be
-quoted, e.g.:
-
- $type = "TABLE";
- $type = "'TABLE','VIEW'";
-
-In addition the following special cases may also be supported by some drivers:
-
-=over 4
-
-=item *
-If the value of $catalog is '%' and $schema and $table name
-are empty strings, the result set contains a list of catalog names.
-For example:
-
- $sth = $dbh->table_info('%', '', '');
-
-=item *
-If the value of $schema is '%' and $catalog and $table are empty
-strings, the result set contains a list of schema names.
-
-=item *
-If the value of $type is '%' and $catalog, $schema, and $table are all
-empty strings, the result set contains a list of table types.
-
-=back
-
-If your driver doesn't support one or more of the selection filter
-parameters then you may get back more than you asked for and can
-do the filtering yourself.
-
-This method can be expensive, and can return a large amount of data.
-(For example, small Oracle installation returns over 2000 rows.)
-So it's a good idea to use the filters to limit the data as much as possible.
-
-The statement handle returned has at least the following fields in the
-order show below. Other fields, after these, may also be present.
-
-B<TABLE_CAT>: Table catalog identifier. This field is NULL (C<undef>) if not
-applicable to the data source, which is usually the case. This field
-is empty if not applicable to the table.
-
-B<TABLE_SCHEM>: The name of the schema containing the TABLE_NAME value.
-This field is NULL (C<undef>) if not applicable to data source, and
-empty if not applicable to the table.
-
-B<TABLE_NAME>: Name of the table (or view, synonym, etc).
-
-B<TABLE_TYPE>: One of the following: "TABLE", "VIEW", "SYSTEM TABLE",
-"GLOBAL TEMPORARY", "LOCAL TEMPORARY", "ALIAS", "SYNONYM" or a type
-identifier that is specific to the data
-source.
-
-B<REMARKS>: A description of the table. May be NULL (C<undef>).
-
-Note that C<table_info> might not return records for all tables.
-Applications can use any valid table regardless of whether it's
-returned by C<table_info>.
-
-See also L</tables>, L</"Catalog Methods"> and
-L</"Standards Reference Information">.
-
-=head3 C<column_info>
-
- $sth = $dbh->column_info( $catalog, $schema, $table, $column );
-
- # then $sth->fetchall_arrayref or $sth->fetchall_hashref etc
-
-Returns an active statement handle that can be used to fetch
-information about columns in specified tables.
-
-The arguments $schema, $table and $column may accept search patterns
-according to the database/driver, for example: $table = '%FOO%';
-
-Note: The support for the selection criteria is driver specific. If the
-driver doesn't support one or more of them then you may get back more
-than you asked for and can do the filtering yourself.
-
-Note: If your driver does not support column_info an undef is
-returned. This is distinct from asking for something which does not
-exist in a driver which supports column_info as a valid statement
-handle to an empty result-set will be returned in this case.
-
-If the arguments don't match any tables then you'll still get a statement
-handle, it'll just return no rows.
-
-The statement handle returned has at least the following fields in the
-order shown below. Other fields, after these, may also be present.
-
-B<TABLE_CAT>: The catalog identifier.
-This field is NULL (C<undef>) if not applicable to the data source,
-which is often the case. This field is empty if not applicable to the
-table.
-
-B<TABLE_SCHEM>: The schema identifier.
-This field is NULL (C<undef>) if not applicable to the data source,
-and empty if not applicable to the table.
-
-B<TABLE_NAME>: The table identifier.
-Note: A driver may provide column metadata not only for base tables, but
-also for derived objects like SYNONYMS etc.
-
-B<COLUMN_NAME>: The column identifier.
-
-B<DATA_TYPE>: The concise data type code.
-
-B<TYPE_NAME>: A data source dependent data type name.
-
-B<COLUMN_SIZE>: The column size.
-This is the maximum length in characters for character data types,
-the number of digits or bits for numeric data types or the length
-in the representation of temporal types.
-See the relevant specifications for detailed information.
-
-B<BUFFER_LENGTH>: The length in bytes of transferred data.
-
-B<DECIMAL_DIGITS>: The total number of significant digits to the right of
-the decimal point.
-
-B<NUM_PREC_RADIX>: The radix for numeric precision.
-The value is 10 or 2 for numeric data types and NULL (C<undef>) if not
-applicable.
-
-B<NULLABLE>: Indicates if a column can accept NULLs.
-The following values are defined:
-
- SQL_NO_NULLS 0
- SQL_NULLABLE 1
- SQL_NULLABLE_UNKNOWN 2
-
-B<REMARKS>: A description of the column.
-
-B<COLUMN_DEF>: The default value of the column, in a format that can be used
-directly in an SQL statement.
-
-Note that this may be an expression and not simply the text used for the
-default value in the original CREATE TABLE statement. For example, given:
-
- col1 char(30) default current_user -- a 'function'
- col2 char(30) default 'string' -- a string literal
-
-where "current_user" is the name of a function, the corresponding C<COLUMN_DEF>
-values would be:
-
- Database col1 col2
- -------- ---- ----
- Oracle: current_user 'string'
- Postgres: "current_user"() 'string'::text
- MS SQL: (user_name()) ('string')
-
-B<SQL_DATA_TYPE>: The SQL data type.
-
-B<SQL_DATETIME_SUB>: The subtype code for datetime and interval data types.
-
-B<CHAR_OCTET_LENGTH>: The maximum length in bytes of a character or binary
-data type column.
-
-B<ORDINAL_POSITION>: The column sequence number (starting with 1).
-
-B<IS_NULLABLE>: Indicates if the column can accept NULLs.
-Possible values are: 'NO', 'YES' and ''.
-
-SQL/CLI defines the following additional columns:
-
- CHAR_SET_CAT
- CHAR_SET_SCHEM
- CHAR_SET_NAME
- COLLATION_CAT
- COLLATION_SCHEM
- COLLATION_NAME
- UDT_CAT
- UDT_SCHEM
- UDT_NAME
- DOMAIN_CAT
- DOMAIN_SCHEM
- DOMAIN_NAME
- SCOPE_CAT
- SCOPE_SCHEM
- SCOPE_NAME
- MAX_CARDINALITY
- DTD_IDENTIFIER
- IS_SELF_REF
-
-Drivers capable of supplying any of those values should do so in
-the corresponding column and supply undef values for the others.
-
-Drivers wishing to provide extra database/driver specific information
-should do so in extra columns beyond all those listed above, and
-use lowercase field names with the driver-specific prefix (i.e.,
-'ora_...'). Applications accessing such fields should do so by name
-and not by column number.
-
-The result set is ordered by TABLE_CAT, TABLE_SCHEM, TABLE_NAME
-and ORDINAL_POSITION.
-
-Note: There is some overlap with statement handle attributes (in perl) and
-SQLDescribeCol (in ODBC). However, SQLColumns provides more metadata.
-
-See also L</"Catalog Methods"> and L</"Standards Reference Information">.
-
-=head3 C<primary_key_info>
-
- $sth = $dbh->primary_key_info( $catalog, $schema, $table );
-
- # then $sth->fetchall_arrayref or $sth->fetchall_hashref etc
-
-Returns an active statement handle that can be used to fetch information
-about columns that make up the primary key for a table.
-The arguments don't accept search patterns (unlike table_info()).
-
-The statement handle will return one row per column, ordered by
-TABLE_CAT, TABLE_SCHEM, TABLE_NAME, and KEY_SEQ.
-If there is no primary key then the statement handle will fetch no rows.
-
-Note: The support for the selection criteria, such as $catalog, is
-driver specific. If the driver doesn't support catalogs and/or
-schemas, it may ignore these criteria.
-
-The statement handle returned has at least the following fields in the
-order shown below. Other fields, after these, may also be present.
-
-B<TABLE_CAT>: The catalog identifier.
-This field is NULL (C<undef>) if not applicable to the data source,
-which is often the case. This field is empty if not applicable to the
-table.
-
-B<TABLE_SCHEM>: The schema identifier.
-This field is NULL (C<undef>) if not applicable to the data source,
-and empty if not applicable to the table.
-
-B<TABLE_NAME>: The table identifier.
-
-B<COLUMN_NAME>: The column identifier.
-
-B<KEY_SEQ>: The column sequence number (starting with 1).
-Note: This field is named B<ORDINAL_POSITION> in SQL/CLI.
-
-B<PK_NAME>: The primary key constraint identifier.
-This field is NULL (C<undef>) if not applicable to the data source.
-
-See also L</"Catalog Methods"> and L</"Standards Reference Information">.
-
-=head3 C<primary_key>
-
- @key_column_names = $dbh->primary_key( $catalog, $schema, $table );
-
-Simple interface to the primary_key_info() method. Returns a list of
-the column names that comprise the primary key of the specified table.
-The list is in primary key column sequence order.
-If there is no primary key then an empty list is returned.
-
-=head3 C<foreign_key_info>
-
- $sth = $dbh->foreign_key_info( $pk_catalog, $pk_schema, $pk_table
- , $fk_catalog, $fk_schema, $fk_table );
-
- $sth = $dbh->foreign_key_info( $pk_catalog, $pk_schema, $pk_table
- , $fk_catalog, $fk_schema, $fk_table
- , \%attr );
-
- # then $sth->fetchall_arrayref or $sth->fetchall_hashref etc
-
-Returns an active statement handle that can be used to fetch information
-about foreign keys in and/or referencing the specified table(s).
-The arguments don't accept search patterns (unlike table_info()).
-
-C<$pk_catalog>, C<$pk_schema>, C<$pk_table>
-identify the primary (unique) key table (B<PKT>).
-
-C<$fk_catalog>, C<$fk_schema>, C<$fk_table>
-identify the foreign key table (B<FKT>).
-
-If both B<PKT> and B<FKT> are given, the function returns the foreign key, if
-any, in table B<FKT> that refers to the primary (unique) key of table B<PKT>.
-(Note: In SQL/CLI, the result is implementation-defined.)
-
-If only B<PKT> is given, then the result set contains the primary key
-of that table and all foreign keys that refer to it.
-
-If only B<FKT> is given, then the result set contains all foreign keys
-in that table and the primary keys to which they refer.
-(Note: In SQL/CLI, the result includes unique keys too.)
-
-For example:
-
- $sth = $dbh->foreign_key_info( undef, $user, 'master');
- $sth = $dbh->foreign_key_info( undef, undef, undef , undef, $user, 'detail');
- $sth = $dbh->foreign_key_info( undef, $user, 'master', undef, $user, 'detail');
-
- # then $sth->fetchall_arrayref or $sth->fetchall_hashref etc
-
-Note: The support for the selection criteria, such as C<$catalog>, is
-driver specific. If the driver doesn't support catalogs and/or
-schemas, it may ignore these criteria.
-
-The statement handle returned has the following fields in the order shown below.
-Because ODBC never includes unique keys, they define different columns in the
-result set than SQL/CLI. SQL/CLI column names are shown in parentheses.
-
-B<PKTABLE_CAT ( UK_TABLE_CAT )>:
-The primary (unique) key table catalog identifier.
-This field is NULL (C<undef>) if not applicable to the data source,
-which is often the case. This field is empty if not applicable to the
-table.
-
-B<PKTABLE_SCHEM ( UK_TABLE_SCHEM )>:
-The primary (unique) key table schema identifier.
-This field is NULL (C<undef>) if not applicable to the data source,
-and empty if not applicable to the table.
-
-B<PKTABLE_NAME ( UK_TABLE_NAME )>:
-The primary (unique) key table identifier.
-
-B<PKCOLUMN_NAME (UK_COLUMN_NAME )>:
-The primary (unique) key column identifier.
-
-B<FKTABLE_CAT ( FK_TABLE_CAT )>:
-The foreign key table catalog identifier.
-This field is NULL (C<undef>) if not applicable to the data source,
-which is often the case. This field is empty if not applicable to the
-table.
-
-B<FKTABLE_SCHEM ( FK_TABLE_SCHEM )>:
-The foreign key table schema identifier.
-This field is NULL (C<undef>) if not applicable to the data source,
-and empty if not applicable to the table.
-
-B<FKTABLE_NAME ( FK_TABLE_NAME )>:
-The foreign key table identifier.
-
-B<FKCOLUMN_NAME ( FK_COLUMN_NAME )>:
-The foreign key column identifier.
-
-B<KEY_SEQ ( ORDINAL_POSITION )>:
-The column sequence number (starting with 1).
-
-B<UPDATE_RULE ( UPDATE_RULE )>:
-The referential action for the UPDATE rule.
-The following codes are defined:
-
- CASCADE 0
- RESTRICT 1
- SET NULL 2
- NO ACTION 3
- SET DEFAULT 4
-
-B<DELETE_RULE ( DELETE_RULE )>:
-The referential action for the DELETE rule.
-The codes are the same as for UPDATE_RULE.
-
-B<FK_NAME ( FK_NAME )>:
-The foreign key name.
-
-B<PK_NAME ( UK_NAME )>:
-The primary (unique) key name.
-
-B<DEFERRABILITY ( DEFERABILITY )>:
-The deferrability of the foreign key constraint.
-The following codes are defined:
-
- INITIALLY DEFERRED 5
- INITIALLY IMMEDIATE 6
- NOT DEFERRABLE 7
-
-B< ( UNIQUE_OR_PRIMARY )>:
-This column is necessary if a driver includes all candidate (i.e. primary and
-alternate) keys in the result set (as specified by SQL/CLI).
-The value of this column is UNIQUE if the foreign key references an alternate
-key and PRIMARY if the foreign key references a primary key, or it
-may be undefined if the driver doesn't have access to the information.
-
-See also L</"Catalog Methods"> and L</"Standards Reference Information">.
-
-=head3 C<statistics_info>
-
-B<Warning:> This method is experimental and may change.
-
- $sth = $dbh->statistics_info( $catalog, $schema, $table, $unique_only, $quick );
-
- # then $sth->fetchall_arrayref or $sth->fetchall_hashref etc
-
-Returns an active statement handle that can be used to fetch statistical
-information about a table and its indexes.
-
-The arguments don't accept search patterns (unlike L</table_info>).
-
-If the boolean argument $unique_only is true, only UNIQUE indexes will be
-returned in the result set, otherwise all indexes will be returned.
-
-If the boolean argument $quick is set, the actual statistical information
-columns (CARDINALITY and PAGES) will only be returned if they are readily
-available from the server, and might not be current. Some databases may
-return stale statistics or no statistics at all with this flag set.
-
-The statement handle will return at most one row per column name per index,
-plus at most one row for the entire table itself, ordered by NON_UNIQUE, TYPE,
-INDEX_QUALIFIER, INDEX_NAME, and ORDINAL_POSITION.
-
-Note: The support for the selection criteria, such as $catalog, is
-driver specific. If the driver doesn't support catalogs and/or
-schemas, it may ignore these criteria.
-
-The statement handle returned has at least the following fields in the
-order shown below. Other fields, after these, may also be present.
-
-B<TABLE_CAT>: The catalog identifier.
-This field is NULL (C<undef>) if not applicable to the data source,
-which is often the case. This field is empty if not applicable to the
-table.
-
-B<TABLE_SCHEM>: The schema identifier.
-This field is NULL (C<undef>) if not applicable to the data source,
-and empty if not applicable to the table.
-
-B<TABLE_NAME>: The table identifier.
-
-B<NON_UNIQUE>: Unique index indicator.
-Returns 0 for unique indexes, 1 for non-unique indexes
-
-B<INDEX_QUALIFIER>: Index qualifier identifier.
-The identifier that is used to qualify the index name when doing a
-C<DROP INDEX>; NULL (C<undef>) is returned if an index qualifier is not
-supported by the data source.
-If a non-NULL (defined) value is returned in this column, it must be used
-to qualify the index name on a C<DROP INDEX> statement; otherwise,
-the TABLE_SCHEM should be used to qualify the index name.
-
-B<INDEX_NAME>: The index identifier.
-
-B<TYPE>: The type of information being returned. Can be any of the
-following values: 'table', 'btree', 'clustered', 'content', 'hashed',
-or 'other'.
-
-In the case that this field is 'table', all fields
-other than TABLE_CAT, TABLE_SCHEM, TABLE_NAME, TYPE,
-CARDINALITY, and PAGES will be NULL (C<undef>).
-
-B<ORDINAL_POSITION>: Column sequence number (starting with 1).
-
-B<COLUMN_NAME>: The column identifier.
-
-B<ASC_OR_DESC>: Column sort sequence.
-C<A> for Ascending, C<D> for Descending, or NULL (C<undef>) if
-not supported for this index.
-
-B<CARDINALITY>: Cardinality of the table or index.
-For indexes, this is the number of unique values in the index.
-For tables, this is the number of rows in the table.
-If not supported, the value will be NULL (C<undef>).
-
-B<PAGES>: Number of storage pages used by this table or index.
-If not supported, the value will be NULL (C<undef>).
-
-B<FILTER_CONDITION>: The index filter condition as a string.
-If the index is not a filtered index, or it cannot be determined
-whether the index is a filtered index, this value is NULL (C<undef>).
-If the index is a filtered index, but the filter condition
-cannot be determined, this value is the empty string C<''>.
-Otherwise it will be the literal filter condition as a string,
-such as C<SALARY <= 4500>.
-
-See also L</"Catalog Methods"> and L</"Standards Reference Information">.
-
-=head3 C<tables>
-
- @names = $dbh->tables( $catalog, $schema, $table, $type );
- @names = $dbh->tables; # deprecated
-
-Simple interface to table_info(). Returns a list of matching
-table names, possibly including a catalog/schema prefix.
-
-See L</table_info> for a description of the parameters.
-
-If C<$dbh-E<gt>get_info(29)> returns true (29 is SQL_IDENTIFIER_QUOTE_CHAR)
-then the table names are constructed and quoted by L</quote_identifier>
-to ensure they are usable even if they contain whitespace or reserved
-words etc. This means that the table names returned will include
-quote characters.
-
-=head3 C<type_info_all>
-
- $type_info_all = $dbh->type_info_all;
-
-Returns a reference to an array which holds information about each data
-type variant supported by the database and driver. The array and its
-contents should be treated as read-only.
-
-The first item is a reference to an 'index' hash of C<Name =>E<gt> C<Index> pairs.
-The items following that are references to arrays, one per supported data
-type variant. The leading index hash defines the names and order of the
-fields within the arrays that follow it.
-For example:
-
- $type_info_all = [
- { TYPE_NAME => 0,
- DATA_TYPE => 1,
- COLUMN_SIZE => 2, # was PRECISION originally
- LITERAL_PREFIX => 3,
- LITERAL_SUFFIX => 4,
- CREATE_PARAMS => 5,
- NULLABLE => 6,
- CASE_SENSITIVE => 7,
- SEARCHABLE => 8,
- UNSIGNED_ATTRIBUTE=> 9,
- FIXED_PREC_SCALE => 10, # was MONEY originally
- AUTO_UNIQUE_VALUE => 11, # was AUTO_INCREMENT originally
- LOCAL_TYPE_NAME => 12,
- MINIMUM_SCALE => 13,
- MAXIMUM_SCALE => 14,
- SQL_DATA_TYPE => 15,
- SQL_DATETIME_SUB => 16,
- NUM_PREC_RADIX => 17,
- INTERVAL_PRECISION=> 18,
- },
- [ 'VARCHAR', SQL_VARCHAR,
- undef, "'","'", undef,0, 1,1,0,0,0,undef,1,255, undef
- ],
- [ 'INTEGER', SQL_INTEGER,
- undef, "", "", undef,0, 0,1,0,0,0,undef,0, 0, 10
- ],
- ];
-
-More than one row may have the same value in the C<DATA_TYPE>
-field if there are different ways to spell the type name and/or there
-are variants of the type with different attributes (e.g., with and
-without C<AUTO_UNIQUE_VALUE> set, with and without C<UNSIGNED_ATTRIBUTE>, etc).
-
-The rows are ordered by C<DATA_TYPE> first and then by how closely each
-type maps to the corresponding ODBC SQL data type, closest first.
-
-The meaning of the fields is described in the documentation for
-the L</type_info> method.
-
-An 'index' hash is provided so you don't need to rely on index
-values defined above. However, using DBD::ODBC with some old ODBC
-drivers may return older names, shown as comments in the example above.
-Another issue with the index hash is that the lettercase of the
-keys is not defined. It is usually uppercase, as show here, but
-drivers may return names with any lettercase.
-
-Drivers are also free to return extra driver-specific columns of
-information - though it's recommended that they start at column
-index 50 to leave room for expansion of the DBI/ODBC specification.
-
-The type_info_all() method is not normally used directly.
-The L</type_info> method provides a more usable and useful interface
-to the data.
-
-=head3 C<type_info>
-
- @type_info = $dbh->type_info($data_type);
-
-Returns a list of hash references holding information about one or more
-variants of $data_type. The list is ordered by C<DATA_TYPE> first and
-then by how closely each type maps to the corresponding ODBC SQL data
-type, closest first. If called in a scalar context then only the first
-(best) element is returned.
-
-If $data_type is undefined or C<SQL_ALL_TYPES>, then the list will
-contain hashes for all data type variants supported by the database and driver.
-
-If $data_type is an array reference then C<type_info> returns the
-information for the I<first> type in the array that has any matches.
-
-The keys of the hash follow the same letter case conventions as the
-rest of the DBI (see L</Naming Conventions and Name Space>). The
-following uppercase items should always exist, though may be undef:
-
-=over 4
-
-=item TYPE_NAME (string)
-
-Data type name for use in CREATE TABLE statements etc.
-
-=item DATA_TYPE (integer)
-
-SQL data type number.
-
-=item COLUMN_SIZE (integer)
-
-For numeric types, this is either the total number of digits (if the
-NUM_PREC_RADIX value is 10) or the total number of bits allowed in the
-column (if NUM_PREC_RADIX is 2).
-
-For string types, this is the maximum size of the string in characters.
-
-For date and interval types, this is the maximum number of characters
-needed to display the value.
-
-=item LITERAL_PREFIX (string)
-
-Characters used to prefix a literal. A typical prefix is "C<'>" for characters,
-or possibly "C<0x>" for binary values passed as hexadecimal. NULL (C<undef>) is
-returned for data types for which this is not applicable.
-
-
-=item LITERAL_SUFFIX (string)
-
-Characters used to suffix a literal. Typically "C<'>" for characters.
-NULL (C<undef>) is returned for data types where this is not applicable.
-
-=item CREATE_PARAMS (string)
-
-Parameter names for data type definition. For example, C<CREATE_PARAMS> for a
-C<DECIMAL> would be "C<precision,scale>" if the DECIMAL type should be
-declared as C<DECIMAL(>I<precision,scale>C<)> where I<precision> and I<scale>
-are integer values. For a C<VARCHAR> it would be "C<max length>".
-NULL (C<undef>) is returned for data types for which this is not applicable.
-
-=item NULLABLE (integer)
-
-Indicates whether the data type accepts a NULL value:
-C<0> or an empty string = no, C<1> = yes, C<2> = unknown.
-
-=item CASE_SENSITIVE (boolean)
-
-Indicates whether the data type is case sensitive in collations and
-comparisons.
-
-=item SEARCHABLE (integer)
-
-Indicates how the data type can be used in a WHERE clause, as
-follows:
-
- 0 - Cannot be used in a WHERE clause
- 1 - Only with a LIKE predicate
- 2 - All comparison operators except LIKE
- 3 - Can be used in a WHERE clause with any comparison operator
-
-=item UNSIGNED_ATTRIBUTE (boolean)
-
-Indicates whether the data type is unsigned. NULL (C<undef>) is returned
-for data types for which this is not applicable.
-
-=item FIXED_PREC_SCALE (boolean)
-
-Indicates whether the data type always has the same precision and scale
-(such as a money type). NULL (C<undef>) is returned for data types
-for which
-this is not applicable.
-
-=item AUTO_UNIQUE_VALUE (boolean)
-
-Indicates whether a column of this data type is automatically set to a
-unique value whenever a new row is inserted. NULL (C<undef>) is returned
-for data types for which this is not applicable.
-
-=item LOCAL_TYPE_NAME (string)
-
-Localized version of the C<TYPE_NAME> for use in dialog with users.
-NULL (C<undef>) is returned if a localized name is not available (in which
-case C<TYPE_NAME> should be used).
-
-=item MINIMUM_SCALE (integer)
-
-The minimum scale of the data type. If a data type has a fixed scale,
-then C<MAXIMUM_SCALE> holds the same value. NULL (C<undef>) is returned for
-data types for which this is not applicable.
-
-=item MAXIMUM_SCALE (integer)
-
-The maximum scale of the data type. If a data type has a fixed scale,
-then C<MINIMUM_SCALE> holds the same value. NULL (C<undef>) is returned for
-data types for which this is not applicable.
-
-=item SQL_DATA_TYPE (integer)
-
-This column is the same as the C<DATA_TYPE> column, except for interval
-and datetime data types. For interval and datetime data types, the
-C<SQL_DATA_TYPE> field will return C<SQL_INTERVAL> or C<SQL_DATETIME>, and the
-C<SQL_DATETIME_SUB> field below will return the subcode for the specific
-interval or datetime data type. If this field is NULL, then the driver
-does not support or report on interval or datetime subtypes.
-
-=item SQL_DATETIME_SUB (integer)
-
-For interval or datetime data types, where the C<SQL_DATA_TYPE>
-field above is C<SQL_INTERVAL> or C<SQL_DATETIME>, this field will
-hold the I<subcode> for the specific interval or datetime data type.
-Otherwise it will be NULL (C<undef>).
-
-Although not mentioned explicitly in the standards, it seems there
-is a simple relationship between these values:
-
- DATA_TYPE == (10 * SQL_DATA_TYPE) + SQL_DATETIME_SUB
-
-=item NUM_PREC_RADIX (integer)
-
-The radix value of the data type. For approximate numeric types,
-C<NUM_PREC_RADIX>
-contains the value 2 and C<COLUMN_SIZE> holds the number of bits. For
-exact numeric types, C<NUM_PREC_RADIX> contains the value 10 and C<COLUMN_SIZE> holds
-the number of decimal digits. NULL (C<undef>) is returned either for data types
-for which this is not applicable or if the driver cannot report this information.
-
-=item INTERVAL_PRECISION (integer)
-
-The interval leading precision for interval types. NULL is returned
-either for data types for which this is not applicable or if the driver
-cannot report this information.
-
-=back
-
-For example, to find the type name for the fields in a select statement
-you can do:
-
- @names = map { scalar $dbh->type_info($_)->{TYPE_NAME} } @{ $sth->{TYPE} }
-
-Since DBI and ODBC drivers vary in how they map their types into the
-ISO standard types you may need to search for more than one type.
-Here's an example looking for a usable type to store a date:
-
- $my_date_type = $dbh->type_info( [ SQL_DATE, SQL_TIMESTAMP ] );
-
-Similarly, to more reliably find a type to store small integers, you could
-use a list starting with C<SQL_SMALLINT>, C<SQL_INTEGER>, C<SQL_DECIMAL>, etc.
-
-See also L</"Standards Reference Information">.
-
-
-=head3 C<quote>
-
- $sql = $dbh->quote($value);
- $sql = $dbh->quote($value, $data_type);
-
-Quote a string literal for use as a literal value in an SQL statement,
-by escaping any special characters (such as quotation marks)
-contained within the string and adding the required type of outer
-quotation marks.
-
- $sql = sprintf "SELECT foo FROM bar WHERE baz = %s",
- $dbh->quote("Don't");
-
-For most database types, at least those that conform to SQL standards, quote
-would return C<'Don''t'> (including the outer quotation marks). For others it
-may return something like C<'Don\'t'>
-
-An undefined C<$value> value will be returned as the string C<NULL> (without
-single quotation marks) to match how NULLs are represented in SQL.
-
-If C<$data_type> is supplied, it is used to try to determine the required
-quoting behaviour by using the information returned by L</type_info>.
-As a special case, the standard numeric types are optimized to return
-C<$value> without calling C<type_info>.
-
-Quote will probably I<not> be able to deal with all possible input
-(such as binary data or data containing newlines), and is not related in
-any way with escaping or quoting shell meta-characters.
-
-It is valid for the quote() method to return an SQL expression that
-evaluates to the desired string. For example:
-
- $quoted = $dbh->quote("one\ntwo\0three")
-
-may return something like:
-
- CONCAT('one', CHAR(12), 'two', CHAR(0), 'three')
-
-The quote() method should I<not> be used with L</"Placeholders and
-Bind Values">.
-
-=head3 C<quote_identifier>
-
- $sql = $dbh->quote_identifier( $name );
- $sql = $dbh->quote_identifier( $catalog, $schema, $table, \%attr );
-
-Quote an identifier (table name etc.) for use in an SQL statement,
-by escaping any special characters (such as double quotation marks)
-it contains and adding the required type of outer quotation marks.
-
-Undefined names are ignored and the remainder are quoted and then
-joined together, typically with a dot (C<.>) character. For example:
-
- $id = $dbh->quote_identifier( undef, 'Her schema', 'My table' );
-
-would, for most database types, return C<"Her schema"."My table">
-(including all the double quotation marks).
-
-If three names are supplied then the first is assumed to be a
-catalog name and special rules may be applied based on what L</get_info>
-returns for SQL_CATALOG_NAME_SEPARATOR (41) and SQL_CATALOG_LOCATION (114).
-For example, for Oracle:
-
- $id = $dbh->quote_identifier( 'link', 'schema', 'table' );
-
-would return C<"schema"."table"@"link">.
-
-=head3 C<take_imp_data>
-
- $imp_data = $dbh->take_imp_data;
-
-Leaves the $dbh in an almost dead, zombie-like, state and returns
-a binary string of raw implementation data from the driver which
-describes the current database connection. Effectively it detaches
-the underlying database API connection data from the DBI handle.
-After calling take_imp_data(), all other methods except C<DESTROY>
-will generate a warning and return undef.
-
-Why would you want to do this? You don't, forget I even mentioned it.
-Unless, that is, you're implementing something advanced like a
-multi-threaded connection pool. See L<DBI::Pool>.
-
-The returned $imp_data can be passed as a C<dbi_imp_data> attribute
-to a later connect() call, even in a separate thread in the same
-process, where the driver can use it to 'adopt' the existing
-connection that the implementation data was taken from.
-
-Some things to keep in mind...
-
-B<*> the $imp_data holds the only reference to the underlying
-database API connection data. That connection is still 'live' and
-won't be cleaned up properly unless the $imp_data is used to create
-a new $dbh which is then allowed to disconnect() normally.
-
-B<*> using the same $imp_data to create more than one other new
-$dbh at a time may well lead to unpleasant problems. Don't do that.
-
-Any child statement handles are effectively destroyed when take_imp_data() is
-called.
-
-The C<take_imp_data> method was added in DBI 1.36 but wasn't useful till 1.49.
-
-
-=head2 Database Handle Attributes
-
-This section describes attributes specific to database handles.
-
-Changes to these database handle attributes do not affect any other
-existing or future database handles.
-
-Attempting to set or get the value of an unknown attribute generates a warning,
-except for private driver-specific attributes (which all have names
-starting with a lowercase letter).
-
-Example:
-
- $h->{AutoCommit} = ...; # set/write
- ... = $h->{AutoCommit}; # get/read
-
-=head3 C<AutoCommit>
-
-Type: boolean
-
-If true, then database changes cannot be rolled-back (undone). If false,
-then database changes automatically occur within a "transaction", which
-must either be committed or rolled back using the C<commit> or C<rollback>
-methods.
-
-Drivers should always default to C<AutoCommit> mode (an unfortunate
-choice largely forced on the DBI by ODBC and JDBC conventions.)
-
-Attempting to set C<AutoCommit> to an unsupported value is a fatal error.
-This is an important feature of the DBI. Applications that need
-full transaction behaviour can set C<$dbh-E<gt>{AutoCommit} = 0> (or
-set C<AutoCommit> to 0 via L</connect>)
-without having to check that the value was assigned successfully.
-
-For the purposes of this description, we can divide databases into three
-categories:
-
- Databases which don't support transactions at all.
- Databases in which a transaction is always active.
- Databases in which a transaction must be explicitly started (C<'BEGIN WORK'>).
-
-B<* Databases which don't support transactions at all>
-
-For these databases, attempting to turn C<AutoCommit> off is a fatal error.
-C<commit> and C<rollback> both issue warnings about being ineffective while
-C<AutoCommit> is in effect.
-
-B<* Databases in which a transaction is always active>
-
-These are typically mainstream commercial relational databases with
-"ANSI standard" transaction behaviour.
-If C<AutoCommit> is off, then changes to the database won't have any
-lasting effect unless L</commit> is called (but see also
-L</disconnect>). If L</rollback> is called then any changes since the
-last commit are undone.
-
-If C<AutoCommit> is on, then the effect is the same as if the DBI
-called C<commit> automatically after every successful database
-operation. So calling C<commit> or C<rollback> explicitly while
-C<AutoCommit> is on would be ineffective because the changes would
-have already been committed.
-
-Changing C<AutoCommit> from off to on will trigger a L</commit>.
-
-For databases which don't support a specific auto-commit mode, the
-driver has to commit each statement automatically using an explicit
-C<COMMIT> after it completes successfully (and roll it back using an
-explicit C<ROLLBACK> if it fails). The error information reported to the
-application will correspond to the statement which was executed, unless
-it succeeded and the commit or rollback failed.
-
-B<* Databases in which a transaction must be explicitly started>
-
-For these databases, the intention is to have them act like databases in
-which a transaction is always active (as described above).
-
-To do this, the driver will automatically begin an explicit transaction
-when C<AutoCommit> is turned off, or after a L</commit> or
-L</rollback> (or when the application issues the next database
-operation after one of those events).
-
-In this way, the application does not have to treat these databases
-as a special case.
-
-See L</commit>, L</disconnect> and L</Transactions> for other important
-notes about transactions.
-
-
-=head3 C<Driver>
-
-Type: handle
-
-Holds the handle of the parent driver. The only recommended use for this
-is to find the name of the driver using:
-
- $dbh->{Driver}->{Name}
-
-
-=head3 C<Name>
-
-Type: string
-
-Holds the "name" of the database. Usually (and recommended to be) the
-same as the "C<dbi:DriverName:...>" string used to connect to the database,
-but with the leading "C<dbi:DriverName:>" removed.
-
-
-=head3 C<Statement>
-
-Type: string, read-only
-
-Returns the statement string passed to the most recent L</prepare> or
-L</do> method called in this database handle, even if that method
-failed. This is especially useful where C<RaiseError> is enabled and
-the exception handler checks $@ and sees that a 'prepare' method call
-failed.
-
-
-=head3 C<RowCacheSize>
-
-Type: integer
-
-A hint to the driver indicating the size of the local row cache that the
-application would like the driver to use for future C<SELECT> statements.
-If a row cache is not implemented, then setting C<RowCacheSize> is ignored
-and getting the value returns C<undef>.
-
-Some C<RowCacheSize> values have special meaning, as follows:
-
- 0 - Automatically determine a reasonable cache size for each C<SELECT>
- 1 - Disable the local row cache
- >1 - Cache this many rows
- <0 - Cache as many rows that will fit into this much memory for each C<SELECT>.
-
-Note that large cache sizes may require a very large amount of memory
-(I<cached rows * maximum size of row>). Also, a large cache will cause
-a longer delay not only for the first fetch, but also whenever the
-cache needs refilling.
-
-See also the L</RowsInCache> statement handle attribute.
-
-=head3 C<Username>
-
-Type: string
-
-Returns the username used to connect to the database.
-
-
-=head1 DBI STATEMENT HANDLE OBJECTS
-
-This section lists the methods and attributes associated with DBI
-statement handles.
-
-=head2 Statement Handle Methods
-
-The DBI defines the following methods for use on DBI statement handles:
-
-=head3 C<bind_param>
-
- $sth->bind_param($p_num, $bind_value)
- $sth->bind_param($p_num, $bind_value, \%attr)
- $sth->bind_param($p_num, $bind_value, $bind_type)
-
-The C<bind_param> method takes a copy of $bind_value and associates it
-(binds it) with a placeholder, identified by $p_num, embedded in
-the prepared statement. Placeholders are indicated with question
-mark character (C<?>). For example:
-
- $dbh->{RaiseError} = 1; # save having to check each method call
- $sth = $dbh->prepare("SELECT name, age FROM people WHERE name LIKE ?");
- $sth->bind_param(1, "John%"); # placeholders are numbered from 1
- $sth->execute;
- DBI::dump_results($sth);
-
-See L</Placeholders and Bind Values> for more information.
-
-
-B<Data Types for Placeholders>
-
-The C<\%attr> parameter can be used to hint at the data type the
-placeholder should have. This is rarely needed. Typically, the driver is only
-interested in knowing if the placeholder should be bound as a number or a string.
-
- $sth->bind_param(1, $value, { TYPE => SQL_INTEGER });
-
-As a short-cut for the common case, the data type can be passed
-directly, in place of the C<\%attr> hash reference. This example is
-equivalent to the one above:
-
- $sth->bind_param(1, $value, SQL_INTEGER);
-
-The C<TYPE> value indicates the standard (non-driver-specific) type for
-this parameter. To specify the driver-specific type, the driver may
-support a driver-specific attribute, such as C<{ ora_type =E<gt> 97 }>.
-
-The SQL_INTEGER and other related constants can be imported using
-
- use DBI qw(:sql_types);
-
-See L</"DBI Constants"> for more information.
-
-The data type is 'sticky' in that bind values passed to execute() are bound
-with the data type specified by earlier bind_param() calls, if any.
-Portable applications should not rely on being able to change the data type
-after the first C<bind_param> call.
-
-Perl only has string and number scalar data types. All database types
-that aren't numbers are bound as strings and must be in a format the
-database will understand except where the bind_param() TYPE attribute
-specifies a type that implies a particular format. For example, given:
-
- $sth->bind_param(1, $value, SQL_DATETIME);
-
-the driver should expect $value to be in the ODBC standard SQL_DATETIME
-format, which is 'YYYY-MM-DD HH:MM:SS'. Similarly for SQL_DATE, SQL_TIME etc.
-
-As an alternative to specifying the data type in the C<bind_param> call,
-you can let the driver pass the value as the default type (C<VARCHAR>).
-You can then use an SQL function to convert the type within the statement.
-For example:
-
- INSERT INTO price(code, price) VALUES (?, CONVERT(MONEY,?))
-
-The C<CONVERT> function used here is just an example. The actual function
-and syntax will vary between different databases and is non-portable.
-
-See also L</Placeholders and Bind Values> for more information.
-
-
-=head3 C<bind_param_inout>
-
- $rc = $sth->bind_param_inout($p_num, \$bind_value, $max_len) or die $sth->errstr;
- $rv = $sth->bind_param_inout($p_num, \$bind_value, $max_len, \%attr) or ...
- $rv = $sth->bind_param_inout($p_num, \$bind_value, $max_len, $bind_type) or ...
-
-This method acts like L</bind_param>, but also enables values to be
-updated by the statement. The statement is typically
-a call to a stored procedure. The C<$bind_value> must be passed as a
-reference to the actual value to be used.
-
-Note that unlike L</bind_param>, the C<$bind_value> variable is not
-copied when C<bind_param_inout> is called. Instead, the value in the
-variable is read at the time L</execute> is called.
-
-The additional C<$max_len> parameter specifies the minimum amount of
-memory to allocate to C<$bind_value> for the new value. If the value
-returned from the database is too
-big to fit, then the execution should fail. If unsure what value to use,
-pick a generous length, i.e., a length larger than the longest value that would ever be
-returned. The only cost of using a larger value than needed is wasted memory.
-
-Undefined values or C<undef> are used to indicate null values.
-See also L</Placeholders and Bind Values> for more information.
-
-
-=head3 C<bind_param_array>
-
- $rc = $sth->bind_param_array($p_num, $array_ref_or_value)
- $rc = $sth->bind_param_array($p_num, $array_ref_or_value, \%attr)
- $rc = $sth->bind_param_array($p_num, $array_ref_or_value, $bind_type)
-
-The C<bind_param_array> method is used to bind an array of values
-to a placeholder embedded in the prepared statement which is to be executed
-with L</execute_array>. For example:
-
- $dbh->{RaiseError} = 1; # save having to check each method call
- $sth = $dbh->prepare("INSERT INTO staff (first_name, last_name, dept) VALUES(?, ?, ?)");
- $sth->bind_param_array(1, [ 'John', 'Mary', 'Tim' ]);
- $sth->bind_param_array(2, [ 'Booth', 'Todd', 'Robinson' ]);
- $sth->bind_param_array(3, "SALES"); # scalar will be reused for each row
- $sth->execute_array( { ArrayTupleStatus => \my @tuple_status } );
-
-The C<%attr> ($bind_type) argument is the same as defined for L</bind_param>.
-Refer to L</bind_param> for general details on using placeholders.
-
-(Note that bind_param_array() can I<not> be used to expand a
-placeholder into a list of values for a statement like "SELECT foo
-WHERE bar IN (?)". A placeholder can only ever represent one value
-per execution.)
-
-Scalar values, including C<undef>, may also be bound by
-C<bind_param_array>. In which case the same value will be used for each
-L</execute> call. Driver-specific implementations may behave
-differently, e.g., when binding to a stored procedure call, some
-databases may permit mixing scalars and arrays as arguments.
-
-The default implementation provided by DBI (for drivers that have
-not implemented array binding) is to iteratively call L</execute> for
-each parameter tuple provided in the bound arrays. Drivers may
-provide more optimized implementations using whatever bulk operation
-support the database API provides. The default driver behaviour should
-match the default DBI behaviour, but always consult your driver
-documentation as there may be driver specific issues to consider.
-
-Note that the default implementation currently only supports non-data
-returning statements (INSERT, UPDATE, but not SELECT). Also,
-C<bind_param_array> and L</bind_param> cannot be mixed in the same
-statement execution, and C<bind_param_array> must be used with
-L</execute_array>; using C<bind_param_array> will have no effect
-for L</execute>.
-
-The C<bind_param_array> method was added in DBI 1.22.
-
-=head3 C<execute>
-
- $rv = $sth->execute or die $sth->errstr;
- $rv = $sth->execute(@bind_values) or die $sth->errstr;
-
-Perform whatever processing is necessary to execute the prepared
-statement. An C<undef> is returned if an error occurs. A successful
-C<execute> always returns true regardless of the number of rows affected,
-even if it's zero (see below). It is always important to check the
-return status of C<execute> (and most other DBI methods) for errors
-if you're not using L</RaiseError>.
-
-For a I<non>-C<SELECT> statement, C<execute> returns the number of rows
-affected, if known. If no rows were affected, then C<execute> returns
-"C<0E0>", which Perl will treat as 0 but will regard as true. Note that it
-is I<not> an error for no rows to be affected by a statement. If the
-number of rows affected is not known, then C<execute> returns -1.
-
-For C<SELECT> statements, execute simply "starts" the query within the
-database engine. Use one of the fetch methods to retrieve the data after
-calling C<execute>. The C<execute> method does I<not> return the number of
-rows that will be returned by the query (because most databases can't
-tell in advance), it simply returns a true value.
-
-You can tell if the statement was a C<SELECT> statement by checking if
-C<$sth-E<gt>{NUM_OF_FIELDS}> is greater than zero after calling C<execute>.
-
-If any arguments are given, then C<execute> will effectively call
-L</bind_param> for each value before executing the statement. Values
-bound in this way are usually treated as C<SQL_VARCHAR> types unless
-the driver can determine the correct type (which is rare), or unless
-C<bind_param> (or C<bind_param_inout>) has already been used to
-specify the type.
-
-Note that passing C<execute> an empty array is the same as passing no arguments
-at all, which will execute the statement with previously bound values.
-That's probably not what you want.
-
-If execute() is called on a statement handle that's still active
-($sth->{Active} is true) then it should effectively call finish()
-to tidy up the previous execution results before starting this new
-execution.
-
-=head3 C<execute_array>
-
- $tuples = $sth->execute_array(\%attr) or die $sth->errstr;
- $tuples = $sth->execute_array(\%attr, @bind_values) or die $sth->errstr;
-
- ($tuples, $rows) = $sth->execute_array(\%attr) or die $sth->errstr;
- ($tuples, $rows) = $sth->execute_array(\%attr, @bind_values) or die $sth->errstr;
-
-Execute the prepared statement once for each parameter tuple
-(group of values) provided either in the @bind_values, or by prior
-calls to L</bind_param_array>, or via a reference passed in \%attr.
-
-When called in scalar context the execute_array() method returns the
-number of tuples executed, or C<undef> if an error occurred. Like
-execute(), a successful execute_array() always returns true regardless
-of the number of tuples executed, even if it's zero. If there were any
-errors the ArrayTupleStatus array can be used to discover which tuples
-failed and with what errors.
-
-When called in list context the execute_array() method returns two scalars;
-$tuples is the same as calling execute_array() in scalar context and $rows is
-the number of rows affected for each tuple, if available or
--1 if the driver cannot determine this. NOTE, some drivers cannot determine
-the number of rows affected per tuple but can provide the number of rows
-affected for the batch.
-If you are doing an update operation the returned rows affected may not be what
-you expect if, for instance, one or more of the tuples affected the same row
-multiple times. Some drivers may not yet support list context, in which case
-$rows will be undef, or may not be able to provide the number of rows affected
-when performing this batch operation, in which case $rows will be -1.
-
-Bind values for the tuples to be executed may be supplied row-wise
-by an C<ArrayTupleFetch> attribute, or else column-wise in the
-C<@bind_values> argument, or else column-wise by prior calls to
-L</bind_param_array>.
-
-Where column-wise binding is used (via the C<@bind_values> argument
-or calls to bind_param_array()) the maximum number of elements in
-any one of the bound value arrays determines the number of tuples
-executed. Placeholders with fewer values in their parameter arrays
-are treated as if padded with undef (NULL) values.
-
-If a scalar value is bound, instead of an array reference, it is
-treated as a I<variable> length array with all elements having the
-same value. It does not influence the number of tuples executed,
-so if all bound arrays have zero elements then zero tuples will
-be executed. If I<all> bound values are scalars then one tuple
-will be executed, making execute_array() act just like execute().
-
-The C<ArrayTupleFetch> attribute can be used to specify a reference
-to a subroutine that will be called to provide the bind values for
-each tuple execution. The subroutine should return an reference to
-an array which contains the appropriate number of bind values, or
-return an undef if there is no more data to execute.
-
-As a convenience, the C<ArrayTupleFetch> attribute can also be
-used to specify a statement handle. In which case the fetchrow_arrayref()
-method will be called on the given statement handle in order to
-provide the bind values for each tuple execution.
-
-The values specified via bind_param_array() or the @bind_values
-parameter may be either scalars, or arrayrefs. If any C<@bind_values>
-are given, then C<execute_array> will effectively call L</bind_param_array>
-for each value before executing the statement. Values bound in
-this way are usually treated as C<SQL_VARCHAR> types unless the
-driver can determine the correct type (which is rare), or unless
-C<bind_param>, C<bind_param_inout>, C<bind_param_array>, or
-C<bind_param_inout_array> has already been used to specify the type.
-See L</bind_param_array> for details.
-
-The C<ArrayTupleStatus> attribute can be used to specify a
-reference to an array which will receive the execute status of each
-executed parameter tuple. Note the C<ArrayTupleStatus> attribute was
-mandatory until DBI 1.38.
-
-For tuples which are successfully executed, the element at the same
-ordinal position in the status array is the resulting rowcount (or -1
-if unknown).
-If the execution of a tuple causes an error, then the corresponding
-status array element will be set to a reference to an array containing
-L</err>, L</errstr> and L</state> set by the failed execution.
-
-If B<any> tuple execution returns an error, C<execute_array> will
-return C<undef>. In that case, the application should inspect the
-status array to determine which parameter tuples failed.
-Some databases may not continue executing tuples beyond the first
-failure. In this case the status array will either hold fewer
-elements, or the elements beyond the failure will be undef.
-
-If all parameter tuples are successfully executed, C<execute_array>
-returns the number tuples executed. If no tuples were executed,
-then execute_array() returns "C<0E0>", just like execute() does,
-which Perl will treat as 0 but will regard as true.
-
-For example:
-
- $sth = $dbh->prepare("INSERT INTO staff (first_name, last_name) VALUES (?, ?)");
- my $tuples = $sth->execute_array(
- { ArrayTupleStatus => \my @tuple_status },
- \@first_names,
- \@last_names,
- );
- if ($tuples) {
- print "Successfully inserted $tuples records\n";
- }
- else {
- for my $tuple (0..@last_names-1) {
- my $status = $tuple_status[$tuple];
- $status = [0, "Skipped"] unless defined $status;
- next unless ref $status;
- printf "Failed to insert (%s, %s): %s\n",
- $first_names[$tuple], $last_names[$tuple], $status->[1];
- }
- }
-
-Support for data returning statements such as SELECT is driver-specific
-and subject to change. At present, the default implementation
-provided by DBI only supports non-data returning statements.
-
-Transaction semantics when using array binding are driver and
-database specific. If C<AutoCommit> is on, the default DBI
-implementation will cause each parameter tuple to be individually
-committed (or rolled back in the event of an error). If C<AutoCommit>
-is off, the application is responsible for explicitly committing
-the entire set of bound parameter tuples. Note that different
-drivers and databases may have different behaviours when some
-parameter tuples cause failures. In some cases, the driver or
-database may automatically rollback the effect of all prior parameter
-tuples that succeeded in the transaction; other drivers or databases
-may retain the effect of prior successfully executed parameter
-tuples. Be sure to check your driver and database for its specific
-behaviour.
-
-Note that, in general, performance will usually be better with
-C<AutoCommit> turned off, and using explicit C<commit> after each
-C<execute_array> call.
-
-The C<execute_array> method was added in DBI 1.22, and ArrayTupleFetch
-was added in 1.36.
-
-=head3 C<execute_for_fetch>
-
- $tuples = $sth->execute_for_fetch($fetch_tuple_sub);
- $tuples = $sth->execute_for_fetch($fetch_tuple_sub, \@tuple_status);
-
- ($tuples, $rows) = $sth->execute_for_fetch($fetch_tuple_sub);
- ($tuples, $rows) = $sth->execute_for_fetch($fetch_tuple_sub, \@tuple_status);
-
-The execute_for_fetch() method is used to perform bulk operations and
-although it is most often used via the execute_array() method you can
-use it directly. The main difference between execute_array and
-execute_for_fetch is the former does column or row-wise binding and
-the latter uses row-wise binding.
-
-The fetch subroutine, referenced by $fetch_tuple_sub, is expected
-to return a reference to an array (known as a 'tuple') or undef.
-
-The execute_for_fetch() method calls $fetch_tuple_sub, without any
-parameters, until it returns a false value. Each tuple returned is
-used to provide bind values for an $sth->execute(@$tuple) call.
-
-In scalar context execute_for_fetch() returns C<undef> if there were any
-errors and the number of tuples executed otherwise. Like execute() and
-execute_array() a zero is returned as "0E0" so execute_for_fetch() is
-only false on error. If there were any errors the @tuple_status array
-can be used to discover which tuples failed and with what errors.
-
-When called in list context execute_for_fetch() returns two scalars;
-$tuples is the same as calling execute_for_fetch() in scalar context and $rows is
-the sum of the number of rows affected for each tuple, if available or -1
-if the driver cannot determine this.
-If you are doing an update operation the returned rows affected may not be what
-you expect if, for instance, one or more of the tuples affected the same row
-multiple times. Some drivers may not yet support list context, in which case
-$rows will be undef, or may not be able to provide the number of rows affected
-when performing this batch operation, in which case $rows will be -1.
-
-If \@tuple_status is passed then the execute_for_fetch method uses
-it to return status information. The tuple_status array holds one
-element per tuple. If the corresponding execute() did not fail then
-the element holds the return value from execute(), which is typically
-a row count. If the execute() did fail then the element holds a
-reference to an array containing ($sth->err, $sth->errstr, $sth->state).
-
-If the driver detects an error that it knows means no further tuples can be
-executed then it may return, with an error status, even though $fetch_tuple_sub
-may still have more tuples to be executed.
-
-Although each tuple returned by $fetch_tuple_sub is effectively used
-to call $sth->execute(@$tuple_array_ref) the exact timing may vary.
-Drivers are free to accumulate sets of tuples to pass to the
-database server in bulk group operations for more efficient execution.
-However, the $fetch_tuple_sub is specifically allowed to return
-the same array reference each time (which is what fetchrow_arrayref()
-usually does).
-
-For example:
-
- my $sel = $dbh1->prepare("select foo, bar from table1");
- $sel->execute;
-
- my $ins = $dbh2->prepare("insert into table2 (foo, bar) values (?,?)");
- my $fetch_tuple_sub = sub { $sel->fetchrow_arrayref };
-
- my @tuple_status;
- $rc = $ins->execute_for_fetch($fetch_tuple_sub, \@tuple_status);
- my @errors = grep { ref $_ } @tuple_status;
-
-Similarly, if you already have an array containing the data rows
-to be processed you'd use a subroutine to shift off and return
-each array ref in turn:
-
- $ins->execute_for_fetch( sub { shift @array_of_arrays }, \@tuple_status);
-
-The C<execute_for_fetch> method was added in DBI 1.38.
-
-
-=head3 C<fetchrow_arrayref>
-
- $ary_ref = $sth->fetchrow_arrayref;
- $ary_ref = $sth->fetch; # alias
-
-Fetches the next row of data and returns a reference to an array
-holding the field values. Null fields are returned as C<undef>
-values in the array.
-This is the fastest way to fetch data, particularly if used with
-C<$sth-E<gt>bind_columns>.
-
-If there are no more rows or if an error occurs, then C<fetchrow_arrayref>
-returns an C<undef>. You should check C<$sth-E<gt>err> afterwards (or use the
-C<RaiseError> attribute) to discover if the C<undef> returned was due to an
-error.
-
-Note that the same array reference is returned for each fetch, so don't
-store the reference and then use it after a later fetch. Also, the
-elements of the array are also reused for each row, so take care if you
-want to take a reference to an element. See also L</bind_columns>.
-
-=head3 C<fetchrow_array>
-
- @ary = $sth->fetchrow_array;
-
-An alternative to C<fetchrow_arrayref>. Fetches the next row of data
-and returns it as a list containing the field values. Null fields
-are returned as C<undef> values in the list.
-
-If there are no more rows or if an error occurs, then C<fetchrow_array>
-returns an empty list. You should check C<$sth-E<gt>err> afterwards (or use
-the C<RaiseError> attribute) to discover if the empty list returned was
-due to an error.
-
-If called in a scalar context for a statement handle that has more
-than one column, it is undefined whether the driver will return
-the value of the first column or the last. So don't do that.
-Also, in a scalar context, an C<undef> is returned if there are no
-more rows or if an error occurred. That C<undef> can't be distinguished
-from an C<undef> returned because the first field value was NULL.
-For these reasons you should exercise some caution if you use
-C<fetchrow_array> in a scalar context.
-
-=head3 C<fetchrow_hashref>
-
- $hash_ref = $sth->fetchrow_hashref;
- $hash_ref = $sth->fetchrow_hashref($name);
-
-An alternative to C<fetchrow_arrayref>. Fetches the next row of data
-and returns it as a reference to a hash containing field name and field
-value pairs. Null fields are returned as C<undef> values in the hash.
-
-If there are no more rows or if an error occurs, then C<fetchrow_hashref>
-returns an C<undef>. You should check C<$sth-E<gt>err> afterwards (or use the
-C<RaiseError> attribute) to discover if the C<undef> returned was due to an
-error.
-
-The optional C<$name> parameter specifies the name of the statement handle
-attribute. For historical reasons it defaults to "C<NAME>", however using
-either "C<NAME_lc>" or "C<NAME_uc>" is recommended for portability.
-
-The keys of the hash are the same names returned by C<$sth-E<gt>{$name}>. If
-more than one field has the same name, there will only be one entry in the
-returned hash for those fields, so statements like "C<select foo, foo from bar>"
-will return only a single key from C<fetchrow_hashref>. In these cases use
-column aliases or C<fetchrow_arrayref>. Note that it is the database server
-(and not the DBD implementation) which provides the I<name> for fields
-containing functions like "C<count(*)>" or "C<max(c_foo)>" and they may clash
-with existing column names (most databases don't care about duplicate column
-names in a result-set). If you want these to return as unique names that are
-the same across databases, use I<aliases>, as in "C<select count(*) as cnt>"
-or "C<select max(c_foo) mx_foo, ...>" depending on the syntax your database
-supports.
-
-Because of the extra work C<fetchrow_hashref> and Perl have to perform, it
-is not as efficient as C<fetchrow_arrayref> or C<fetchrow_array>.
-
-By default a reference to a new hash is returned for each row.
-It is likely that a future version of the DBI will support an
-attribute which will enable the same hash to be reused for each
-row. This will give a significant performance boost, but it won't
-be enabled by default because of the risk of breaking old code.
-
-
-=head3 C<fetchall_arrayref>
-
- $tbl_ary_ref = $sth->fetchall_arrayref;
- $tbl_ary_ref = $sth->fetchall_arrayref( $slice );
- $tbl_ary_ref = $sth->fetchall_arrayref( $slice, $max_rows );
-
-The C<fetchall_arrayref> method can be used to fetch all the data to be
-returned from a prepared and executed statement handle. It returns a
-reference to an array that contains one reference per row.
-
-If called on an I<inactive> statement handle, C<fetchall_arrayref> returns undef.
-
-If there are no rows left to return from an I<active> statement handle, C<fetchall_arrayref> returns a reference
-to an empty array. If an error occurs, C<fetchall_arrayref> returns the
-data fetched thus far, which may be none. You should check C<$sth-E<gt>err>
-afterwards (or use the C<RaiseError> attribute) to discover if the data is
-complete or was truncated due to an error.
-
-If $slice is an array reference, C<fetchall_arrayref> uses L</fetchrow_arrayref>
-to fetch each row as an array ref. If the $slice array is not empty
-then it is used as a slice to select individual columns by perl array
-index number (starting at 0, unlike column and parameter numbers which
-start at 1).
-
-With no parameters, or if $slice is undefined, C<fetchall_arrayref>
-acts as if passed an empty array ref.
-
-For example, to fetch just the first column of every row:
-
- $tbl_ary_ref = $sth->fetchall_arrayref([0]);
-
-To fetch the second to last and last column of every row:
-
- $tbl_ary_ref = $sth->fetchall_arrayref([-2,-1]);
-
-Those two examples both return a reference to an array of array refs.
-
-If $slice is a hash reference, C<fetchall_arrayref> fetches each row as a hash
-reference. If the $slice hash is empty then the keys in the hashes have
-whatever name lettercase is returned by default. (See L</FetchHashKeyName>
-attribute.) If the $slice hash is I<not> empty, then it is used as a slice to
-select individual columns by name. The values of the hash should be set to 1.
-The key names of the returned hashes match the letter case of the names in the
-parameter hash, regardless of the L</FetchHashKeyName> attribute.
-
-For example, to fetch all fields of every row as a hash ref:
-
- $tbl_ary_ref = $sth->fetchall_arrayref({});
-
-To fetch only the fields called "foo" and "bar" of every row as a hash ref
-(with keys named "foo" and "BAR", regardless of the original capitalization):
-
- $tbl_ary_ref = $sth->fetchall_arrayref({ foo=>1, BAR=>1 });
-
-Those two examples both return a reference to an array of hash refs.
-
-If $slice is a I<reference to a hash reference>, that hash is used to select
-and rename columns. The keys are 0-based column index numbers and the values
-are the corresponding keys for the returned row hashes.
-
-For example, to fetch only the first and second columns of every row as a hash
-ref (with keys named "k" and "v" regardless of their original names):
-
- $tbl_ary_ref = $sth->fetchall_arrayref( \{ 0 => 'k', 1 => 'v' } );
-
-If $max_rows is defined and greater than or equal to zero then it
-is used to limit the number of rows fetched before returning.
-fetchall_arrayref() can then be called again to fetch more rows.
-This is especially useful when you need the better performance of
-fetchall_arrayref() but don't have enough memory to fetch and return
-all the rows in one go.
-
-Here's an example (assumes RaiseError is enabled):
-
- my $rows = []; # cache for batches of rows
- while( my $row = ( shift(@$rows) || # get row from cache, or reload cache:
- shift(@{$rows=$sth->fetchall_arrayref(undef,10_000)||[]}) )
- ) {
- ...
- }
-
-That I<might> be the fastest way to fetch and process lots of rows using the DBI,
-but it depends on the relative cost of method calls vs memory allocation.
-
-A standard C<while> loop with column binding is often faster because
-the cost of allocating memory for the batch of rows is greater than
-the saving by reducing method calls. It's possible that the DBI may
-provide a way to reuse the memory of a previous batch in future, which
-would then shift the balance back towards fetchall_arrayref().
-
-
-=head3 C<fetchall_hashref>
-
- $hash_ref = $sth->fetchall_hashref($key_field);
-
-The C<fetchall_hashref> method can be used to fetch all the data to be
-returned from a prepared and executed statement handle. It returns a reference
-to a hash containing a key for each distinct value of the $key_field column
-that was fetched. For each key the corresponding value is a reference to a hash
-containing all the selected columns and their values, as returned by
-C<fetchrow_hashref()>.
-
-If there are no rows to return, C<fetchall_hashref> returns a reference
-to an empty hash. If an error occurs, C<fetchall_hashref> returns the
-data fetched thus far, which may be none. You should check
-C<$sth-E<gt>err> afterwards (or use the C<RaiseError> attribute) to
-discover if the data is complete or was truncated due to an error.
-
-The $key_field parameter provides the name of the field that holds the
-value to be used for the key for the returned hash. For example:
-
- $dbh->{FetchHashKeyName} = 'NAME_lc';
- $sth = $dbh->prepare("SELECT FOO, BAR, ID, NAME, BAZ FROM TABLE");
- $sth->execute;
- $hash_ref = $sth->fetchall_hashref('id');
- print "Name for id 42 is $hash_ref->{42}->{name}\n";
-
-The $key_field parameter can also be specified as an integer column
-number (counting from 1). If $key_field doesn't match any column in
-the statement, as a name first then as a number, then an error is
-returned.
-
-For queries returning more than one 'key' column, you can specify
-multiple column names by passing $key_field as a reference to an
-array containing one or more key column names (or index numbers).
-For example:
-
- $sth = $dbh->prepare("SELECT foo, bar, baz FROM table");
- $sth->execute;
- $hash_ref = $sth->fetchall_hashref( [ qw(foo bar) ] );
- print "For foo 42 and bar 38, baz is $hash_ref->{42}->{38}->{baz}\n";
-
-The fetchall_hashref() method is normally used only where the key
-fields values for each row are unique. If multiple rows are returned
-with the same values for the key fields then later rows overwrite
-earlier ones.
-
-=head3 C<finish>
-
- $rc = $sth->finish;
-
-Indicate that no more data will be fetched from this statement handle
-before it is either executed again or destroyed. You almost certainly
-do I<not> need to call this method.
-
-Adding calls to C<finish> after loop that fetches all rows is a common mistake,
-don't do it, it can mask genuine problems like uncaught fetch errors.
-
-When all the data has been fetched from a C<SELECT> statement, the driver will
-automatically call C<finish> for you. So you should I<not> call it explicitly
-I<except> when you know that you've not fetched all the data from a statement
-handle I<and> the handle won't be destroyed soon.
-
-The most common example is when you only want to fetch just one row,
-but in that case the C<selectrow_*> methods are usually better anyway.
-
-Consider a query like:
-
- SELECT foo FROM table WHERE bar=? ORDER BY baz
-
-on a very large table. When executed, the database server will have to use
-temporary buffer space to store the sorted rows. If, after executing
-the handle and selecting just a few rows, the handle won't be re-executed for
-some time and won't be destroyed, the C<finish> method can be used to tell
-the server that the buffer space can be freed.
-
-Calling C<finish> resets the L</Active> attribute for the statement. It
-may also make some statement handle attributes (such as C<NAME> and C<TYPE>)
-unavailable if they have not already been accessed (and thus cached).
-
-The C<finish> method does not affect the transaction status of the
-database connection. It has nothing to do with transactions. It's mostly an
-internal "housekeeping" method that is rarely needed.
-See also L</disconnect> and the L</Active> attribute.
-
-The C<finish> method should have been called C<discard_pending_rows>.
-
-
-=head3 C<rows>
-
- $rv = $sth->rows;
-
-Returns the number of rows affected by the last row affecting command,
-or -1 if the number of rows is not known or not available.
-
-Generally, you can only rely on a row count after a I<non>-C<SELECT>
-C<execute> (for some specific operations like C<UPDATE> and C<DELETE>), or
-after fetching all the rows of a C<SELECT> statement.
-
-For C<SELECT> statements, it is generally not possible to know how many
-rows will be returned except by fetching them all. Some drivers will
-return the number of rows the application has fetched so far, but
-others may return -1 until all rows have been fetched. So use of the
-C<rows> method or C<$DBI::rows> with C<SELECT> statements is not
-recommended.
-
-One alternative method to get a row count for a C<SELECT> is to execute a
-"SELECT COUNT(*) FROM ..." SQL statement with the same "..." as your
-query and then fetch the row count from that.
-
-
-=head3 C<bind_col>
-
- $rc = $sth->bind_col($column_number, \$var_to_bind);
- $rc = $sth->bind_col($column_number, \$var_to_bind, \%attr );
- $rc = $sth->bind_col($column_number, \$var_to_bind, $bind_type );
-
-Binds a Perl variable and/or some attributes to an output column
-(field) of a C<SELECT> statement. Column numbers count up from 1.
-You do not need to bind output columns in order to fetch data.
-For maximum portability between drivers, bind_col() should be called
-after execute() and not before.
-See also L</bind_columns> for an example.
-
-The binding is performed at a low level using Perl aliasing.
-Whenever a row is fetched from the database $var_to_bind appears
-to be automatically updated simply because it now refers to the same
-memory location as the corresponding column value. This makes using
-bound variables very efficient.
-Binding a tied variable doesn't work, currently.
-
-The L</bind_param> method
-performs a similar, but opposite, function for input variables.
-
-B<Data Types for Column Binding>
-
-The C<\%attr> parameter can be used to hint at the data type
-formatting the column should have. For example, you can use:
-
- $sth->bind_col(1, undef, { TYPE => SQL_DATETIME });
-
-to specify that you'd like the column (which presumably is some
-kind of datetime type) to be returned in the standard format for
-SQL_DATETIME, which is 'YYYY-MM-DD HH:MM:SS', rather than the
-native formatting the database would normally use.
-
-There's no $var_to_bind in that example to emphasize the point
-that bind_col() works on the underlying column and not just
-a particular bound variable.
-
-As a short-cut for the common case, the data type can be passed
-directly, in place of the C<\%attr> hash reference. This example is
-equivalent to the one above:
-
- $sth->bind_col(1, undef, SQL_DATETIME);
-
-The C<TYPE> value indicates the standard (non-driver-specific) type for
-this parameter. To specify the driver-specific type, the driver may
-support a driver-specific attribute, such as C<{ ora_type =E<gt> 97 }>.
-
-The SQL_DATETIME and other related constants can be imported using
-
- use DBI qw(:sql_types);
-
-See L</"DBI Constants"> for more information.
-
-Few drivers support specifying a data type via a C<bind_col> call
-(most will simply ignore the data type). Fewer still allow the data
-type to be altered once set. If you do set a column type the type
-should remain sticky through further calls to bind_col for the same
-column if the type is not overridden (this is important for instance
-when you are using a slice in fetchall_arrayref).
-
-The TYPE attribute for bind_col() was first specified in DBI 1.41.
-
-From DBI 1.611, drivers can use the C<TYPE> attribute to attempt to
-cast the bound scalar to a perl type which more closely matches
-C<TYPE>. At present DBI supports C<SQL_INTEGER>, C<SQL_DOUBLE> and
-C<SQL_NUMERIC>. See L</sql_type_cast> for details of how types are
-cast.
-
-B<Other attributes for Column Binding>
-
-The C<\%attr> parameter may also contain the following attributes:
-
-=over
-
-=item C<StrictlyTyped>
-
-If a C<TYPE> attribute is passed to bind_col, then the driver will
-attempt to change the bound perl scalar to match the type more
-closely. If the bound value cannot be cast to the requested C<TYPE>
-then by default it is left untouched and no error is generated. If you
-specify C<StrictlyTyped> as 1 and the cast fails, this will generate
-an error.
-
-This attribute was first added in DBI 1.611. When 1.611 was released
-few drivers actually supported this attribute but DBD::Oracle and
-DBD::ODBC should from versions 1.24.
-
-=item C<DiscardString>
-
-When the C<TYPE> attribute is passed to L</bind_col> and the driver
-successfully casts the bound perl scalar to a non-string type
-then if C<DiscardString> is set to 1, the string portion of the
-scalar will be discarded. By default, C<DiscardString> is not set.
-
-This attribute was first added in DBI 1.611. When 1.611 was released
-few drivers actually supported this attribute but DBD::Oracle and
-DBD::ODBC should from versions 1.24.
-
-=back
-
-
-=head3 C<bind_columns>
-
- $rc = $sth->bind_columns(@list_of_refs_to_vars_to_bind);
-
-Calls L</bind_col> for each column of the C<SELECT> statement.
-
-The list of references should have the same number of elements as the number of
-columns in the C<SELECT> statement. If it doesn't then C<bind_columns> will
-bind the elements given, up to the number of columns, and then return an error.
-
-For maximum portability between drivers, bind_columns() should be called
-after execute() and not before.
-
-For example:
-
- $dbh->{RaiseError} = 1; # do this, or check every call for errors
- $sth = $dbh->prepare(q{ SELECT region, sales FROM sales_by_region });
- $sth->execute;
- my ($region, $sales);
-
- # Bind Perl variables to columns:
- $rv = $sth->bind_columns(\$region, \$sales);
-
- # you can also use Perl's \(...) syntax (see perlref docs):
- # $sth->bind_columns(\($region, $sales));
-
- # Column binding is the most efficient way to fetch data
- while ($sth->fetch) {
- print "$region: $sales\n";
- }
-
-For compatibility with old scripts, the first parameter will be
-ignored if it is C<undef> or a hash reference.
-
-Here's a more fancy example that binds columns to the values I<inside>
-a hash (thanks to H.Merijn Brand):
-
- $sth->execute;
- my %row;
- $sth->bind_columns( \( @row{ @{$sth->{NAME_lc} } } ));
- while ($sth->fetch) {
- print "$row{region}: $row{sales}\n";
- }
-
-
-=head3 C<dump_results>
-
- $rows = $sth->dump_results($maxlen, $lsep, $fsep, $fh);
-
-Fetches all the rows from C<$sth>, calls C<DBI::neat_list> for each row, and
-prints the results to C<$fh> (defaults to C<STDOUT>) separated by C<$lsep>
-(default C<"\n">). C<$fsep> defaults to C<", "> and C<$maxlen> defaults to 35.
-
-This method is designed as a handy utility for prototyping and
-testing queries. Since it uses L</neat_list> to
-format and edit the string for reading by humans, it is not recommended
-for data transfer applications.
-
-
-=head2 Statement Handle Attributes
-
-This section describes attributes specific to statement handles. Most
-of these attributes are read-only.
-
-Changes to these statement handle attributes do not affect any other
-existing or future statement handles.
-
-Attempting to set or get the value of an unknown attribute generates a warning,
-except for private driver specific attributes (which all have names
-starting with a lowercase letter).
-
-Example:
-
- ... = $h->{NUM_OF_FIELDS}; # get/read
-
-Some drivers cannot provide valid values for some or all of these
-attributes until after C<$sth-E<gt>execute> has been successfully
-called. Typically the attribute will be C<undef> in these situations.
-
-Some attributes, like NAME, are not appropriate to some types of
-statement, like SELECT. Typically the attribute will be C<undef>
-in these situations.
-
-For drivers which support stored procedures and multiple result sets
-(see L</more_results>) these attributes relate to the I<current> result set.
-
-See also L</finish> to learn more about the effect it
-may have on some attributes.
-
-=head3 C<NUM_OF_FIELDS>
-
-Type: integer, read-only
-
-Number of fields (columns) in the data the prepared statement may return.
-Statements that don't return rows of data, like C<DELETE> and C<CREATE>
-set C<NUM_OF_FIELDS> to 0 (though it may be undef in some drivers).
-
-
-=head3 C<NUM_OF_PARAMS>
-
-Type: integer, read-only
-
-The number of parameters (placeholders) in the prepared statement.
-See SUBSTITUTION VARIABLES below for more details.
-
-
-=head3 C<NAME>
-
-Type: array-ref, read-only
-
-Returns a reference to an array of field names for each column. The
-names may contain spaces but should not be truncated or have any
-trailing space. Note that the names have the letter case (upper, lower
-or mixed) as returned by the driver being used. Portable applications
-should use L</NAME_lc> or L</NAME_uc>.
-
- print "First column name: $sth->{NAME}->[0]\n";
-
-Also note that the name returned for (aggregate) functions like C<count(*)>
-or C<max(c_foo)> is determined by the database server and not by C<DBI> or
-the C<DBD> backend.
-
-=head3 C<NAME_lc>
-
-Type: array-ref, read-only
-
-Like C</NAME> but always returns lowercase names.
-
-=head3 C<NAME_uc>
-
-Type: array-ref, read-only
-
-Like C</NAME> but always returns uppercase names.
-
-=head3 C<NAME_hash>
-
-Type: hash-ref, read-only
-
-=head3 C<NAME_lc_hash>
-
-Type: hash-ref, read-only
-
-=head3 C<NAME_uc_hash>
-
-Type: hash-ref, read-only
-
-The C<NAME_hash>, C<NAME_lc_hash>, and C<NAME_uc_hash> attributes
-return column name information as a reference to a hash.
-
-The keys of the hash are the names of the columns. The letter case of
-the keys corresponds to the letter case returned by the C<NAME>,
-C<NAME_lc>, and C<NAME_uc> attributes respectively (as described above).
-
-The value of each hash entry is the perl index number of the
-corresponding column (counting from 0). For example:
-
- $sth = $dbh->prepare("select Id, Name from table");
- $sth->execute;
- @row = $sth->fetchrow_array;
- print "Name $row[ $sth->{NAME_lc_hash}{name} ]\n";
-
-
-=head3 C<TYPE>
-
-Type: array-ref, read-only
-
-Returns a reference to an array of integer values for each
-column. The value indicates the data type of the corresponding column.
-
-The values correspond to the international standards (ANSI X3.135
-and ISO/IEC 9075) which, in general terms, means ODBC. Driver-specific
-types that don't exactly match standard types should generally return
-the same values as an ODBC driver supplied by the makers of the
-database. That might include private type numbers in ranges the vendor
-has officially registered with the ISO working group:
-
- ftp://sqlstandards.org/SC32/SQL_Registry/
-
-Where there's no vendor-supplied ODBC driver to be compatible with,
-the DBI driver can use type numbers in the range that is now
-officially reserved for use by the DBI: -9999 to -9000.
-
-All possible values for C<TYPE> should have at least one entry in the
-output of the C<type_info_all> method (see L</type_info_all>).
-
-=head3 C<PRECISION>
-
-Type: array-ref, read-only
-
-Returns a reference to an array of integer values for each column.
-
-For numeric columns, the value is the maximum number of digits
-(without considering a sign character or decimal point). Note that
-the "display size" for floating point types (REAL, FLOAT, DOUBLE)
-can be up to 7 characters greater than the precision (for the
-sign + decimal point + the letter E + a sign + 2 or 3 digits).
-
-For any character type column the value is the OCTET_LENGTH,
-in other words the number of bytes, not characters.
-
-(More recent standards refer to this as COLUMN_SIZE but we stick
-with PRECISION for backwards compatibility.)
-
-=head3 C<SCALE>
-
-Type: array-ref, read-only
-
-Returns a reference to an array of integer values for each column.
-NULL (C<undef>) values indicate columns where scale is not applicable.
-
-=head3 C<NULLABLE>
-
-Type: array-ref, read-only
-
-Returns a reference to an array indicating the possibility of each
-column returning a null. Possible values are C<0>
-(or an empty string) = no, C<1> = yes, C<2> = unknown.
-
- print "First column may return NULL\n" if $sth->{NULLABLE}->[0];
-
-
-=head3 C<CursorName>
-
-Type: string, read-only
-
-Returns the name of the cursor associated with the statement handle, if
-available. If not available or if the database driver does not support the
-C<"where current of ..."> SQL syntax, then it returns C<undef>.
-
-
-=head3 C<Database>
-
-Type: dbh, read-only
-
-Returns the parent $dbh of the statement handle.
-
-
-=head3 C<Statement>
-
-Type: string, read-only
-
-Returns the statement string passed to the L</prepare> method.
-
-
-=head3 C<ParamValues>
-
-Type: hash ref, read-only
-
-Returns a reference to a hash containing the values currently bound
-to placeholders. The keys of the hash are the 'names' of the
-placeholders, typically integers starting at 1. Returns undef if
-not supported by the driver.
-
-See L</ShowErrorStatement> for an example of how this is used.
-
-* Keys:
-
-If the driver supports C<ParamValues> but no values have been bound
-yet then the driver should return a hash with placeholders names
-in the keys but all the values undef, but some drivers may return
-a ref to an empty hash because they can't pre-determine the names.
-
-It is possible that the keys in the hash returned by C<ParamValues>
-are not exactly the same as those implied by the prepared statement.
-For example, DBD::Oracle translates 'C<?>' placeholders into 'C<:pN>'
-where N is a sequence number starting at 1.
-
-* Values:
-
-It is possible that the values in the hash returned by C<ParamValues>
-are not I<exactly> the same as those passed to bind_param() or execute().
-The driver may have slightly modified values in some way based on the
-TYPE the value was bound with. For example a floating point value
-bound as an SQL_INTEGER type may be returned as an integer.
-The values returned by C<ParamValues> can be passed to another
-bind_param() method with the same TYPE and will be seen by the
-database as the same value. See also L</ParamTypes> below.
-
-The C<ParamValues> attribute was added in DBI 1.28.
-
-=head3 C<ParamTypes>
-
-Type: hash ref, read-only
-
-Returns a reference to a hash containing the type information
-currently bound to placeholders.
-Returns undef if not supported by the driver.
-
-* Keys:
-
-See L</ParamValues> above.
-
-* Values:
-
-The hash values are hashrefs of type information in the same form as that
-passed to the various bind_param() methods (See L</bind_param> for the format
-and values).
-
-It is possible that the values in the hash returned by C<ParamTypes>
-are not exactly the same as those passed to bind_param() or execute().
-Param attributes specified using the abbreviated form, like this:
-
- $sth->bind_param(1, SQL_INTEGER);
-
-are returned in the expanded form, as if called like this:
-
- $sth->bind_param(1, { TYPE => SQL_INTEGER });
-
-The driver may have modified the type information in some way based
-on the bound values, other hints provided by the prepare()'d
-SQL statement, or alternate type mappings required by the driver or target
-database system. The driver may also add private keys (with names beginning
-with the drivers reserved prefix, e.g., odbc_xxx).
-
-* Example:
-
-The keys and values in the returned hash can be passed to the various
-bind_param() methods to effectively reproduce a previous param binding.
-For example:
-
- # assuming $sth1 is a previously prepared statement handle
- my $sth2 = $dbh->prepare( $sth1->{Statement} );
- my $ParamValues = $sth1->{ParamValues} || {};
- my $ParamTypes = $sth1->{ParamTypes} || {};
- $sth2->bind_param($_, $ParamValues->{$_}, $ParamTypes->{$_})
- for keys %{ {%$ParamValues, %$ParamTypes} };
- $sth2->execute();
-
-The C<ParamTypes> attribute was added in DBI 1.49. Implementation
-is the responsibility of individual drivers; the DBI layer default
-implementation simply returns undef.
-
-
-=head3 C<ParamArrays>
-
-Type: hash ref, read-only
-
-Returns a reference to a hash containing the values currently bound to
-placeholders with L</execute_array> or L</bind_param_array>. The
-keys of the hash are the 'names' of the placeholders, typically
-integers starting at 1. Returns undef if not supported by the driver
-or no arrays of parameters are bound.
-
-Each key value is an array reference containing a list of the bound
-parameters for that column.
-
-For example:
-
- $sth = $dbh->prepare("INSERT INTO staff (id, name) values (?,?)");
- $sth->execute_array({},[1,2], ['fred','dave']);
- if ($sth->{ParamArrays}) {
- foreach $param (keys %{$sth->{ParamArrays}}) {
- printf "Parameters for %s : %s\n", $param,
- join(",", @{$sth->{ParamArrays}->{$param}});
- }
- }
-
-It is possible that the values in the hash returned by C<ParamArrays>
-are not I<exactly> the same as those passed to L</bind_param_array> or
-L</execute_array>. The driver may have slightly modified values in some
-way based on the TYPE the value was bound with. For example a floating
-point value bound as an SQL_INTEGER type may be returned as an
-integer.
-
-It is also possible that the keys in the hash returned by
-C<ParamArrays> are not exactly the same as those implied by the
-prepared statement. For example, DBD::Oracle translates 'C<?>'
-placeholders into 'C<:pN>' where N is a sequence number starting at 1.
-
-=head3 C<RowsInCache>
-
-Type: integer, read-only
-
-If the driver supports a local row cache for C<SELECT> statements, then
-this attribute holds the number of un-fetched rows in the cache. If the
-driver doesn't, then it returns C<undef>. Note that some drivers pre-fetch
-rows on execute, whereas others wait till the first fetch.
-
-See also the L</RowCacheSize> database handle attribute.
-
-=head1 FURTHER INFORMATION
-
-=head2 Catalog Methods
-
-An application can retrieve metadata information from the DBMS by issuing
-appropriate queries on the views of the Information Schema. Unfortunately,
-C<INFORMATION_SCHEMA> views are seldom supported by the DBMS.
-Special methods (catalog methods) are available to return result sets
-for a small but important portion of that metadata:
-
- column_info
- foreign_key_info
- primary_key_info
- table_info
- statistics_info
-
-All catalog methods accept arguments in order to restrict the result sets.
-Passing C<undef> to an optional argument does not constrain the search for
-that argument.
-However, an empty string ('') is treated as a regular search criteria
-and will only match an empty value.
-
-B<Note>: SQL/CLI and ODBC differ in the handling of empty strings. An
-empty string will not restrict the result set in SQL/CLI.
-
-Most arguments in the catalog methods accept only I<ordinary values>, e.g.
-the arguments of C<primary_key_info()>.
-Such arguments are treated as a literal string, i.e. the case is significant
-and quote characters are taken literally.
-
-Some arguments in the catalog methods accept I<search patterns> (strings
-containing '_' and/or '%'), e.g. the C<$table> argument of C<column_info()>.
-Passing '%' is equivalent to leaving the argument C<undef>.
-
-B<Caveat>: The underscore ('_') is valid and often used in SQL identifiers.
-Passing such a value to a search pattern argument may return more rows than
-expected!
-To include pattern characters as literals, they must be preceded by an
-escape character which can be achieved with
-
- $esc = $dbh->get_info( 14 ); # SQL_SEARCH_PATTERN_ESCAPE
- $search_pattern =~ s/([_%])/$esc$1/g;
-
-The ODBC and SQL/CLI specifications define a way to change the default
-behaviour described above: All arguments (except I<list value arguments>)
-are treated as I<identifier> if the C<SQL_ATTR_METADATA_ID> attribute is
-set to C<SQL_TRUE>.
-I<Quoted identifiers> are very similar to I<ordinary values>, i.e. their
-body (the string within the quotes) is interpreted literally.
-I<Unquoted identifiers> are compared in UPPERCASE.
-
-The DBI (currently) does not support the C<SQL_ATTR_METADATA_ID> attribute,
-i.e. it behaves like an ODBC driver where C<SQL_ATTR_METADATA_ID> is set to
-C<SQL_FALSE>.
-
-
-=head2 Transactions
-
-Transactions are a fundamental part of any robust database system. They
-protect against errors and database corruption by ensuring that sets of
-related changes to the database take place in atomic (indivisible,
-all-or-nothing) units.
-
-This section applies to databases that support transactions and where
-C<AutoCommit> is off. See L</AutoCommit> for details of using C<AutoCommit>
-with various types of databases.
-
-The recommended way to implement robust transactions in Perl
-applications is to enable L</RaiseError> and catch the error that's 'thrown' as
-an exception. For example, using L<Try::Tiny>:
-
- use Try::Tiny;
- $dbh->{AutoCommit} = 0; # enable transactions, if possible
- $dbh->{RaiseError} = 1;
- try {
- foo(...) # do lots of work here
- bar(...) # including inserts
- baz(...) # and updates
- $dbh->commit; # commit the changes if we get this far
- } catch {
- warn "Transaction aborted because $_"; # Try::Tiny copies $@ into $_
- # now rollback to undo the incomplete changes
- # but do it in an eval{} as it may also fail
- eval { $dbh->rollback };
- # add other application on-error-clean-up code here
- };
-
-If the C<RaiseError> attribute is not set, then DBI calls would need to be
-manually checked for errors, typically like this:
-
- $h->method(@args) or die $h->errstr;
-
-With C<RaiseError> set, the DBI will automatically C<die> if any DBI method
-call on that handle (or a child handle) fails, so you don't have to
-test the return value of each method call. See L</RaiseError> for more
-details.
-
-A major advantage of the C<eval> approach is that the transaction will be
-properly rolled back if I<any> code (not just DBI calls) in the inner
-application dies for any reason. The major advantage of using the
-C<$h-E<gt>{RaiseError}> attribute is that all DBI calls will be checked
-automatically. Both techniques are strongly recommended.
-
-After calling C<commit> or C<rollback> many drivers will not let you
-fetch from a previously active C<SELECT> statement handle that's a child
-of the same database handle. A typical way round this is to connect the
-the database twice and use one connection for C<SELECT> statements.
-
-See L</AutoCommit> and L</disconnect> for other important information
-about transactions.
-
-
-=head2 Handling BLOB / LONG / Memo Fields
-
-Many databases support "blob" (binary large objects), "long", or similar
-datatypes for holding very long strings or large amounts of binary
-data in a single field. Some databases support variable length long
-values over 2,000,000,000 bytes in length.
-
-Since values of that size can't usually be held in memory, and because
-databases can't usually know in advance the length of the longest long
-that will be returned from a C<SELECT> statement (unlike other data
-types), some special handling is required.
-
-In this situation, the value of the C<$h-E<gt>{LongReadLen}>
-attribute is used to determine how much buffer space to allocate
-when fetching such fields. The C<$h-E<gt>{LongTruncOk}> attribute
-is used to determine how to behave if a fetched value can't fit
-into the buffer.
-
-See the description of L</LongReadLen> for more information.
-
-When trying to insert long or binary values, placeholders should be used
-since there are often limits on the maximum size of an C<INSERT>
-statement and the L</quote> method generally can't cope with binary
-data. See L</Placeholders and Bind Values>.
-
-
-=head2 Simple Examples
-
-Here's a complete example program to select and fetch some data:
-
- my $data_source = "dbi::DriverName:db_name";
- my $dbh = DBI->connect($data_source, $user, $password)
- or die "Can't connect to $data_source: $DBI::errstr";
-
- my $sth = $dbh->prepare( q{
- SELECT name, phone
- FROM mytelbook
- }) or die "Can't prepare statement: $DBI::errstr";
-
- my $rc = $sth->execute
- or die "Can't execute statement: $DBI::errstr";
-
- print "Query will return $sth->{NUM_OF_FIELDS} fields.\n\n";
- print "Field names: @{ $sth->{NAME} }\n";
-
- while (($name, $phone) = $sth->fetchrow_array) {
- print "$name: $phone\n";
- }
- # check for problems which may have terminated the fetch early
- die $sth->errstr if $sth->err;
-
- $dbh->disconnect;
-
-Here's a complete example program to insert some data from a file.
-(This example uses C<RaiseError> to avoid needing to check each call).
-
- my $dbh = DBI->connect("dbi:DriverName:db_name", $user, $password, {
- RaiseError => 1, AutoCommit => 0
- });
-
- my $sth = $dbh->prepare( q{
- INSERT INTO table (name, phone) VALUES (?, ?)
- });
-
- open FH, "<phone.csv" or die "Unable to open phone.csv: $!";
- while (<FH>) {
- chomp;
- my ($name, $phone) = split /,/;
- $sth->execute($name, $phone);
- }
- close FH;
-
- $dbh->commit;
- $dbh->disconnect;
-
-Here's how to convert fetched NULLs (undefined values) into empty strings:
-
- while($row = $sth->fetchrow_arrayref) {
- # this is a fast and simple way to deal with nulls:
- foreach (@$row) { $_ = '' unless defined }
- print "@$row\n";
- }
-
-The C<q{...}> style quoting used in these examples avoids clashing with
-quotes that may be used in the SQL statement. Use the double-quote like
-C<qq{...}> operator if you want to interpolate variables into the string.
-See L<perlop/"Quote and Quote-like Operators"> for more details.
-
-=head2 Threads and Thread Safety
-
-Perl 5.7 and later support a new threading model called iThreads.
-(The old "5.005 style" threads are not supported by the DBI.)
-
-In the iThreads model each thread has its own copy of the perl
-interpreter. When a new thread is created the original perl
-interpreter is 'cloned' to create a new copy for the new thread.
-
-If the DBI and drivers are loaded and handles created before the
-thread is created then it will get a cloned copy of the DBI, the
-drivers and the handles.
-
-However, the internal pointer data within the handles will refer
-to the DBI and drivers in the original interpreter. Using those
-handles in the new interpreter thread is not safe, so the DBI detects
-this and croaks on any method call using handles that don't belong
-to the current thread (except for DESTROY).
-
-Because of this (possibly temporary) restriction, newly created
-threads must make their own connections to the database. Handles
-can't be shared across threads.
-
-But BEWARE, some underlying database APIs (the code the DBD driver
-uses to talk to the database, often supplied by the database vendor)
-are not thread safe. If it's not thread safe, then allowing more
-than one thread to enter the code at the same time may cause
-subtle/serious problems. In some cases allowing more than
-one thread to enter the code, even if I<not> at the same time,
-can cause problems. You have been warned.
-
-Using DBI with perl threads is not yet recommended for production
-environments. For more information see
-L<http://www.perlmonks.org/index.pl?node_id=288022>
-
-Note: There is a bug in perl 5.8.2 when configured with threads
-and debugging enabled (bug #24463) which causes a DBI test to fail.
-
-=head2 Signal Handling and Canceling Operations
-
-[The following only applies to systems with unix-like signal handling.
-I'd welcome additions for other systems, especially Windows.]
-
-The first thing to say is that signal handling in Perl versions less
-than 5.8 is I<not> safe. There is always a small risk of Perl
-crashing and/or core dumping when, or after, handling a signal
-because the signal could arrive and be handled while internal data
-structures are being changed. If the signal handling code
-used those same internal data structures it could cause all manner
-of subtle and not-so-subtle problems. The risk was reduced with
-5.4.4 but was still present in all perls up through 5.8.0.
-
-Beginning in perl 5.8.0 perl implements 'safe' signal handling if
-your system has the POSIX sigaction() routine. Now when a signal
-is delivered perl just makes a note of it but does I<not> run the
-%SIG handler. The handling is 'deferred' until a 'safe' moment.
-
-Although this change made signal handling safe, it also lead to
-a problem with signals being deferred for longer than you'd like.
-If a signal arrived while executing a system call, such as waiting
-for data on a network connection, the signal is noted and then the
-system call that was executing returns with an EINTR error code
-to indicate that it was interrupted. All fine so far.
-
-The problem comes when the code that made the system call sees the
-EINTR code and decides it's going to call it again. Perl doesn't
-do that, but database code sometimes does. If that happens then the
-signal handler doesn't get called until later. Maybe much later.
-
-Fortunately there are ways around this which we'll discuss below.
-Unfortunately they make signals unsafe again.
-
-The two most common uses of signals in relation to the DBI are for
-canceling operations when the user types Ctrl-C (interrupt), and for
-implementing a timeout using C<alarm()> and C<$SIG{ALRM}>.
-
-=over 4
-
-=item Cancel
-
-The DBI provides a C<cancel> method for statement handles. The
-C<cancel> method should abort the current operation and is designed
-to be called from a signal handler. For example:
-
- $SIG{INT} = sub { $sth->cancel };
-
-However, few drivers implement this (the DBI provides a default
-method that just returns C<undef>) and, even if implemented, there
-is still a possibility that the statement handle, and even the
-parent database handle, will not be usable afterwards.
-
-If C<cancel> returns true, then it has successfully
-invoked the database engine's own cancel function. If it returns false,
-then C<cancel> failed. If it returns C<undef>, then the database
-driver does not have cancel implemented - very few do.
-
-=item Timeout
-
-The traditional way to implement a timeout is to set C<$SIG{ALRM}>
-to refer to some code that will be executed when an ALRM signal
-arrives and then to call alarm($seconds) to schedule an ALRM signal
-to be delivered $seconds in the future. For example:
-
- my $failed;
- eval {
- local $SIG{ALRM} = sub { die "TIMEOUT\n" }; # N.B. \n required
- eval {
- alarm($seconds);
- ... code to execute with timeout here (which may die) ...
- 1;
- } or $failed = 1;
- # outer eval catches alarm that might fire JUST before this alarm(0)
- alarm(0); # cancel alarm (if code ran fast)
- die "$@" if $failed;
- 1;
- } or $failed = 1;
- if ( $failed ) {
- if ( defined $@ and $@ eq "TIMEOUT\n" ) { ... }
- else { ... } # some other error
- }
-
-The first (outer) eval is used to avoid the unlikely but possible
-chance that the "code to execute" dies and the alarm fires before it
-is cancelled. Without the outer eval, if this happened your program
-will die if you have no ALRM handler or a non-local alarm handler
-will be called.
-
-Unfortunately, as described above, this won't always work as expected,
-depending on your perl version and the underlying database code.
-
-With Oracle for instance (DBD::Oracle), if the system which hosts
-the database is down the DBI->connect() call will hang for several
-minutes before returning an error.
-
-=back
-
-The solution on these systems is to use the C<POSIX::sigaction()>
-routine to gain low level access to how the signal handler is installed.
-
-The code would look something like this (for the DBD-Oracle connect()):
-
- use POSIX qw(:signal_h);
-
- my $mask = POSIX::SigSet->new( SIGALRM ); # signals to mask in the handler
- my $action = POSIX::SigAction->new(
- sub { die "connect timeout\n" }, # the handler code ref
- $mask,
- # not using (perl 5.8.2 and later) 'safe' switch or sa_flags
- );
- my $oldaction = POSIX::SigAction->new();
- sigaction( SIGALRM, $action, $oldaction );
- my $dbh;
- my $failed;
- eval {
- eval {
- alarm(5); # seconds before time out
- $dbh = DBI->connect("dbi:Oracle:$dsn" ... );
- 1;
- } or $failed = 1;
- alarm(0); # cancel alarm (if connect worked fast)
- die "$@\n" if $failed; # connect died
- 1;
- } or $failed = 1;
- sigaction( SIGALRM, $oldaction ); # restore original signal handler
- if ( $failed ) {
- if ( defined $@ and $@ eq "connect timeout\n" ) {...}
- else { # connect died }
- }
-
-See previous example for the reasoning around the double eval.
-
-Similar techniques can be used for canceling statement execution.
-
-Unfortunately, this solution is somewhat messy, and it does I<not> work with
-perl versions less than perl 5.8 where C<POSIX::sigaction()> appears to be broken.
-
-For a cleaner implementation that works across perl versions, see Lincoln Baxter's
-Sys::SigAction module at L<Sys::SigAction>.
-The documentation for Sys::SigAction includes an longer discussion
-of this problem, and a DBD::Oracle test script.
-
-Be sure to read all the signal handling sections of the L<perlipc> manual.
-
-And finally, two more points to keep firmly in mind. Firstly,
-remember that what we've done here is essentially revert to old
-style I<unsafe> handling of these signals. So do as little as
-possible in the handler. Ideally just die(). Secondly, the handles
-in use at the time the signal is handled may not be safe to use
-afterwards.
-
-
-=head2 Subclassing the DBI
-
-DBI can be subclassed and extended just like any other object
-oriented module. Before we talk about how to do that, it's important
-to be clear about the various DBI classes and how they work together.
-
-By default C<$dbh = DBI-E<gt>connect(...)> returns a $dbh blessed
-into the C<DBI::db> class. And the C<$dbh-E<gt>prepare> method
-returns an $sth blessed into the C<DBI::st> class (actually it
-simply changes the last four characters of the calling handle class
-to be C<::st>).
-
-The leading 'C<DBI>' is known as the 'root class' and the extra
-'C<::db>' or 'C<::st>' are the 'handle type suffixes'. If you want
-to subclass the DBI you'll need to put your overriding methods into
-the appropriate classes. For example, if you want to use a root class
-of C<MySubDBI> and override the do(), prepare() and execute() methods,
-then your do() and prepare() methods should be in the C<MySubDBI::db>
-class and the execute() method should be in the C<MySubDBI::st> class.
-
-To setup the inheritance hierarchy the @ISA variable in C<MySubDBI::db>
-should include C<DBI::db> and the @ISA variable in C<MySubDBI::st>
-should include C<DBI::st>. The C<MySubDBI> root class itself isn't
-currently used for anything visible and so, apart from setting @ISA
-to include C<DBI>, it can be left empty.
-
-So, having put your overriding methods into the right classes, and
-setup the inheritance hierarchy, how do you get the DBI to use them?
-You have two choices, either a static method call using the name
-of your subclass:
-
- $dbh = MySubDBI->connect(...);
-
-or specifying a C<RootClass> attribute:
-
- $dbh = DBI->connect(..., { RootClass => 'MySubDBI' });
-
-If both forms are used then the attribute takes precedence.
-
-The only differences between the two are that using an explicit
-RootClass attribute will a) make the DBI automatically attempt to load
-a module by that name if the class doesn't exist, and b) won't call
-your MySubDBI::connect() method, if you have one.
-
-When subclassing is being used then, after a successful new
-connect, the DBI->connect method automatically calls:
-
- $dbh->connected($dsn, $user, $pass, \%attr);
-
-The default method does nothing. The call is made just to simplify
-any post-connection setup that your subclass may want to perform.
-The parameters are the same as passed to DBI->connect.
-If your subclass supplies a connected method, it should be part of the
-MySubDBI::db package.
-
-One more thing to note: you must let the DBI do the handle creation. If you
-want to override the connect() method in your *::dr class then it must still
-call SUPER::connect to get a $dbh to work with. Similarly, an overridden
-prepare() method in *::db must still call SUPER::prepare to get a $sth.
-If you try to create your own handles using bless() then you'll find the DBI
-will reject them with an "is not a DBI handle (has no magic)" error.
-
-Here's a brief example of a DBI subclass. A more thorough example
-can be found in F<t/subclass.t> in the DBI distribution.
-
- package MySubDBI;
-
- use strict;
-
- use DBI;
- use vars qw(@ISA);
- @ISA = qw(DBI);
-
- package MySubDBI::db;
- use vars qw(@ISA);
- @ISA = qw(DBI::db);
-
- sub prepare {
- my ($dbh, @args) = @_;
- my $sth = $dbh->SUPER::prepare(@args)
- or return;
- $sth->{private_mysubdbi_info} = { foo => 'bar' };
- return $sth;
- }
-
- package MySubDBI::st;
- use vars qw(@ISA);
- @ISA = qw(DBI::st);
-
- sub fetch {
- my ($sth, @args) = @_;
- my $row = $sth->SUPER::fetch(@args)
- or return;
- do_something_magical_with_row_data($row)
- or return $sth->set_err(1234, "The magic failed", undef, "fetch");
- return $row;
- }
-
-When calling a SUPER::method that returns a handle, be careful to
-check the return value before trying to do other things with it in
-your overridden method. This is especially important if you want to
-set a hash attribute on the handle, as Perl's autovivification will
-bite you by (in)conveniently creating an unblessed hashref, which your
-method will then return with usually baffling results later on like
-the error "dbih_getcom handle HASH(0xa4451a8) is not a DBI handle (has
-no magic". It's best to check right after the call and return undef
-immediately on error, just like DBI would and just like the example
-above.
-
-If your method needs to record an error it should call the set_err()
-method with the error code and error string, as shown in the example
-above. The error code and error string will be recorded in the
-handle and available via C<$h-E<gt>err> and C<$DBI::errstr> etc.
-The set_err() method always returns an undef or empty list as
-appropriate. Since your method should nearly always return an undef
-or empty list as soon as an error is detected it's handy to simply
-return what set_err() returns, as shown in the example above.
-
-If the handle has C<RaiseError>, C<PrintError>, or C<HandleError>
-etc. set then the set_err() method will honour them. This means
-that if C<RaiseError> is set then set_err() won't return in the
-normal way but will 'throw an exception' that can be caught with
-an C<eval> block.
-
-You can stash private data into DBI handles
-via C<$h-E<gt>{private_..._*}>. See the entry under L</ATTRIBUTES
-COMMON TO ALL HANDLES> for info and important caveats.
-
-=head2 Memory Leaks
-
-When tracking down memory leaks using tools like L<Devel::Leak>
-you'll find that some DBI internals are reported as 'leaking' memory.
-This is very unlikely to be a real leak. The DBI has various caches to improve
-performance and the apparrent leaks are simply the normal operation of these
-caches.
-
-The most frequent sources of the apparrent leaks are L</ChildHandles>,
-L</prepare_cached> and L</connect_cached>.
-
-For example http://stackoverflow.com/questions/13338308/perl-dbi-memory-leak
-
-Given how widely the DBI is used, you can rest assured that if a new release of
-the DBI did have a real leak it would be discovered, reported, and fixed
-immediately. The leak you're looking for is probably elsewhere. Good luck!
-
-
-=head1 TRACING
-
-The DBI has a powerful tracing mechanism built in. It enables you
-to see what's going on 'behind the scenes', both within the DBI and
-the drivers you're using.
-
-=head2 Trace Settings
-
-Which details are written to the trace output is controlled by a
-combination of a I<trace level>, an integer from 0 to 15, and a set
-of I<trace flags> that are either on or off. Together these are known
-as the I<trace settings> and are stored together in a single integer.
-For normal use you only need to set the trace level, and generally
-only to a value between 1 and 4.
-
-Each handle has its own trace settings, and so does the DBI.
-When you call a method the DBI merges the handles settings into its
-own for the duration of the call: the trace flags of the handle are
-OR'd into the trace flags of the DBI, and if the handle has a higher
-trace level then the DBI trace level is raised to match it.
-The previous DBI trace settings are restored when the called method
-returns.
-
-=head2 Trace Levels
-
-Trace I<levels> are as follows:
-
- 0 - Trace disabled.
- 1 - Trace top-level DBI method calls returning with results or errors.
- 2 - As above, adding tracing of top-level method entry with parameters.
- 3 - As above, adding some high-level information from the driver
- and some internal information from the DBI.
- 4 - As above, adding more detailed information from the driver.
- This is the first level to trace all the rows being fetched.
- 5 to 15 - As above but with more and more internal information.
-
-Trace level 1 is best for a simple overview of what's happening.
-Trace levels 2 thru 4 a good choice for general purpose tracing.
-Levels 5 and above are best reserved for investigating a specific
-problem, when you need to see "inside" the driver and DBI.
-
-The trace output is detailed and typically very useful. Much of the
-trace output is formatted using the L</neat> function, so strings
-in the trace output may be edited and truncated by that function.
-
-=head2 Trace Flags
-
-Trace I<flags> are used to enable tracing of specific activities
-within the DBI and drivers. The DBI defines some trace flags and
-drivers can define others. DBI trace flag names begin with a capital
-letter and driver specific names begin with a lowercase letter, as
-usual.
-
-Currently the DBI defines these trace flags:
-
- ALL - turn on all DBI and driver flags (not recommended)
- SQL - trace SQL statements executed
- (not yet implemented in DBI but implemented in some DBDs)
- CON - trace connection process
- ENC - trace encoding (unicode translations etc)
- (not yet implemented in DBI but implemented in some DBDs)
- DBD - trace only DBD messages
- (not implemented by all DBDs yet)
- TXN - trace transactions
- (not implemented in all DBDs yet)
-
-The L</parse_trace_flags> and L</parse_trace_flag> methods are used
-to convert trace flag names into the corresponding integer bit flags.
-
-=head2 Enabling Trace
-
-The C<$h-E<gt>trace> method sets the trace settings for a handle
-and C<DBI-E<gt>trace> does the same for the DBI.
-
-In addition to the L</trace> method, you can enable the same trace
-information, and direct the output to a file, by setting the
-C<DBI_TRACE> environment variable before starting Perl.
-See L</DBI_TRACE> for more information.
-
-Finally, you can set, or get, the trace settings for a handle using
-the C<TraceLevel> attribute.
-
-All of those methods use parse_trace_flags() and so allow you set
-both the trace level and multiple trace flags by using a string
-containing the trace level and/or flag names separated by vertical
-bar ("C<|>") or comma ("C<,>") characters. For example:
-
- local $h->{TraceLevel} = "3|SQL|foo";
-
-=head2 Trace Output
-
-Initially trace output is written to C<STDERR>. Both the
-C<$h-E<gt>trace> and C<DBI-E<gt>trace> methods take an optional
-$trace_file parameter, which may be either the name of a file to be
-opened by DBI in append mode, or a reference to an existing writable
-(possibly layered) filehandle. If $trace_file is a filename,
-and can be opened in append mode, or $trace_file is a writable
-filehandle, then I<all> trace output (currently including that from
-other handles) is redirected to that file. A warning is generated
-if $trace_file can't be opened or is not writable.
-
-Further calls to trace() without $trace_file do not alter where
-the trace output is sent. If $trace_file is undefined, then
-trace output is sent to C<STDERR> and, if the prior trace was opened with
-$trace_file as a filename, the previous trace file is closed; if $trace_file was
-a filehandle, the filehandle is B<not> closed.
-
-B<NOTE>: If $trace_file is specified as a filehandle, the filehandle
-should not be closed until all DBI operations are completed, or the
-application has reset the trace file via another call to
-C<trace()> that changes the trace file.
-
-=head2 Tracing to Layered Filehandles
-
-B<NOTE>:
-
-=over 4
-
-=item *
-Tied filehandles are not currently supported, as
-tie operations are not available to the PerlIO
-methods used by the DBI.
-
-=item *
-PerlIO layer support requires Perl version 5.8 or higher.
-
-=back
-
-As of version 5.8, Perl provides the ability to layer various
-"disciplines" on an open filehandle via the L<PerlIO> module.
-
-A simple example of using PerlIO layers is to use a scalar as the output:
-
- my $scalar = '';
- open( my $fh, "+>:scalar", \$scalar );
- $dbh->trace( 2, $fh );
-
-Now all trace output is simply appended to $scalar.
-
-A more complex application of tracing to a layered filehandle is the
-use of a custom layer (I<Refer to >L<Perlio::via> I<for details
-on creating custom PerlIO layers.>). Consider an application with the
-following logger module:
-
- package MyFancyLogger;
-
- sub new
- {
- my $self = {};
- my $fh;
- open $fh, '>', 'fancylog.log';
- $self->{_fh} = $fh;
- $self->{_buf} = '';
- return bless $self, shift;
- }
-
- sub log
- {
- my $self = shift;
- return unless exists $self->{_fh};
- my $fh = $self->{_fh};
- $self->{_buf} .= shift;
- #
- # DBI feeds us pieces at a time, so accumulate a complete line
- # before outputing
- #
- print $fh "At ", scalar localtime(), ':', $self->{_buf}, "\n" and
- $self->{_buf} = ''
- if $self->{_buf}=~tr/\n//;
- }
-
- sub close {
- my $self = shift;
- return unless exists $self->{_fh};
- my $fh = $self->{_fh};
- print $fh "At ", scalar localtime(), ':', $self->{_buf}, "\n" and
- $self->{_buf} = ''
- if $self->{_buf};
- close $fh;
- delete $self->{_fh};
- }
-
- 1;
-
-To redirect DBI traces to this logger requires creating
-a package for the layer:
-
- package PerlIO::via::MyFancyLogLayer;
-
- sub PUSHED
- {
- my ($class,$mode,$fh) = @_;
- my $logger;
- return bless \$logger,$class;
- }
-
- sub OPEN {
- my ($self, $path, $mode, $fh) = @_;
- #
- # $path is actually our logger object
- #
- $$self = $path;
- return 1;
- }
-
- sub WRITE
- {
- my ($self, $buf, $fh) = @_;
- $$self->log($buf);
- return length($buf);
- }
-
- sub CLOSE {
- my $self = shift;
- $$self->close();
- return 0;
- }
-
- 1;
-
-
-The application can then cause DBI traces to be routed to the
-logger using
-
- use PerlIO::via::MyFancyLogLayer;
-
- open my $fh, '>:via(MyFancyLogLayer)', MyFancyLogger->new();
-
- $dbh->trace('SQL', $fh);
-
-Now all trace output will be processed by MyFancyLogger's
-log() method.
-
-=head2 Trace Content
-
-Many of the values embedded in trace output are formatted using the neat()
-utility function. This means they may be quoted, sanitized, and possibly
-truncated if longer than C<$DBI::neat_maxlen>. See L</neat> for more details.
-
-=head2 Tracing Tips
-
-You can add tracing to your own application code using the L</trace_msg> method.
-
-It can sometimes be handy to compare trace files from two different runs of the
-same script. However using a tool like C<diff> on the original log output
-doesn't work well because the trace file is full of object addresses that may
-differ on each run.
-
-The DBI includes a handy utility called dbilogstrip that can be used to
-'normalize' the log content. It can be used as a filter like this:
-
- DBI_TRACE=2 perl yourscript.pl ...args1... 2>&1 | dbilogstrip > dbitrace1.log
- DBI_TRACE=2 perl yourscript.pl ...args2... 2>&1 | dbilogstrip > dbitrace2.log
- diff -u dbitrace1.log dbitrace2.log
-
-See L<dbilogstrip> for more information.
-
-=head1 DBI ENVIRONMENT VARIABLES
-
-The DBI module recognizes a number of environment variables, but most of
-them should not be used most of the time.
-It is better to be explicit about what you are doing to avoid the need
-for environment variables, especially in a web serving system where web
-servers are stingy about which environment variables are available.
-
-=head2 DBI_DSN
-
-The DBI_DSN environment variable is used by DBI->connect if you do not
-specify a data source when you issue the connect.
-It should have a format such as "dbi:Driver:databasename".
-
-=head2 DBI_DRIVER
-
-The DBI_DRIVER environment variable is used to fill in the database
-driver name in DBI->connect if the data source string starts "dbi::"
-(thereby omitting the driver).
-If DBI_DSN omits the driver name, DBI_DRIVER can fill the gap.
-
-=head2 DBI_AUTOPROXY
-
-The DBI_AUTOPROXY environment variable takes a string value that starts
-"dbi:Proxy:" and is typically followed by "hostname=...;port=...".
-It is used to alter the behaviour of DBI->connect.
-For full details, see DBI::Proxy documentation.
-
-=head2 DBI_USER
-
-The DBI_USER environment variable takes a string value that is used as
-the user name if the DBI->connect call is given undef (as distinct from
-an empty string) as the username argument.
-Be wary of the security implications of using this.
-
-=head2 DBI_PASS
-
-The DBI_PASS environment variable takes a string value that is used as
-the password if the DBI->connect call is given undef (as distinct from
-an empty string) as the password argument.
-Be extra wary of the security implications of using this.
-
-=head2 DBI_DBNAME (obsolete)
-
-The DBI_DBNAME environment variable takes a string value that is used only when the
-obsolescent style of DBI->connect (with driver name as fourth parameter) is used, and
-when no value is provided for the first (database name) argument.
-
-=head2 DBI_TRACE
-
-The DBI_TRACE environment variable specifies the global default
-trace settings for the DBI at startup. Can also be used to direct
-trace output to a file. When the DBI is loaded it does:
-
- DBI->trace(split /=/, $ENV{DBI_TRACE}, 2) if $ENV{DBI_TRACE};
-
-So if C<DBI_TRACE> contains an "C<=>" character then what follows
-it is used as the name of the file to append the trace to.
-
-output appended to that file. If the name begins with a number
-followed by an equal sign (C<=>), then the number and the equal sign are
-stripped off from the name, and the number is used to set the trace
-level. For example:
-
- DBI_TRACE=1=dbitrace.log perl your_test_script.pl
-
-On Unix-like systems using a Bourne-like shell, you can do this easily
-on the command line:
-
- DBI_TRACE=2 perl your_test_script.pl
-
-See L</TRACING> for more information.
-
-=head2 PERL_DBI_DEBUG (obsolete)
-
-An old variable that should no longer be used; equivalent to DBI_TRACE.
-
-=head2 DBI_PROFILE
-
-The DBI_PROFILE environment variable can be used to enable profiling
-of DBI method calls. See L<DBI::Profile> for more information.
-
-=head2 DBI_PUREPERL
-
-The DBI_PUREPERL environment variable can be used to enable the
-use of DBI::PurePerl. See L<DBI::PurePerl> for more information.
-
-=head1 WARNING AND ERROR MESSAGES
-
-=head2 Fatal Errors
-
-=over 4
-
-=item Can't call method "prepare" without a package or object reference
-
-The C<$dbh> handle you're using to call C<prepare> is probably undefined because
-the preceding C<connect> failed. You should always check the return status of
-DBI methods, or use the L</RaiseError> attribute.
-
-=item Can't call method "execute" without a package or object reference
-
-The C<$sth> handle you're using to call C<execute> is probably undefined because
-the preceding C<prepare> failed. You should always check the return status of
-DBI methods, or use the L</RaiseError> attribute.
-
-=item DBI/DBD internal version mismatch
-
-The DBD driver module was built with a different version of DBI than
-the one currently being used. You should rebuild the DBD module under
-the current version of DBI.
-
-(Some rare platforms require "static linking". On those platforms, there
-may be an old DBI or DBD driver version actually embedded in the Perl
-executable being used.)
-
-=item DBD driver has not implemented the AutoCommit attribute
-
-The DBD driver implementation is incomplete. Consult the author.
-
-=item Can't [sg]et %s->{%s}: unrecognised attribute
-
-You attempted to set or get an unknown attribute of a handle. Make
-sure you have spelled the attribute name correctly; case is significant
-(e.g., "Autocommit" is not the same as "AutoCommit").
-
-=back
-
-=head1 Pure-Perl DBI
-
-A pure-perl emulation of the DBI is included in the distribution
-for people using pure-perl drivers who, for whatever reason, can't
-install the compiled DBI. See L<DBI::PurePerl>.
-
-=head1 SEE ALSO
-
-=head2 Driver and Database Documentation
-
-Refer to the documentation for the DBD driver that you are using.
-
-Refer to the SQL Language Reference Manual for the database engine that you are using.
-
-=head2 ODBC and SQL/CLI Standards Reference Information
-
-More detailed information about the semantics of certain DBI methods
-that are based on ODBC and SQL/CLI standards is available on-line
-via microsoft.com, for ODBC, and www.jtc1sc32.org for the SQL/CLI
-standard:
-
- DBI method ODBC function SQL/CLI Working Draft
- ---------- ------------- ---------------------
- column_info SQLColumns Page 124
- foreign_key_info SQLForeignKeys Page 163
- get_info SQLGetInfo Page 214
- primary_key_info SQLPrimaryKeys Page 254
- table_info SQLTables Page 294
- type_info SQLGetTypeInfo Page 239
- statistics_info SQLStatistics
-
-To find documentation on the ODBC function you can use
-the MSDN search facility at:
-
- http://msdn.microsoft.com/Search
-
-and search for something like C<"SQLColumns returns">.
-
-And for SQL/CLI standard information on SQLColumns you'd read page 124 of
-the (very large) SQL/CLI Working Draft available from:
-
- http://jtc1sc32.org/doc/N0701-0750/32N0744T.pdf
-
-=head2 Standards Reference Information
-
-A hyperlinked, browsable version of the BNF syntax for SQL92 (plus
-Oracle 7 SQL and PL/SQL) is available here:
-
- http://cui.unige.ch/db-research/Enseignement/analyseinfo/SQL92/BNFindex.html
-
-You can find more information about SQL standards online by searching for the
-appropriate standard names and numbers. For example, searching for
-"ANSI/ISO/IEC International Standard (IS) Database Language SQL - Part 1:
-SQL/Framework" you'll find a copy at:
-
- ftp://ftp.iks-jena.de/mitarb/lutz/standards/sql/ansi-iso-9075-1-1999.pdf
-
-=head2 Books and Articles
-
-Programming the Perl DBI, by Alligator Descartes and Tim Bunce.
-L<http://books.perl.org/book/154>
-
-Programming Perl 3rd Ed. by Larry Wall, Tom Christiansen & Jon Orwant.
-L<http://books.perl.org/book/134>
-
-Learning Perl by Randal Schwartz.
-L<http://books.perl.org/book/101>
-
-Details of many other books related to perl can be found at L<http://books.perl.org>
-
-=head2 Perl Modules
-
-Index of DBI related modules available from CPAN:
-
- L<https://metacpan.org/search?q=DBD%3A%3A>
- L<https://metacpan.org/search?q=DBIx%3A%3A>
- L<https://metacpan.org/search?q=DBI>
-
-For a good comparison of RDBMS-OO mappers and some OO-RDBMS mappers
-(including Class::DBI, Alzabo, and DBIx::RecordSet in the former
-category and Tangram and SPOPS in the latter) see the Perl
-Object-Oriented Persistence project pages at:
-
- http://poop.sourceforge.net
-
-A similar page for Java toolkits can be found at:
-
- http://c2.com/cgi-bin/wiki?ObjectRelationalToolComparison
-
-=head2 Mailing List
-
-The I<dbi-users> mailing list is the primary means of communication among
-users of the DBI and its related modules. For details send email to:
-
- L<dbi-users-help@perl.org>
-
-There are typically between 700 and 900 messages per month. You have
-to subscribe in order to be able to post. However you can opt for a
-'post-only' subscription.
-
-Mailing list archives (of variable quality) are held at:
-
- http://groups.google.com/groups?group=perl.dbi.users
- http://www.xray.mpe.mpg.de/mailing-lists/dbi/
- http://www.mail-archive.com/dbi-users%40perl.org/
-
-=head2 Assorted Related Links
-
-The DBI "Home Page":
-
- http://dbi.perl.org/
-
-Other DBI related links:
-
- http://www.perlmonks.org/?node=DBI%20recipes
- http://www.perlmonks.org/?node=Speeding%20up%20the%20DBI
-
-Other database related links:
-
- http://www.connectionstrings.com/
-
-Security, especially the "SQL Injection" attack:
-
- http://bobby-tables.com/
- http://online.securityfocus.com/infocus/1644
-
-
-=head2 FAQ
-
-See L<http://faq.dbi-support.com/>
-
-=head1 AUTHORS
-
-DBI by Tim Bunce, L<http://www.tim.bunce.name>
-
-This pod text by Tim Bunce, J. Douglas Dunlop, Jonathan Leffler and others.
-Perl by Larry Wall and the C<perl5-porters>.
-
-=head1 COPYRIGHT
-
-The DBI module is Copyright (c) 1994-2012 Tim Bunce. Ireland.
-All rights reserved.
-
-You may distribute under the terms of either the GNU General Public
-License or the Artistic License, as specified in the Perl 5.10.0 README file.
-
-=head1 SUPPORT / WARRANTY
-
-The DBI is free Open Source software. IT COMES WITHOUT WARRANTY OF ANY KIND.
-
-=head2 Support
-
-My consulting company, Data Plan Services, offers annual and
-multi-annual support contracts for the DBI. These provide sustained
-support for DBI development, and sustained value for you in return.
-Contact me for details.
-
-=head2 Sponsor Enhancements
-
-If your company would benefit from a specific new DBI feature,
-please consider sponsoring its development. Work is performed
-rapidly, and usually on a fixed-price payment-on-delivery basis.
-Contact me for details.
-
-Using such targeted financing allows you to contribute to DBI
-development, and rapidly get something specific and valuable in return.
-
-=head1 ACKNOWLEDGEMENTS
-
-I would like to acknowledge the valuable contributions of the many
-people I have worked with on the DBI project, especially in the early
-years (1992-1994). In no particular order: Kevin Stock, Buzz Moschetti,
-Kurt Andersen, Ted Lemon, William Hails, Garth Kennedy, Michael Peppler,
-Neil S. Briscoe, Jeff Urlwin, David J. Hughes, Jeff Stander,
-Forrest D Whitcher, Larry Wall, Jeff Fried, Roy Johnson, Paul Hudson,
-Georg Rehfeld, Steve Sizemore, Ron Pool, Jon Meek, Tom Christiansen,
-Steve Baumgarten, Randal Schwartz, and a whole lot more.
-
-Then, of course, there are the poor souls who have struggled through
-untold and undocumented obstacles to actually implement DBI drivers.
-Among their ranks are Jochen Wiedmann, Alligator Descartes, Jonathan
-Leffler, Jeff Urlwin, Michael Peppler, Henrik Tougaard, Edwin Pratomo,
-Davide Migliavacca, Jan Pazdziora, Peter Haworth, Edmund Mergl, Steve
-Williams, Thomas Lowery, and Phlip Plumlee. Without them, the DBI would
-not be the practical reality it is today. I'm also especially grateful
-to Alligator Descartes for starting work on the first edition of the
-"Programming the Perl DBI" book and letting me jump on board.
-
-The DBI and DBD::Oracle were originally developed while I was Technical
-Director (CTO) of the Paul Ingram Group in the UK. So I'd especially like
-to thank Paul for his generosity and vision in supporting this work for many years.
-
-A couple of specific DBI features have been sponsored by enlightened companies:
-
-The development of the swap_inner_handle() method was sponsored by BizRate.com (L<http://BizRate.com>)
-
-The development of DBD::Gofer and related modules was sponsored by
-Shopzilla.com (L<http://Shopzilla.com>), where I currently work.
-
-=head1 CONTRIBUTING
-
-As you can see above, many people have contributed to the DBI and
-drivers in many ways over many years.
-
-If you'd like to help then see L<http://dbi.perl.org/contributing>.
-
-If you'd like the DBI to do something new or different then a good way
-to make that happen is to do it yourself and send me a patch to the
-source code that shows the changes. (But read "Speak before you patch"
-below.)
-
-=head2 Browsing the source code repository
-
-Use https://github.com/perl5-dbi/dbi
-
-=head2 How to create a patch using Git
-
-The DBI source code is maintained using Git. To access the source
-you'll need to install a Git client. Then, to get the source code, do:
-
- git clone https://github.com/perl5-dbi/dbi.git DBI-git
-
-The source code will now be available in the new subdirectory C<DBI-git>.
-
-When you want to synchronize later, issue the command
-
- git pull --all
-
-Make your changes, test them, test them again until everything passes.
-If there are no tests for the new feature you added or a behaviour change,
-the change should include a new test. Then commit the changes. Either use
-
- git gui
-
-or
-
- git commit -a -m 'Message to my changes'
-
-If you get any conflicts reported you'll need to fix them first.
-
-Then generate the patch file to be mailed:
-
- git format-patch -1 --attach
-
-which will create a file 0001-*.patch (where * relates to the commit message).
-Read the patch file, as a sanity check, and then email it to dbi-dev@perl.org.
-
-If you have a L<github|https://github.com> account, you can also fork the
-repository, commit your changes to the forked repository and then do a
-pull request.
-
-=head2 How to create a patch without Git
-
-Unpack a fresh copy of the distribution:
-
- wget http://cpan.metacpan.org/authors/id/T/TI/TIMB/DBI-1.627.tar.gz
- tar xfz DBI-1.627.tar.gz
-
-Rename the newly created top level directory:
-
- mv DBI-1.627 DBI-1.627.your_foo
-
-Edit the contents of DBI-1.627.your_foo/* till it does what you want.
-
-Test your changes and then remove all temporary files:
-
- make test && make distclean
-
-Go back to the directory you originally unpacked the distribution:
-
- cd ..
-
-Unpack I<another> copy of the original distribution you started with:
-
- tar xfz DBI-1.627.tar.gz
-
-Then create a patch file by performing a recursive C<diff> on the two
-top level directories:
-
- diff -purd DBI-1.627 DBI-1.627.your_foo > DBI-1.627.your_foo.patch
-
-=head2 Speak before you patch
-
-For anything non-trivial or possibly controversial it's a good idea
-to discuss (on dbi-dev@perl.org) the changes you propose before
-actually spending time working on them. Otherwise you run the risk
-of them being rejected because they don't fit into some larger plans
-you may not be aware of.
-
-You can also reach the developers on IRC (chat). If they are on-line,
-the most likely place to talk to them is the #dbi channel on irc.perl.org
-
-=head1 TRANSLATIONS
-
-A German translation of this manual (possibly slightly out of date) is
-available, thanks to O'Reilly, at:
-
- http://www.oreilly.de/catalog/perldbiger/
-
-=head1 TRAINING
-
-References to DBI related training resources. No recommendation implied.
-
- http://www.treepax.co.uk/
- http://www.keller.com/dbweb/
-
-(If you offer professional DBI related training services,
-please send me your details so I can add them here.)
-
-=head1 OTHER RELATED WORK AND PERL MODULES
-
-=over 4
-
-=item L<Apache::DBI>
-
-To be used with the Apache daemon together with an embedded Perl
-interpreter like C<mod_perl>. Establishes a database connection which
-remains open for the lifetime of the HTTP daemon. This way the CGI
-connect and disconnect for every database access becomes superfluous.
-
-=item SQL Parser
-
-See also the L<SQL::Statement> module, SQL parser and engine.
-
-=back
-
-=cut
-
-# LocalWords: DBI
+++ /dev/null
-=head1 NAME
-
-DBI::Changes - List of significant changes to the DBI
-
-=encoding ISO8859-1
-
-=cut
-
-=head2 Changes in DBI 1.641 - 19th March 2018
-
- Remove dependency on Storable 2.16 introduced in DBI 1.639
- thanks to Ribasushi #60
- Avoid compiler warnings in Driver.xst #59
- thanks to pali #59
-
-=head2 Changes in DBI 1.640 - 28th January 2018
-
- Fix test t/91_store_warning.t for perl 5.10.0
- thanks to pali #57
-
- Add Perl 5.10.0 and 5.8.1 specific versions to Travis testing
- thanks to pali #57
- Add registration of mariadb_ prefix for new DBD::MariaDB driver
- thanks to pali #56
-
-=head2 Changes in DBI 1.639 - 28th December 2017
-
- Fix UTF-8 support for warn/croak calls within DBI internals,
- thanks to pali #53
- Fix dependency on Storable for perl older than 5.8.9,
- thanks to H.Merijn Brand.
-
- Add DBD::Mem driver, a pure-perl in-memory driver using DBI::DBD::SqlEngine,
- thanks to Jens Rehsack #42
-
- Corrected missing semicolon in example in documentation,
- thanks to pali #55
-
-=head2 Changes in DBI 1.637 - 16th August 2017
-
- Fix use of externally controlled format string (CWE-134) thanks to pali #44
- This could cause a crash if, for example, a db error contained a %.
- https://cwe.mitre.org/data/definitions/134.html
- Fix extension detection for DBD::File related drivers
- Fix tests for perl without dot in @INC RT#120443
- Fix loss of error message on parent handle, thanks to charsbar #34
- Fix disappearing $_ inside callbacks, thanks to robschaber #47
- Fix dependency on Storable for perl older than 5.8.9
-
- Allow objects to be used as passwords without throwing an error, thanks to demerphq #40
- Allow $sth NAME_* attributes to be set from Perl code, re #45
- Added support for DBD::XMLSimple thanks to nigelhorne #38
-
- Documentation updates:
- Improve examples using eval to be more correct, thanks to pali #39
- Add cautionary note to prepare_cached docs re refs in %attr #46
- Small POD changes (Getting Help -> Online) thanks to openstrike #33
- Adds links to more module names and fix typo, thanks to oalders #43
- Typo fix thanks to bor #37
-
-=head2 Changes in DBI 1.636 - 24th April 2016
-
- Fix compilation for threaded perl <= 5.12 broken in 1.635 RT#113955
- Revert change to DBI::PurePerl DESTROY in 1.635
- Change t/16destroy.t to avoid race hazard RT#113951
- Output perl version and archname in t/01basics.t
- Add perl 5.22 and 5.22-extras to travis-ci config
-
-=head2 Changes in DBI 1.635 - 24th April 2016
-
- Fixed RaiseError/PrintError for UTF-8 errors/warnings. RT#102404
- Fixed cases where ShowErrorStatement might show incorrect Statement RT#97434
- Fixed DBD::Gofer for UTF-8-enabled STDIN/STDOUT
- thanks to mauke PR#32
- Fixed fetchall_arrayref({}) behavior with no columns
- thanks to Dan McGee PR#31
- Fixed tied CachedKids ref leak in attribute cache by weakening
- thanks to Michael Conrad RT#113852
- Fixed "panic: attempt to copy freed scalar" upon commit() or rollback()
- thanks to fbriere for detailed bug report RT#102791
- Ceased to ignore DESTROY of outer handle in DBI::PurePerl
- Treat undef in DBI::Profile Path as string "undef"
- thanks to fREW Schmidt RT#113298
- Fix SQL::Nano parser to ignore trailing semicolon
- thanks to H.Merijn Brand.
-
- Added @ary = $dbh->selectall_array(...) method
- thanks to Ed Avis RT#106411
- Added appveyor support (Travis like CI for windows)
- thanks to mbeijen PR#30
-
- Corrected spelling errors in pod
- thanks to Gregor Herrmann RT#107838
- Corrected and/or removed broken links to SQL standards
- thanks to David Pottage RT#111437
- Corrected doc example to use dbi: instead of DBI: in DSN
- thanks to Michael R. Davis RT#101181
- Removed/updated broken links in docs
- thanks to mbeijen PR#29
- Clarified docs for DBI::hash($string)
- Removed the ancient DBI::FAQ module RT#102714
- Fixed t/pod.t to require Test::Pod >= 1.41 RT#101769
-
-This release was developed at the Perl QA Hackathon 2016
-L<http://act.qa-hackathon.org/qa2016/>
-which was made possible by the generosity of many sponsors:
-
-L<https://www.fastmail.com> FastMail,
-L<https://www.ziprecruiter.com> ZipRecruiter,
-L<http://www.activestate.com> ActiveState,
-L<http://www.opusvl.com> OpusVL,
-L<https://www.strato.com> Strato,
-L<http://www.surevoip.co.uk> SureVoIP,
-L<http://www.cv-library.co.uk> CV-Library,
-L<https://www.iinteractive.com/> Infinity,
-L<https://opensource.careers/perl-careers/> Perl Careers,
-L<https://www.mongodb.com> MongoDB,
-L<https://www.thinkproject.com> thinkproject!,
-L<https://www.dreamhost.com/> Dreamhost,
-L<http://www.perl6.org/> Perl 6,
-L<http://www.perl-services.de/> Perl Services,
-L<https://www.evozon.com/> Evozon,
-L<http://www.booking.com> Booking,
-L<http://eligo.co.uk> Eligo,
-L<http://www.oetiker.ch/> Oetiker+Partner,
-L<http://capside.com/en/> CAPSiDE,
-L<https://www.procura.nl/> Procura,
-L<https://constructor.io/> Constructor.io,
-L<https://metacpan.org/author/BABF> Robbie Bow,
-L<https://metacpan.org/author/RSAVAGE> Ron Savage,
-L<https://metacpan.org/author/ITCHARLIE> Charlie Gonzalez,
-L<https://twitter.com/jscook2345> Justin Cook.
-
-=head2 Changes in DBI 1.634 - 3rd August 2015
-
- Enabled strictures on all modules (Jose Luis Perez Diez) #22
- Note that this might cause new exceptions in existing code.
- Please take time for extra testing before deploying to production.
- Improved handling of row counts for compiled drivers and enable them to
- return larger row counts (IV type) by defining new *_iv macros.
- Fixed quote_identifier that was adding a trailing separator when there
- was only a catalog (Martin J. Evans)
-
- Removed redundant keys() call in fetchall_arrayref with hash slice (ilmari) #24
- Corrected pod xref to Placeholders section (Matthew D. Fuller)
- Corrected pod grammar (Nick Tonkin) #25
-
- Added support for tables('', '', '', '%') special case (Martin J. Evans)
- Added support for DBD prefixes with numbers (Jens Rehsack) #19
- Added extra initializer for DBI::DBD::SqlEngine based DBD's (Jens Rehsack)
- Added Memory Leaks section to the DBI docs (Tim)
- Added Artistic v1 & GPL v1 LICENSE file (Jose Luis Perez Diez) #21
-
-=head2 Changes in DBI 1.633 - 11th Jan 2015
-
- Fixed selectrow_*ref to return undef on error in list context
- instead if an empty list.
- Changed t/42prof_data.t more informative
- Changed $sth->{TYPE} to be NUMERIC in DBD::File drivers as per the
- DBI docs. Note TYPE_NAME is now also available. [H.Merijn Brand]
- Fixed compilation error on bleadperl due DEFSV no longer being an lvalue
- [Dagfinn Ilmari Mannsåker]
-
- Added docs for escaping placeholders using a backslash.
- Added docs for get_info(9000) indicating ability to escape placeholders.
- Added multi_ prefix for DBD::Multi (Dan Wright) and ad2_ prefix for
- DBD::AnyData2
-
-=head2 Changes in DBI 1.632 - 9th Nov 2014
-
- Fixed risk of memory corruption with many arguments to methods
- originally reported by OSCHWALD for Callbacks but may apply
- to other functionality in DBI method dispatch RT#86744.
- Fixed DBD::PurePerl to not set $sth->{Active} true by default
- drivers are expected to set it true as needed.
- Fixed DBI::DBD::SqlEngine to complain loudly when prerequite
- driver_prefix is not fulfilled (RT#93204) [Jens Rehsack]
- Fixed redundant sprintf argument warning RT#97062 [Reini Urban]
- Fixed security issue where DBD::File drivers would open files
- from folders other than specifically passed using the
- f_dir attribute RT#99508 [H.Merijn Brand]
-
- Changed delete $h->{$key} to work for keys with 'private_' prefix
- per request in RT#83156. local $h->{$key} works as before.
-
- Added security notice to DBD::Proxy and DBI::ProxyServer because they
- use Storable which is insecure. Thanks to ppisar@redhat.com RT#90475
- Added note to AutoInactiveDestroy docs strongly recommending that it
- is enabled in all new code.
-
-=head2 Changes in DBI 1.631 - 20th Jan 2014
-
-NOTE: This release changes the handle passed to Callbacks from being an 'inner'
-handle to being an 'outer' handle. If you have code that makes use of Callbacks,
-ensure that you understand what this change means and review your callback code.
-
- Fixed err_hash handling of integer err RT#92172 [Dagfinn Ilmari]
- Fixed use of \Q vs \E in t/70callbacks.t
-
- Changed the handle passed to Callbacks from being an 'inner'
- handle to being an 'outer' handle.
-
- Improved reliability of concurrent testing
- PR#8 [Peter Rabbitson]
- Changed optional dependencies to "suggest"
- PR#9 [Karen Etheridge]
- Changed to avoid mg_get in neatsvpv during global destruction
- PR#10 [Matt Phillips]
-
-=head2 Changes in DBI 1.630 - 28th Oct 2013
-
-NOTE: This release enables PrintWarn by default regardless of $^W.
-Your applications may generate more log messages than before.
-
- Fixed err for new drh to be undef not to 0 [Martin J. Evans]
- Fixed RT#83132 - moved DBIstcf* constants to util
- export tag [Martin J. Evans]
- PrintWarn is now triggered by warnings recorded in methods like STORE
- that don't clear err RT#89015 [Tim Bunce]
-
- Changed tracing to no longer show quote and quote_identifier calls
- at trace level 1.
- Changed DBD::Gofer ping while disconnected set_err from warn to info.
- Clarified wording of log message when err is cleared.
- Changed bootstrap to use $XS_VERSION RT#89618 [Andreas Koenig]
-
- Added connect_cached.connected Callback PR#3 [David E. Wheeler]
-
- Clarified effect of refs in connect_cached attributes [David E. Wheeler]
- Extended ReadOnly attribute docs for when the driver cannot
- ensure read only [Martin J. Evans]
- Corrected SQL_BIGINT docs to say ODBC value is used PR#5 [ilmari]
-
-There was no DBI 1.629 release.
-
-=head2 Changes in DBI 1.628 - 22nd July 2013
-
- Fixed missing fields on partial insert via DBI::DBD::SqlEngine
- engines (DBD::CSV, DBD::DBM etc.) [H.Merijn Brand, Jens Rehsack]
- Fixed stack corruption on callbacks RT#85562 RT#84974 [Aaron Schweiger]
- Fixed DBI::SQL::Nano_::Statement handling of "0" [Jens Rehsack]
- Fixed exit op precedence in test RT#87029 [Reni Urban]
-
- Added support for finding tables in multiple directories
- via new DBD::File f_dir_search attribute [H.Merijn Brand]
- Enable compiling by C++ RT#84285 [Kurt Jaeger]
-
- Typo fixes in pod and comment [David Steinbrunner]
- Change DBI's docs to refer to git not svn [H.Merijn Brand]
- Clarify bind_col TYPE attribute is sticky [Martin J. Evans]
- Fixed reference to $sth in selectall_arrayref docs RT#84873
- Spelling fixes [Ville Skyttä]
- Changed $VERSIONs to hardcoded strings [H.Merijn Brand]
-
-=head2 Changes in DBI 1.627 - 16th May 2013
-
- Fixed VERSION regression in DBI::SQL::Nano [Tim Bunce]
-
-=head2 Changes in DBI 1.626 - 15th May 2013
-
- Fixed pod text/link was reversed in a few cases RT#85168
- [H.Merijn Brand]
-
- Handle aliasing of STORE'd attributes in DBI::DBD::SqlEngine
- [Jens Rehsack]
-
- Updated repository URI to git [Jens Rehsack]
-
- Fixed skip() count arg in t/48dbi_dbd_sqlengine.t [Tim Bunce]
-
-=head2 Changes in DBI 1.625 (svn r15595) 28th March 2013
-
- Fixed heap-use-after-free during global destruction RT#75614
- thanks to Reini Urban.
- Fixed ignoring RootClass attribute during connect() by
- DBI::DBD::SqlEngine reported in RT#84260 by Michael Schout
-
-=head2 Changes in DBI 1.624 (svn r15576) 22nd March 2013
-
- Fixed Gofer for hash randomization in perl 5.17.10+ RT#84146
-
- Clarify docs for can() re RT#83207
-
-=head2 Changes in DBI 1.623 (svn r15547) 2nd Jan 2013
-
- Fixed RT#64330 - ping wipes out errstr (Martin J. Evans).
- Fixed RT#75868 - DBD::Proxy shouldn't call connected() on the server.
- Fixed RT#80474 - segfault in DESTROY with threads.
- Fixed RT#81516 - Test failures due to hash randomisation in perl 5.17.6
- thanks to Jens Rehsack and H.Merijn Brand and feedback on IRC
- Fixed RT#81724 - Handle copy-on-write scalars (sprout)
- Fixed unused variable / self-assignment compiler warnings.
- Fixed default table_info in DBI::DBD::SqlEngine which passed NAMES
- attribute instead of NAME to DBD::Sponge RT72343 (Martin J. Evans)
-
- Corrected a spelling error thanks to Chris Sanders.
- Corrected typo in DBI->installed_versions docs RT#78825
- thanks to Jan Dubois.
-
- Refactored table meta information management from DBD::File into
- DBI::DBD::SqlEngine (H.Merijn Brand, Jens Rehsack)
- Prevent undefined f_dir being used in opendir (H.Merijn Brand)
-
- Added logic to force destruction of children before parents
- during global destruction. See RT#75614.
- Added DBD::File Plugin-Support for table names and data sources
- (Jens Rehsack, #dbi Team)
- Added new tests to 08keeperr for RT#64330
- thanks to Kenichi Ishigaki.
- Added extra internal handle type check, RT#79952
- thanks to Reini Urban.
- Added cubrid_ registered prefix for DBD::cubrid, RT#78453
-
- Removed internal _not_impl method (Martin J. Evans).
-
- NOTE: The "old-style" DBD::DBM attributes 'dbm_ext' and 'dbm_lockfile'
- have been deprecated for several years and their use will now generate
- a warning.
-
-=head2 Changes in DBI 1.622 (svn r15327) 6th June 2012
-
- Fixed lack of =encoding in non-ASCII pod docs. RT#77588
-
- Corrected typo in DBI::ProfileDumper thanks to Finn Hakansson.
-
-=head2 Changes in DBI 1.621 (svn r15315) 21st May 2012
-
- Fixed segmentation fault when a thread is created from
- within another thread RT#77137, thanks to Dave Mitchell.
- Updated previous Changes to credit Booking.com for sponsoring
- Dave Mitchell's recent DBI optimization work.
-
-=head2 Changes in DBI 1.620 (svn r15300) 25th April 2012
-
- Modified column renaming in fetchall_arrayref, added in 1.619,
- to work on column index numbers not names (an incompatible change).
- Reworked the fetchall_arrayref documentation.
- Hash slices in fetchall_arrayref now detect invalid column names.
-
-=head2 Changes in DBI 1.619 (svn r15294) 23rd April 2012
-
- Fixed the connected method to stop showing the password in
- trace file (Martin J. Evans).
- Fixed _install_method to set CvFILE correctly
- thanks to sprout RT#76296
- Fixed SqlEngine "list_tables" thanks to David McMath
- and Norbert Gruener. RT#67223 RT#69260
-
- Optimized DBI method dispatch thanks to Dave Mitchell.
- Optimized driver access to DBI internal state thanks to Dave Mitchell.
- Optimized driver access to handle data thanks to Dave Mitchell.
- Dave's work on these optimizations was sponsored by Booking.com.
- Optimized fetchall_arrayref with hash slice thanks
- to Dagfinn Ilmari Mannsåker. RT#76520
- Allow renaming columns in fetchall_arrayref hash slices
- thanks to Dagfinn Ilmari Mannsåker. RT#76572
- Reserved snmp_ and tree_ for DBD::SNMP and DBD::TreeData
-
-=head2 Changes in DBI 1.618 (svn r15170) 25rd February 2012
-
- Fixed compiler warnings in Driver_xst.h (Martin J. Evans)
- Fixed compiler warning in DBI.xs (H.Merijn Brand)
- Fixed Gofer tests failing on Windows RT74975 (Manoj Kumar)
- Fixed my_ctx compile errors on Windows (Dave Mitchell)
-
- Significantly optimized method dispatch via cache (Dave Mitchell)
- Significantly optimized DBI internals for threads (Dave Mitchell)
- Dave's work on these optimizations was sponsored by Booking.com.
- Xsub to xsub calling optimization now enabled for threaded perls.
- Corrected typo in example in docs (David Precious)
- Added note that calling clone() without an arg may warn in future.
- Minor changes to the install_method() docs in DBI::DBD.
- Updated dbipport.h from Devel::PPPort 3.20
-
-=head2 Changes in DBI 1.617 (svn r15107) 30th January 2012
-
- NOTE: The officially supported minimum perl version will change
- from perl 5.8.1 (2003) to perl 5.8.3 (2004) in a future release.
- (The last change, from perl 5.6 to 5.8.1, was announced
- in July 2008 and implemented in DBI 1.611 in April 2010.)
-
- Fixed ParamTypes example in the pod (Martin J. Evans)
- Fixed the definition of ArrayTupleStatus and remove confusion over
- rows affected in list context of execute_array (Martin J. Evans)
- Fixed sql_type_cast example and typo in errors (Martin J. Evans)
- Fixed Gofer error handling for keeperr methods like ping (Tim Bunce)
- Fixed $dbh->clone({}) RT73250 (Tim Bunce)
- Fixed is_nested_call logic error RT73118 (Reini Urban)
-
- Enhanced performance for threaded perls (Dave Mitchell, Tim Bunce)
- Dave's work on this optimization was sponsored by Booking.com.
- Enhanced and standardized driver trace level mechanism (Tim Bunce)
- Removed old code that was an inneffective attempt to detect
- people doing DBI->{Attrib}.
- Clear ParamValues on bind_param param count error RT66127 (Tim Bunce)
- Changed DBI::ProxyServer to require DBI at compile-time RT62672 (Tim Bunce)
-
- Added pod for default_user to DBI::DBD (Martin J. Evans)
- Added CON, ENC and DBD trace flags and extended 09trace.t (Martin J. Evans)
- Added TXN trace flags and applied CON and TXN to relevant methods (Tim Bunce)
- Added some more fetchall_arrayref(..., $maxrows) tests (Tim Bunce)
- Clarified docs for fetchall_arrayref called on an inactive handle.
- Clarified docs for clone method (Tim Bunce)
- Added note to DBI::Profile about async queries (Marcel Grünauer).
- Reserved spatialite_ as a driver prefix for DBD::Spatialite
- Reserved mo_ as a driver prefix for DBD::MO
- Updated link to the SQL Reunion 95 docs, RT69577 (Ash Daminato)
- Changed links for DBI recipes. RT73286 (Martin J. Evans)
-
-=head2 Changes in DBI 1.616 (svn r14616) 30th December 2010
-
- Fixed spurious dbi_profile lines written to the log when
- profiling is enabled and a trace flag, like SQL, is used.
- Fixed to recognize SQL::Statement errors even if instantiated
- with RaiseError=0 (Jens Rehsack)
- Fixed RT#61513 by catching attribute assignment to tied table access
- interface (Jens Rehsack)
- Fixing some misbehavior of DBD::File when running within the Gofer
- server.
- Fixed compiler warnings RT#62640
-
- Optimized connect() to remove redundant FETCH of \%attrib values.
- Improved initialization phases in DBI::DBD::SqlEngine (Jens Rehsack)
-
- Added DBD::Gofer::Transport::corostream. An experimental proof-of-concept
- transport that enables asynchronous database calls with few code changes.
- It enables asynchronous use of DBI frameworks like DBIx::Class.
-
- Added additional notes on DBDs which avoid creating a statement in
- the do() method and the effects on error handlers (Martin J. Evans)
- Adding new attribute "sql_dialect" to DBI::DBD::SqlEngine to allow
- users control used SQL dialect (ANSI, CSV or AnyData), defaults to
- CSV (Jens Rehsack)
- Add documentation for DBI::DBD::SqlEngine attributes (Jens Rehsack)
- Documented dbd_st_execute return (Martin J. Evans)
- Fixed typo in InactiveDestroy thanks to Emmanuel Rodriguez.
-
-=head2 Changes in DBI 1.615 (svn r14438) 21st September 2010
-
- Fixed t/51dbm_file for file/directory names with whitespaces in them
- RT#61445 (Jens Rehsack)
- Fixed compiler warnings from ignored hv_store result (Martin J. Evans)
- Fixed portability to VMS (Craig A. Berry)
-
-=head2 Changes in DBI 1.614 (svn r14408) 17th September 2010
-
- Fixed bind_param () in DBI::DBD::SqlEngine (rt#61281)
- Fixed internals to not refer to old perl symbols that
- will no longer be visible in perl >5.13.3 (Andreas Koenig)
- Many compiled drivers are likely to need updating.
- Fixed issue in DBD::File when absolute filename is used as table name
- (Jens Rehsack)
- Croak manually when file after tie doesn't exists in DBD::DBM
- when it have to exists (Jens Rehsack)
- Fixed issue in DBD::File when users set individual file name for tables
- via f_meta compatibility interface - reported by H.Merijn Brand while
- working on RT#61168 (Jens Rehsack)
-
- Changed 50dbm_simple to simplify and fix problems (Martin J. Evans)
- Changed 50dbm_simple to skip aggregation tests when not using
- SQL::Statement (Jens Rehsack)
- Minor speed improvements in DBD::File (Jens Rehsack)
-
- Added $h->{AutoInactiveDestroy} as simpler safer form of
- $h->{InactiveDestroy} (David E. Wheeler)
- Added ability for parallel testing "prove -j4 ..." (Jens Rehsack)
- Added tests for delete in DBM (H.Merijn Brand)
- Added test for absolute filename as table to 51dbm_file (Jens Rehsack)
- Added two initialization phases to DBI::DBD::SqlEngine (Jens Rehsack)
- Added improved developers documentation for DBI::DBD::SqlEngine
- (Jens Rehsack)
- Added guides how to write DBI drivers using DBI::DBD::SqlEngine
- or DBD::File (Jens Rehsack)
- Added register_compat_map() and table_meta_attr_changed() to
- DBD::File::Table to support clean fix of RT#61168 (Jens Rehsack)
-
-=head2 Changes in DBI 1.613 (svn r14271) 22nd July 2010
-
- Fixed Win32 prerequisite module from PathTools to File::Spec.
-
- Changed attribute headings and fixed references in DBI pod (Martin J. Evans)
- Corrected typos in DBI::FAQ and DBI::ProxyServer (Ansgar Burchardt)
-
-=head2 Changes in DBI 1.612 (svn r14254) 16th July 2010
-
-NOTE: This is a minor release for the DBI core but a major release for
-DBD::File and drivers that depend on it, like DBD::DBM and DBD::CSV.
-
-This is also the first release where the bulk of the development work
-has been done by other people. I'd like to thank (in no particular order)
-Jens Rehsack, Martin J. Evans, and H.Merijn Brand for all their contributions.
-
- Fixed DBD::File's {ChopBlank} handling (it stripped \s instead of space
- only as documented in DBI) (H.Merijn Brand)
- Fixed DBD::DBM breakage with SQL::Statement (Jens Rehsack, fixes RT#56561)
- Fixed DBD::File file handle leak (Jens Rehsack)
- Fixed problems in 50dbm.t when running tests with multiple
- dbms (Martin J. Evans)
- Fixed DBD::DBM bugs found during tests (Jens Rehsack)
- Fixed DBD::File doesn't find files without extensions under some
- circumstances (Jens Rehsack, H.Merijn Brand, fixes RT#59038)
-
- Changed Makefile.PL to modernize with CONFLICTS, recommended dependencies
- and resources (Jens Rehsack)
- Changed DBI::ProfileDumper to rename any existing profile file by
- appending .prev, instead of overwriting it.
- Changed DBI::ProfileDumper::Apache to work in more configurations
- including vhosts using PerlOptions +Parent.
- Add driver_prefix method to DBI (Jens Rehsack)
-
- Added more tests to 50dbm_simple.t to prove optimizations in
- DBI::SQL::Nano and SQL::Statement (Jens Rehsack)
- Updated tests to cover optional installed SQL::Statement (Jens Rehsack)
- Synchronize API between SQL::Statement and DBI::SQL::Nano (Jens Rehsack)
- Merged some optimizations from SQL::Statement into DBI::SQL::Nano
- (Jens Rehsack)
- Added basic test for DBD::File (H.Merijn Brand, Jens Rehsack)
- Extract dealing with Perl SQL engines from DBD::File into
- DBI::DBD::SqlEngine for better subclassing of 3rd party non-db DBDs
- (Jens Rehsack)
-
- Updated and clarified documentation for finish method (Tim Bunce).
- Changes to DBD::File for better English and hopefully better
- explanation (Martin J. Evans)
- Update documentation of DBD::DBM to cover current implementation,
- tried to explain some things better and changes most examples to
- preferred style of Merijn and myself (Jens Rehsack)
- Added developer documentation (including a roadmap of future plans)
- for DBD::File
-
-=head2 Changes in DBI 1.611 (svn r13935) 29th April 2010
-
- NOTE: minimum perl version is now 5.8.1 (as announced in DBI 1.607)
-
- Fixed selectcol_arrayref MaxRows attribute to count rows not values
- thanks to Vernon Lyon.
- Fixed DBI->trace(0, *STDERR); (H.Merijn Brand)
- which tried to open a file named "*main::STDERR" in perl-5.10.x
- Fixes in DBD::DBM for use under threads (Jens Rehsack)
-
- Changed "Issuing rollback() due to DESTROY without explicit disconnect"
- warning to not be issued if ReadOnly set for that dbh.
-
- Added f_lock and f_encoding support to DBD::File (H.Merijn Brand)
- Added ChildCallbacks => { ... } to Callbacks as a way to
- specify Callbacks for child handles.
- With tests added by David E. Wheeler.
- Added DBI::sql_type_cast($value, $type, $flags) to cast a string value
- to an SQL type. e.g. SQL_INTEGER effectively does $value += 0;
- Has other options plus an internal interface for drivers.
-
- Documentation changes:
- Small fixes in the documentation of DBD::DBM (H.Merijn Brand)
- Documented specification of type casting behaviour for bind_col()
- based on DBI::sql_type_cast() and two new bind_col attributes
- StrictlyTyped and DiscardString. Thanks to Martin Evans.
- Document fetchrow_hashref() behaviour for functions,
- aliases and duplicate names (H.Merijn Brand)
- Updated DBI::Profile and DBD::File docs to fix pod nits
- thanks to Frank Wiegand.
- Corrected typos in Gopher documentation reported by Jan Krynicky.
- Documented the Callbacks attribute thanks to David E. Wheeler.
- Corrected the Timeout examples as per rt 50621 (Martin J. Evans).
- Removed some internal broken links in the pod (Martin J. Evans)
- Added Note to column_info for drivers which do not
- support it (Martin J. Evans)
- Updated dbipport.h to Devel::PPPort 3.19 (H.Merijn Brand)
-
-=head2 Changes in DBI 1.609 (svn r12816) 8th June 2009
-
- Fixes to DBD::File (H.Merijn Brand)
- added f_schema attribute
- table names case sensitive when quoted, insensitive when unquoted
- workaround a bug in SQL::Statement (temporary fix) related
- to the "You passed x parameters where y required" error
-
- Added ImplementorClass and Name info to the "Issuing rollback() due to
- DESTROY without explicit disconnect" warning to identify the handle.
- Applies to compiled drivers when they are recompiled.
- Added DBI->visit_handles($coderef) method.
- Added $h->visit_child_handles($coderef) method.
- Added docs for column_info()'s COLUMN_DEF value.
- Clarified docs on stickyness of data type via bind_param().
- Clarified docs on stickyness of data type via bind_col().
-
-=head2 Changes in DBI 1.608 (svn r12742) 5th May 2009
-
- Fixes to DBD::File (H.Merijn Brand)
- bind_param () now honors the attribute argument
- added f_ext attribute
- File::Spec is always required. (CORE since 5.00405)
- Fail and set errstr on parameter count mismatch in execute ()
- Fixed two small memory leaks when running in mod_perl
- one in DBI->connect and one in DBI::Gofer::Execute.
- Both due to "local $ENV{...};" leaking memory.
- Fixed DBD_ATTRIB_DELETE macro for driver authors
- and updated DBI::DBD docs thanks to Martin J. Evans.
- Fixed 64bit issues in trace messages thanks to Charles Jardine.
- Fixed FETCH_many() method to work with drivers that incorrectly return
- an empty list from $h->FETCH. Affected gofer.
-
- Added 'sqlite_' as registered prefix for DBD::SQLite.
- Corrected many typos in DBI docs thanks to Martin J. Evans.
- Improved DBI::DBD docs thanks to H.Merijn Brand.
-
-=head2 Changes in DBI 1.607 (svn r11571) 22nd July 2008
-
- NOTE: Perl 5.8.1 is now the minimum supported version.
- If you need support for earlier versions send me a patch.
-
- Fixed missing import of carp in DBI::Gofer::Execute.
-
- Added note to docs about effect of execute(@empty_array).
- Clarified docs for ReadOnly thanks to Martin Evans.
-
-=head2 Changes in DBI 1.605 (svn r11434) 16th June 2008
-
- Fixed broken DBIS macro with threads on big-endian machines
- with 64bit ints but 32bit pointers. Ticket #32309.
- Fixed the selectall_arrayref, selectrow_arrayref, and selectrow_array
- methods that get embedded into compiled drivers to use the
- inner sth handle when passed a $sth instead of an sql string.
- Drivers will need to be recompiled to pick up this change.
- Fixed leak in neat() for some kinds of values thanks to Rudolf Lippan.
- Fixed DBI::PurePerl neat() to behave more like XS neat().
-
- Increased default $DBI::neat_maxlen from 400 to 1000.
- Increased timeout on tests to accommodate very slow systems.
- Changed behaviour of trace levels 1..4 to show less information
- at lower levels.
- Changed the format of the key used for $h->{CachedKids}
- (which is undocumented so you shouldn't depend on it anyway)
- Changed gofer error handling to avoid duplicate error text in errstr.
- Clarified docs re ":N" style placeholders.
- Improved gofer retry-on-error logic and refactored to aid subclassing.
- Improved gofer trace output in assorted ways.
-
- Removed the beeps "\a" from Makefile.PL warnings.
- Removed check for PlRPC-modules from Makefile.PL
-
- Added sorting of ParamValues reported by ShowErrorStatement
- thanks to to Rudolf Lippan.
- Added cache miss trace message to DBD::Gofer transport class.
- Added $drh->dbixs_revision method.
- Added explicit LICENSE specification (perl) to META.yaml
-
-=head2 Changes in DBI 1.604 (svn rev 10994) 24th March 2008
-
- Fixed fetchall_arrayref with $max_rows argument broken in 1.603,
- thanks to Greg Sabino Mullane.
- Fixed a few harmless compiler warnings on cygwin.
-
-=head2 Changes in DBI 1.603
-
- Fixed pure-perl fetchall_arrayref with $max_rows argument
- to not error when fetching after all rows already fetched.
- (Was fixed for compiled drivers back in DBI 1.31.)
- Thanks to Mark Overmeer.
- Fixed C sprintf formats and casts, fixing compiler warnings.
-
- Changed dbi_profile() to accept a hash of profiles and apply to all.
- Changed gofer stream transport to improve error reporting.
- Changed gofer test timeout to avoid spurious failures on slow systems.
-
- Added options to t/85gofer.t so it's more useful for manual testing.
-
-=head2 Changes in DBI 1.602 (svn rev 10706) 8th February 2008
-
- Fixed potential coredump if stack reallocated while calling back
- into perl from XS code. Thanks to John Gardiner Myers.
- Fixed DBI::Util::CacheMemory->new to not clear the cache.
- Fixed avg in DBI::Profile as_text() thanks to Abe Ingersoll.
- Fixed DBD::DBM bug in push_names thanks to J M Davitt.
- Fixed take_imp_data for some platforms thanks to Jeffrey Klein.
- Fixed docs tie'ing CacheKids (ie LRU cache) thanks to Peter John Edwards.
-
- Expanded DBI::DBD docs for driver authors thanks to Martin Evans.
- Enhanced t/80proxy.t test script.
- Enhanced t/85gofer.t test script thanks to Stig.
- Enhanced t/10examp.t test script thanks to David Cantrell.
- Documented $DBI::stderr as the default value of err for internal errors.
-
- Gofer changes:
- track_recent now also keeps track of N most recent errors.
- The connect method is now also counted in stats.
-
-=head2 Changes in DBI 1.601 (svn rev 10103), 21st October 2007
-
- Fixed t/05thrclone.t to work with Test::More >= 0.71
- thanks to Jerry D. Hedden and Michael G Schwern.
- Fixed DBI for VMS thanks to Peter (Stig) Edwards.
-
- Added client-side caching to DBD::Gofer. Can use any cache with
- get($k)/set($k,$v) methods, including all the Cache and Cache::Cache
- distribution modules plus Cache::Memcached, Cache::FastMmap etc.
- Works for all transports. Overridable per handle.
-
- Added DBI::Util::CacheMemory for use with DBD::Gofer caching.
- It's a very fast and small strict subset of Cache::Memory.
-
-=head2 Changes in DBI 1.59 (svn rev 9874), 23rd August 2007
-
- Fixed DBI::ProfileData to unescape headers lines read from data file.
- Fixed DBI::ProfileData to not clobber $_, thanks to Alexey Tourbin.
- Fixed DBI::SQL::Nano to not clobber $_, thanks to Alexey Tourbin.
- Fixed DBI::PurePerl to return undef for ChildHandles if weaken not available.
- Fixed DBD::Proxy disconnect error thanks to Philip Dye.
- Fixed DBD::Gofer::Transport::Base bug (typo) in timeout code.
- Fixed DBD::Proxy rows method thanks to Philip Dye.
- Fixed dbiprof compile errors, thanks to Alexey Tourbin.
- Fixed t/03handle.t to skip some tests if ChildHandles not available.
-
- Added check_response_sub to DBI::Gofer::Execute
-
-=head2 Changes in DBI 1.58 (svn rev 9678), 25th June 2007
-
- Fixed code triggering fatal error in bleadperl, thanks to Steve Hay.
- Fixed compiler warning thanks to Jerry D. Hedden.
- Fixed t/40profile.t to use int(dbi_time()) for systems like Cygwin where
- time() seems to be rounded not truncated from the high resolution time.
- Removed dump_results() test from t/80proxy.t.
-
-=head2 Changes in DBI 1.57 (svn rev 9639), 13th June 2007
-
- Note: this release includes a change to the DBI::hash() function which will
- now produce different values than before *if* your perl was built with 64-bit
- 'int' type (i.e. "perl -V:intsize" says intsize='8'). It's relatively rare
- for perl to be configured that way, even on 64-bit systems.
-
- Fixed XS versions of select*_*() methods to call execute()
- fetch() etc., with inner handle instead of outer.
- Fixed execute_for_fetch() to not cache errstr values
- thanks to Bart Degryse.
- Fixed unused var compiler warning thanks to JDHEDDEN.
- Fixed t/86gofer_fail tests to be less likely to fail falsely.
-
- Changed DBI::hash to return 'I32' type instead of 'int' so results are
- portable/consistent regardless of size of the int type.
- Corrected timeout example in docs thanks to Egmont Koblinger.
- Changed t/01basic.t to warn instead of failing when it detects
- a problem with Math::BigInt (some recent versions had problems).
-
- Added support for !Time and !Time~N to DBI::Profile Path. See docs.
- Added extra trace info to connect_cached thanks to Walery Studennikov.
- Added non-random (deterministic) mode to DBI_GOFER_RANDOM mechanism.
- Added DBIXS_REVISION macro that drivers can use.
- Added more docs for private_attribute_info() method.
-
- DBI::Profile changes:
- dbi_profile() now returns ref to relevant leaf node.
- Don't profile DESTROY during global destruction.
- Added as_node_path_list() and as_text() methods.
- DBI::ProfileDumper changes:
- Don't write file if there's no profile data.
- Uses full natural precision when saving data (was using %.6f)
- Optimized flush_to_disk().
- Locks the data file while writing.
- Enabled filename to be a code ref for dynamic names.
- DBI::ProfileDumper::Apache changes:
- Added Quiet=>1 to avoid write to STDERR in flush_to_disk().
- Added Dir=>... to specify a writable destination directory.
- Enabled DBI_PROFILE_APACHE_LOG_DIR for mod_perl 1 as well as 2.
- Added parent pid to default data file name.
- DBI::ProfileData changes:
- Added DeleteFiles option to rename & delete files once read.
- Locks the data files while reading.
- Added ability to sort by Path elements.
- dbiprof changes:
- Added --dumpnodes and --delete options.
- Added/updated docs for both DBI::ProfileDumper && ::Apache.
-
-=head2 Changes in DBI 1.56 (svn rev 9660), 18th June 2007
-
- Fixed printf arg warnings thanks to JDHEDDEN.
- Fixed returning driver-private sth attributes via gofer.
-
- Changed pod docs docs to use =head3 instead of =item
- so now in html you get links to individual methods etc.
- Changed default gofer retry_limit from 2 to 0.
- Changed tests to workaround Math::BigInt broken versions.
- Changed dbi_profile_merge() to dbi_profile_merge_nodes()
- old name still works as an alias for the new one.
- Removed old DBI internal sanity check that's no longer valid
- causing "panic: DESTROY (dbih_clearcom)" when tracing enabled
-
- Added DBI_GOFER_RANDOM env var that can be use to trigger random
- failures and delays when executing gofer requests. Designed to help
- test automatic retry on failures and timeout handling.
- Added lots more docs to all the DBD::Gofer and DBI::Gofer classes.
-
-=head2 Changes in DBI 1.55 (svn rev 9504), 4th May 2007
-
- Fixed set_err() so HandleSetErr hook is executed reliably, if set.
- Fixed accuracy of profiling when perl configured to use long doubles.
- Fixed 42prof_data.t on fast systems with poor timers thanks to Malcolm Nooning.
- Fixed potential corruption in selectall_arrayref and selectrow_arrayref
- for compiled drivers, thanks to Rob Davies.
- Rebuild your compiled drivers after installing DBI.
-
- Changed some handle creation code from perl to C code,
- to reduce handle creation cost by ~20%.
- Changed internal implementation of the CachedKids attribute
- so it's a normal handle attribute (and initially undef).
- Changed connect_cached and prepare_cached to avoid a FETCH method call,
- and thereby reduced cost by ~5% and ~30% respectively.
- Changed _set_fbav to not croak when given a wrongly sized array,
- it now warns and adjusts the row buffer to match.
- Changed some internals to improve performance with threaded perls.
- Changed DBD::NullP to be slightly more useful for testing.
- Changed File::Spec prerequisite to not require a minimum version.
- Changed tests to work with other DBMs thanks to ZMAN.
- Changed ex/perl_dbi_nulls_test.pl to be more descriptive.
-
- Added more functionality to the (undocumented) Callback mechanism.
- Callbacks can now elect to provide a value to be returned, in which case
- the method won't be called. A callback for "*" is applied to all methods
- that don't have their own callback.
- Added $h->{ReadOnly} attribute.
- Added support for DBI Profile Path to contain refs to scalars
- which will be de-ref'd for each profile sample.
- Added dbilogstrip utility to edit DBI logs for diff'ing (gets installed)
- Added details for SQLite 3.3 to NULL handling docs thanks to Alex Teslik.
- Added take_imp_data() to DBI::PurePerl.
-
- Gofer related changes:
- Fixed gofer pipeone & stream transports to avoid risk of hanging.
- Improved error handling and tracing significantly.
- Added way to generate random 1-in-N failures for methods.
- Added automatic retry-on-error mechanism to gofer transport base class.
- Added tests to show automatic retry mechanism works a treat!
- Added go_retry_hook callback hook so apps can fine-tune retry behaviour.
- Added header to request and response packets for sanity checking
- and to enable version skew between client and server.
- Added forced_single_resultset, max_cached_sth_per_dbh and max_cached_dbh_per_drh
- to gofer executor config.
- Driver-private methods installed with install_method are now proxied.
- No longer does a round-trip to the server for methods it knows
- have not been overridden by the remote driver.
- Most significant aspects of gofer behaviour are controlled by policy mechanism.
- Added policy-controlled caching of results for some methods, such as schema metadata.
- The connect_cached and prepare_cached methods cache on client and server.
- The bind_param_array and execute_array methods are now supported.
- Worked around a DBD::Sybase bind_param bug (which is fixed in DBD::Sybase 1.07)
- Added goferperf.pl utility (doesn't get installed).
- Many other assorted Gofer related bug fixes, enhancements and docs.
- The http and mod_perl transports have been remove to their own distribution.
- Client and server will need upgrading together for this release.
-
-=head2 Changes in DBI 1.54 (svn rev 9157), 23rd February 2007
-
- NOTE: This release includes the 'next big thing': DBD::Gofer.
- Take a look!
-
- WARNING: This version has some subtle changes in DBI internals.
- It's possible, though doubtful, that some may affect your code.
- I recommend some extra testing before using this release.
- Or perhaps I'm just being over cautious...
-
- Fixed type_info when called for multiple dbh thanks to Cosimo Streppone.
- Fixed compile warnings in bleadperl on freebsd-6.1-release
- and solaris 10g thanks to Philip M. Gollucci.
- Fixed to compile for perl built with -DNO_MATHOMS thanks to Jerry D. Hedden.
- Fixed to work for bleadperl (r29544) thanks to Nicholas Clark.
- Users of Perl >= 5.9.5 will require DBI >= 1.54.
- Fixed rare error when profiling access to $DBI::err etc tied variables.
- Fixed DBI::ProfileDumper to not be affected by changes to $/ and $,
- thanks to Michael Schwern.
-
- Changed t/40profile.t to skip tests for perl < 5.8.0.
- Changed setting trace file to no longer write "Trace file set" to new file.
- Changed 'handle cleared whilst still active' warning for dbh
- to only be given for dbh that have active sth or are not AutoCommit.
- Changed take_imp_data to call finish on all Active child sth.
- Changed DBI::PurePerl trace() method to be more consistent.
- Changed set_err method to effectively not append to errstr if the new errstr
- is the same as the current one.
- Changed handle factory methods, like connect, prepare, and table_info,
- to copy any error/warn/info state of the handle being returned
- up into the handle the method was called on.
- Changed row buffer handling to not alter NUM_OF_FIELDS if it's
- inconsistent with number of elements in row buffer array.
- Updated DBI::DBD docs re handling multiple result sets.
- Updated DBI::DBD docs for driver authors thanks to Ammon Riley
- and Dean Arnold.
- Updated column_info docs to note that if a table doesn't exist
- you get an sth for an empty result set and not an error.
-
- Added new DBD::Gofer 'stateless proxy' driver and framework,
- and the DBI test suite is now also executed via DBD::Gofer,
- and DBD::Gofer+DBI::PurePerl, in addition to DBI::PurePerl.
- Added ability for trace() to support filehandle argument,
- including tracing into a string, thanks to Dean Arnold.
- Added ability for drivers to implement func() method
- so proxy drivers can proxy the func method itself.
- Added SQL_BIGINT type code (resolved to the ODBC/JDBC value (-5))
- Added $h->private_attribute_info method.
-
-=head2 Changes in DBI 1.53 (svn rev 7995), 31st October 2006
-
- Fixed checks for weaken to work with early 5.8.x versions
- Fixed DBD::Proxy handling of some methods, including commit and rollback.
- Fixed t/40profile.t to be more insensitive to long double precision.
- Fixed t/40profile.t to be insensitive to small negative shifts in time
- thanks to Jamie McCarthy.
- Fixed t/40profile.t to skip tests for perl < 5.8.0.
- Fixed to work with current 'bleadperl' (~5.9.5) thanks to Steve Peters.
- Users of Perl >= 5.9.5 will require DBI >= 1.53.
- Fixed to be more robust against drivers not handling multiple result
- sets properly, thanks to Gisle Aas.
-
- Added array context support to execute_array and execute_for_fetch
- methods which returns executed tuples and rows affected.
- Added Tie::Cache::LRU example to docs thanks to Brandon Black.
-
-=head2 Changes in DBI 1.52 (svn rev 6840), 30th July 2006
-
- Fixed memory leak (per handle) thanks to Nicholas Clark and Ephraim Dan.
- Fixed memory leak (16 bytes per sth) thanks to Doru Theodor Petrescu.
- Fixed execute_for_fetch/execute_array to RaiseError thanks to Martin J. Evans.
- Fixed for perl 5.9.4. Users of Perl >= 5.9.4 will require DBI >= 1.52.
-
- Updated DBD::File to 0.35 to match the latest release on CPAN.
-
- Added $dbh->statistics_info specification thanks to Brandon Black.
-
- Many changes and additions to profiling:
- Profile Path can now uses sane strings instead of obscure numbers,
- can refer to attributes, assorted magical values, and even code refs!
- Parsing of non-numeric DBI_PROFILE env var values has changed.
- Changed DBI::Profile docs extensively - many new features.
- See DBI::Profile docs for more information.
-
-=head2 Changes in DBI 1.51 (svn rev 6475), 6th June 2006
-
- Fixed $dbh->clone method 'signature' thanks to Jeffrey Klein.
- Fixed default ping() method to return false if !$dbh->{Active}.
- Fixed t/40profile.t to be insensitive to long double precision.
- Fixed for perl 5.8.0's more limited weaken() function.
- Fixed DBD::Proxy to not alter $@ in disconnect or AUTOLOADd methods.
- Fixed bind_columns() to use return set_err(...) instead of die()
- to report incorrect number of parameters, thanks to Ben Thul.
- Fixed bind_col() to ignore undef as bind location, thanks to David Wheeler.
- Fixed for perl 5.9.x for non-threaded builds thanks to Nicholas Clark.
- Users of Perl >= 5.9.x will require DBI >= 1.51.
- Fixed fetching of rows as hash refs to preserve utf8 on field names
- from $sth->{NAME} thanks to Alexey Gaidukov.
- Fixed build on Win32 (dbd_postamble) thanks to David Golden.
-
- Improved performance for thread-enabled perls thanks to Gisle Aas.
- Drivers can now use PERL_NO_GET_CONTEXT thanks to Gisle Aas.
- Driver authors please read the notes in the DBI::DBD docs.
- Changed DBI::Profile format to always include a percentage,
- if not exiting then uses time between the first and last DBI call.
- Changed DBI::ProfileData to be more forgiving of systems with
- unstable clocks (where time may go backwards occasionally).
- Clarified the 'Subclassing the DBI' docs.
- Assorted minor changes to docs from comments on annocpan.org.
- Changed Makefile.PL to avoid incompatible options for old gcc.
-
- Added 'fetch array of hash refs' example to selectall_arrayref
- docs thanks to Tom Schindl.
- Added docs for $sth->{ParamArrays} thanks to Martin J. Evans.
- Added reference to $DBI::neat_maxlen in TRACING section of docs.
- Added ability for DBI::Profile Path to include attributes
- and a summary of where the code was called from.
-
-=head2 Changes in DBI 1.50 (svn rev 2307), 13 December 2005
-
- Fixed Makefile.PL options for gcc bug introduced in 1.49.
- Fixed handle magic order to keep DBD::Oracle happy.
- Fixed selectrow_array to return empty list on error.
-
- Changed dbi_profile_merge() to be able to recurse and merge
- sub-trees of profile data.
-
- Added documentation for dbi_profile_merge(), including how to
- measure the time spent inside the DBI for an http request.
-
-=head2 Changes in DBI 1.49 (svn rev 2287), 29th November 2005
-
- Fixed assorted attribute handling bugs in DBD::Proxy.
- Fixed croak() in DBD::NullP thanks to Sergey Skvortsov.
- Fixed handling of take_imp_data() and dbi_imp_data attribute.
- Fixed bugs in DBD::DBM thanks to Jeff Zucker.
- Fixed bug in DBI::ProfileDumper thanks to Sam Tregar.
- Fixed ping in DBD::Proxy thanks to George Campbell.
- Fixed dangling ref in $sth after parent $dbh destroyed
- with thanks to il@rol.ru for the bug report #13151
- Fixed prerequisites to include Storable thanks to Michael Schwern.
- Fixed take_imp_data to be more practical.
-
- Change to require perl 5.6.1 (as advertised in 2003) not 5.6.0.
- Changed internals to be more strictly coded thanks to Andy Lester.
- Changed warning about multiple copies of Driver.xst found in @INC
- to ignore duplicated directories thanks to Ed Avis.
- Changed Driver.xst to enable drivers to define an dbd_st_prepare_sv
- function where the statement parameter is an SV. That enables
- compiled drivers to support SQL strings that are UTF-8.
- Changed "use DBI" to only set $DBI::connect_via if not already set.
- Changed docs to clarify pre-method clearing of err values.
-
- Added ability for DBI::ProfileData to edit profile path on loading.
- This enables aggregation of different SQL statements into the same
- profile node - very handy when not using placeholders or when working
- multiple separate tables for the same thing (ie logtable_2005_11_28)
- Added $sth->{ParamTypes} specification thanks to Dean Arnold.
- Added $h->{Callbacks} attribute to enable code hooks to be invoked
- when certain methods are called. For example:
- $dbh->{Callbacks}->{prepare} = sub { ... };
- With thanks to David Wheeler for the kick start.
- Added $h->{ChildHandles} (using weakrefs) thanks to Sam Tregar
- I've recoded it in C so there's no significant performance impact.
- Added $h->{Type} docs (returns 'dr', 'db', or 'st')
- Adding trace message in DESTROY if InactiveDestroy enabled.
- Added %drhs = DBI->installed_drivers();
-
- Ported DBI::ProfileDumper::Apache to mod_perl2 RC5+
- thanks to Philip M. Golluci
-
-=head2 Changes in DBI 1.48 (svn rev 928), 14th March 2005
-
- Fixed DBI::DBD::Metadata generation of type_info_all thanks to Steffen Goeldner
- (driver authors who have used it should rerun it).
-
- Updated docs for NULL Value placeholders thanks to Brian Campbell.
-
- Added multi-keyfield nested hash fetching to fetchall_hashref()
- thanks to Zhuang (John) Li for polishing up my draft.
- Added registered driver prefixes: amzn_ for DBD::Amazon and yaswi_ for DBD::Yaswi.
-
-
-=head2 Changes in DBI 1.47 (svn rev 854), 2nd February 2005
-
- Fixed DBI::ProxyServer to not create pid files by default.
- References: Ubuntu Security Notice USN-70-1, CAN-2005-0077
- Thanks to Javier Fernández-Sanguino Peña from the
- Debian Security Audit Project, and Jonathan Leffler.
- Fixed some tests to work with older Test::More versions.
- Fixed setting $DBI::err/errstr in DBI::PurePerl.
- Fixed potential undef warning from connect_cached().
- Fixed $DBI::lasth handling for DESTROY so lasth points to
- parent even if DESTROY called other methods.
- Fixed DBD::Proxy method calls to not alter $@.
- Fixed DBD::File problem with encoding pragma thanks to Erik Rijkers.
-
- Changed error handling so undef errstr doesn't cause warning.
- Changed DBI::DBD docs to use =head3/=head4 pod thanks to
- Jonathan Leffler. This may generate warnings for perl 5.6.
- Changed DBI::PurePerl to set autoflush on trace filehandle.
- Changed DBD::Proxy to treat Username as a local attribute
- so recent DBI version can be used with old DBI::ProxyServer.
- Changed driver handle caching in DBD::File.
- Added $GetInfoType{SQL_DATABASE_NAME} thanks to Steffen Goeldner.
-
- Updated docs to recommend some common DSN string attributes.
- Updated connect_cached() docs with issues and suggestions.
- Updated docs for NULL Value placeholders thanks to Brian Campbell.
- Updated docs for primary_key_info and primary_keys.
- Updated docs to clarify that the default fetchrow_hashref behaviour,
- of returning a ref to a new hash for each row, will not change.
- Updated err/errstr/state docs for DBD authors thanks to Steffen Goeldner.
- Updated handle/attribute docs for DBD authors thanks to Steffen Goeldner.
- Corrected and updated LongReadLen docs thanks to Bart Lateur.
- Added DBD::JDBC as a registered driver.
-
-=head2 Changes in DBI 1.46 (svn rev 584), 16th November 2004
-
- Fixed parsing bugs in DBI::SQL::Nano thanks to Jeff Zucker.
- Fixed a couple of bad links in docs thanks to Graham Barr.
- Fixed test.pl Win32 undef warning thanks to H.Merijn Brand & David Repko.
- Fixed minor issues in DBI::DBD::Metadata thanks to Steffen Goeldner.
- Fixed DBI::PurePerl neat() to use double quotes for utf8.
-
- Changed execute_array() definition, and default implementation,
- to not consider scalar values for execute tuple count. See docs.
- Changed DBD::File to enable ShowErrorStatement by default,
- which affects DBD::File subclasses such as DBD::CSV and DBD::DBM.
- Changed use DBI qw(:utils) tag to include $neat_maxlen.
- Updated Roadmap and ToDo.
-
- Added data_string_diff() data_string_desc() and data_diff()
- utility functions to help diagnose Unicode issues.
- All can be imported via the use DBI qw(:utils) tag.
-
-=head2 Changes in DBI 1.45 (svn rev 480), 6th October 2004
-
- Fixed DBI::DBD code for drivers broken in 1.44.
- Fixed "Free to wrong pool"/"Attempt to free unreferenced scalar" in FETCH.
-
-=head2 Changes in DBI 1.44 (svn rev 478), 5th October 2004
-
- Fixed build issues on VMS thanks to Jakob Snoer.
- Fixed DBD::File finish() method to return 1 thanks to Jan Dubois.
- Fixed rare core dump during global destruction thanks to Mark Jason Dominus.
- Fixed risk of utf8 flag persisting from one row to the next.
-
- Changed bind_param_array() so it doesn't require all bind arrays
- to have the same number of elements.
- Changed bind_param_array() to error if placeholder number <= 0.
- Changed execute_array() definition, and default implementation,
- to effectively NULL-pad shorter bind arrays.
- Changed execute_array() to return "0E0" for 0 as per the docs.
- Changed execute_for_fetch() definition, and default implementation,
- to return "0E0" for 0 like execute() and execute_array().
- Changed Test::More prerequisite to Test::Simple (which is also the name
- of the distribution both are packaged in) to work around ppm behaviour.
-
- Corrected docs to say that get/set of unknown attribute generates
- a warning and is no longer fatal. Thanks to Vadim.
- Corrected fetchall_arrayref() docs example thanks to Drew Broadley.
-
- Added $h1->swap_inner_handle($h2) sponsored by BizRate.com
-
-
-=head2 Changes in DBI 1.43 (svn rev 377), 2nd July 2004
-
- Fixed connect() and connect_cached() RaiseError/PrintError
- which would sometimes show "(no error string)" as the error.
- Fixed compiler warning thanks to Paul Marquess.
- Fixed "trace level set to" trace message thanks to H.Merijn Brand.
- Fixed DBD::DBM $dbh->{dbm_tables}->{...} to be keyed by the
- table name not the file name thanks to Jeff Zucker.
- Fixed last_insert_id(...) thanks to Rudy Lippan.
- Fixed propagation of scalar/list context into proxied methods.
- Fixed DBI::Profile::DESTROY to not alter $@.
- Fixed DBI::ProfileDumper new() docs thanks to Michael Schwern.
- Fixed _load_class to propagate $@ thanks to Drew Taylor.
- Fixed compile warnings on Win32 thanks to Robert Baron.
- Fixed problem building with recent versions of MakeMaker.
- Fixed DBD::Sponge not to generate warning with threads.
- Fixed DBI_AUTOPROXY to work more than once thanks to Steven Hirsch.
-
- Changed TraceLevel 1 to not show recursive/nested calls.
- Changed getting or setting an invalid attribute to no longer be
- a fatal error but generate a warning instead.
- Changed selectall_arrayref() to call finish() if
- $attr->{MaxRows} is defined.
- Changed all tests to use Test::More and enhanced the tests thanks
- to Stevan Little and Andy Lester. See http://qa.perl.org/phalanx/
- Changed Test::More minimum prerequisite version to 0.40 (2001).
- Changed DBI::Profile header to include the date and time.
-
- Added DBI->parse_dsn($dsn) method.
- Added warning if build directory path contains white space.
- Added docs for parse_trace_flags() and parse_trace_flag().
- Removed "may change" warnings from the docs for table_info(),
- primary_key_info(), and foreign_key_info() methods.
-
-=head2 Changes in DBI 1.42 (svn rev 222), 12th March 2004
-
- Fixed $sth->{NUM_OF_FIELDS} of non-executed statement handle
- to be undef as per the docs (it was 0).
- Fixed t/41prof_dump.t to work with perl5.9.1.
- Fixed DBD_ATTRIB_DELETE macro thanks to Marco Paskamp.
- Fixed DBI::PurePerl looks_like_number() and $DBI::rows.
- Fixed ref($h)->can("foo") to not croak.
-
- Changed attributes (NAME, TYPE etc) of non-executed statement
- handle to be undef instead of triggering an error.
- Changed ShowErrorStatement to apply to more $dbh methods.
- Changed DBI_TRACE env var so just does this at load time:
- DBI->trace(split '=', $ENV{DBI_TRACE}, 2);
- Improved "invalid number of parameters" error message.
- Added DBI::common as base class for DBI::db, DBD::st etc.
- Moved methods common to all handles into DBI::common.
-
- Major tracing enhancement:
-
- Added $h->parse_trace_flags("foo|SQL|7") to map a group of
- trace flags into the corresponding trace flag bits.
- Added automatic calling of parse_trace_flags() if
- setting the trace level to a non-numeric value:
- $h->{TraceLevel}="foo|SQL|7"; $h->trace("foo|SQL|7");
- DBI->connect("dbi:Driver(TraceLevel=SQL|foo):...", ...);
- Currently no trace flags have been defined.
- Added to, and reworked, the trace documentation.
- Added dbivport.h for driver authors to use.
-
- Major driver additions that Jeff Zucker and I have been working on:
-
- Added DBI::SQL::Nano a 'smaller than micro' SQL parser
- with an SQL::Statement compatible API. If SQL::Statement
- is installed then DBI::SQL::Nano becomes an empty subclass
- of SQL::Statement, unless the DBI_SQL_NANO env var is true.
- Added DBD::File, modified to use DBI::SQL::Nano.
- Added DBD::DBM, an SQL interface to DBM files using DBD::File.
-
- Documentation changes:
-
- Corrected typos in docs thanks to Steffen Goeldner.
- Corrected execute_for_fetch example thanks to Dean Arnold.
-
-=head2 Changes in DBI 1.41 (svn rev 130), 22nd February 2004
-
- Fixed execute_for_array() so tuple_status parameter is optional
- as per docs, thanks to Ed Avis.
- Fixed execute_for_array() docs to say that it returns undef if
- any of the execute() calls fail.
- Fixed take_imp_data() test on m68k reported by Christian Hammers.
- Fixed write_typeinfo_pm inconsistencies in DBI::DBD::Metadata
- thanks to Andy Hassall.
- Fixed $h->{TraceLevel} to not return DBI->trace trace level
- which it used to if DBI->trace trace level was higher.
-
- Changed set_err() to append to errstr, with a leading "\n" if it's
- not empty, so that multiple error/warning messages are recorded.
- Changed trace to limit elements dumped when an array reference is
- returned from a method to the max(40, $DBI::neat_maxlen/10)
- so that fetchall_arrayref(), for example, doesn't flood the trace.
- Changed trace level to be a four bit integer (levels 0 thru 15)
- and a set of topic flags (no topics have been assigned yet).
- Changed column_info() to check argument count.
- Extended bind_param() TYPE attribute specification to imply
- standard formating of value, eg SQL_DATE implies 'YYYY-MM-DD'.
-
- Added way for drivers to indicate 'success with info' or 'warning'
- by setting err to "0" for warning and "" for information.
- Both values are false and so don't trigger RaiseError etc.
- Thanks to Steffen Goeldner for the original idea.
- Added $h->{HandleSetErr} = sub { ... } to be called at the
- point that an error, warn, or info state is recorded.
- The code can alter the err, errstr, and state values
- (e.g., to promote an error to a warning, or the reverse).
- Added $h->{PrintWarn} attribute to enable printing of warnings
- recorded by the driver. Defaults to same value as $^W (perl -w).
- Added $h->{ErrCount} attribute, incremented whenever an error is
- recorded by the driver via set_err().
- Added $h->{Executed} attribute, set if do()/execute() called.
- Added \%attr parameter to foreign_key_info() method.
- Added ref count of inner handle to "DESTROY ignored for outer" msg.
- Added Win32 build config checks to DBI::DBD thanks to Andy Hassall.
- Added bind_col to Driver.xst so drivers can define their own.
- Added TYPE attribute to bind_col and specified the expected
- driver behaviour.
-
- Major update to signal handling docs thanks to Lincoln Baxter.
- Corrected dbiproxy usage doc thanks to Christian Hammers.
- Corrected type_info_all index hash docs thanks to Steffen Goeldner.
- Corrected type_info COLUMN_SIZE to chars not bytes thanks to Dean Arnold.
- Corrected get_info() docs to include details of DBI::Const::GetInfoType.
- Clarified that $sth->{PRECISION} is OCTET_LENGTH for char types.
-
-=head2 Changes in DBI 1.40, 7th January 2004
-
- Fixed handling of CachedKids when DESTROYing threaded handles.
- Fixed sql_user_name() in DBI::DBD::Metadata (used by write_getinfo_pm)
- to use $dbh->{Username}. Driver authors please update your code.
-
- Changed connect_cached() when running under Apache::DBI
- to route calls to Apache::DBI::connect().
-
- Added CLONE() to DBD::Sponge and DBD::ExampleP.
- Added warning when starting a new thread about any loaded driver
- which does not have a CLONE() function.
- Added new prepare_cache($sql, \%attr, 3) option to manage Active handles.
- Added SCALE and NULLABLE support to DBD::Sponge.
- Added missing execute() in fetchall_hashref docs thanks to Iain Truskett.
- Added a CONTRIBUTING section to the docs with notes on creating patches.
-
-=head2 Changes in DBI 1.39, 27th November 2003
-
- Fixed STORE to not clear error during nested DBI call, again/better,
- thanks to Tony Bowden for the report and helpful test case.
- Fixed DBI dispatch to not try to use AUTOLOAD for driver methods unless
- the method has been declared (as methods should be when using AUTOLOAD).
- This fixes a problem when the Attribute::Handlers module is loaded.
- Fixed cwd check code to use $Config{path_sep} thanks to Steve Hay.
- Fixed unqualified croak() calls thanks to Steffen Goeldner.
- Fixed DBD::ExampleP TYPE and PRECISION attributes thanks to Tom Lowery.
- Fixed tracing of methods that only get traced at high trace levels.
-
- The level 1 trace no longer includes nested method calls so it generally
- just shows the methods the application explicitly calls.
- Added line to trace log (level>=4) when err/errstr is cleared.
- Updated docs for InactiveDestroy and point out where and when the
- trace includes the process id.
- Update DBI::DBD docs thanks to Steffen Goeldner.
- Removed docs saying that the DBI->data_sources method could be
- passed a $dbh. The $dbh->data_sources method should be used instead.
- Added link to 'DBI recipes' thanks to Giuseppe Maxia:
- http://gmax.oltrelinux.com/dbirecipes.html (note that this
- is not an endorsement that the recipies are 'optimal')
-
- Note: There is a bug in perl 5.8.2 when configured with threads
- and debugging enabled (bug #24463) which causes a DBI test to fail.
-
-=head2 Changes in DBI 1.38, 21th August 2003
-
- NOTE: The DBI now requires perl version 5.6.0 or later.
- (As per notice in DBI 1.33 released 27th February 2003)
-
- Fixed spurious t/03handles failure on 64bit perls reported by H.Merijn Brand.
- Fixed spurious t/15array failure on some perl versions thanks to Ed Avis.
- Fixed build using dmake on windows thanks to Steffen Goeldner.
- Fixed build on using some shells thanks to Gurusamy Sarathy.
- Fixed ParamValues to only be appended to ShowErrorStatement if not empty.
- Fixed $dbh->{Statement} not being writable by drivers in some cases.
- Fixed occasional undef warnings on connect failures thanks to Ed Avis.
- Fixed small memory leak when using $sth->{NAME..._hash}.
- Fixed 64bit warnings thanks to Marian Jancar.
- Fixed DBD::Proxy::db::DESTROY to not alter $@ thanks to Keith Chapman.
- Fixed Makefile.PL status from WriteMakefile() thanks to Leon Brocard.
-
- Changed "Can't set ...->{Foo}: unrecognised attribute" from an error to a
- warning when running with DBI::ProxyServer to simplify upgrades.
- Changed execute_array() to no longer require ArrayTupleStatus attribute.
- Changed DBI->available_drivers to not hide DBD::Sponge.
- Updated/moved placeholder docs to a better place thanks to Johan Vromans.
- Changed dbd_db_do4 api in Driver.xst to match dbd_st_execute (return int,
- not bool), relevant only to driver authors.
- Changed neat(), and thus trace(), so strings marked as utf8 are presented
- in double quotes instead of single quotes and are not sanitized.
-
- Added $dbh->data_sources method.
- Added $dbh->last_insert_id method.
- Added $sth->execute_for_fetch($fetch_tuple_sub, \@tuple_status) method.
- Added DBI->installed_versions thanks to Jeff Zucker.
- Added $DBI::Profile::ON_DESTROY_DUMP variable.
- Added docs for DBD::Sponge thanks to Mark Stosberg.
-
-=head2 Changes in DBI 1.37, 15th May 2003
-
- Fixed "Can't get dbh->{Statement}: unrecognised attribute" error in test
- caused by change to perl internals in 5.8.0
- Fixed to build with latest development perl (5.8.1@19525).
- Fixed C code to use all ANSI declarations thanks to Steven Lembark.
-
-=head2 Changes in DBI 1.36, 11th May 2003
-
- Fixed DBI->connect to carp instead of croak on 'old-style' usage.
- Fixed connect(,,, { RootClass => $foo }) to not croak if module not found.
- Fixed code generated by DBI::DBD::Metadata thanks to DARREN@cpan.org (#2270)
- Fixed DBI::PurePerl to not reset $@ during method dispatch.
- Fixed VMS build thanks to Michael Schwern.
- Fixed Proxy disconnect thanks to Steven Hirsch.
- Fixed error in DBI::DBD docs thanks to Andy Hassall.
-
- Changed t/40profile.t to not require Time::HiRes.
- Changed DBI::ProxyServer to load DBI only on first request, which
- helps threaded server mode, thanks to Bob Showalter.
- Changed execute_array() return value from row count to executed
- tuple count, and now the ArrayTupleStatus attribute is mandatory.
- NOTE: That is an API definition change that may affect your code.
- Changed CompatMode attribute to also disable attribute 'quick FETCH'.
- Changed attribute FETCH to be slightly faster thanks to Stas Bekman.
-
- Added workaround for perl bug #17575 tied hash nested FETCH
- thanks to Silvio Wanka.
- Added Username and Password attributes to connect(..., \%attr) and so
- also embedded in DSN like "dbi:Driver(Username=user,Password=pass):..."
- Username and Password can't contain ")", ",", or "=" characters.
- The predence is DSN first, then \%attr, then $user & $pass parameters,
- and finally the DBI_USER & DBI_PASS environment variables.
- The Username attribute is stored in the $dbh but the Password is not.
- Added ProxyServer HOWTO configure restrictions docs thanks to Jochen Wiedmann.
- Added MaxRows attribute to selectcol_arrayref prompted by Wojciech Pietron.
- Added dump_handle as a method not just a DBI:: utility function.
- Added on-demand by-row data feed into execute_array() using code ref,
- or statement handle. For example, to insert from a select:
- $insert_sth->execute_array( { ArrayTupleFetch => $select_sth, ... } )
- Added warning to trace log when $h->{foo}=... is ignored due to
- invalid prefix (e.g., not 'private_').
-
-=head2 Changes in DBI 1.35, 7th March 2003
-
- Fixed memory leak in fetchrow_hashref introduced in DBI 1.33.
- Fixed various DBD::Proxy errors introduced in DBI 1.33.
- Fixed to ANSI C in dbd_dr_data_sources thanks to Jonathan Leffler.
- Fixed $h->can($method_name) to return correct code ref.
- Removed DBI::Format from distribution as it's now part of the
- separate DBI::Shell distribution by Tom Lowery.
- Updated DBI::DBD docs with a note about the CLONE method.
- Updated DBI::DBD docs thanks to Jonathan Leffler.
- Updated DBI::DBD::Metadata for perl 5.5.3 thanks to Jonathan Leffler.
- Added note to install_method docs about setup_driver() method.
-
-=head2 Changes in DBI 1.34, 28th February 2003
-
- Fixed DBI::DBD docs to refer to DBI::DBD::Metadata thanks to Jonathan Leffler.
- Fixed dbi_time() compile using BorlandC on Windows thanks to Steffen Goeldner.
- Fixed profile tests to do enough work to measure on Windows.
- Fixed disconnect_all() to not be required by drivers.
-
- Added $okay = $h->can($method_name) to check if a method exists.
- Added DBD::*::*->install_method($method_name, \%attr) so driver private
- methods can be 'installed' into the DBI dispatcher and no longer
- need to be called using $h->func(..., $method_name).
-
- Enhanced $dbh->clone() and documentation.
- Enhanced docs to note that dbi_time(), and thus profiling, is limited
- to only millisecond (seconds/1000) resolution on Windows.
- Removed old DBI::Shell from distribution and added Tom Lowery's improved
- version to the Bundle::DBI file.
- Updated minimum version numbers for modules in Bundle::DBI.
-
-=head2 Changes in DBI 1.33, 27th February 2003
-
- NOTE: Future versions of the DBI *will not* support perl 5.6.0 or earlier.
- : Perl 5.6.1 will be the minimum supported version.
-
- NOTE: The "old-style" connect: DBI->connect($database, $user, $pass, $driver);
- : has been deprecated for several years and will now generate a warning.
- : It will be removed in a later release. Please change any old connect() calls.
-
- Added $dbh2 = $dbh1->clone to make a new connection to the database
- that is identical to the original one. clone() can be called even after
- the original handle has been disconnected. See the docs for more details.
-
- Fixed merging of profile data to not sum DBIprof_FIRST_TIME values.
- Fixed unescaping of newlines in DBI::ProfileData thanks to Sam Tregar.
- Fixed Taint bug with fetchrow_hashref with help from Bradley Baetz.
- Fixed $dbh->{Active} for DBD::Proxy, reported by Bob Showalter.
- Fixed STORE to not clear error during nested DBI call,
- thanks to Tony Bowden for the report and helpful test case.
- Fixed DBI::PurePerl error clearing behaviour.
- Fixed dbi_time() and thus DBI::Profile on Windows thanks to Smejkal Petr.
- Fixed problem that meant ShowErrorStatement could show wrong statement,
- thanks to Ron Savage for the report and test case.
- Changed Apache::DBI hook to check for $ENV{MOD_PERL} instead of
- $ENV{GATEWAY_INTERFACE} thanks to Ask Bjoern Hansen.
- No longer tries to dup trace logfp when an interpreter is being cloned.
- Database handles no longer inherit shared $h->err/errstr/state storage
- from their drivers, so each $dbh has it's own $h->err etc. values
- and is no longer affected by calls made on other dbh's.
- Now when a dbh is destroyed it's err/errstr/state values are copied
- up to the driver so checking $DBI::errstr still works as expected.
-
- Build / portability fixes:
- Fixed t/40profile.t to not use Time::HiRes.
- Fixed t/06attrs.t to not be locale sensitive, reported by Christian Hammers.
- Fixed sgi compiler warnings, reported by Paul Blake.
- Fixed build using make -j4, reported by Jonathan Leffler.
- Fixed build and tests under VMS thanks to Craig A. Berry.
-
- Documentation changes:
- Documented $high_resolution_time = dbi_time() function.
- Documented that bind_col() can take an attribute hash.
- Clarified documentation for ParamValues attribute hash keys.
- Many good DBI documentation tweaks from Jonathan Leffler,
- including a major update to the DBI::DBD driver author guide.
- Clarified that execute() should itself call finish() if it's
- called on a statement handle that's still active.
- Clarified $sth->{ParamValues}. Driver authors please note.
- Removed "NEW" markers on some methods and attributes and
- added text to each giving the DBI version it was added in,
- if it was added after DBI 1.21 (Feb 2002).
-
- Changes of note for authors of all drivers:
- Added SQL_DATA_TYPE, SQL_DATETIME_SUB, NUM_PREC_RADIX, and
- INTERVAL_PRECISION fields to docs for type_info_all. There were
- already in type_info(), but type_info_all() didn't specify the
- index values. Please check and update your type_info_all() code.
- Added DBI::DBD::Metadata module that auto-generates your drivers
- get_info and type_info_all data and code, thanks mainly to
- Jonathan Leffler and Steffen Goeldner. If you've not implemented
- get_info and type_info_all methods and your database has an ODBC
- driver available then this will do all the hard work for you!
- Drivers should no longer pass Err, Errstr, or State to _new_drh
- or _new_dbh functions.
- Please check that you support the slightly modified behaviour of
- $sth->{ParamValues}, e.g., always return hash with keys if possible.
-
- Changes of note for authors of compiled drivers:
- Added dbd_db_login6 & dbd_st_finish3 prototypes thanks to Jonathan Leffler.
- All dbd_*_*() functions implemented by drivers must have a
- corresponding #define dbd_*_* <driver_prefix>_*_* otherwise
- the driver may not work with a future release of the DBI.
-
- Changes of note for authors of drivers which use Driver.xst:
- Some new method hooks have been added are are enabled by
- defining corresponding macros:
- $drh->data_sources() - dbd_dr_data_sources
- $dbh->do() - dbd_db_do4
- The following methods won't be compiled into the driver unless
- the corresponding macro has been #defined:
- $drh->disconnect_all() - dbd_discon_all
-
-
-=head2 Changes in DBI 1.32, 1st December 2002
-
- Fixed to work with 5.005_03 thanks to Tatsuhiko Miyagawa (I've not tested it).
- Reenabled taint tests (accidentally left disabled) spotted by Bradley Baetz.
- Improved docs for FetchHashKeyName attribute thanks to Ian Barwick.
- Fixed core dump if fetchrow_hashref given bad argument (name of attribute
- with a value that wasn't an array reference), spotted by Ian Barwick.
- Fixed some compiler warnings thanks to David Wheeler.
- Updated Steven Hirsch's enhanced proxy work (seems I left out a bit).
- Made t/40profile.t tests more reliable, reported by Randy, who is part of
- the excellent CPAN testers team: http://testers.cpan.org/
- (Please visit, see the valuable work they do and, ideally, join in!)
-
-=head2 Changes in DBI 1.31, 29th November 2002
-
- The fetchall_arrayref method, when called with a $maxrows parameter,
- no longer gives an error if called again after all rows have been
- fetched. This simplifies application logic when fetching in batches.
- Also added batch-fetch while() loop example to the docs.
- The proxy now supports non-lazy (synchronous) prepare, positioned
- updates (for selects containing 'for update'), PlRPC config set
- via attributes, and accurate propagation of errors, all thanks
- to Steven Hirsch (plus a minor fix from Sean McMurray and doc
- tweaks from Michael A Chase).
- The DBI_AUTOPROXY env var can now hold the full dsn of the proxy driver
- plus attributes, like "dbi:Proxy(proxy_foo=>1):host=...".
- Added TaintIn & TaintOut attributes to give finer control over
- tainting thanks to Bradley Baetz.
- The RootClass attribute no longer ignores failure to load a module,
- but also doesn't try to load a module if the class already exists,
- with thanks to James FitzGibbon.
- HandleError attribute works for connect failures thanks to David Wheeler.
- The connect() RaiseError/PrintError message now includes the username.
- Changed "last handle unknown or destroyed" warning to be a trace message.
- Removed undocumented $h->event() method.
- Further enhancements to DBD::PurePerl accuracy.
- The CursorName attribute now defaults to undef and not an error.
-
- DBI::Profile changes:
- New DBI::ProfileDumper, DBI::ProfileDumper::Apache, and
- DBI::ProfileData modules (to manage the storage and processing
- of profile data), plus dbiprof program for analyzing profile
- data - with many thanks to Sam Tregar.
- Added $DBI::err (etc) tied variable lookup time to profile.
- Added time for DESTROY method into parent handles profile (used to be ignored).
-
- Documentation changes:
- Documented $dbh = $sth->{Database} attribute.
- Documented $dbh->connected(...) post-connection call when subclassing.
- Updated some minor doc issues thanks to H.Merijn Brand.
- Updated Makefile.PL example in DBI::DBD thanks to KAWAI,Takanori.
- Fixed execute_array() example thanks to Peter van Hardenberg.
-
- Changes for driver authors, not required but strongly recommended:
- Change DBIS to DBIc_DBISTATE(imp_xxh) [or imp_dbh, imp_sth etc]
- Change DBILOGFP to DBIc_LOGPIO(imp_xxh) [or imp_dbh, imp_sth etc]
- Any function from which all instances of DBIS and DBILOGFP are
- removed can also have dPERLINTERP removed (a good thing).
- All use of the DBIh_EVENT* macros should be removed.
- Major update to DBI::DBD docs thanks largely to Jonathan Leffler.
- Add these key values: 'Err' => \my $err, 'Errstr' => \my $errstr,
- to the hash passed to DBI::_new_dbh() in your driver source code.
- That will make each $dbh have it's own $h->err and $h->errstr
- values separate from other $dbh belonging to the same driver.
- If you have a ::db or ::st DESTROY methods that do nothing
- you can now remove them - which speeds up handle destruction.
-
-
-=head2 Changes in DBI 1.30, 18th July 2002
-
- Fixed problems with selectrow_array, selectrow_arrayref, and
- selectall_arrayref introduced in DBI 1.29.
- Fixed FETCHing a handle attribute to not clear $DBI::err etc (broken in 1.29).
- Fixed core dump at trace level 9 or above.
- Fixed compilation with perl 5.6.1 + ithreads (i.e. Windows).
- Changed definition of behaviour of selectrow_array when called in a scalar
- context to match fetchrow_array.
- Corrected selectrow_arrayref docs which showed selectrow_array thanks to Paul DuBois.
-
-=head2 Changes in DBI 1.29, 15th July 2002
-
- NOTE: This release changes the specified behaviour for the
- : fetchrow_array method when called in a scalar context:
- : The DBI spec used to say that it would return the FIRST field.
- : Which field it returns (i.e., the first or the last) is now undefined.
- : This does not affect statements that only select one column, which is
- : usually the case when fetchrow_array is called in a scalar context.
- : FYI, this change was triggered by discovering that the fetchrow_array
- : implementation in Driver.xst (used by most compiled drivers)
- : didn't match the DBI specification. Rather than change the code
- : to match, and risk breaking existing applications, I've changed the
- : specification (that part was always of dubious value anyway).
-
- NOTE: Future versions of the DBI may not support for perl 5.5 much longer.
- : If you are still using perl 5.005_03 you should be making plans to
- : upgrade to at least perl 5.6.1, or 5.8.0. Perl 5.8.0 is due to be
- : released in the next week or so. (Although it's a "point 0" release,
- : it is the most thoroughly tested release ever.)
-
- Added XS/C implementations of selectrow_array, selectrow_arrayref, and
- selectall_arrayref to Driver.xst. See DBI 1.26 Changes for more info.
- Removed support for the old (fatally flawed) "5005" threading model.
- Added support for new perl 5.8 iThreads thanks to Gerald Richter.
- (Threading support and safety should still be regarded as beta
- quality until further notice. But it's much better than it was.)
- Updated the "Threads and Thread Safety" section of the docs.
- The trace output can be sent to STDOUT instead of STDERR by using
- "STDOUT" as the name of the file, i.e., $h->trace(..., "STDOUT")
- Added pointer to perlreftut, perldsc, perllol, and perlboot manuals
- into the intro section of the docs, suggested by Brian McCain.
- Fixed DBI::Const::GetInfo::* pod docs thanks to Zack Weinberg.
- Some changes to how $dbh method calls are treated by DBI::Profile:
- Meta-data methods now clear $dbh->{Statement} on entry.
- Some $dbh methods are now profiled as if $dbh->{Statement} was empty
- (because thet're unlikely to actually relate to its contents).
- Updated dbiport.h to ppport.h from perl 5.8.0.
- Tested with perl 5.5.3 (vanilla, Solaris), 5.6.1 (vanilla, Solaris), and
- perl 5.8.0 (RC3@17527 with iThreads & Multiplicity on Solaris and FreeBSD).
-
-=head2 Changes in DBI 1.28, 14th June 2002
-
- Added $sth->{ParamValues} to return a hash of the most recent
- values bound to placeholders via bind_param() or execute().
- Individual drivers need to be updated to support it.
- Enhanced ShowErrorStatement to include ParamValues if available:
- "DBD::foo::st execute failed: errstr [for statement ``...'' with params: 1='foo']"
- Further enhancements to DBD::PurePerl accuracy.
-
-=head2 Changes in DBI 1.27, 13th June 2002
-
- Fixed missing column in C implementation of fetchall_arrayref()
- thanks to Philip Molter for the prompt reporting of the problem.
-
-=head2 Changes in DBI 1.26, 13th June 2002
-
- Fixed t/40profile.t to work on Windows thanks to Smejkal Petr.
- Fixed $h->{Profile} to return undef, not error, if not set.
- Fixed DBI->available_drivers in scalar context thanks to Michael Schwern.
-
- Added C implementations of selectrow_arrayref() and fetchall_arrayref()
- in Driver.xst. All compiled drivers using Driver.xst will now be
- faster making those calls. Most noticeable with fetchall_arrayref for
- many rows or selectrow_arrayref with a fast query. For example, using
- DBD::mysql a selectrow_arrayref for a single row using a primary key
- is ~20% faster, and fetchall_arrayref for 20000 rows is twice as fast!
- Drivers just need to be recompiled and reinstalled to enable it.
- The fetchall_arrayref speed up only applies if $slice parameter is not used.
- Added $max_rows parameter to fetchall_arrayref() to optionally limit
- the number of rows returned. Can now fetch batches of rows.
- Added MaxRows attribute to selectall_arrayref()
- which then passes it to fetchall_arrayref().
- Changed selectrow_array to make use of selectrow_arrayref.
- Trace level 1 now shows first two parameters of all methods
- (used to only for that for some, like prepare,execute,do etc)
- Trace indicator for recursive calls (first char on trace lines)
- now starts at 1 not 2.
-
- Documented that $h->func() does not trigger RaiseError etc
- so applications must explicitly check for errors.
- DBI::Profile with DBI_PROFILE now shows percentage time inside DBI.
- HandleError docs updated to show that handler can edit error message.
- HandleError subroutine interface is now regarded as stable.
-
-=head2 Changes in DBI 1.25, 5th June 2002
-
- Fixed build problem on Windows and some compiler warnings.
- Fixed $dbh->{Driver} and $sth->{Statement} for driver internals
- These are 'inner' handles as per behaviour prior to DBI 1.16.
- Further minor improvements to DBI::PurePerl accuracy.
-
-=head2 Changes in DBI 1.24, 4th June 2002
-
- Fixed reference loop causing a handle/memory leak
- that was introduced in DBI 1.16.
- Fixed DBI::Format to work with 'filehandles' from IO::Scalar
- and similar modules thanks to report by Jeff Boes.
- Fixed $h->func for DBI::PurePerl thanks to Jeff Zucker.
- Fixed $dbh->{Name} for DBI::PurePerl thanks to Dean Arnold.
-
- Added DBI method call profiling and benchmarking.
- This is a major new addition to the DBI.
- See $h->{Profile} attribute and DBI::Profile module.
- For a quick trial, set the DBI_PROFILE environment variable and
- run your favourite DBI script. Try it with DBI_PROFILE set to 1,
- then try 2, 4, 8, 10, and -10. Have fun!
-
- Added execute_array() and bind_param_array() documentation
- with thanks to Dean Arnold.
- Added notes about the DBI having not yet been tested with iThreads
- (testing and patches for SvLOCK etc welcome).
- Removed undocumented Handlers attribute (replaced by HandleError).
- Tested with 5.5.3 and 5.8.0 RC1.
-
-=head2 Changes in DBI 1.23, 25th May 2002
-
- Greatly improved DBI::PurePerl in performance and accuracy.
- Added more detail to DBI::PurePerl docs about what's not supported.
- Fixed undef warnings from t/15array.t and DBD::Sponge.
-
-=head2 Changes in DBI 1.22, 22nd May 2002
-
- Added execute_array() and bind_param_array() with special thanks
- to Dean Arnold. Not yet documented. See t/15array.t for examples.
- All drivers now automatically support these methods.
- Added DBI::PurePerl, a transparent DBI emulation for pure-perl drivers
- with special thanks to Jeff Zucker. Perldoc DBI::PurePerl for details.
- Added DBI::Const::GetInfo* modules thanks to Steffen Goeldner.
- Added write_getinfo_pm utility to DBI::DBD thanks to Steffen Goeldner.
- Added $allow_active==2 mode for prepare_cached() thanks to Stephen Clouse.
-
- Updated DBI::Format to Revision 11.4 thanks to Tom Lowery.
- Use File::Spec in Makefile.PL (helps VMS etc) thanks to Craig Berry.
- Extend $h->{Warn} to commit/rollback ineffective warning thanks to Jeff Baker.
- Extended t/preparse.t and removed "use Devel::Peek" thanks to Scott Hildreth.
- Only copy Changes to blib/lib/Changes.pm once thanks to Jonathan Leffler.
- Updated internals for modern perls thanks to Jonathan Leffler and Jeff Urlwin.
- Tested with perl 5.7.3 (just using default perl config).
-
- Documentation changes:
-
- Added 'Catalog Methods' section to docs thanks to Steffen Goeldner.
- Updated README thanks to Michael Schwern.
- Clarified that driver may choose not to start new transaction until
- next use of $dbh after commit/rollback.
- Clarified docs for finish method.
- Clarified potentials problems with prepare_cached() thanks to Stephen Clouse.
-
-
-=head2 Changes in DBI 1.21, 7th February 2002
-
- The minimum supported perl version is now 5.005_03.
-
- Fixed DBD::Proxy support for AutoCommit thanks to Jochen Wiedmann.
- Fixed DBI::ProxyServer bind_param(_inout) handing thanks to Oleg Mechtcheriakov.
- Fixed DBI::ProxyServer fetch loop thanks to nobull@mail.com.
- Fixed install_driver do-the-right-thing with $@ on error. It, and connect(),
- will leave $@ empty on success and holding the error message on error.
- Thanks to Jay Lawrence, Gavin Sherlock and others for the bug report.
- Fixed fetchrow_hashref to assign columns to the hash left-to-right
- so later fields with the same name overwrite earlier ones
- as per DBI < 1.15, thanks to Kay Roepke.
-
- Changed tables() to use quote_indentifier() if the driver returns a
- true value for $dbh->get_info(29) # SQL_IDENTIFIER_QUOTE_CHAR
- Changed ping() so it no longer triggers RaiseError/PrintError.
- Changed connect() to not call $class->install_driver unless needed.
- Changed DESTROY to catch fatal exceptions and append to $@.
-
- Added ISO SQL/CLI & ODBCv3 data type definitions thanks to Steffen Goeldner.
- Removed the definition of SQL_BIGINT data type constant as the value is
- inconsistent between standards (ODBC=-5, SQL/CLI=25).
- Added $dbh->column_info(...) thanks to Steffen Goeldner.
- Added $dbh->foreign_key_info(...) thanks to Steffen Goeldner.
- Added $dbh->quote_identifier(...) insipred by Simon Oliver.
- Added $dbh->set_err(...) for DBD authors and DBI subclasses
- (actually been there for a while, now expanded and documented).
- Added $h->{HandleError} = sub { ... } addition and/or alternative
- to RaiseError/PrintError. See the docs for more info.
- Added $h->{TraceLevel} = N attribute to set/get trace level of handle
- thus can set trace level via an (eg externally specified) DSN
- using the embedded attribute syntax:
- $dsn = 'dbi:DB2(PrintError=1,TraceLevel=2):dbname';
- Plus, you can also now do: local($h->{TraceLevel}) = N;
- (but that leaks a little memory in some versions of perl).
- Added some call tree information to trace output if trace level >= 3
- With thanks to Graham Barr for the stack walking code.
- Added experimental undocumented $dbh->preparse(), see t/preparse.t
- With thanks to Scott T. Hildreth for much of the work.
- Added Fowler/Noll/Vo hash type as an option to DBI::hash().
-
- Documentation changes:
-
- Added DBI::Changes so now you can "perldoc DBI::Changes", yeah!
- Added selectrow_arrayref & selectrow_hashref docs thanks to Doug Wilson.
- Added 'Standards Reference Information' section to docs to gather
- together all references to relevant on-line standards.
- Added link to poop.sourceforge.net into the docs thanks to Dave Rolsky.
- Added link to hyperlinked BNF for SQL92 thanks to Jeff Zucker.
- Added 'Subclassing the DBI' docs thanks to Stephen Clouse, and
- then changed some of them to reflect the new approach to subclassing.
- Added stronger wording to description of $h->{private_*} attributes.
- Added docs for DBI::hash.
-
- Driver API changes:
-
- Now a COPY of the DBI->connect() attributes is passed to the driver
- connect() method, so it can process and delete any elements it wants.
- Deleting elements reduces/avoids the explicit
- $dbh->{$_} = $attr->{$_} foreach keys %$attr;
- that DBI->connect does after the driver connect() method returns.
-
-
-=head2 Changes in DBI 1.20, 24th August 2001
-
- WARNING: This release contains two changes that may affect your code.
- : Any code using selectall_hashref(), which was added in March 2001, WILL
- : need to be changed. Any code using fetchall_arrayref() with a non-empty
- : hash slice parameter may, in a few rare cases, need to be changed.
- : See the change list below for more information about the changes.
- : See the DBI documentation for a description of current behaviour.
-
- Fixed memory leak thanks to Toni Andjelkovic.
- Changed fetchall_arrayref({ foo=>1, ...}) specification again (sorry):
- The key names of the returned hashes is identical to the letter case of
- the names in the parameter hash, regardless of the L</FetchHashKeyName>
- attribute. The letter case is ignored for matching.
- Changed fetchall_arrayref([...]) array slice syntax specification to
- clarify that the numbers in the array slice are perl index numbers
- (which start at 0) and not column numbers (which start at 1).
- Added { Columns=>... } and { Slice =>... } attributes to selectall_arrayref()
- which is passed to fetchall_arrayref() so it can fetch hashes now.
- Added a { Columns => [...] } attribute to selectcol_arrayref() so that
- the list it returns can be built from more than one column per row.
- Why? Consider my %hash = @{$dbh->selectcol_arrayref($sql,{ Columns=>[1,2]})}
- to return id-value pairs which can be used directly to build a hash.
- Added $hash_ref = $sth->fetchall_hashref( $key_field )
- which returns a ref to a hash with, typically, one element per row.
- $key_field is the name of the field to get the key for each row from.
- The value of the hash for each row is a hash returned by fetchrow_hashref.
- Changed selectall_hashref to return a hash ref (from fetchall_hashref)
- and not an array of hashes as it has since DBI 1.15 (end March 2001).
- WARNING: THIS CHANGE WILL BREAK ANY CODE USING selectall_hashref()!
- Sorry, but I think this is an important regularization of the API.
- To get previous selectall_hashref() behaviour (an array of hash refs)
- change $ary_ref = $dbh->selectall_hashref( $statement, undef, @bind);
- to $ary_ref = $dbh->selectall_arrayref($statement, { Columns=>{} }, @bind);
- Added NAME_lc_hash, NAME_uc_hash, NAME_hash statement handle attributes.
- which return a ref to a hash of field_name => field_index (0..n-1) pairs.
- Fixed select_hash() example thanks to Doug Wilson.
- Removed (unbundled) DBD::ADO and DBD::Multiplex from the DBI distribution.
- The latest versions of those modules are available from CPAN sites.
- Added $dbh->begin_work. This method causes AutoCommit to be turned
- off just until the next commit() or rollback().
- Driver authors: if the DBIcf_BegunWork flag is set when your commit or
- rollback method is called then please turn AutoCommit on and clear the
- DBIcf_BegunWork flag. If you don't then the DBI will but it'll be much
- less efficient and won't handle error conditions very cleanly.
- Retested on perl 5.4.4, but the DBI won't support 5.4.x much longer.
- Added text to SUPPORT section of the docs:
- For direct DBI and DBD::Oracle support, enhancement, and related work
- I am available for consultancy on standard commercial terms.
- Added text to ACKNOWLEDGEMENTS section of the docs:
- Much of the DBI and DBD::Oracle was developed while I was Technical
- Director (CTO) of the Paul Ingram Group (www.ig.co.uk). So I'd
- especially like to thank Paul for his generosity and vision in
- supporting this work for many years.
-
-=head2 Changes in DBI 1.19, 20th July 2001
-
- Made fetchall_arrayref({ foo=>1, ...}) be more strict to the specification
- in relation to wanting hash slice keys to be lowercase names.
- WARNING: If you've used fetchall_arrayref({...}) with a hash slice
- that contains keys with uppercase letters then your code will break.
- (As far as I recall the spec has always said don't do that.)
- Fixed $sth->execute() to update $dbh->{Statement} to $sth->{Statement}.
- Added row number to trace output for fetch method calls.
- Trace level 1 no longer shows fetches with row>1 (to reduce output volume).
- Added $h->{FetchHashKeyName} = 'NAME_lc' or 'NAME_uc' to alter
- behaviour of fetchrow_hashref() method. See docs.
- Added type_info quote caching to quote() method thanks to Dean Kopesky.
- Makes using quote() with second data type param much much faster.
- Added type_into_all() caching to type_info(), spotted by Dean Kopesky.
- Added new API definition for table_info() and tables(),
- driver authors please note!
- Added primary_key_info() to DBI API thanks to Steffen Goeldner.
- Added primary_key() to DBI API as simpler interface to primary_key_info().
- Indent and other fixes for DBI::DBD doc thanks to H.Merijn Brand.
- Added prepare_cached() insert_hash() example thanks to Doug Wilson.
- Removed false docs for fetchall_hashref(), use fetchall_arrayref({}).
-
-=head2 Changes in DBI 1.18, 4th June 2001
-
- Fixed that altering ShowErrorStatement also altered AutoCommit!
- Thanks to Jeff Boes for spotting that clanger.
- Fixed DBD::Proxy to handle commit() and rollback(). Long overdue, sorry.
- Fixed incompatibility with perl 5.004 (but no one's using that right? :)
- Fixed connect_cached and prepare_cached to not be affected by the order
- of elements in the attribute hash. Spotted by Mitch Helle-Morrissey.
- Fixed version number of DBI::Shell
- reported by Stuhlpfarrer Gerhard and others.
- Defined and documented table_info() attribute semantics (ODBC compatible)
- thanks to Olga Voronova, who also implemented then in DBD::Oracle.
- Updated Win32::DBIODBC (Win32::ODBC emulation) thanks to Roy Lee.
-
-=head2 Changes in DBI 1.16, 30th May 2001
-
- Reimplemented fetchrow_hashref in C, now fetches about 25% faster!
- Changed behaviour if both PrintError and RaiseError are enabled
- to simply do both (in that order, obviously :)
- Slight reduction in DBI handle creation overhead.
- Fixed $dbh->{Driver} & $sth->{Database} to return 'outer' handles.
- Fixed execute param count check to honour RaiseError spotted by Belinda Giardie.
- Fixed build for perl5.6.1 with PERLIO thanks to H.Merijn Brand.
- Fixed client sql restrictions in ProxyServer.pm thanks to Jochen Wiedmann.
- Fixed batch mode command parsing in Shell thanks to Christian Lemburg.
- Fixed typo in selectcol_arrayref docs thanks to Jonathan Leffler.
- Fixed selectrow_hashref to be available to callers thanks to T.J.Mather.
- Fixed core dump if statement handle didn't define Statement attribute.
- Added bind_param_inout docs to DBI::DBD thanks to Jonathan Leffler.
- Added note to data_sources() method docs that some drivers may
- require a connected database handle to be supplied as an attribute.
- Trace of install_driver method now shows path of driver file loaded.
- Changed many '||' to 'or' in the docs thanks to H.Merijn Brand.
- Updated DBD::ADO again (improvements in error handling) from Tom Lowery.
- Updated Win32::DBIODBC (Win32::ODBC emulation) thanks to Roy Lee.
- Updated email and web addresses in DBI::FAQ thanks to Michael A Chase.
-
-=head2 Changes in DBI 1.15, 28th March 2001
-
- Added selectrow_arrayref
- Added selectrow_hashref
- Added selectall_hashref thanks to Leon Brocard.
- Added DBI->connect(..., { dbi_connect_method => 'method' })
- Added $dbh->{Statement} aliased to most recent child $sth->{Statement}.
- Added $h->{ShowErrorStatement}=1 to cause the appending of the
- relevant Statement text to the RaiseError/PrintError text.
- Modified type_info to always return hash keys in uppercase and
- to not require uppercase 'DATA_TYPE' key from type_info_all.
- Thanks to Jennifer Tong and Rob Douglas.
- Added \%attr param to tables() and table_info() methods.
- Trace method uses warn() if it can't open the new file.
- Trace shows source line and filename during global destruction.
- Updated packages:
- Updated Win32::DBIODBC (Win32::ODBC emulation) thanks to Roy Lee.
- Updated DBD::ADO to much improved version 0.4 from Tom Lowery.
- Updated DBD::Sponge to include $sth->{PRECISION} thanks to Tom Lowery.
- Changed DBD::ExampleP to use lstat() instead of stat().
- Documentation:
- Documented $DBI::lasth (which has been there since day 1).
- Documented SQL_* names.
- Clarified and extended docs for $h->state thanks to Masaaki Hirose.
- Clarified fetchall_arrayref({}) docs (thanks to, er, someone!).
- Clarified type_info_all re lettercase and index values.
- Updated DBI::FAQ to 0.38 thanks to Alligator Descartes.
- Added cute bind_columns example thanks to H.Merijn Brand.
- Extended docs on \%attr arg to data_sources method.
- Makefile.PL
- Removed obscure potential 'rm -rf /' (thanks to Ulrich Pfeifer).
- Removed use of glob and find (thanks to Michael A. Chase).
- Proxy:
- Removed debug messages from DBD::Proxy AUTOLOAD thanks to Brian McCauley.
- Added fix for problem using table_info thanks to Tom Lowery.
- Added better determination of where to put the pid file, and...
- Added KNOWN ISSUES section to DBD::Proxy docs thanks to Jochen Wiedmann.
- Shell:
- Updated DBI::Format to include DBI::Format::String thanks to Tom Lowery.
- Added describe command thanks to Tom Lowery.
- Added columnseparator option thanks to Tom Lowery (I think).
- Added 'raw' format thanks to, er, someone, maybe Tom again.
- Known issues:
- Perl 5.005 and 5.006 both leak memory doing local($handle->{Foo}).
- Perl 5.004 doesn't. The leak is not a DBI or driver bug.
-
-=head2 Changes in DBI 1.14, 14th June 2000
-
- NOTE: This version is the one the DBI book is based on.
- NOTE: This version requires at least Perl 5.004.
- Perl 5.6 ithreads changes with thanks to Doug MacEachern.
- Changed trace output to use PerlIO thanks to Paul Moore.
- Fixed bug in RaiseError/PrintError handling.
- (% chars in the error string could cause a core dump.)
- Fixed Win32 PerlEx IIS concurrency bugs thanks to Murray Nesbitt.
- Major documentation polishing thanks to Linda Mui at O'Reilly.
- Password parameter now shown as **** in trace output.
- Added two fields to type_info and type_info_all.
- Added $dsn to PrintError/RaiseError message from DBI->connect().
- Changed prepare_cached() croak to carp if sth still Active.
- Added prepare_cached() example to the docs.
- Added further DBD::ADO enhancements from Thomas Lowery.
-
-=head2 Changes in DBI 1.13, 11th July 1999
-
- Fixed Win32 PerlEx IIS concurrency bugs thanks to Murray Nesbitt.
- Fixed problems with DBD::ExampleP long_list test mode.
- Added SQL_WCHAR SQL_WVARCHAR SQL_WLONGVARCHAR and SQL_BIT
- to list of known and exportable SQL types.
- Improved data fetch performance of DBD::ADO.
- Added GetTypeInfo to DBD::ADO thanks to Thomas Lowery.
- Actually documented connect_cached thanks to Michael Schwern.
- Fixed user/key/cipher bug in ProxyServer thanks to Joshua Pincus.
-
-=head2 Changes in DBI 1.12, 29th June 1999
-
- Fixed significant DBD::ADO bug (fetch skipped first row).
- Fixed ProxyServer bug handling non-select statements.
- Fixed VMS problem with t/examp.t thanks to Craig Berry.
- Trace only shows calls to trace_msg and _set_fbav at high levels.
- Modified t/examp.t to workaround Cygwin buffering bug.
-
-=head2 Changes in DBI 1.11, 17th June 1999
-
- Fixed bind_columns argument checking to allow a single arg.
- Fixed problems with internal default_user method.
- Fixed broken DBD::ADO.
- Made default $DBI::rows more robust for some obscure cases.
-
-=head2 Changes in DBI 1.10, 14th June 1999
-
- Fixed trace_msg.al error when using Apache.
- Fixed dbd_st_finish enhancement in Driver.xst (internals).
- Enable drivers to define default username and password
- and temporarily disabled warning added in 1.09.
- Thread safety optimised for single thread case.
-
-=head2 Changes in DBI 1.09, 9th June 1999
-
- Added optional minimum trace level parameter to trace_msg().
- Added warning in Makefile.PL that DBI will require 5.004 soon.
- Added $dbh->selectcol_arrayref($statement) method.
- Fixed fetchall_arrayref hash-slice mode undef NAME problem.
- Fixed problem with tainted parameter checking and t/examp.t.
- Fixed problem with thread safety code, including 64 bit machines.
- Thread safety now enabled by default for threaded perls.
- Enhanced code for MULTIPLICITY/PERL_OBJECT from ActiveState.
- Enhanced prepare_cached() method.
- Minor changes to trace levels (less internal info at level 2).
- Trace log now shows "!! ERROR..." before the "<- method" line.
- DBI->connect() now warn's if user / password is undefined and
- DBI_USER / DBI_PASS environment variables are not defined.
- The t/proxy.t test now ignores any /etc/dbiproxy.conf file.
- Added portability fixes for MacOS from Chris Nandor.
- Updated mailing list address from fugue.com to isc.org.
-
-=head2 Changes in DBI 1.08, 12th May 1999
-
- Much improved DBD::ADO driver thanks to Phlip Plumlee and others.
- Connect now allows you to specify attribute settings within the DSN
- E.g., "dbi:Driver(RaiseError=>1,Taint=>1,AutoCommit=>0):dbname"
- The $h->{Taint} attribute now also enables taint checking of
- arguments to almost all DBI methods.
- Improved trace output in various ways.
- Fixed bug where $sth->{NAME_xx} was undef in some situations.
- Fixed code for MULTIPLICITY/PERL_OBJECT thanks to Alex Smishlajev.
- Fixed and documented DBI->connect_cached.
- Workaround for Cygwin32 build problem with help from Jong-Pork Park.
- bind_columns no longer needs undef or hash ref as first parameter.
-
-=head2 Changes in DBI 1.07, 6th May 1999
-
- Trace output now shows contents of array refs returned by DBI.
- Changed names of some result columns from type_info, type_info_all,
- tables and table_info to match ODBC 3.5 / ISO/IEC standards.
- Many fixes for DBD::Proxy and ProxyServer.
- Fixed error reporting in install_driver.
- Major enhancement to DBI::W32ODBC from Patrick Hollins.
- Added $h->{Taint} to taint fetched data if tainting (perl -T).
- Added code for MULTIPLICITY/PERL_OBJECT contributed by ActiveState.
- Added $sth->more_results (undocumented for now).
-
-=head2 Changes in DBI 1.06, 6th January 1999
-
- Fixed Win32 Makefile.PL problem in 1.04 and 1.05.
- Significant DBD::Proxy enhancements and fixes
- including support for bind_param_inout (Jochen and I)
- Added experimental DBI->connect_cached method.
- Added $sth->{NAME_uc} and $sth->{NAME_lc} attributes.
- Enhanced fetchrow_hashref to take an attribute name arg.
-
-=head2 Changes in DBI 1.05, 4th January 1999
-
- Improved DBD::ADO connect (thanks to Phlip Plumlee).
- Improved thread safety (thanks to Jochen Wiedmann).
- [Quick release prompted by truncation of copies on CPAN]
-
-=head2 Changes in DBI 1.04, 3rd January 1999
-
- Fixed error in Driver.xst. DBI build now tests Driver.xst.
- Removed unused variable compiler warnings in Driver.xst.
- DBI::DBD module now tested during DBI build.
- Further clarification in the DBI::DBD driver writers manual.
- Added optional name parameter to $sth->fetchrow_hashref.
-
-=head2 Changes in DBI 1.03, 1st January 1999
-
- Now builds with Perl>=5.005_54 (PERL_POLLUTE in DBIXS.h)
- DBI trace trims path from "at yourfile.pl line nnn".
- Trace level 1 now shows statement passed to prepare.
- Assorted improvements to the DBI manual.
- Assorted improvements to the DBI::DBD driver writers manual.
- Fixed $dbh->quote prototype to include optional $data_type.
- Fixed $dbh->prepare_cached problems.
- $dbh->selectrow_array behaves better in scalar context.
- Added a (very) experimental DBD::ADO driver for Win32 ADO.
- Added experimental thread support (perl Makefile.PL -thread).
- Updated the DBI::FAQ - thanks to Alligator Descartes.
- The following changes were implemented and/or packaged
- by Jochen Wiedmann - thanks Jochen:
- Added a Bundle for CPAN installation of DBI, the DBI proxy
- server and prerequisites (lib/Bundle/DBI.pm).
- DBI->available_drivers uses File::Spec, if available.
- This makes it work on MacOS. (DBI.pm)
- Modified type_info to work with read-only values returned
- by type_info_all. (DBI.pm)
- Added handling of magic values in $sth->execute,
- $sth->bind_param and other methods (Driver.xst)
- Added Perl's CORE directory to the linkers path on Win32,
- required by recent versions of ActiveState Perl.
- Fixed DBD::Sponge to work with empty result sets.
- Complete rewrite of DBI::ProxyServer and DBD::Proxy.
-
-=head2 Changes in DBI 1.02, 2nd September 1998
-
- Fixed DBI::Shell including @ARGV and /current.
- Added basic DBI::Shell test.
- Renamed DBI::Shell /display to /format.
-
-=head2 Changes in DBI 1.01, 2nd September 1998
-
- Many enhancements to Shell (with many contributions from
- Jochen Wiedmann, Tom Lowery and Adam Marks).
- Assorted fixes to DBD::Proxy and DBI::ProxyServer.
- Tidied up trace messages - trace(2) much cleaner now.
- Added $dbh->{RowCacheSize} and $sth->{RowsInCache}.
- Added experimental DBI::Format (mainly for DBI::Shell).
- Fixed fetchall_arrayref($slice_hash).
- DBI->connect now honours PrintError=1 if connect fails.
- Assorted clarifications to the docs.
-
-=head2 Changes in DBI 1.00, 14th August 1998
-
- The DBI is no longer 'alpha' software!
- Added $dbh->tables and $dbh->table_info.
- Documented \%attr arg to data_sources method.
- Added $sth->{TYPE}, $sth->{PRECISION} and $sth->{SCALE}.
- Added $sth->{Statement}.
- DBI::Shell now uses neat_list to print results
- It also escapes "'" chars and converts newlines to spaces.
-
-=head2 Changes in DBI 0.95, 10th August 1998
-
- WARNING: THIS IS AN EXPERIMENTAL RELEASE!
-
- Fixed 0.94 slip so it will build on pre-5.005 again.
- Added DBI_AUTOPROXY environment variable.
- Array ref returned from fetch/fetchrow_arrayref now readonly.
- Improved connect error reporting by DBD::Proxy.
- All trace/debug messages from DBI now go to trace file.
-
-=head2 Changes in DBI 0.94, 9th August 1998
-
- WARNING: THIS IS AN EXPERIMENTAL RELEASE!
-
- Added DBD::Shell and dbish interactive DBI shell. Try it!
- Any database attribs can be set via DBI->connect(,,, \%attr).
- Added _get_fbav and _set_fbav methods for Perl driver developers
- (see ExampleP driver for perl usage). Drivers which don't use
- one of these methods (either via XS or Perl) are not compliant.
- DBI trace now shows adds " at yourfile.pl line nnn"!
- PrintError and RaiseError now prepend driver and method name.
- The available_drivers method no longer returns NullP or Sponge.
- Added $dbh->{Name}.
- Added $dbh->quote($value, $data_type).
- Added more hints to install_driver failure message.
- Added DBD::Proxy and DBI::ProxyServer (from Jochen Wiedmann).
- Added $DBI::neat_maxlen to control truncation of trace output.
- Added $dbh->selectall_arrayref and $dbh->selectrow_array methods.
- Added $dbh->tables.
- Added $dbh->type_info and $dbh->type_info_all.
- Added $h->trace_msg($msg) to write to trace log.
- Added @bool = DBI::looks_like_number(@ary).
- Many assorted improvements to the DBI docs.
-
-=head2 Changes in DBI 0.93, 13th February 1998
-
- Fixed DBI::DBD::dbd_postamble bug causing 'Driver.xsi not found' errors.
- Changes to handling of 'magic' values in neatsvpv (used by trace).
- execute (in Driver.xst) stops binding after first bind error.
- This release requires drivers to be rebuilt.
-
-=head2 Changes in DBI 0.92, 3rd February 1998
-
- Fixed per-handle memory leak (with many thanks to Irving Reid).
- Added $dbh->prepare_cached() caching variant of $dbh->prepare.
- Added some attributes:
- $h->{Active} is the handle 'Active' (vague concept) (boolean)
- $h->{Kids} e.g. number of sth's associated with a dbh
- $h->{ActiveKids} number of the above which are 'Active'
- $dbh->{CachedKids} ref to prepare_cached sth cache
- Added support for general-purpose 'private_' attributes.
- Added experimental support for subclassing the DBI: see t/subclass.t
- Added SQL_ALL_TYPES to exported :sql_types.
- Added dbd_dbi_dir() and dbd_dbi_arch_dir() to DBI::DBD module so that
- DBD Makefile.PLs can work with the DBI installed in non-standard locations.
- Fixed 'Undefined value' warning and &sv_no output from neatsvpv/trace.
- Fixed small 'once per interpreter' leak.
- Assorted minor documentation fixes.
-
-=head2 Changes in DBI 0.91, 10th December 1997
-
- NOTE: This fix may break some existing scripts:
- DBI->connect("dbi:...",$user,$pass) was not setting AutoCommit and PrintError!
- DBI->connect(..., { ... }) no longer sets AutoCommit or PrintError twice.
- DBI->connect(..., { RaiseError=>1 }) now croaks if connect fails.
- Fixed $fh parameter of $sth->dump_results;
- Added default statement DESTROY method which carps.
- Added default driver DESTROY method to silence AUTOLOAD/__DIE__/CGI::Carp
- Added more SQL_* types to %EXPORT_TAGS and @EXPORT_OK.
- Assorted documentation updates (mainly clarifications).
- Added workaround for perl's 'sticky lvalue' bug.
- Added better warning for bind_col(umns) where fields==0.
- Fixed to build okay with 5.004_54 with or without USE_THREADS.
- Note that the DBI has not been tested for thread safety yet.
-
-=head2 Changes in DBI 0.90, 6th September 1997
-
- Can once again be built with Perl 5.003.
- The DBI class can be subclassed more easily now.
- InactiveDestroy fixed for drivers using the *.xst template.
- Slightly faster handle creation.
- Changed prototype for dbd_*_*_attrib() to add extra param.
- Note: 0.90, 0.89 and possibly some other recent versions have
- a small memory leak. This will be fixed in the next release.
-
-=head2 Changes in DBI 0.89, 25th July 1997
-
- Minor fix to neatsvpv (mainly used for debug trace) to workaround
- bug in perl where SvPV removes IOK flag from an SV.
- Minor updates to the docs.
-
-=head2 Changes in DBI 0.88, 22nd July 1997
-
- Fixed build for perl5.003 and Win32 with Borland.
- Fixed documentation formatting.
- Fixed DBI_DSN ignored for old-style connect (with explicit driver).
- Fixed AutoCommit in DBD::ExampleP
- Fixed $h->trace.
- The DBI can now export SQL type values: use DBI ':sql_types';
- Modified Driver.xst and renamed DBDI.h to dbd_xsh.h
-
-=head2 Changes in DBI 0.87, 18th July 1997
-
- Fixed minor type clashes.
- Added more docs about placeholders and bind values.
-
-=head2 Changes in DBI 0.86, 16th July 1997
-
- Fixed failed connect causing 'unblessed ref' and other errors.
- Drivers must handle AutoCommit FETCH and STORE else DBI croaks.
- Added $h->{LongReadLen} and $h->{LongTruncOk} attributes for BLOBS.
- Added DBI_USER and DBI_PASS env vars. See connect docs for usage.
- Added DBI->trace() to set global trace level (like per-handle $h->trace).
- PERL_DBI_DEBUG env var renamed DBI_DEBUG (old name still works for now).
- Updated docs, including commit, rollback, AutoCommit and Transactions sections.
- Added bind_param method and execute(@bind_values) to docs.
- Fixed fetchall_arrayref.
-
- Since the DBIS structure has change the internal version numbers have also
- changed (DBIXS_VERSION == 9 and DBISTATE_VERSION == 9) so drivers will have
- to be recompiled. The test is also now more sensitive and the version
- mismatch error message now more clear about what to do. Old drivers are
- likely to core dump (this time) until recompiled for this DBI. In future
- DBI/DBD version mismatch will always produce a clear error message.
-
- Note that this DBI release contains and documents many new features
- that won't appear in drivers for some time. Driver writers might like
- to read perldoc DBI::DBD and comment on or apply the information given.
-
-=head2 Changes in DBI 0.85, 25th June 1997
-
- NOTE: New-style connect now defaults to AutoCommit mode unless
- { AutoCommit => 0 } specified in connect attributes. See the docs.
- AutoCommit attribute now defined and tracked by DBI core.
- Drivers should use/honour this and not implement their own.
- Added pod doc changes from Andreas and Jonathan.
- New DBI_DSN env var default for connect method. See docs.
- Documented the func method.
- Fixed "Usage: DBD::_::common::DESTROY" error.
- Fixed bug which set some attributes true when there value was fetched.
- Added new internal DBIc_set() macro for drivers to use.
-
-=head2 Changes in DBI 0.84, 20th June 1997
-
- Added $h->{PrintError} attribute which, if set true, causes all errors to
- trigger a warn().
- New-style DBI->connect call now automatically sets PrintError=1 unless
- { PrintError => 0 } specified in the connect attributes. See the docs.
- The old-style connect with a separate driver parameter is deprecated.
- Fixed fetchrow_hashref.
- Renamed $h->debug to $h->trace() and added a trace filename arg.
- Assorted other minor tidy-ups.
-
-=head2 Changes in DBI 0.83, 11th June 1997
-
- Added driver specification syntax to DBI->connect data_source
- parameter: DBI->connect('dbi:driver:...', $user, $passwd);
- The DBI->data_sources method should return data_source
- names with the appropriate 'dbi:driver:' prefix.
- DBI->connect will warn if \%attr is true but not a hash ref.
- Added the new fetchrow methods:
- @row_ary = $sth->fetchrow_array;
- $ary_ref = $sth->fetchrow_arrayref;
- $hash_ref = $sth->fetchrow_hashref;
- The old fetch and fetchrow methods still work.
- Driver implementors should implement the new names for
- fetchrow_array and fetchrow_arrayref ASAP (use the xs ALIAS:
- directive to define aliases for fetch and fetchrow).
- Fixed occasional problems with t/examp.t test.
- Added automatic errstr reporting to the debug trace output.
- Added the DBI FAQ from Alligator Descartes in module form for
- easy reading via "perldoc DBI::FAQ". Needs reformatting.
- Unknown driver specific attribute names no longer croak.
- Fixed problem with internal neatsvpv macro.
-
-=head2 Changes in DBI 0.82, 23rd May 1997
-
- Added $h->{RaiseError} attribute which, if set true, causes all errors to
- trigger a die(). This makes it much easier to implement robust applications
- in terms of higher level eval { ... } blocks and rollbacks.
- Added DBI->data_sources($driver) method for implementation by drivers.
- The quote method now returns the string NULL (without quotes) for undef.
- Added VMS support thanks to Dan Sugalski.
- Added a 'quick start guide' to the README.
- Added neatsvpv function pointer to DBIS structure to make it available for
- use by drivers. A macro defines neatsvpv(sv,len) as (DBIS->neatsvpv(sv,len)).
- Old XS macro SV_YES_NO changes to standard boolSV.
- Since the DBIS structure has change the internal version numbers have also
- changed (DBIXS_VERSION == 8 and DBISTATE_VERSION == 8) so drivers will have
- to be recompiled.
-
-=head2 Changes in DBI 0.81, 7th May 1997
-
- Minor fix to let DBI build using less modern perls.
- Fixed a suprious typo warning.
-
-=head2 Changes in DBI 0.80, 6th May 1997
-
- Builds with no changes on NT using perl5.003_99 (with thanks to Jeffrey Urlwin).
- Automatically supports Apache::DBI (with thanks to Edmund Mergl).
- DBI scripts no longer need to be modified to make use of Apache::DBI.
- Added a ping method and an experimental connect_test_perf method.
- Added a fetchhash and fetch_all methods.
- The func method no longer pre-clears err and errstr.
- Added ChopBlanks attribute (currently defaults to off, that may change).
- Support for the attribute needs to be implemented by individual drivers.
- Reworked tests into standard t/*.t form.
- Added more pod text. Fixed assorted bugs.
-
-
-=head2 Changes in DBI 0.79, 7th Apr 1997
-
- Minor release. Tidied up pod text and added some more descriptions
- (especially disconnect). Minor changes to DBI.xs to remove compiler
- warnings.
-
-=head2 Changes in DBI 0.78, 28th Mar 1997
-
- Greatly extended the pod documentation in DBI.pm, including the under
- used bind_columns method. Use 'perldoc DBI' to read after installing.
- Fixed $h->err. Fetching an attribute value no longer resets err.
- Added $h->{InactiveDestroy}, see documentation for details.
- Improved debugging of cached ('quick') attribute fetches.
- errstr will return err code value if there is no string value.
- Added DBI/W32ODBC to the distribution. This is a pure-perl experimental
- DBI emulation layer for Win32::ODBC. Note that it's unsupported, your
- mileage will vary, and bug reports without fixes will probably be ignored.
-
-=head2 Changes in DBI 0.77, 21st Feb 1997
-
- Removed erroneous $h->errstate and $h->errmsg methods from DBI.pm.
- Added $h->err, $h->errstr and $h->state default methods in DBI.xs.
- Updated informal DBI API notes in DBI.pm. Updated README slightly.
- DBIXS.h now correctly installed into INST_ARCHAUTODIR.
- (DBD authors will need to edit their Makefile.PL's to use
- -I$(INSTALLSITEARCH)/auto/DBI -I$(INSTALLSITEARCH)/DBI)
-
-
-=head2 Changes in DBI 0.76, 3rd Feb 1997
-
- Fixed a compiler type warnings (pedantic IRIX again).
-
-=head2 Changes in DBI 0.75, 27th Jan 1997
-
- Fix problem introduced by a change in Perl5.003_XX.
- Updated README and DBI.pm docs.
-
-=head2 Changes in DBI 0.74, 14th Jan 1997
-
- Dispatch now sets dbi_debug to the level of the current handle
- (this makes tracing/debugging individual handles much easier).
- The '>> DISPATCH' log line now only logged at debug >= 3 (was 2).
- The $csr->NUM_OF_FIELDS attribute can be set if not >0 already.
- You can log to a file using the env var PERL_DBI_DEBUG=/tmp/dbi.log.
- Added a type cast needed by IRIX.
- No longer sets perl_destruct_level unless debug set >= 4.
- Make compatible with PerlIO and sfio.
-
-=head2 Changes in DBI 0.73, 10th Oct 1996
-
- Fixed some compiler type warnings (IRIX).
- Fixed DBI->internal->{DebugLog} = $filename.
- Made debug log file unbuffered.
- Added experimental bind_param_inout method to interface.
- Usage: $dbh->bind_param_inout($param, \$value, $maxlen [, \%attribs ])
- (only currently used by DBD::Oracle at this time.)
-
-=head2 Changes in DBI 0.72, 23 Sep 1996
-
- Using an undefined value as a handle now gives a better
- error message (mainly useful for emulators like Oraperl).
- $dbh->do($sql, @params) now works for binding placeholders.
-
-=head2 Changes in DBI 0.71, 10 July 1996
-
- Removed spurious abort() from invalid handle check.
- Added quote method to DBI interface and added test.
-
-=head2 Changes in DBI 0.70, 16 June 1996
-
- Added extra invalid handle check (dbih_getcom)
- Fixed broken $dbh->quote method.
- Added check for old GCC in Makefile.PL
-
-=head2 Changes in DBI 0.69
-
- Fixed small memory leak.
- Clarified the behaviour of DBI->connect.
- $dbh->do now returns '0E0' instead of 'OK'.
- Fixed "Can't read $DBI::errstr, lost last handle" problem.
-
-
-=head2 Changes in DBI 0.68, 2 Mar 1996
-
- Changes to suit perl5.002 and site_lib directories.
- Detects old versions ahead of new in @INC.
-
-
-=head2 Changes in DBI 0.67, 15 Feb 1996
-
- Trivial change to test suite to fix a problem shown up by the
- Perl5.002gamma release Test::Harness.
-
-
-=head2 Changes in DBI 0.66, 29 Jan 1996
-
- Minor changes to bring the DBI into line with 5.002 mechanisms,
- specifically the xs/pm VERSION checking mechanism.
- No functionality changes. One no-last-handle bug fix (rare problem).
- Requires 5.002 (beta2 or later).
-
-
-=head2 Changes in DBI 0.65, 23 Oct 1995
-
- Added $DBI::state to hold SQL CLI / ODBC SQLSTATE value.
- SQLSTATE "00000" (success) is returned as "" (false), all else is true.
- If a driver does not explicitly initialise it (via $h->{State} or
- DBIc_STATE(imp_xxh) then $DBI::state will automatically return "" if
- $DBI::err is false otherwise "S1000" (general error).
- As always, this is a new feature and liable to change.
-
- The is *no longer* a default error handler!
- You can add your own using push(@{$h->{Handlers}}, sub { ... })
- but be aware that this interface may change (or go away).
-
- The DBI now automatically clears $DBI::err, errstr and state before
- calling most DBI methods. Previously error conditions would persist.
- Added DBIh_CLEAR_ERROR(imp_xxh) macro.
-
- DBI now EXPORT_OK's some utility functions, neat($value),
- neat_list(@values) and dump_results($sth).
-
- Slightly enhanced t/min.t minimal test script in an effort to help
- narrow down the few stray core dumps that some porters still report.
-
- Renamed readblob to blob_read (old name still works but warns).
- Added default blob_copy_to_file method.
-
- Added $sth = $dbh->tables method. This returns an $sth for a query
- which has these columns: TABLE_CATALOGUE, TABLE_OWNER, TABLE_NAME,
- TABLE_TYPE, REMARKS in that order. The TABLE_CATALOGUE column
- should be ignored for now.
-
-
-=head2 Changes in DBI 0.64, 23 Oct 1995
-
- Fixed 'disconnect invalidates 1 associated cursor(s)' problem.
- Drivers using DBIc_ACTIVE_on/off() macros should not need any changes
- other than to test for DBIc_ACTIVE_KIDS() instead of DBIc_KIDS().
- Fixed possible core dump in dbih_clearcom during global destruction.
-
-
-=head2 Changes in DBI 0.63, 1 Sep 1995
-
- Minor update. Fixed uninitialised memory bug in method
- attribute handling and streamlined processing and debugging.
- Revised usage definitions for bind_* methods and readblob.
-
-
-=head2 Changes in DBI 0.62, 26 Aug 1995
-
- Added method redirection method $h->func(..., $method_name).
- This is now the official way to call private driver methods
- that are not part of the DBI standard. E.g.:
- @ary = $sth->func('ora_types');
- It can also be used to call existing methods. Has very low cost.
-
- $sth->bind_col columns now start from 1 (not 0) to match SQL.
- $sth->bind_columns now takes a leading attribute parameter (or undef),
- e.g., $sth->bind_columns($attribs, \$col1 [, \$col2 , ...]);
-
- Added handy DBD_ATTRIBS_CHECK macro to vet attribs in XS.
- Added handy DBD_ATTRIB_GET_SVP, DBD_ATTRIB_GET_BOOL and
- DBD_ATTRIB_GET_IV macros for handling attributes.
-
- Fixed STORE for NUM_OF_FIELDS and NUM_OF_PARAMS.
- Added FETCH for NUM_OF_FIELDS and NUM_OF_PARAMS.
-
- Dispatch no longer bothers to call _untie().
- Faster startup via install_method/_add_dispatch changes.
-
-
-=head2 Changes in DBI 0.61, 22 Aug 1995
-
- Added $sth->bind_col($column, \$var [, \%attribs ]);
-
- This method enables perl variable to be directly and automatically
- updated when a row is fetched. It requires no driver support
- (if the driver has been written to use DBIS->get_fbav).
- Currently \%attribs is unused.
-
- Added $sth->bind_columns(\$var [, \$var , ...]);
-
- This method is a short-cut for bind_col which binds all the
- columns of a query in one go (with no attributes). It also
- requires no driver support.
-
- Added $sth->bind_param($parameter, $var [, \%attribs ]);
-
- This method enables attributes to be specified when values are
- bound to placeholders. It also enables binding to occur away
- from the execute method to improve execute efficiency.
- The DBI does not provide a default implementation of this.
- See the DBD::Oracle module for a detailed example.
-
- The DBI now provides default implementations of both fetch and
- fetchrow. Each is written in terms of the other. A driver is
- expected to implement at least one of them.
-
- More macro and assorted structure changes in DBDXS.h. Sorry!
- The old dbihcom definitions have gone. All fields have macros.
- The imp_xxh_t type is now used within the DBI as well as drivers.
- Drivers must set DBIc_NUM_FIELDS(imp_sth) and DBIc_NUM_PARAMS(imp_sth).
-
- test.pl includes a trivial test of bind_param and bind_columns.
-
-
-=head2 Changes in DBI 0.60, 17 Aug 1995
-
- This release has significant code changes but much less
- dramatic than the previous release. The new implementors data
- handling mechanism has matured significantly (don't be put off
- by all the struct typedefs in DBIXS.h, there's just to make it
- easier for drivers while keeping things type-safe).
-
- The DBI now includes two new methods:
-
- do $dbh->do($statement)
-
- This method prepares, executes and finishes a statement. It is
- designed to be used for executing one-off non-select statements
- where there is no benefit in reusing a prepared statement handle.
-
- fetch $array_ref = $sth->fetch;
-
- This method is the new 'lowest-level' row fetching method. The
- previous @row = $sth->fetchrow method now defaults to calling
- the fetch method and expanding the returned array reference.
-
- The DBI now provides fallback attribute FETCH and STORE functions
- which drivers should call if they don't recognise an attribute.
-
- THIS RELEASE IS A GOOD STARTING POINT FOR DRIVER DEVELOPERS!
- Study DBIXS.h from the DBI and Oracle.xs etc from DBD::Oracle.
- There will be further changes in the interface but nothing
- as dramatic as these last two releases! (I hope :-)
-
-
-=head2 Changes in DBI 0.59 15 Aug 1995
-
- NOTE: THIS IS AN UNSTABLE RELEASE!
-
- Major reworking of internal data management!
- Performance improvements and memory leaks fixed.
- Added a new NullP (empty) driver and a -m flag
- to test.pl to help check for memory leaks.
- Study DBD::Oracle version 0.21 for more details.
- (Comparing parts of v0.21 with v0.20 may be useful.)
-
-
-=head2 Changes in DBI 0.58 21 June 1995
-
- Added DBI->internal->{DebugLog} = $filename;
- Reworked internal logging.
- Added $VERSION.
- Made disconnect_all a compulsory method for drivers.
-
-
-=head1 ANCIENT HISTORY
-
-12th Oct 1994: First public release of the DBI module.
- (for Perl 5.000-beta-3h)
-
-19th Sep 1994: DBperl project renamed to DBI.
-
-29th Sep 1992: DBperl project started.
-
-=cut
+++ /dev/null
-# $Id: ANSI.pm 8696 2007-01-24 23:12:38Z Tim $
-#
-# Copyright (c) 2002 Tim Bunce Ireland
-#
-# Constant data describing ANSI CLI info types and return values for the
-# SQLGetInfo() method of ODBC.
-#
-# You may distribute under the terms of either the GNU General Public
-# License or the Artistic License, as specified in the Perl README file.
-use strict;
-
-package DBI::Const::GetInfo::ANSI;
-
-our (%InfoTypes,%ReturnTypes,%ReturnValues,);
-
-=head1 NAME
-
-DBI::Const::GetInfo::ANSI - ISO/IEC SQL/CLI Constants for GetInfo
-
-=head1 SYNOPSIS
-
- The API for this module is private and subject to change.
-
-=head1 DESCRIPTION
-
-Information requested by GetInfo().
-
-See: A.1 C header file SQLCLI.H, Page 316, 317.
-
-The API for this module is private and subject to change.
-
-=head1 REFERENCES
-
- ISO/IEC FCD 9075-3:200x Information technology - Database Languages -
- SQL - Part 3: Call-Level Interface (SQL/CLI)
-
- SC32 N00744 = WG3:VIE-005 = H2-2002-007
-
- Date: 2002-01-15
-
-=cut
-
-my
-$VERSION = "2.008697";
-
-%InfoTypes =
-(
- SQL_ALTER_TABLE => 86
-, SQL_CATALOG_NAME => 10003
-, SQL_COLLATING_SEQUENCE => 10004
-, SQL_CURSOR_COMMIT_BEHAVIOR => 23
-, SQL_CURSOR_SENSITIVITY => 10001
-, SQL_DATA_SOURCE_NAME => 2
-, SQL_DATA_SOURCE_READ_ONLY => 25
-, SQL_DBMS_NAME => 17
-, SQL_DBMS_VERSION => 18
-, SQL_DEFAULT_TRANSACTION_ISOLATION => 26
-, SQL_DESCRIBE_PARAMETER => 10002
-, SQL_FETCH_DIRECTION => 8
-, SQL_GETDATA_EXTENSIONS => 81
-, SQL_IDENTIFIER_CASE => 28
-, SQL_INTEGRITY => 73
-, SQL_MAXIMUM_CATALOG_NAME_LENGTH => 34
-, SQL_MAXIMUM_COLUMNS_IN_GROUP_BY => 97
-, SQL_MAXIMUM_COLUMNS_IN_ORDER_BY => 99
-, SQL_MAXIMUM_COLUMNS_IN_SELECT => 100
-, SQL_MAXIMUM_COLUMNS_IN_TABLE => 101
-, SQL_MAXIMUM_COLUMN_NAME_LENGTH => 30
-, SQL_MAXIMUM_CONCURRENT_ACTIVITIES => 1
-, SQL_MAXIMUM_CURSOR_NAME_LENGTH => 31
-, SQL_MAXIMUM_DRIVER_CONNECTIONS => 0
-, SQL_MAXIMUM_IDENTIFIER_LENGTH => 10005
-, SQL_MAXIMUM_SCHEMA_NAME_LENGTH => 32
-, SQL_MAXIMUM_STMT_OCTETS => 20000
-, SQL_MAXIMUM_STMT_OCTETS_DATA => 20001
-, SQL_MAXIMUM_STMT_OCTETS_SCHEMA => 20002
-, SQL_MAXIMUM_TABLES_IN_SELECT => 106
-, SQL_MAXIMUM_TABLE_NAME_LENGTH => 35
-, SQL_MAXIMUM_USER_NAME_LENGTH => 107
-, SQL_NULL_COLLATION => 85
-, SQL_ORDER_BY_COLUMNS_IN_SELECT => 90
-, SQL_OUTER_JOIN_CAPABILITIES => 115
-, SQL_SCROLL_CONCURRENCY => 43
-, SQL_SEARCH_PATTERN_ESCAPE => 14
-, SQL_SERVER_NAME => 13
-, SQL_SPECIAL_CHARACTERS => 94
-, SQL_TRANSACTION_CAPABLE => 46
-, SQL_TRANSACTION_ISOLATION_OPTION => 72
-, SQL_USER_NAME => 47
-);
-
-=head2 %ReturnTypes
-
-See: Codes and data types for implementation information (Table 28), Page 85, 86.
-
-Mapped to ODBC datatype names.
-
-=cut
-
-%ReturnTypes = # maxlen
-(
- SQL_ALTER_TABLE => 'SQLUINTEGER bitmask' # INTEGER
-, SQL_CATALOG_NAME => 'SQLCHAR' # CHARACTER (1)
-, SQL_COLLATING_SEQUENCE => 'SQLCHAR' # CHARACTER (254)
-, SQL_CURSOR_COMMIT_BEHAVIOR => 'SQLUSMALLINT' # SMALLINT
-, SQL_CURSOR_SENSITIVITY => 'SQLUINTEGER' # INTEGER
-, SQL_DATA_SOURCE_NAME => 'SQLCHAR' # CHARACTER (128)
-, SQL_DATA_SOURCE_READ_ONLY => 'SQLCHAR' # CHARACTER (1)
-, SQL_DBMS_NAME => 'SQLCHAR' # CHARACTER (254)
-, SQL_DBMS_VERSION => 'SQLCHAR' # CHARACTER (254)
-, SQL_DEFAULT_TRANSACTION_ISOLATION => 'SQLUINTEGER' # INTEGER
-, SQL_DESCRIBE_PARAMETER => 'SQLCHAR' # CHARACTER (1)
-, SQL_FETCH_DIRECTION => 'SQLUINTEGER bitmask' # INTEGER
-, SQL_GETDATA_EXTENSIONS => 'SQLUINTEGER bitmask' # INTEGER
-, SQL_IDENTIFIER_CASE => 'SQLUSMALLINT' # SMALLINT
-, SQL_INTEGRITY => 'SQLCHAR' # CHARACTER (1)
-, SQL_MAXIMUM_CATALOG_NAME_LENGTH => 'SQLUSMALLINT' # SMALLINT
-, SQL_MAXIMUM_COLUMNS_IN_GROUP_BY => 'SQLUSMALLINT' # SMALLINT
-, SQL_MAXIMUM_COLUMNS_IN_ORDER_BY => 'SQLUSMALLINT' # SMALLINT
-, SQL_MAXIMUM_COLUMNS_IN_SELECT => 'SQLUSMALLINT' # SMALLINT
-, SQL_MAXIMUM_COLUMNS_IN_TABLE => 'SQLUSMALLINT' # SMALLINT
-, SQL_MAXIMUM_COLUMN_NAME_LENGTH => 'SQLUSMALLINT' # SMALLINT
-, SQL_MAXIMUM_CONCURRENT_ACTIVITIES => 'SQLUSMALLINT' # SMALLINT
-, SQL_MAXIMUM_CURSOR_NAME_LENGTH => 'SQLUSMALLINT' # SMALLINT
-, SQL_MAXIMUM_DRIVER_CONNECTIONS => 'SQLUSMALLINT' # SMALLINT
-, SQL_MAXIMUM_IDENTIFIER_LENGTH => 'SQLUSMALLINT' # SMALLINT
-, SQL_MAXIMUM_SCHEMA_NAME_LENGTH => 'SQLUSMALLINT' # SMALLINT
-, SQL_MAXIMUM_STMT_OCTETS => 'SQLUSMALLINT' # SMALLINT
-, SQL_MAXIMUM_STMT_OCTETS_DATA => 'SQLUSMALLINT' # SMALLINT
-, SQL_MAXIMUM_STMT_OCTETS_SCHEMA => 'SQLUSMALLINT' # SMALLINT
-, SQL_MAXIMUM_TABLES_IN_SELECT => 'SQLUSMALLINT' # SMALLINT
-, SQL_MAXIMUM_TABLE_NAME_LENGTH => 'SQLUSMALLINT' # SMALLINT
-, SQL_MAXIMUM_USER_NAME_LENGTH => 'SQLUSMALLINT' # SMALLINT
-, SQL_NULL_COLLATION => 'SQLUSMALLINT' # SMALLINT
-, SQL_ORDER_BY_COLUMNS_IN_SELECT => 'SQLCHAR' # CHARACTER (1)
-, SQL_OUTER_JOIN_CAPABILITIES => 'SQLUINTEGER bitmask' # INTEGER
-, SQL_SCROLL_CONCURRENCY => 'SQLUINTEGER bitmask' # INTEGER
-, SQL_SEARCH_PATTERN_ESCAPE => 'SQLCHAR' # CHARACTER (1)
-, SQL_SERVER_NAME => 'SQLCHAR' # CHARACTER (128)
-, SQL_SPECIAL_CHARACTERS => 'SQLCHAR' # CHARACTER (254)
-, SQL_TRANSACTION_CAPABLE => 'SQLUSMALLINT' # SMALLINT
-, SQL_TRANSACTION_ISOLATION_OPTION => 'SQLUINTEGER bitmask' # INTEGER
-, SQL_USER_NAME => 'SQLCHAR' # CHARACTER (128)
-);
-
-=head2 %ReturnValues
-
-See: A.1 C header file SQLCLI.H, Page 317, 318.
-
-=cut
-
-$ReturnValues{SQL_ALTER_TABLE} =
-{
- SQL_AT_ADD_COLUMN => 0x00000001
-, SQL_AT_DROP_COLUMN => 0x00000002
-, SQL_AT_ALTER_COLUMN => 0x00000004
-, SQL_AT_ADD_CONSTRAINT => 0x00000008
-, SQL_AT_DROP_CONSTRAINT => 0x00000010
-};
-$ReturnValues{SQL_CURSOR_COMMIT_BEHAVIOR} =
-{
- SQL_CB_DELETE => 0
-, SQL_CB_CLOSE => 1
-, SQL_CB_PRESERVE => 2
-};
-$ReturnValues{SQL_FETCH_DIRECTION} =
-{
- SQL_FD_FETCH_NEXT => 0x00000001
-, SQL_FD_FETCH_FIRST => 0x00000002
-, SQL_FD_FETCH_LAST => 0x00000004
-, SQL_FD_FETCH_PRIOR => 0x00000008
-, SQL_FD_FETCH_ABSOLUTE => 0x00000010
-, SQL_FD_FETCH_RELATIVE => 0x00000020
-};
-$ReturnValues{SQL_GETDATA_EXTENSIONS} =
-{
- SQL_GD_ANY_COLUMN => 0x00000001
-, SQL_GD_ANY_ORDER => 0x00000002
-};
-$ReturnValues{SQL_IDENTIFIER_CASE} =
-{
- SQL_IC_UPPER => 1
-, SQL_IC_LOWER => 2
-, SQL_IC_SENSITIVE => 3
-, SQL_IC_MIXED => 4
-};
-$ReturnValues{SQL_NULL_COLLATION} =
-{
- SQL_NC_HIGH => 1
-, SQL_NC_LOW => 2
-};
-$ReturnValues{SQL_OUTER_JOIN_CAPABILITIES} =
-{
- SQL_OUTER_JOIN_LEFT => 0x00000001
-, SQL_OUTER_JOIN_RIGHT => 0x00000002
-, SQL_OUTER_JOIN_FULL => 0x00000004
-, SQL_OUTER_JOIN_NESTED => 0x00000008
-, SQL_OUTER_JOIN_NOT_ORDERED => 0x00000010
-, SQL_OUTER_JOIN_INNER => 0x00000020
-, SQL_OUTER_JOIN_ALL_COMPARISON_OPS => 0x00000040
-};
-$ReturnValues{SQL_SCROLL_CONCURRENCY} =
-{
- SQL_SCCO_READ_ONLY => 0x00000001
-, SQL_SCCO_LOCK => 0x00000002
-, SQL_SCCO_OPT_ROWVER => 0x00000004
-, SQL_SCCO_OPT_VALUES => 0x00000008
-};
-$ReturnValues{SQL_TRANSACTION_ACCESS_MODE} =
-{
- SQL_TRANSACTION_READ_ONLY => 0x00000001
-, SQL_TRANSACTION_READ_WRITE => 0x00000002
-};
-$ReturnValues{SQL_TRANSACTION_CAPABLE} =
-{
- SQL_TC_NONE => 0
-, SQL_TC_DML => 1
-, SQL_TC_ALL => 2
-, SQL_TC_DDL_COMMIT => 3
-, SQL_TC_DDL_IGNORE => 4
-};
-$ReturnValues{SQL_TRANSACTION_ISOLATION} =
-{
- SQL_TRANSACTION_READ_UNCOMMITTED => 0x00000001
-, SQL_TRANSACTION_READ_COMMITTED => 0x00000002
-, SQL_TRANSACTION_REPEATABLE_READ => 0x00000004
-, SQL_TRANSACTION_SERIALIZABLE => 0x00000008
-};
-
-1;
-
-=head1 TODO
-
-Corrections, e.g.:
-
- SQL_TRANSACTION_ISOLATION_OPTION vs. SQL_TRANSACTION_ISOLATION
-
-=cut
+++ /dev/null
-# $Id: ODBC.pm 11373 2008-06-02 19:01:33Z Tim $
-#
-# Copyright (c) 2002 Tim Bunce Ireland
-#
-# Constant data describing Microsoft ODBC info types and return values
-# for the SQLGetInfo() method of ODBC.
-#
-# You may distribute under the terms of either the GNU General Public
-# License or the Artistic License, as specified in the Perl README file.
-use strict;
-package DBI::Const::GetInfo::ODBC;
-
-our (%InfoTypes,%ReturnTypes,%ReturnValues,);
-=head1 NAME
-
-DBI::Const::GetInfo::ODBC - ODBC Constants for GetInfo
-
-=head1 SYNOPSIS
-
- The API for this module is private and subject to change.
-
-=head1 DESCRIPTION
-
-Information requested by GetInfo().
-
-The API for this module is private and subject to change.
-
-=head1 REFERENCES
-
- MDAC SDK 2.6
- ODBC version number (0x0351)
-
- sql.h
- sqlext.h
-
-=cut
-
-my
-$VERSION = "2.011374";
-
-%InfoTypes =
-(
- SQL_ACCESSIBLE_PROCEDURES => 20
-, SQL_ACCESSIBLE_TABLES => 19
-, SQL_ACTIVE_CONNECTIONS => 0
-, SQL_ACTIVE_ENVIRONMENTS => 116
-, SQL_ACTIVE_STATEMENTS => 1
-, SQL_AGGREGATE_FUNCTIONS => 169
-, SQL_ALTER_DOMAIN => 117
-, SQL_ALTER_TABLE => 86
-, SQL_ASYNC_MODE => 10021
-, SQL_BATCH_ROW_COUNT => 120
-, SQL_BATCH_SUPPORT => 121
-, SQL_BOOKMARK_PERSISTENCE => 82
-, SQL_CATALOG_LOCATION => 114 # SQL_QUALIFIER_LOCATION
-, SQL_CATALOG_NAME => 10003
-, SQL_CATALOG_NAME_SEPARATOR => 41 # SQL_QUALIFIER_NAME_SEPARATOR
-, SQL_CATALOG_TERM => 42 # SQL_QUALIFIER_TERM
-, SQL_CATALOG_USAGE => 92 # SQL_QUALIFIER_USAGE
-, SQL_COLLATION_SEQ => 10004
-, SQL_COLUMN_ALIAS => 87
-, SQL_CONCAT_NULL_BEHAVIOR => 22
-, SQL_CONVERT_BIGINT => 53
-, SQL_CONVERT_BINARY => 54
-, SQL_CONVERT_BIT => 55
-, SQL_CONVERT_CHAR => 56
-, SQL_CONVERT_DATE => 57
-, SQL_CONVERT_DECIMAL => 58
-, SQL_CONVERT_DOUBLE => 59
-, SQL_CONVERT_FLOAT => 60
-, SQL_CONVERT_FUNCTIONS => 48
-, SQL_CONVERT_GUID => 173
-, SQL_CONVERT_INTEGER => 61
-, SQL_CONVERT_INTERVAL_DAY_TIME => 123
-, SQL_CONVERT_INTERVAL_YEAR_MONTH => 124
-, SQL_CONVERT_LONGVARBINARY => 71
-, SQL_CONVERT_LONGVARCHAR => 62
-, SQL_CONVERT_NUMERIC => 63
-, SQL_CONVERT_REAL => 64
-, SQL_CONVERT_SMALLINT => 65
-, SQL_CONVERT_TIME => 66
-, SQL_CONVERT_TIMESTAMP => 67
-, SQL_CONVERT_TINYINT => 68
-, SQL_CONVERT_VARBINARY => 69
-, SQL_CONVERT_VARCHAR => 70
-, SQL_CONVERT_WCHAR => 122
-, SQL_CONVERT_WLONGVARCHAR => 125
-, SQL_CONVERT_WVARCHAR => 126
-, SQL_CORRELATION_NAME => 74
-, SQL_CREATE_ASSERTION => 127
-, SQL_CREATE_CHARACTER_SET => 128
-, SQL_CREATE_COLLATION => 129
-, SQL_CREATE_DOMAIN => 130
-, SQL_CREATE_SCHEMA => 131
-, SQL_CREATE_TABLE => 132
-, SQL_CREATE_TRANSLATION => 133
-, SQL_CREATE_VIEW => 134
-, SQL_CURSOR_COMMIT_BEHAVIOR => 23
-, SQL_CURSOR_ROLLBACK_BEHAVIOR => 24
-, SQL_CURSOR_SENSITIVITY => 10001
-, SQL_DATA_SOURCE_NAME => 2
-, SQL_DATA_SOURCE_READ_ONLY => 25
-, SQL_DATABASE_NAME => 16
-, SQL_DATETIME_LITERALS => 119
-, SQL_DBMS_NAME => 17
-, SQL_DBMS_VER => 18
-, SQL_DDL_INDEX => 170
-, SQL_DEFAULT_TXN_ISOLATION => 26
-, SQL_DESCRIBE_PARAMETER => 10002
-, SQL_DM_VER => 171
-, SQL_DRIVER_HDBC => 3
-, SQL_DRIVER_HDESC => 135
-, SQL_DRIVER_HENV => 4
-, SQL_DRIVER_HLIB => 76
-, SQL_DRIVER_HSTMT => 5
-, SQL_DRIVER_NAME => 6
-, SQL_DRIVER_ODBC_VER => 77
-, SQL_DRIVER_VER => 7
-, SQL_DROP_ASSERTION => 136
-, SQL_DROP_CHARACTER_SET => 137
-, SQL_DROP_COLLATION => 138
-, SQL_DROP_DOMAIN => 139
-, SQL_DROP_SCHEMA => 140
-, SQL_DROP_TABLE => 141
-, SQL_DROP_TRANSLATION => 142
-, SQL_DROP_VIEW => 143
-, SQL_DYNAMIC_CURSOR_ATTRIBUTES1 => 144
-, SQL_DYNAMIC_CURSOR_ATTRIBUTES2 => 145
-, SQL_EXPRESSIONS_IN_ORDERBY => 27
-, SQL_FETCH_DIRECTION => 8
-, SQL_FILE_USAGE => 84
-, SQL_FORWARD_ONLY_CURSOR_ATTRIBUTES1 => 146
-, SQL_FORWARD_ONLY_CURSOR_ATTRIBUTES2 => 147
-, SQL_GETDATA_EXTENSIONS => 81
-, SQL_GROUP_BY => 88
-, SQL_IDENTIFIER_CASE => 28
-, SQL_IDENTIFIER_QUOTE_CHAR => 29
-, SQL_INDEX_KEYWORDS => 148
-# SQL_INFO_DRIVER_START => 1000
-# SQL_INFO_FIRST => 0
-# SQL_INFO_LAST => 114 # SQL_QUALIFIER_LOCATION
-, SQL_INFO_SCHEMA_VIEWS => 149
-, SQL_INSERT_STATEMENT => 172
-, SQL_INTEGRITY => 73
-, SQL_KEYSET_CURSOR_ATTRIBUTES1 => 150
-, SQL_KEYSET_CURSOR_ATTRIBUTES2 => 151
-, SQL_KEYWORDS => 89
-, SQL_LIKE_ESCAPE_CLAUSE => 113
-, SQL_LOCK_TYPES => 78
-, SQL_MAXIMUM_CATALOG_NAME_LENGTH => 34 # SQL_MAX_CATALOG_NAME_LEN
-, SQL_MAXIMUM_COLUMNS_IN_GROUP_BY => 97 # SQL_MAX_COLUMNS_IN_GROUP_BY
-, SQL_MAXIMUM_COLUMNS_IN_INDEX => 98 # SQL_MAX_COLUMNS_IN_INDEX
-, SQL_MAXIMUM_COLUMNS_IN_ORDER_BY => 99 # SQL_MAX_COLUMNS_IN_ORDER_BY
-, SQL_MAXIMUM_COLUMNS_IN_SELECT => 100 # SQL_MAX_COLUMNS_IN_SELECT
-, SQL_MAXIMUM_COLUMN_NAME_LENGTH => 30 # SQL_MAX_COLUMN_NAME_LEN
-, SQL_MAXIMUM_CONCURRENT_ACTIVITIES => 1 # SQL_MAX_CONCURRENT_ACTIVITIES
-, SQL_MAXIMUM_CURSOR_NAME_LENGTH => 31 # SQL_MAX_CURSOR_NAME_LEN
-, SQL_MAXIMUM_DRIVER_CONNECTIONS => 0 # SQL_MAX_DRIVER_CONNECTIONS
-, SQL_MAXIMUM_IDENTIFIER_LENGTH => 10005 # SQL_MAX_IDENTIFIER_LEN
-, SQL_MAXIMUM_INDEX_SIZE => 102 # SQL_MAX_INDEX_SIZE
-, SQL_MAXIMUM_ROW_SIZE => 104 # SQL_MAX_ROW_SIZE
-, SQL_MAXIMUM_SCHEMA_NAME_LENGTH => 32 # SQL_MAX_SCHEMA_NAME_LEN
-, SQL_MAXIMUM_STATEMENT_LENGTH => 105 # SQL_MAX_STATEMENT_LEN
-, SQL_MAXIMUM_TABLES_IN_SELECT => 106 # SQL_MAX_TABLES_IN_SELECT
-, SQL_MAXIMUM_USER_NAME_LENGTH => 107 # SQL_MAX_USER_NAME_LEN
-, SQL_MAX_ASYNC_CONCURRENT_STATEMENTS => 10022
-, SQL_MAX_BINARY_LITERAL_LEN => 112
-, SQL_MAX_CATALOG_NAME_LEN => 34
-, SQL_MAX_CHAR_LITERAL_LEN => 108
-, SQL_MAX_COLUMNS_IN_GROUP_BY => 97
-, SQL_MAX_COLUMNS_IN_INDEX => 98
-, SQL_MAX_COLUMNS_IN_ORDER_BY => 99
-, SQL_MAX_COLUMNS_IN_SELECT => 100
-, SQL_MAX_COLUMNS_IN_TABLE => 101
-, SQL_MAX_COLUMN_NAME_LEN => 30
-, SQL_MAX_CONCURRENT_ACTIVITIES => 1
-, SQL_MAX_CURSOR_NAME_LEN => 31
-, SQL_MAX_DRIVER_CONNECTIONS => 0
-, SQL_MAX_IDENTIFIER_LEN => 10005
-, SQL_MAX_INDEX_SIZE => 102
-, SQL_MAX_OWNER_NAME_LEN => 32
-, SQL_MAX_PROCEDURE_NAME_LEN => 33
-, SQL_MAX_QUALIFIER_NAME_LEN => 34
-, SQL_MAX_ROW_SIZE => 104
-, SQL_MAX_ROW_SIZE_INCLUDES_LONG => 103
-, SQL_MAX_SCHEMA_NAME_LEN => 32
-, SQL_MAX_STATEMENT_LEN => 105
-, SQL_MAX_TABLES_IN_SELECT => 106
-, SQL_MAX_TABLE_NAME_LEN => 35
-, SQL_MAX_USER_NAME_LEN => 107
-, SQL_MULTIPLE_ACTIVE_TXN => 37
-, SQL_MULT_RESULT_SETS => 36
-, SQL_NEED_LONG_DATA_LEN => 111
-, SQL_NON_NULLABLE_COLUMNS => 75
-, SQL_NULL_COLLATION => 85
-, SQL_NUMERIC_FUNCTIONS => 49
-, SQL_ODBC_API_CONFORMANCE => 9
-, SQL_ODBC_INTERFACE_CONFORMANCE => 152
-, SQL_ODBC_SAG_CLI_CONFORMANCE => 12
-, SQL_ODBC_SQL_CONFORMANCE => 15
-, SQL_ODBC_SQL_OPT_IEF => 73
-, SQL_ODBC_VER => 10
-, SQL_OJ_CAPABILITIES => 115
-, SQL_ORDER_BY_COLUMNS_IN_SELECT => 90
-, SQL_OUTER_JOINS => 38
-, SQL_OUTER_JOIN_CAPABILITIES => 115 # SQL_OJ_CAPABILITIES
-, SQL_OWNER_TERM => 39
-, SQL_OWNER_USAGE => 91
-, SQL_PARAM_ARRAY_ROW_COUNTS => 153
-, SQL_PARAM_ARRAY_SELECTS => 154
-, SQL_POSITIONED_STATEMENTS => 80
-, SQL_POS_OPERATIONS => 79
-, SQL_PROCEDURES => 21
-, SQL_PROCEDURE_TERM => 40
-, SQL_QUALIFIER_LOCATION => 114
-, SQL_QUALIFIER_NAME_SEPARATOR => 41
-, SQL_QUALIFIER_TERM => 42
-, SQL_QUALIFIER_USAGE => 92
-, SQL_QUOTED_IDENTIFIER_CASE => 93
-, SQL_ROW_UPDATES => 11
-, SQL_SCHEMA_TERM => 39 # SQL_OWNER_TERM
-, SQL_SCHEMA_USAGE => 91 # SQL_OWNER_USAGE
-, SQL_SCROLL_CONCURRENCY => 43
-, SQL_SCROLL_OPTIONS => 44
-, SQL_SEARCH_PATTERN_ESCAPE => 14
-, SQL_SERVER_NAME => 13
-, SQL_SPECIAL_CHARACTERS => 94
-, SQL_SQL92_DATETIME_FUNCTIONS => 155
-, SQL_SQL92_FOREIGN_KEY_DELETE_RULE => 156
-, SQL_SQL92_FOREIGN_KEY_UPDATE_RULE => 157
-, SQL_SQL92_GRANT => 158
-, SQL_SQL92_NUMERIC_VALUE_FUNCTIONS => 159
-, SQL_SQL92_PREDICATES => 160
-, SQL_SQL92_RELATIONAL_JOIN_OPERATORS => 161
-, SQL_SQL92_REVOKE => 162
-, SQL_SQL92_ROW_VALUE_CONSTRUCTOR => 163
-, SQL_SQL92_STRING_FUNCTIONS => 164
-, SQL_SQL92_VALUE_EXPRESSIONS => 165
-, SQL_SQL_CONFORMANCE => 118
-, SQL_STANDARD_CLI_CONFORMANCE => 166
-, SQL_STATIC_CURSOR_ATTRIBUTES1 => 167
-, SQL_STATIC_CURSOR_ATTRIBUTES2 => 168
-, SQL_STATIC_SENSITIVITY => 83
-, SQL_STRING_FUNCTIONS => 50
-, SQL_SUBQUERIES => 95
-, SQL_SYSTEM_FUNCTIONS => 51
-, SQL_TABLE_TERM => 45
-, SQL_TIMEDATE_ADD_INTERVALS => 109
-, SQL_TIMEDATE_DIFF_INTERVALS => 110
-, SQL_TIMEDATE_FUNCTIONS => 52
-, SQL_TRANSACTION_CAPABLE => 46 # SQL_TXN_CAPABLE
-, SQL_TRANSACTION_ISOLATION_OPTION => 72 # SQL_TXN_ISOLATION_OPTION
-, SQL_TXN_CAPABLE => 46
-, SQL_TXN_ISOLATION_OPTION => 72
-, SQL_UNION => 96
-, SQL_UNION_STATEMENT => 96 # SQL_UNION
-, SQL_USER_NAME => 47
-, SQL_XOPEN_CLI_YEAR => 10000
-);
-
-=head2 %ReturnTypes
-
-See: mk:@MSITStore:X:\dm\cli\mdac\sdk26\Docs\odbc.chm::/htm/odbcsqlgetinfo.htm
-
- => : alias
- => !!! : edited
-
-=cut
-
-%ReturnTypes =
-(
- SQL_ACCESSIBLE_PROCEDURES => 'SQLCHAR' # 20
-, SQL_ACCESSIBLE_TABLES => 'SQLCHAR' # 19
-, SQL_ACTIVE_CONNECTIONS => 'SQLUSMALLINT' # 0 =>
-, SQL_ACTIVE_ENVIRONMENTS => 'SQLUSMALLINT' # 116
-, SQL_ACTIVE_STATEMENTS => 'SQLUSMALLINT' # 1 =>
-, SQL_AGGREGATE_FUNCTIONS => 'SQLUINTEGER bitmask' # 169
-, SQL_ALTER_DOMAIN => 'SQLUINTEGER bitmask' # 117
-, SQL_ALTER_TABLE => 'SQLUINTEGER bitmask' # 86
-, SQL_ASYNC_MODE => 'SQLUINTEGER' # 10021
-, SQL_BATCH_ROW_COUNT => 'SQLUINTEGER bitmask' # 120
-, SQL_BATCH_SUPPORT => 'SQLUINTEGER bitmask' # 121
-, SQL_BOOKMARK_PERSISTENCE => 'SQLUINTEGER bitmask' # 82
-, SQL_CATALOG_LOCATION => 'SQLUSMALLINT' # 114
-, SQL_CATALOG_NAME => 'SQLCHAR' # 10003
-, SQL_CATALOG_NAME_SEPARATOR => 'SQLCHAR' # 41
-, SQL_CATALOG_TERM => 'SQLCHAR' # 42
-, SQL_CATALOG_USAGE => 'SQLUINTEGER bitmask' # 92
-, SQL_COLLATION_SEQ => 'SQLCHAR' # 10004
-, SQL_COLUMN_ALIAS => 'SQLCHAR' # 87
-, SQL_CONCAT_NULL_BEHAVIOR => 'SQLUSMALLINT' # 22
-, SQL_CONVERT_BIGINT => 'SQLUINTEGER bitmask' # 53
-, SQL_CONVERT_BINARY => 'SQLUINTEGER bitmask' # 54
-, SQL_CONVERT_BIT => 'SQLUINTEGER bitmask' # 55
-, SQL_CONVERT_CHAR => 'SQLUINTEGER bitmask' # 56
-, SQL_CONVERT_DATE => 'SQLUINTEGER bitmask' # 57
-, SQL_CONVERT_DECIMAL => 'SQLUINTEGER bitmask' # 58
-, SQL_CONVERT_DOUBLE => 'SQLUINTEGER bitmask' # 59
-, SQL_CONVERT_FLOAT => 'SQLUINTEGER bitmask' # 60
-, SQL_CONVERT_FUNCTIONS => 'SQLUINTEGER bitmask' # 48
-, SQL_CONVERT_GUID => 'SQLUINTEGER bitmask' # 173
-, SQL_CONVERT_INTEGER => 'SQLUINTEGER bitmask' # 61
-, SQL_CONVERT_INTERVAL_DAY_TIME => 'SQLUINTEGER bitmask' # 123
-, SQL_CONVERT_INTERVAL_YEAR_MONTH => 'SQLUINTEGER bitmask' # 124
-, SQL_CONVERT_LONGVARBINARY => 'SQLUINTEGER bitmask' # 71
-, SQL_CONVERT_LONGVARCHAR => 'SQLUINTEGER bitmask' # 62
-, SQL_CONVERT_NUMERIC => 'SQLUINTEGER bitmask' # 63
-, SQL_CONVERT_REAL => 'SQLUINTEGER bitmask' # 64
-, SQL_CONVERT_SMALLINT => 'SQLUINTEGER bitmask' # 65
-, SQL_CONVERT_TIME => 'SQLUINTEGER bitmask' # 66
-, SQL_CONVERT_TIMESTAMP => 'SQLUINTEGER bitmask' # 67
-, SQL_CONVERT_TINYINT => 'SQLUINTEGER bitmask' # 68
-, SQL_CONVERT_VARBINARY => 'SQLUINTEGER bitmask' # 69
-, SQL_CONVERT_VARCHAR => 'SQLUINTEGER bitmask' # 70
-, SQL_CONVERT_WCHAR => 'SQLUINTEGER bitmask' # 122 => !!!
-, SQL_CONVERT_WLONGVARCHAR => 'SQLUINTEGER bitmask' # 125 => !!!
-, SQL_CONVERT_WVARCHAR => 'SQLUINTEGER bitmask' # 126 => !!!
-, SQL_CORRELATION_NAME => 'SQLUSMALLINT' # 74
-, SQL_CREATE_ASSERTION => 'SQLUINTEGER bitmask' # 127
-, SQL_CREATE_CHARACTER_SET => 'SQLUINTEGER bitmask' # 128
-, SQL_CREATE_COLLATION => 'SQLUINTEGER bitmask' # 129
-, SQL_CREATE_DOMAIN => 'SQLUINTEGER bitmask' # 130
-, SQL_CREATE_SCHEMA => 'SQLUINTEGER bitmask' # 131
-, SQL_CREATE_TABLE => 'SQLUINTEGER bitmask' # 132
-, SQL_CREATE_TRANSLATION => 'SQLUINTEGER bitmask' # 133
-, SQL_CREATE_VIEW => 'SQLUINTEGER bitmask' # 134
-, SQL_CURSOR_COMMIT_BEHAVIOR => 'SQLUSMALLINT' # 23
-, SQL_CURSOR_ROLLBACK_BEHAVIOR => 'SQLUSMALLINT' # 24
-, SQL_CURSOR_SENSITIVITY => 'SQLUINTEGER' # 10001
-, SQL_DATA_SOURCE_NAME => 'SQLCHAR' # 2
-, SQL_DATA_SOURCE_READ_ONLY => 'SQLCHAR' # 25
-, SQL_DATABASE_NAME => 'SQLCHAR' # 16
-, SQL_DATETIME_LITERALS => 'SQLUINTEGER bitmask' # 119
-, SQL_DBMS_NAME => 'SQLCHAR' # 17
-, SQL_DBMS_VER => 'SQLCHAR' # 18
-, SQL_DDL_INDEX => 'SQLUINTEGER bitmask' # 170
-, SQL_DEFAULT_TXN_ISOLATION => 'SQLUINTEGER' # 26
-, SQL_DESCRIBE_PARAMETER => 'SQLCHAR' # 10002
-, SQL_DM_VER => 'SQLCHAR' # 171
-, SQL_DRIVER_HDBC => 'SQLUINTEGER' # 3
-, SQL_DRIVER_HDESC => 'SQLUINTEGER' # 135
-, SQL_DRIVER_HENV => 'SQLUINTEGER' # 4
-, SQL_DRIVER_HLIB => 'SQLUINTEGER' # 76
-, SQL_DRIVER_HSTMT => 'SQLUINTEGER' # 5
-, SQL_DRIVER_NAME => 'SQLCHAR' # 6
-, SQL_DRIVER_ODBC_VER => 'SQLCHAR' # 77
-, SQL_DRIVER_VER => 'SQLCHAR' # 7
-, SQL_DROP_ASSERTION => 'SQLUINTEGER bitmask' # 136
-, SQL_DROP_CHARACTER_SET => 'SQLUINTEGER bitmask' # 137
-, SQL_DROP_COLLATION => 'SQLUINTEGER bitmask' # 138
-, SQL_DROP_DOMAIN => 'SQLUINTEGER bitmask' # 139
-, SQL_DROP_SCHEMA => 'SQLUINTEGER bitmask' # 140
-, SQL_DROP_TABLE => 'SQLUINTEGER bitmask' # 141
-, SQL_DROP_TRANSLATION => 'SQLUINTEGER bitmask' # 142
-, SQL_DROP_VIEW => 'SQLUINTEGER bitmask' # 143
-, SQL_DYNAMIC_CURSOR_ATTRIBUTES1 => 'SQLUINTEGER bitmask' # 144
-, SQL_DYNAMIC_CURSOR_ATTRIBUTES2 => 'SQLUINTEGER bitmask' # 145
-, SQL_EXPRESSIONS_IN_ORDERBY => 'SQLCHAR' # 27
-, SQL_FETCH_DIRECTION => 'SQLUINTEGER bitmask' # 8 => !!!
-, SQL_FILE_USAGE => 'SQLUSMALLINT' # 84
-, SQL_FORWARD_ONLY_CURSOR_ATTRIBUTES1 => 'SQLUINTEGER bitmask' # 146
-, SQL_FORWARD_ONLY_CURSOR_ATTRIBUTES2 => 'SQLUINTEGER bitmask' # 147
-, SQL_GETDATA_EXTENSIONS => 'SQLUINTEGER bitmask' # 81
-, SQL_GROUP_BY => 'SQLUSMALLINT' # 88
-, SQL_IDENTIFIER_CASE => 'SQLUSMALLINT' # 28
-, SQL_IDENTIFIER_QUOTE_CHAR => 'SQLCHAR' # 29
-, SQL_INDEX_KEYWORDS => 'SQLUINTEGER bitmask' # 148
-# SQL_INFO_DRIVER_START => '' # 1000 =>
-# SQL_INFO_FIRST => 'SQLUSMALLINT' # 0 =>
-# SQL_INFO_LAST => 'SQLUSMALLINT' # 114 =>
-, SQL_INFO_SCHEMA_VIEWS => 'SQLUINTEGER bitmask' # 149
-, SQL_INSERT_STATEMENT => 'SQLUINTEGER bitmask' # 172
-, SQL_INTEGRITY => 'SQLCHAR' # 73
-, SQL_KEYSET_CURSOR_ATTRIBUTES1 => 'SQLUINTEGER bitmask' # 150
-, SQL_KEYSET_CURSOR_ATTRIBUTES2 => 'SQLUINTEGER bitmask' # 151
-, SQL_KEYWORDS => 'SQLCHAR' # 89
-, SQL_LIKE_ESCAPE_CLAUSE => 'SQLCHAR' # 113
-, SQL_LOCK_TYPES => 'SQLUINTEGER bitmask' # 78 => !!!
-, SQL_MAXIMUM_CATALOG_NAME_LENGTH => 'SQLUSMALLINT' # 34 =>
-, SQL_MAXIMUM_COLUMNS_IN_GROUP_BY => 'SQLUSMALLINT' # 97 =>
-, SQL_MAXIMUM_COLUMNS_IN_INDEX => 'SQLUSMALLINT' # 98 =>
-, SQL_MAXIMUM_COLUMNS_IN_ORDER_BY => 'SQLUSMALLINT' # 99 =>
-, SQL_MAXIMUM_COLUMNS_IN_SELECT => 'SQLUSMALLINT' # 100 =>
-, SQL_MAXIMUM_COLUMN_NAME_LENGTH => 'SQLUSMALLINT' # 30 =>
-, SQL_MAXIMUM_CONCURRENT_ACTIVITIES => 'SQLUSMALLINT' # 1 =>
-, SQL_MAXIMUM_CURSOR_NAME_LENGTH => 'SQLUSMALLINT' # 31 =>
-, SQL_MAXIMUM_DRIVER_CONNECTIONS => 'SQLUSMALLINT' # 0 =>
-, SQL_MAXIMUM_IDENTIFIER_LENGTH => 'SQLUSMALLINT' # 10005 =>
-, SQL_MAXIMUM_INDEX_SIZE => 'SQLUINTEGER' # 102 =>
-, SQL_MAXIMUM_ROW_SIZE => 'SQLUINTEGER' # 104 =>
-, SQL_MAXIMUM_SCHEMA_NAME_LENGTH => 'SQLUSMALLINT' # 32 =>
-, SQL_MAXIMUM_STATEMENT_LENGTH => 'SQLUINTEGER' # 105 =>
-, SQL_MAXIMUM_TABLES_IN_SELECT => 'SQLUSMALLINT' # 106 =>
-, SQL_MAXIMUM_USER_NAME_LENGTH => 'SQLUSMALLINT' # 107 =>
-, SQL_MAX_ASYNC_CONCURRENT_STATEMENTS => 'SQLUINTEGER' # 10022
-, SQL_MAX_BINARY_LITERAL_LEN => 'SQLUINTEGER' # 112
-, SQL_MAX_CATALOG_NAME_LEN => 'SQLUSMALLINT' # 34
-, SQL_MAX_CHAR_LITERAL_LEN => 'SQLUINTEGER' # 108
-, SQL_MAX_COLUMNS_IN_GROUP_BY => 'SQLUSMALLINT' # 97
-, SQL_MAX_COLUMNS_IN_INDEX => 'SQLUSMALLINT' # 98
-, SQL_MAX_COLUMNS_IN_ORDER_BY => 'SQLUSMALLINT' # 99
-, SQL_MAX_COLUMNS_IN_SELECT => 'SQLUSMALLINT' # 100
-, SQL_MAX_COLUMNS_IN_TABLE => 'SQLUSMALLINT' # 101
-, SQL_MAX_COLUMN_NAME_LEN => 'SQLUSMALLINT' # 30
-, SQL_MAX_CONCURRENT_ACTIVITIES => 'SQLUSMALLINT' # 1
-, SQL_MAX_CURSOR_NAME_LEN => 'SQLUSMALLINT' # 31
-, SQL_MAX_DRIVER_CONNECTIONS => 'SQLUSMALLINT' # 0
-, SQL_MAX_IDENTIFIER_LEN => 'SQLUSMALLINT' # 10005
-, SQL_MAX_INDEX_SIZE => 'SQLUINTEGER' # 102
-, SQL_MAX_OWNER_NAME_LEN => 'SQLUSMALLINT' # 32 =>
-, SQL_MAX_PROCEDURE_NAME_LEN => 'SQLUSMALLINT' # 33
-, SQL_MAX_QUALIFIER_NAME_LEN => 'SQLUSMALLINT' # 34 =>
-, SQL_MAX_ROW_SIZE => 'SQLUINTEGER' # 104
-, SQL_MAX_ROW_SIZE_INCLUDES_LONG => 'SQLCHAR' # 103
-, SQL_MAX_SCHEMA_NAME_LEN => 'SQLUSMALLINT' # 32
-, SQL_MAX_STATEMENT_LEN => 'SQLUINTEGER' # 105
-, SQL_MAX_TABLES_IN_SELECT => 'SQLUSMALLINT' # 106
-, SQL_MAX_TABLE_NAME_LEN => 'SQLUSMALLINT' # 35
-, SQL_MAX_USER_NAME_LEN => 'SQLUSMALLINT' # 107
-, SQL_MULTIPLE_ACTIVE_TXN => 'SQLCHAR' # 37
-, SQL_MULT_RESULT_SETS => 'SQLCHAR' # 36
-, SQL_NEED_LONG_DATA_LEN => 'SQLCHAR' # 111
-, SQL_NON_NULLABLE_COLUMNS => 'SQLUSMALLINT' # 75
-, SQL_NULL_COLLATION => 'SQLUSMALLINT' # 85
-, SQL_NUMERIC_FUNCTIONS => 'SQLUINTEGER bitmask' # 49
-, SQL_ODBC_API_CONFORMANCE => 'SQLUSMALLINT' # 9 => !!!
-, SQL_ODBC_INTERFACE_CONFORMANCE => 'SQLUINTEGER' # 152
-, SQL_ODBC_SAG_CLI_CONFORMANCE => 'SQLUSMALLINT' # 12 => !!!
-, SQL_ODBC_SQL_CONFORMANCE => 'SQLUSMALLINT' # 15 => !!!
-, SQL_ODBC_SQL_OPT_IEF => 'SQLCHAR' # 73 =>
-, SQL_ODBC_VER => 'SQLCHAR' # 10
-, SQL_OJ_CAPABILITIES => 'SQLUINTEGER bitmask' # 115
-, SQL_ORDER_BY_COLUMNS_IN_SELECT => 'SQLCHAR' # 90
-, SQL_OUTER_JOINS => 'SQLCHAR' # 38 => !!!
-, SQL_OUTER_JOIN_CAPABILITIES => 'SQLUINTEGER bitmask' # 115 =>
-, SQL_OWNER_TERM => 'SQLCHAR' # 39 =>
-, SQL_OWNER_USAGE => 'SQLUINTEGER bitmask' # 91 =>
-, SQL_PARAM_ARRAY_ROW_COUNTS => 'SQLUINTEGER' # 153
-, SQL_PARAM_ARRAY_SELECTS => 'SQLUINTEGER' # 154
-, SQL_POSITIONED_STATEMENTS => 'SQLUINTEGER bitmask' # 80 => !!!
-, SQL_POS_OPERATIONS => 'SQLINTEGER bitmask' # 79
-, SQL_PROCEDURES => 'SQLCHAR' # 21
-, SQL_PROCEDURE_TERM => 'SQLCHAR' # 40
-, SQL_QUALIFIER_LOCATION => 'SQLUSMALLINT' # 114 =>
-, SQL_QUALIFIER_NAME_SEPARATOR => 'SQLCHAR' # 41 =>
-, SQL_QUALIFIER_TERM => 'SQLCHAR' # 42 =>
-, SQL_QUALIFIER_USAGE => 'SQLUINTEGER bitmask' # 92 =>
-, SQL_QUOTED_IDENTIFIER_CASE => 'SQLUSMALLINT' # 93
-, SQL_ROW_UPDATES => 'SQLCHAR' # 11
-, SQL_SCHEMA_TERM => 'SQLCHAR' # 39
-, SQL_SCHEMA_USAGE => 'SQLUINTEGER bitmask' # 91
-, SQL_SCROLL_CONCURRENCY => 'SQLUINTEGER bitmask' # 43 => !!!
-, SQL_SCROLL_OPTIONS => 'SQLUINTEGER bitmask' # 44
-, SQL_SEARCH_PATTERN_ESCAPE => 'SQLCHAR' # 14
-, SQL_SERVER_NAME => 'SQLCHAR' # 13
-, SQL_SPECIAL_CHARACTERS => 'SQLCHAR' # 94
-, SQL_SQL92_DATETIME_FUNCTIONS => 'SQLUINTEGER bitmask' # 155
-, SQL_SQL92_FOREIGN_KEY_DELETE_RULE => 'SQLUINTEGER bitmask' # 156
-, SQL_SQL92_FOREIGN_KEY_UPDATE_RULE => 'SQLUINTEGER bitmask' # 157
-, SQL_SQL92_GRANT => 'SQLUINTEGER bitmask' # 158
-, SQL_SQL92_NUMERIC_VALUE_FUNCTIONS => 'SQLUINTEGER bitmask' # 159
-, SQL_SQL92_PREDICATES => 'SQLUINTEGER bitmask' # 160
-, SQL_SQL92_RELATIONAL_JOIN_OPERATORS => 'SQLUINTEGER bitmask' # 161
-, SQL_SQL92_REVOKE => 'SQLUINTEGER bitmask' # 162
-, SQL_SQL92_ROW_VALUE_CONSTRUCTOR => 'SQLUINTEGER bitmask' # 163
-, SQL_SQL92_STRING_FUNCTIONS => 'SQLUINTEGER bitmask' # 164
-, SQL_SQL92_VALUE_EXPRESSIONS => 'SQLUINTEGER bitmask' # 165
-, SQL_SQL_CONFORMANCE => 'SQLUINTEGER' # 118
-, SQL_STANDARD_CLI_CONFORMANCE => 'SQLUINTEGER bitmask' # 166
-, SQL_STATIC_CURSOR_ATTRIBUTES1 => 'SQLUINTEGER bitmask' # 167
-, SQL_STATIC_CURSOR_ATTRIBUTES2 => 'SQLUINTEGER bitmask' # 168
-, SQL_STATIC_SENSITIVITY => 'SQLUINTEGER bitmask' # 83 => !!!
-, SQL_STRING_FUNCTIONS => 'SQLUINTEGER bitmask' # 50
-, SQL_SUBQUERIES => 'SQLUINTEGER bitmask' # 95
-, SQL_SYSTEM_FUNCTIONS => 'SQLUINTEGER bitmask' # 51
-, SQL_TABLE_TERM => 'SQLCHAR' # 45
-, SQL_TIMEDATE_ADD_INTERVALS => 'SQLUINTEGER bitmask' # 109
-, SQL_TIMEDATE_DIFF_INTERVALS => 'SQLUINTEGER bitmask' # 110
-, SQL_TIMEDATE_FUNCTIONS => 'SQLUINTEGER bitmask' # 52
-, SQL_TRANSACTION_CAPABLE => 'SQLUSMALLINT' # 46 =>
-, SQL_TRANSACTION_ISOLATION_OPTION => 'SQLUINTEGER bitmask' # 72 =>
-, SQL_TXN_CAPABLE => 'SQLUSMALLINT' # 46
-, SQL_TXN_ISOLATION_OPTION => 'SQLUINTEGER bitmask' # 72
-, SQL_UNION => 'SQLUINTEGER bitmask' # 96
-, SQL_UNION_STATEMENT => 'SQLUINTEGER bitmask' # 96 =>
-, SQL_USER_NAME => 'SQLCHAR' # 47
-, SQL_XOPEN_CLI_YEAR => 'SQLCHAR' # 10000
-);
-
-=head2 %ReturnValues
-
-See: sql.h, sqlext.h
-Edited:
- SQL_TXN_ISOLATION_OPTION
-
-=cut
-
-$ReturnValues{SQL_AGGREGATE_FUNCTIONS} =
-{
- SQL_AF_AVG => 0x00000001
-, SQL_AF_COUNT => 0x00000002
-, SQL_AF_MAX => 0x00000004
-, SQL_AF_MIN => 0x00000008
-, SQL_AF_SUM => 0x00000010
-, SQL_AF_DISTINCT => 0x00000020
-, SQL_AF_ALL => 0x00000040
-};
-$ReturnValues{SQL_ALTER_DOMAIN} =
-{
- SQL_AD_CONSTRAINT_NAME_DEFINITION => 0x00000001
-, SQL_AD_ADD_DOMAIN_CONSTRAINT => 0x00000002
-, SQL_AD_DROP_DOMAIN_CONSTRAINT => 0x00000004
-, SQL_AD_ADD_DOMAIN_DEFAULT => 0x00000008
-, SQL_AD_DROP_DOMAIN_DEFAULT => 0x00000010
-, SQL_AD_ADD_CONSTRAINT_INITIALLY_DEFERRED => 0x00000020
-, SQL_AD_ADD_CONSTRAINT_INITIALLY_IMMEDIATE => 0x00000040
-, SQL_AD_ADD_CONSTRAINT_DEFERRABLE => 0x00000080
-, SQL_AD_ADD_CONSTRAINT_NON_DEFERRABLE => 0x00000100
-};
-$ReturnValues{SQL_ALTER_TABLE} =
-{
- SQL_AT_ADD_COLUMN => 0x00000001
-, SQL_AT_DROP_COLUMN => 0x00000002
-, SQL_AT_ADD_CONSTRAINT => 0x00000008
-, SQL_AT_ADD_COLUMN_SINGLE => 0x00000020
-, SQL_AT_ADD_COLUMN_DEFAULT => 0x00000040
-, SQL_AT_ADD_COLUMN_COLLATION => 0x00000080
-, SQL_AT_SET_COLUMN_DEFAULT => 0x00000100
-, SQL_AT_DROP_COLUMN_DEFAULT => 0x00000200
-, SQL_AT_DROP_COLUMN_CASCADE => 0x00000400
-, SQL_AT_DROP_COLUMN_RESTRICT => 0x00000800
-, SQL_AT_ADD_TABLE_CONSTRAINT => 0x00001000
-, SQL_AT_DROP_TABLE_CONSTRAINT_CASCADE => 0x00002000
-, SQL_AT_DROP_TABLE_CONSTRAINT_RESTRICT => 0x00004000
-, SQL_AT_CONSTRAINT_NAME_DEFINITION => 0x00008000
-, SQL_AT_CONSTRAINT_INITIALLY_DEFERRED => 0x00010000
-, SQL_AT_CONSTRAINT_INITIALLY_IMMEDIATE => 0x00020000
-, SQL_AT_CONSTRAINT_DEFERRABLE => 0x00040000
-, SQL_AT_CONSTRAINT_NON_DEFERRABLE => 0x00080000
-};
-$ReturnValues{SQL_ASYNC_MODE} =
-{
- SQL_AM_NONE => 0
-, SQL_AM_CONNECTION => 1
-, SQL_AM_STATEMENT => 2
-};
-$ReturnValues{SQL_ATTR_MAX_ROWS} =
-{
- SQL_CA2_MAX_ROWS_SELECT => 0x00000080
-, SQL_CA2_MAX_ROWS_INSERT => 0x00000100
-, SQL_CA2_MAX_ROWS_DELETE => 0x00000200
-, SQL_CA2_MAX_ROWS_UPDATE => 0x00000400
-, SQL_CA2_MAX_ROWS_CATALOG => 0x00000800
-# SQL_CA2_MAX_ROWS_AFFECTS_ALL =>
-};
-$ReturnValues{SQL_ATTR_SCROLL_CONCURRENCY} =
-{
- SQL_CA2_READ_ONLY_CONCURRENCY => 0x00000001
-, SQL_CA2_LOCK_CONCURRENCY => 0x00000002
-, SQL_CA2_OPT_ROWVER_CONCURRENCY => 0x00000004
-, SQL_CA2_OPT_VALUES_CONCURRENCY => 0x00000008
-, SQL_CA2_SENSITIVITY_ADDITIONS => 0x00000010
-, SQL_CA2_SENSITIVITY_DELETIONS => 0x00000020
-, SQL_CA2_SENSITIVITY_UPDATES => 0x00000040
-};
-$ReturnValues{SQL_BATCH_ROW_COUNT} =
-{
- SQL_BRC_PROCEDURES => 0x0000001
-, SQL_BRC_EXPLICIT => 0x0000002
-, SQL_BRC_ROLLED_UP => 0x0000004
-};
-$ReturnValues{SQL_BATCH_SUPPORT} =
-{
- SQL_BS_SELECT_EXPLICIT => 0x00000001
-, SQL_BS_ROW_COUNT_EXPLICIT => 0x00000002
-, SQL_BS_SELECT_PROC => 0x00000004
-, SQL_BS_ROW_COUNT_PROC => 0x00000008
-};
-$ReturnValues{SQL_BOOKMARK_PERSISTENCE} =
-{
- SQL_BP_CLOSE => 0x00000001
-, SQL_BP_DELETE => 0x00000002
-, SQL_BP_DROP => 0x00000004
-, SQL_BP_TRANSACTION => 0x00000008
-, SQL_BP_UPDATE => 0x00000010
-, SQL_BP_OTHER_HSTMT => 0x00000020
-, SQL_BP_SCROLL => 0x00000040
-};
-$ReturnValues{SQL_CATALOG_LOCATION} =
-{
- SQL_CL_START => 0x0001 # SQL_QL_START
-, SQL_CL_END => 0x0002 # SQL_QL_END
-};
-$ReturnValues{SQL_CATALOG_USAGE} =
-{
- SQL_CU_DML_STATEMENTS => 0x00000001 # SQL_QU_DML_STATEMENTS
-, SQL_CU_PROCEDURE_INVOCATION => 0x00000002 # SQL_QU_PROCEDURE_INVOCATION
-, SQL_CU_TABLE_DEFINITION => 0x00000004 # SQL_QU_TABLE_DEFINITION
-, SQL_CU_INDEX_DEFINITION => 0x00000008 # SQL_QU_INDEX_DEFINITION
-, SQL_CU_PRIVILEGE_DEFINITION => 0x00000010 # SQL_QU_PRIVILEGE_DEFINITION
-};
-$ReturnValues{SQL_CONCAT_NULL_BEHAVIOR} =
-{
- SQL_CB_NULL => 0x0000
-, SQL_CB_NON_NULL => 0x0001
-};
-$ReturnValues{SQL_CONVERT_} =
-{
- SQL_CVT_CHAR => 0x00000001
-, SQL_CVT_NUMERIC => 0x00000002
-, SQL_CVT_DECIMAL => 0x00000004
-, SQL_CVT_INTEGER => 0x00000008
-, SQL_CVT_SMALLINT => 0x00000010
-, SQL_CVT_FLOAT => 0x00000020
-, SQL_CVT_REAL => 0x00000040
-, SQL_CVT_DOUBLE => 0x00000080
-, SQL_CVT_VARCHAR => 0x00000100
-, SQL_CVT_LONGVARCHAR => 0x00000200
-, SQL_CVT_BINARY => 0x00000400
-, SQL_CVT_VARBINARY => 0x00000800
-, SQL_CVT_BIT => 0x00001000
-, SQL_CVT_TINYINT => 0x00002000
-, SQL_CVT_BIGINT => 0x00004000
-, SQL_CVT_DATE => 0x00008000
-, SQL_CVT_TIME => 0x00010000
-, SQL_CVT_TIMESTAMP => 0x00020000
-, SQL_CVT_LONGVARBINARY => 0x00040000
-, SQL_CVT_INTERVAL_YEAR_MONTH => 0x00080000
-, SQL_CVT_INTERVAL_DAY_TIME => 0x00100000
-, SQL_CVT_WCHAR => 0x00200000
-, SQL_CVT_WLONGVARCHAR => 0x00400000
-, SQL_CVT_WVARCHAR => 0x00800000
-, SQL_CVT_GUID => 0x01000000
-};
-$ReturnValues{SQL_CONVERT_BIGINT } = $ReturnValues{SQL_CONVERT_};
-$ReturnValues{SQL_CONVERT_BINARY } = $ReturnValues{SQL_CONVERT_};
-$ReturnValues{SQL_CONVERT_BIT } = $ReturnValues{SQL_CONVERT_};
-$ReturnValues{SQL_CONVERT_CHAR } = $ReturnValues{SQL_CONVERT_};
-$ReturnValues{SQL_CONVERT_DATE } = $ReturnValues{SQL_CONVERT_};
-$ReturnValues{SQL_CONVERT_DECIMAL } = $ReturnValues{SQL_CONVERT_};
-$ReturnValues{SQL_CONVERT_DOUBLE } = $ReturnValues{SQL_CONVERT_};
-$ReturnValues{SQL_CONVERT_FLOAT } = $ReturnValues{SQL_CONVERT_};
-$ReturnValues{SQL_CONVERT_GUID } = $ReturnValues{SQL_CONVERT_};
-$ReturnValues{SQL_CONVERT_INTEGER } = $ReturnValues{SQL_CONVERT_};
-$ReturnValues{SQL_CONVERT_INTERVAL_DAY_TIME } = $ReturnValues{SQL_CONVERT_};
-$ReturnValues{SQL_CONVERT_INTERVAL_YEAR_MONTH} = $ReturnValues{SQL_CONVERT_};
-$ReturnValues{SQL_CONVERT_LONGVARBINARY } = $ReturnValues{SQL_CONVERT_};
-$ReturnValues{SQL_CONVERT_LONGVARCHAR } = $ReturnValues{SQL_CONVERT_};
-$ReturnValues{SQL_CONVERT_NUMERIC } = $ReturnValues{SQL_CONVERT_};
-$ReturnValues{SQL_CONVERT_REAL } = $ReturnValues{SQL_CONVERT_};
-$ReturnValues{SQL_CONVERT_SMALLINT } = $ReturnValues{SQL_CONVERT_};
-$ReturnValues{SQL_CONVERT_TIME } = $ReturnValues{SQL_CONVERT_};
-$ReturnValues{SQL_CONVERT_TIMESTAMP } = $ReturnValues{SQL_CONVERT_};
-$ReturnValues{SQL_CONVERT_TINYINT } = $ReturnValues{SQL_CONVERT_};
-$ReturnValues{SQL_CONVERT_VARBINARY } = $ReturnValues{SQL_CONVERT_};
-$ReturnValues{SQL_CONVERT_VARCHAR } = $ReturnValues{SQL_CONVERT_};
-$ReturnValues{SQL_CONVERT_WCHAR } = $ReturnValues{SQL_CONVERT_};
-$ReturnValues{SQL_CONVERT_WLONGVARCHAR } = $ReturnValues{SQL_CONVERT_};
-$ReturnValues{SQL_CONVERT_WVARCHAR } = $ReturnValues{SQL_CONVERT_};
-
-$ReturnValues{SQL_CONVERT_FUNCTIONS} =
-{
- SQL_FN_CVT_CONVERT => 0x00000001
-, SQL_FN_CVT_CAST => 0x00000002
-};
-$ReturnValues{SQL_CORRELATION_NAME} =
-{
- SQL_CN_NONE => 0x0000
-, SQL_CN_DIFFERENT => 0x0001
-, SQL_CN_ANY => 0x0002
-};
-$ReturnValues{SQL_CREATE_ASSERTION} =
-{
- SQL_CA_CREATE_ASSERTION => 0x00000001
-, SQL_CA_CONSTRAINT_INITIALLY_DEFERRED => 0x00000010
-, SQL_CA_CONSTRAINT_INITIALLY_IMMEDIATE => 0x00000020
-, SQL_CA_CONSTRAINT_DEFERRABLE => 0x00000040
-, SQL_CA_CONSTRAINT_NON_DEFERRABLE => 0x00000080
-};
-$ReturnValues{SQL_CREATE_CHARACTER_SET} =
-{
- SQL_CCS_CREATE_CHARACTER_SET => 0x00000001
-, SQL_CCS_COLLATE_CLAUSE => 0x00000002
-, SQL_CCS_LIMITED_COLLATION => 0x00000004
-};
-$ReturnValues{SQL_CREATE_COLLATION} =
-{
- SQL_CCOL_CREATE_COLLATION => 0x00000001
-};
-$ReturnValues{SQL_CREATE_DOMAIN} =
-{
- SQL_CDO_CREATE_DOMAIN => 0x00000001
-, SQL_CDO_DEFAULT => 0x00000002
-, SQL_CDO_CONSTRAINT => 0x00000004
-, SQL_CDO_COLLATION => 0x00000008
-, SQL_CDO_CONSTRAINT_NAME_DEFINITION => 0x00000010
-, SQL_CDO_CONSTRAINT_INITIALLY_DEFERRED => 0x00000020
-, SQL_CDO_CONSTRAINT_INITIALLY_IMMEDIATE => 0x00000040
-, SQL_CDO_CONSTRAINT_DEFERRABLE => 0x00000080
-, SQL_CDO_CONSTRAINT_NON_DEFERRABLE => 0x00000100
-};
-$ReturnValues{SQL_CREATE_SCHEMA} =
-{
- SQL_CS_CREATE_SCHEMA => 0x00000001
-, SQL_CS_AUTHORIZATION => 0x00000002
-, SQL_CS_DEFAULT_CHARACTER_SET => 0x00000004
-};
-$ReturnValues{SQL_CREATE_TABLE} =
-{
- SQL_CT_CREATE_TABLE => 0x00000001
-, SQL_CT_COMMIT_PRESERVE => 0x00000002
-, SQL_CT_COMMIT_DELETE => 0x00000004
-, SQL_CT_GLOBAL_TEMPORARY => 0x00000008
-, SQL_CT_LOCAL_TEMPORARY => 0x00000010
-, SQL_CT_CONSTRAINT_INITIALLY_DEFERRED => 0x00000020
-, SQL_CT_CONSTRAINT_INITIALLY_IMMEDIATE => 0x00000040
-, SQL_CT_CONSTRAINT_DEFERRABLE => 0x00000080
-, SQL_CT_CONSTRAINT_NON_DEFERRABLE => 0x00000100
-, SQL_CT_COLUMN_CONSTRAINT => 0x00000200
-, SQL_CT_COLUMN_DEFAULT => 0x00000400
-, SQL_CT_COLUMN_COLLATION => 0x00000800
-, SQL_CT_TABLE_CONSTRAINT => 0x00001000
-, SQL_CT_CONSTRAINT_NAME_DEFINITION => 0x00002000
-};
-$ReturnValues{SQL_CREATE_TRANSLATION} =
-{
- SQL_CTR_CREATE_TRANSLATION => 0x00000001
-};
-$ReturnValues{SQL_CREATE_VIEW} =
-{
- SQL_CV_CREATE_VIEW => 0x00000001
-, SQL_CV_CHECK_OPTION => 0x00000002
-, SQL_CV_CASCADED => 0x00000004
-, SQL_CV_LOCAL => 0x00000008
-};
-$ReturnValues{SQL_CURSOR_COMMIT_BEHAVIOR} =
-{
- SQL_CB_DELETE => 0
-, SQL_CB_CLOSE => 1
-, SQL_CB_PRESERVE => 2
-};
-$ReturnValues{SQL_CURSOR_ROLLBACK_BEHAVIOR} = $ReturnValues{SQL_CURSOR_COMMIT_BEHAVIOR};
-
-$ReturnValues{SQL_CURSOR_SENSITIVITY} =
-{
- SQL_UNSPECIFIED => 0
-, SQL_INSENSITIVE => 1
-, SQL_SENSITIVE => 2
-};
-$ReturnValues{SQL_DATETIME_LITERALS} =
-{
- SQL_DL_SQL92_DATE => 0x00000001
-, SQL_DL_SQL92_TIME => 0x00000002
-, SQL_DL_SQL92_TIMESTAMP => 0x00000004
-, SQL_DL_SQL92_INTERVAL_YEAR => 0x00000008
-, SQL_DL_SQL92_INTERVAL_MONTH => 0x00000010
-, SQL_DL_SQL92_INTERVAL_DAY => 0x00000020
-, SQL_DL_SQL92_INTERVAL_HOUR => 0x00000040
-, SQL_DL_SQL92_INTERVAL_MINUTE => 0x00000080
-, SQL_DL_SQL92_INTERVAL_SECOND => 0x00000100
-, SQL_DL_SQL92_INTERVAL_YEAR_TO_MONTH => 0x00000200
-, SQL_DL_SQL92_INTERVAL_DAY_TO_HOUR => 0x00000400
-, SQL_DL_SQL92_INTERVAL_DAY_TO_MINUTE => 0x00000800
-, SQL_DL_SQL92_INTERVAL_DAY_TO_SECOND => 0x00001000
-, SQL_DL_SQL92_INTERVAL_HOUR_TO_MINUTE => 0x00002000
-, SQL_DL_SQL92_INTERVAL_HOUR_TO_SECOND => 0x00004000
-, SQL_DL_SQL92_INTERVAL_MINUTE_TO_SECOND => 0x00008000
-};
-$ReturnValues{SQL_DDL_INDEX} =
-{
- SQL_DI_CREATE_INDEX => 0x00000001
-, SQL_DI_DROP_INDEX => 0x00000002
-};
-$ReturnValues{SQL_DIAG_CURSOR_ROW_COUNT} =
-{
- SQL_CA2_CRC_EXACT => 0x00001000
-, SQL_CA2_CRC_APPROXIMATE => 0x00002000
-, SQL_CA2_SIMULATE_NON_UNIQUE => 0x00004000
-, SQL_CA2_SIMULATE_TRY_UNIQUE => 0x00008000
-, SQL_CA2_SIMULATE_UNIQUE => 0x00010000
-};
-$ReturnValues{SQL_DROP_ASSERTION} =
-{
- SQL_DA_DROP_ASSERTION => 0x00000001
-};
-$ReturnValues{SQL_DROP_CHARACTER_SET} =
-{
- SQL_DCS_DROP_CHARACTER_SET => 0x00000001
-};
-$ReturnValues{SQL_DROP_COLLATION} =
-{
- SQL_DC_DROP_COLLATION => 0x00000001
-};
-$ReturnValues{SQL_DROP_DOMAIN} =
-{
- SQL_DD_DROP_DOMAIN => 0x00000001
-, SQL_DD_RESTRICT => 0x00000002
-, SQL_DD_CASCADE => 0x00000004
-};
-$ReturnValues{SQL_DROP_SCHEMA} =
-{
- SQL_DS_DROP_SCHEMA => 0x00000001
-, SQL_DS_RESTRICT => 0x00000002
-, SQL_DS_CASCADE => 0x00000004
-};
-$ReturnValues{SQL_DROP_TABLE} =
-{
- SQL_DT_DROP_TABLE => 0x00000001
-, SQL_DT_RESTRICT => 0x00000002
-, SQL_DT_CASCADE => 0x00000004
-};
-$ReturnValues{SQL_DROP_TRANSLATION} =
-{
- SQL_DTR_DROP_TRANSLATION => 0x00000001
-};
-$ReturnValues{SQL_DROP_VIEW} =
-{
- SQL_DV_DROP_VIEW => 0x00000001
-, SQL_DV_RESTRICT => 0x00000002
-, SQL_DV_CASCADE => 0x00000004
-};
-$ReturnValues{SQL_CURSOR_ATTRIBUTES1} =
-{
- SQL_CA1_NEXT => 0x00000001
-, SQL_CA1_ABSOLUTE => 0x00000002
-, SQL_CA1_RELATIVE => 0x00000004
-, SQL_CA1_BOOKMARK => 0x00000008
-, SQL_CA1_LOCK_NO_CHANGE => 0x00000040
-, SQL_CA1_LOCK_EXCLUSIVE => 0x00000080
-, SQL_CA1_LOCK_UNLOCK => 0x00000100
-, SQL_CA1_POS_POSITION => 0x00000200
-, SQL_CA1_POS_UPDATE => 0x00000400
-, SQL_CA1_POS_DELETE => 0x00000800
-, SQL_CA1_POS_REFRESH => 0x00001000
-, SQL_CA1_POSITIONED_UPDATE => 0x00002000
-, SQL_CA1_POSITIONED_DELETE => 0x00004000
-, SQL_CA1_SELECT_FOR_UPDATE => 0x00008000
-, SQL_CA1_BULK_ADD => 0x00010000
-, SQL_CA1_BULK_UPDATE_BY_BOOKMARK => 0x00020000
-, SQL_CA1_BULK_DELETE_BY_BOOKMARK => 0x00040000
-, SQL_CA1_BULK_FETCH_BY_BOOKMARK => 0x00080000
-};
-$ReturnValues{ SQL_DYNAMIC_CURSOR_ATTRIBUTES1} = $ReturnValues{SQL_CURSOR_ATTRIBUTES1};
-$ReturnValues{SQL_FORWARD_ONLY_CURSOR_ATTRIBUTES1} = $ReturnValues{SQL_CURSOR_ATTRIBUTES1};
-$ReturnValues{ SQL_KEYSET_CURSOR_ATTRIBUTES1} = $ReturnValues{SQL_CURSOR_ATTRIBUTES1};
-$ReturnValues{ SQL_STATIC_CURSOR_ATTRIBUTES1} = $ReturnValues{SQL_CURSOR_ATTRIBUTES1};
-
-$ReturnValues{SQL_CURSOR_ATTRIBUTES2} =
-{
- SQL_CA2_READ_ONLY_CONCURRENCY => 0x00000001
-, SQL_CA2_LOCK_CONCURRENCY => 0x00000002
-, SQL_CA2_OPT_ROWVER_CONCURRENCY => 0x00000004
-, SQL_CA2_OPT_VALUES_CONCURRENCY => 0x00000008
-, SQL_CA2_SENSITIVITY_ADDITIONS => 0x00000010
-, SQL_CA2_SENSITIVITY_DELETIONS => 0x00000020
-, SQL_CA2_SENSITIVITY_UPDATES => 0x00000040
-, SQL_CA2_MAX_ROWS_SELECT => 0x00000080
-, SQL_CA2_MAX_ROWS_INSERT => 0x00000100
-, SQL_CA2_MAX_ROWS_DELETE => 0x00000200
-, SQL_CA2_MAX_ROWS_UPDATE => 0x00000400
-, SQL_CA2_MAX_ROWS_CATALOG => 0x00000800
-, SQL_CA2_CRC_EXACT => 0x00001000
-, SQL_CA2_CRC_APPROXIMATE => 0x00002000
-, SQL_CA2_SIMULATE_NON_UNIQUE => 0x00004000
-, SQL_CA2_SIMULATE_TRY_UNIQUE => 0x00008000
-, SQL_CA2_SIMULATE_UNIQUE => 0x00010000
-};
-$ReturnValues{ SQL_DYNAMIC_CURSOR_ATTRIBUTES2} = $ReturnValues{SQL_CURSOR_ATTRIBUTES2};
-$ReturnValues{SQL_FORWARD_ONLY_CURSOR_ATTRIBUTES2} = $ReturnValues{SQL_CURSOR_ATTRIBUTES2};
-$ReturnValues{ SQL_KEYSET_CURSOR_ATTRIBUTES2} = $ReturnValues{SQL_CURSOR_ATTRIBUTES2};
-$ReturnValues{ SQL_STATIC_CURSOR_ATTRIBUTES2} = $ReturnValues{SQL_CURSOR_ATTRIBUTES2};
-
-$ReturnValues{SQL_FETCH_DIRECTION} =
-{
- SQL_FD_FETCH_NEXT => 0x00000001
-, SQL_FD_FETCH_FIRST => 0x00000002
-, SQL_FD_FETCH_LAST => 0x00000004
-, SQL_FD_FETCH_PRIOR => 0x00000008
-, SQL_FD_FETCH_ABSOLUTE => 0x00000010
-, SQL_FD_FETCH_RELATIVE => 0x00000020
-, SQL_FD_FETCH_RESUME => 0x00000040
-, SQL_FD_FETCH_BOOKMARK => 0x00000080
-};
-$ReturnValues{SQL_FILE_USAGE} =
-{
- SQL_FILE_NOT_SUPPORTED => 0x0000
-, SQL_FILE_TABLE => 0x0001
-, SQL_FILE_QUALIFIER => 0x0002
-, SQL_FILE_CATALOG => 0x0002 # SQL_FILE_QUALIFIER
-};
-$ReturnValues{SQL_GETDATA_EXTENSIONS} =
-{
- SQL_GD_ANY_COLUMN => 0x00000001
-, SQL_GD_ANY_ORDER => 0x00000002
-, SQL_GD_BLOCK => 0x00000004
-, SQL_GD_BOUND => 0x00000008
-};
-$ReturnValues{SQL_GROUP_BY} =
-{
- SQL_GB_NOT_SUPPORTED => 0x0000
-, SQL_GB_GROUP_BY_EQUALS_SELECT => 0x0001
-, SQL_GB_GROUP_BY_CONTAINS_SELECT => 0x0002
-, SQL_GB_NO_RELATION => 0x0003
-, SQL_GB_COLLATE => 0x0004
-};
-$ReturnValues{SQL_IDENTIFIER_CASE} =
-{
- SQL_IC_UPPER => 1
-, SQL_IC_LOWER => 2
-, SQL_IC_SENSITIVE => 3
-, SQL_IC_MIXED => 4
-};
-$ReturnValues{SQL_INDEX_KEYWORDS} =
-{
- SQL_IK_NONE => 0x00000000
-, SQL_IK_ASC => 0x00000001
-, SQL_IK_DESC => 0x00000002
-# SQL_IK_ALL =>
-};
-$ReturnValues{SQL_INFO_SCHEMA_VIEWS} =
-{
- SQL_ISV_ASSERTIONS => 0x00000001
-, SQL_ISV_CHARACTER_SETS => 0x00000002
-, SQL_ISV_CHECK_CONSTRAINTS => 0x00000004
-, SQL_ISV_COLLATIONS => 0x00000008
-, SQL_ISV_COLUMN_DOMAIN_USAGE => 0x00000010
-, SQL_ISV_COLUMN_PRIVILEGES => 0x00000020
-, SQL_ISV_COLUMNS => 0x00000040
-, SQL_ISV_CONSTRAINT_COLUMN_USAGE => 0x00000080
-, SQL_ISV_CONSTRAINT_TABLE_USAGE => 0x00000100
-, SQL_ISV_DOMAIN_CONSTRAINTS => 0x00000200
-, SQL_ISV_DOMAINS => 0x00000400
-, SQL_ISV_KEY_COLUMN_USAGE => 0x00000800
-, SQL_ISV_REFERENTIAL_CONSTRAINTS => 0x00001000
-, SQL_ISV_SCHEMATA => 0x00002000
-, SQL_ISV_SQL_LANGUAGES => 0x00004000
-, SQL_ISV_TABLE_CONSTRAINTS => 0x00008000
-, SQL_ISV_TABLE_PRIVILEGES => 0x00010000
-, SQL_ISV_TABLES => 0x00020000
-, SQL_ISV_TRANSLATIONS => 0x00040000
-, SQL_ISV_USAGE_PRIVILEGES => 0x00080000
-, SQL_ISV_VIEW_COLUMN_USAGE => 0x00100000
-, SQL_ISV_VIEW_TABLE_USAGE => 0x00200000
-, SQL_ISV_VIEWS => 0x00400000
-};
-$ReturnValues{SQL_INSERT_STATEMENT} =
-{
- SQL_IS_INSERT_LITERALS => 0x00000001
-, SQL_IS_INSERT_SEARCHED => 0x00000002
-, SQL_IS_SELECT_INTO => 0x00000004
-};
-$ReturnValues{SQL_LOCK_TYPES} =
-{
- SQL_LCK_NO_CHANGE => 0x00000001
-, SQL_LCK_EXCLUSIVE => 0x00000002
-, SQL_LCK_UNLOCK => 0x00000004
-};
-$ReturnValues{SQL_NON_NULLABLE_COLUMNS} =
-{
- SQL_NNC_NULL => 0x0000
-, SQL_NNC_NON_NULL => 0x0001
-};
-$ReturnValues{SQL_NULL_COLLATION} =
-{
- SQL_NC_HIGH => 0
-, SQL_NC_LOW => 1
-, SQL_NC_START => 0x0002
-, SQL_NC_END => 0x0004
-};
-$ReturnValues{SQL_NUMERIC_FUNCTIONS} =
-{
- SQL_FN_NUM_ABS => 0x00000001
-, SQL_FN_NUM_ACOS => 0x00000002
-, SQL_FN_NUM_ASIN => 0x00000004
-, SQL_FN_NUM_ATAN => 0x00000008
-, SQL_FN_NUM_ATAN2 => 0x00000010
-, SQL_FN_NUM_CEILING => 0x00000020
-, SQL_FN_NUM_COS => 0x00000040
-, SQL_FN_NUM_COT => 0x00000080
-, SQL_FN_NUM_EXP => 0x00000100
-, SQL_FN_NUM_FLOOR => 0x00000200
-, SQL_FN_NUM_LOG => 0x00000400
-, SQL_FN_NUM_MOD => 0x00000800
-, SQL_FN_NUM_SIGN => 0x00001000
-, SQL_FN_NUM_SIN => 0x00002000
-, SQL_FN_NUM_SQRT => 0x00004000
-, SQL_FN_NUM_TAN => 0x00008000
-, SQL_FN_NUM_PI => 0x00010000
-, SQL_FN_NUM_RAND => 0x00020000
-, SQL_FN_NUM_DEGREES => 0x00040000
-, SQL_FN_NUM_LOG10 => 0x00080000
-, SQL_FN_NUM_POWER => 0x00100000
-, SQL_FN_NUM_RADIANS => 0x00200000
-, SQL_FN_NUM_ROUND => 0x00400000
-, SQL_FN_NUM_TRUNCATE => 0x00800000
-};
-$ReturnValues{SQL_ODBC_API_CONFORMANCE} =
-{
- SQL_OAC_NONE => 0x0000
-, SQL_OAC_LEVEL1 => 0x0001
-, SQL_OAC_LEVEL2 => 0x0002
-};
-$ReturnValues{SQL_ODBC_INTERFACE_CONFORMANCE} =
-{
- SQL_OIC_CORE => 1
-, SQL_OIC_LEVEL1 => 2
-, SQL_OIC_LEVEL2 => 3
-};
-$ReturnValues{SQL_ODBC_SAG_CLI_CONFORMANCE} =
-{
- SQL_OSCC_NOT_COMPLIANT => 0x0000
-, SQL_OSCC_COMPLIANT => 0x0001
-};
-$ReturnValues{SQL_ODBC_SQL_CONFORMANCE} =
-{
- SQL_OSC_MINIMUM => 0x0000
-, SQL_OSC_CORE => 0x0001
-, SQL_OSC_EXTENDED => 0x0002
-};
-$ReturnValues{SQL_OJ_CAPABILITIES} =
-{
- SQL_OJ_LEFT => 0x00000001
-, SQL_OJ_RIGHT => 0x00000002
-, SQL_OJ_FULL => 0x00000004
-, SQL_OJ_NESTED => 0x00000008
-, SQL_OJ_NOT_ORDERED => 0x00000010
-, SQL_OJ_INNER => 0x00000020
-, SQL_OJ_ALL_COMPARISON_OPS => 0x00000040
-};
-$ReturnValues{SQL_OWNER_USAGE} =
-{
- SQL_OU_DML_STATEMENTS => 0x00000001
-, SQL_OU_PROCEDURE_INVOCATION => 0x00000002
-, SQL_OU_TABLE_DEFINITION => 0x00000004
-, SQL_OU_INDEX_DEFINITION => 0x00000008
-, SQL_OU_PRIVILEGE_DEFINITION => 0x00000010
-};
-$ReturnValues{SQL_PARAM_ARRAY_ROW_COUNTS} =
-{
- SQL_PARC_BATCH => 1
-, SQL_PARC_NO_BATCH => 2
-};
-$ReturnValues{SQL_PARAM_ARRAY_SELECTS} =
-{
- SQL_PAS_BATCH => 1
-, SQL_PAS_NO_BATCH => 2
-, SQL_PAS_NO_SELECT => 3
-};
-$ReturnValues{SQL_POSITIONED_STATEMENTS} =
-{
- SQL_PS_POSITIONED_DELETE => 0x00000001
-, SQL_PS_POSITIONED_UPDATE => 0x00000002
-, SQL_PS_SELECT_FOR_UPDATE => 0x00000004
-};
-$ReturnValues{SQL_POS_OPERATIONS} =
-{
- SQL_POS_POSITION => 0x00000001
-, SQL_POS_REFRESH => 0x00000002
-, SQL_POS_UPDATE => 0x00000004
-, SQL_POS_DELETE => 0x00000008
-, SQL_POS_ADD => 0x00000010
-};
-$ReturnValues{SQL_QUALIFIER_LOCATION} =
-{
- SQL_QL_START => 0x0001
-, SQL_QL_END => 0x0002
-};
-$ReturnValues{SQL_QUALIFIER_USAGE} =
-{
- SQL_QU_DML_STATEMENTS => 0x00000001
-, SQL_QU_PROCEDURE_INVOCATION => 0x00000002
-, SQL_QU_TABLE_DEFINITION => 0x00000004
-, SQL_QU_INDEX_DEFINITION => 0x00000008
-, SQL_QU_PRIVILEGE_DEFINITION => 0x00000010
-};
-$ReturnValues{SQL_QUOTED_IDENTIFIER_CASE} = $ReturnValues{SQL_IDENTIFIER_CASE};
-
-$ReturnValues{SQL_SCHEMA_USAGE} =
-{
- SQL_SU_DML_STATEMENTS => 0x00000001 # SQL_OU_DML_STATEMENTS
-, SQL_SU_PROCEDURE_INVOCATION => 0x00000002 # SQL_OU_PROCEDURE_INVOCATION
-, SQL_SU_TABLE_DEFINITION => 0x00000004 # SQL_OU_TABLE_DEFINITION
-, SQL_SU_INDEX_DEFINITION => 0x00000008 # SQL_OU_INDEX_DEFINITION
-, SQL_SU_PRIVILEGE_DEFINITION => 0x00000010 # SQL_OU_PRIVILEGE_DEFINITION
-};
-$ReturnValues{SQL_SCROLL_CONCURRENCY} =
-{
- SQL_SCCO_READ_ONLY => 0x00000001
-, SQL_SCCO_LOCK => 0x00000002
-, SQL_SCCO_OPT_ROWVER => 0x00000004
-, SQL_SCCO_OPT_VALUES => 0x00000008
-};
-$ReturnValues{SQL_SCROLL_OPTIONS} =
-{
- SQL_SO_FORWARD_ONLY => 0x00000001
-, SQL_SO_KEYSET_DRIVEN => 0x00000002
-, SQL_SO_DYNAMIC => 0x00000004
-, SQL_SO_MIXED => 0x00000008
-, SQL_SO_STATIC => 0x00000010
-};
-$ReturnValues{SQL_SQL92_DATETIME_FUNCTIONS} =
-{
- SQL_SDF_CURRENT_DATE => 0x00000001
-, SQL_SDF_CURRENT_TIME => 0x00000002
-, SQL_SDF_CURRENT_TIMESTAMP => 0x00000004
-};
-$ReturnValues{SQL_SQL92_FOREIGN_KEY_DELETE_RULE} =
-{
- SQL_SFKD_CASCADE => 0x00000001
-, SQL_SFKD_NO_ACTION => 0x00000002
-, SQL_SFKD_SET_DEFAULT => 0x00000004
-, SQL_SFKD_SET_NULL => 0x00000008
-};
-$ReturnValues{SQL_SQL92_FOREIGN_KEY_UPDATE_RULE} =
-{
- SQL_SFKU_CASCADE => 0x00000001
-, SQL_SFKU_NO_ACTION => 0x00000002
-, SQL_SFKU_SET_DEFAULT => 0x00000004
-, SQL_SFKU_SET_NULL => 0x00000008
-};
-$ReturnValues{SQL_SQL92_GRANT} =
-{
- SQL_SG_USAGE_ON_DOMAIN => 0x00000001
-, SQL_SG_USAGE_ON_CHARACTER_SET => 0x00000002
-, SQL_SG_USAGE_ON_COLLATION => 0x00000004
-, SQL_SG_USAGE_ON_TRANSLATION => 0x00000008
-, SQL_SG_WITH_GRANT_OPTION => 0x00000010
-, SQL_SG_DELETE_TABLE => 0x00000020
-, SQL_SG_INSERT_TABLE => 0x00000040
-, SQL_SG_INSERT_COLUMN => 0x00000080
-, SQL_SG_REFERENCES_TABLE => 0x00000100
-, SQL_SG_REFERENCES_COLUMN => 0x00000200
-, SQL_SG_SELECT_TABLE => 0x00000400
-, SQL_SG_UPDATE_TABLE => 0x00000800
-, SQL_SG_UPDATE_COLUMN => 0x00001000
-};
-$ReturnValues{SQL_SQL92_NUMERIC_VALUE_FUNCTIONS} =
-{
- SQL_SNVF_BIT_LENGTH => 0x00000001
-, SQL_SNVF_CHAR_LENGTH => 0x00000002
-, SQL_SNVF_CHARACTER_LENGTH => 0x00000004
-, SQL_SNVF_EXTRACT => 0x00000008
-, SQL_SNVF_OCTET_LENGTH => 0x00000010
-, SQL_SNVF_POSITION => 0x00000020
-};
-$ReturnValues{SQL_SQL92_PREDICATES} =
-{
- SQL_SP_EXISTS => 0x00000001
-, SQL_SP_ISNOTNULL => 0x00000002
-, SQL_SP_ISNULL => 0x00000004
-, SQL_SP_MATCH_FULL => 0x00000008
-, SQL_SP_MATCH_PARTIAL => 0x00000010
-, SQL_SP_MATCH_UNIQUE_FULL => 0x00000020
-, SQL_SP_MATCH_UNIQUE_PARTIAL => 0x00000040
-, SQL_SP_OVERLAPS => 0x00000080
-, SQL_SP_UNIQUE => 0x00000100
-, SQL_SP_LIKE => 0x00000200
-, SQL_SP_IN => 0x00000400
-, SQL_SP_BETWEEN => 0x00000800
-, SQL_SP_COMPARISON => 0x00001000
-, SQL_SP_QUANTIFIED_COMPARISON => 0x00002000
-};
-$ReturnValues{SQL_SQL92_RELATIONAL_JOIN_OPERATORS} =
-{
- SQL_SRJO_CORRESPONDING_CLAUSE => 0x00000001
-, SQL_SRJO_CROSS_JOIN => 0x00000002
-, SQL_SRJO_EXCEPT_JOIN => 0x00000004
-, SQL_SRJO_FULL_OUTER_JOIN => 0x00000008
-, SQL_SRJO_INNER_JOIN => 0x00000010
-, SQL_SRJO_INTERSECT_JOIN => 0x00000020
-, SQL_SRJO_LEFT_OUTER_JOIN => 0x00000040
-, SQL_SRJO_NATURAL_JOIN => 0x00000080
-, SQL_SRJO_RIGHT_OUTER_JOIN => 0x00000100
-, SQL_SRJO_UNION_JOIN => 0x00000200
-};
-$ReturnValues{SQL_SQL92_REVOKE} =
-{
- SQL_SR_USAGE_ON_DOMAIN => 0x00000001
-, SQL_SR_USAGE_ON_CHARACTER_SET => 0x00000002
-, SQL_SR_USAGE_ON_COLLATION => 0x00000004
-, SQL_SR_USAGE_ON_TRANSLATION => 0x00000008
-, SQL_SR_GRANT_OPTION_FOR => 0x00000010
-, SQL_SR_CASCADE => 0x00000020
-, SQL_SR_RESTRICT => 0x00000040
-, SQL_SR_DELETE_TABLE => 0x00000080
-, SQL_SR_INSERT_TABLE => 0x00000100
-, SQL_SR_INSERT_COLUMN => 0x00000200
-, SQL_SR_REFERENCES_TABLE => 0x00000400
-, SQL_SR_REFERENCES_COLUMN => 0x00000800
-, SQL_SR_SELECT_TABLE => 0x00001000
-, SQL_SR_UPDATE_TABLE => 0x00002000
-, SQL_SR_UPDATE_COLUMN => 0x00004000
-};
-$ReturnValues{SQL_SQL92_ROW_VALUE_CONSTRUCTOR} =
-{
- SQL_SRVC_VALUE_EXPRESSION => 0x00000001
-, SQL_SRVC_NULL => 0x00000002
-, SQL_SRVC_DEFAULT => 0x00000004
-, SQL_SRVC_ROW_SUBQUERY => 0x00000008
-};
-$ReturnValues{SQL_SQL92_STRING_FUNCTIONS} =
-{
- SQL_SSF_CONVERT => 0x00000001
-, SQL_SSF_LOWER => 0x00000002
-, SQL_SSF_UPPER => 0x00000004
-, SQL_SSF_SUBSTRING => 0x00000008
-, SQL_SSF_TRANSLATE => 0x00000010
-, SQL_SSF_TRIM_BOTH => 0x00000020
-, SQL_SSF_TRIM_LEADING => 0x00000040
-, SQL_SSF_TRIM_TRAILING => 0x00000080
-};
-$ReturnValues{SQL_SQL92_VALUE_EXPRESSIONS} =
-{
- SQL_SVE_CASE => 0x00000001
-, SQL_SVE_CAST => 0x00000002
-, SQL_SVE_COALESCE => 0x00000004
-, SQL_SVE_NULLIF => 0x00000008
-};
-$ReturnValues{SQL_SQL_CONFORMANCE} =
-{
- SQL_SC_SQL92_ENTRY => 0x00000001
-, SQL_SC_FIPS127_2_TRANSITIONAL => 0x00000002
-, SQL_SC_SQL92_INTERMEDIATE => 0x00000004
-, SQL_SC_SQL92_FULL => 0x00000008
-};
-$ReturnValues{SQL_STANDARD_CLI_CONFORMANCE} =
-{
- SQL_SCC_XOPEN_CLI_VERSION1 => 0x00000001
-, SQL_SCC_ISO92_CLI => 0x00000002
-};
-$ReturnValues{SQL_STATIC_SENSITIVITY} =
-{
- SQL_SS_ADDITIONS => 0x00000001
-, SQL_SS_DELETIONS => 0x00000002
-, SQL_SS_UPDATES => 0x00000004
-};
-$ReturnValues{SQL_STRING_FUNCTIONS} =
-{
- SQL_FN_STR_CONCAT => 0x00000001
-, SQL_FN_STR_INSERT => 0x00000002
-, SQL_FN_STR_LEFT => 0x00000004
-, SQL_FN_STR_LTRIM => 0x00000008
-, SQL_FN_STR_LENGTH => 0x00000010
-, SQL_FN_STR_LOCATE => 0x00000020
-, SQL_FN_STR_LCASE => 0x00000040
-, SQL_FN_STR_REPEAT => 0x00000080
-, SQL_FN_STR_REPLACE => 0x00000100
-, SQL_FN_STR_RIGHT => 0x00000200
-, SQL_FN_STR_RTRIM => 0x00000400
-, SQL_FN_STR_SUBSTRING => 0x00000800
-, SQL_FN_STR_UCASE => 0x00001000
-, SQL_FN_STR_ASCII => 0x00002000
-, SQL_FN_STR_CHAR => 0x00004000
-, SQL_FN_STR_DIFFERENCE => 0x00008000
-, SQL_FN_STR_LOCATE_2 => 0x00010000
-, SQL_FN_STR_SOUNDEX => 0x00020000
-, SQL_FN_STR_SPACE => 0x00040000
-, SQL_FN_STR_BIT_LENGTH => 0x00080000
-, SQL_FN_STR_CHAR_LENGTH => 0x00100000
-, SQL_FN_STR_CHARACTER_LENGTH => 0x00200000
-, SQL_FN_STR_OCTET_LENGTH => 0x00400000
-, SQL_FN_STR_POSITION => 0x00800000
-};
-$ReturnValues{SQL_SUBQUERIES} =
-{
- SQL_SQ_COMPARISON => 0x00000001
-, SQL_SQ_EXISTS => 0x00000002
-, SQL_SQ_IN => 0x00000004
-, SQL_SQ_QUANTIFIED => 0x00000008
-, SQL_SQ_CORRELATED_SUBQUERIES => 0x00000010
-};
-$ReturnValues{SQL_SYSTEM_FUNCTIONS} =
-{
- SQL_FN_SYS_USERNAME => 0x00000001
-, SQL_FN_SYS_DBNAME => 0x00000002
-, SQL_FN_SYS_IFNULL => 0x00000004
-};
-$ReturnValues{SQL_TIMEDATE_ADD_INTERVALS} =
-{
- SQL_FN_TSI_FRAC_SECOND => 0x00000001
-, SQL_FN_TSI_SECOND => 0x00000002
-, SQL_FN_TSI_MINUTE => 0x00000004
-, SQL_FN_TSI_HOUR => 0x00000008
-, SQL_FN_TSI_DAY => 0x00000010
-, SQL_FN_TSI_WEEK => 0x00000020
-, SQL_FN_TSI_MONTH => 0x00000040
-, SQL_FN_TSI_QUARTER => 0x00000080
-, SQL_FN_TSI_YEAR => 0x00000100
-};
-$ReturnValues{SQL_TIMEDATE_FUNCTIONS} =
-{
- SQL_FN_TD_NOW => 0x00000001
-, SQL_FN_TD_CURDATE => 0x00000002
-, SQL_FN_TD_DAYOFMONTH => 0x00000004
-, SQL_FN_TD_DAYOFWEEK => 0x00000008
-, SQL_FN_TD_DAYOFYEAR => 0x00000010
-, SQL_FN_TD_MONTH => 0x00000020
-, SQL_FN_TD_QUARTER => 0x00000040
-, SQL_FN_TD_WEEK => 0x00000080
-, SQL_FN_TD_YEAR => 0x00000100
-, SQL_FN_TD_CURTIME => 0x00000200
-, SQL_FN_TD_HOUR => 0x00000400
-, SQL_FN_TD_MINUTE => 0x00000800
-, SQL_FN_TD_SECOND => 0x00001000
-, SQL_FN_TD_TIMESTAMPADD => 0x00002000
-, SQL_FN_TD_TIMESTAMPDIFF => 0x00004000
-, SQL_FN_TD_DAYNAME => 0x00008000
-, SQL_FN_TD_MONTHNAME => 0x00010000
-, SQL_FN_TD_CURRENT_DATE => 0x00020000
-, SQL_FN_TD_CURRENT_TIME => 0x00040000
-, SQL_FN_TD_CURRENT_TIMESTAMP => 0x00080000
-, SQL_FN_TD_EXTRACT => 0x00100000
-};
-$ReturnValues{SQL_TXN_CAPABLE} =
-{
- SQL_TC_NONE => 0
-, SQL_TC_DML => 1
-, SQL_TC_ALL => 2
-, SQL_TC_DDL_COMMIT => 3
-, SQL_TC_DDL_IGNORE => 4
-};
-$ReturnValues{SQL_TRANSACTION_ISOLATION_OPTION} =
-{
- SQL_TRANSACTION_READ_UNCOMMITTED => 0x00000001 # SQL_TXN_READ_UNCOMMITTED
-, SQL_TRANSACTION_READ_COMMITTED => 0x00000002 # SQL_TXN_READ_COMMITTED
-, SQL_TRANSACTION_REPEATABLE_READ => 0x00000004 # SQL_TXN_REPEATABLE_READ
-, SQL_TRANSACTION_SERIALIZABLE => 0x00000008 # SQL_TXN_SERIALIZABLE
-};
-$ReturnValues{SQL_DEFAULT_TRANSACTION_ISOLATION} = $ReturnValues{SQL_TRANSACTION_ISOLATION_OPTION};
-
-$ReturnValues{SQL_TXN_ISOLATION_OPTION} =
-{
- SQL_TXN_READ_UNCOMMITTED => 0x00000001
-, SQL_TXN_READ_COMMITTED => 0x00000002
-, SQL_TXN_REPEATABLE_READ => 0x00000004
-, SQL_TXN_SERIALIZABLE => 0x00000008
-};
-$ReturnValues{SQL_DEFAULT_TXN_ISOLATION} = $ReturnValues{SQL_TXN_ISOLATION_OPTION};
-
-$ReturnValues{SQL_TXN_VERSIONING} =
-{
- SQL_TXN_VERSIONING => 0x00000010
-};
-$ReturnValues{SQL_UNION} =
-{
- SQL_U_UNION => 0x00000001
-, SQL_U_UNION_ALL => 0x00000002
-};
-$ReturnValues{SQL_UNION_STATEMENT} =
-{
- SQL_US_UNION => 0x00000001 # SQL_U_UNION
-, SQL_US_UNION_ALL => 0x00000002 # SQL_U_UNION_ALL
-};
-
-1;
-
-=head1 TODO
-
- Corrections?
- SQL_NULL_COLLATION: ODBC vs ANSI
- Unique values for $ReturnValues{...}?, e.g. SQL_FILE_USAGE
-
-=cut
+++ /dev/null
-# $Id: GetInfoReturn.pm 8696 2007-01-24 23:12:38Z Tim $
-#
-# Copyright (c) 2002 Tim Bunce Ireland
-#
-# Constant data describing return values from the DBI getinfo function.
-#
-# You may distribute under the terms of either the GNU General Public
-# License or the Artistic License, as specified in the Perl README file.
-
-package DBI::Const::GetInfoReturn;
-
-use strict;
-
-use Exporter ();
-
-use vars qw(@ISA @EXPORT @EXPORT_OK %GetInfoReturnTypes %GetInfoReturnValues);
-
-@ISA = qw(Exporter);
-@EXPORT = qw(%GetInfoReturnTypes %GetInfoReturnValues);
-
-my
-$VERSION = "2.008697";
-
-=head1 NAME
-
-DBI::Const::GetInfoReturn - Data and functions for describing GetInfo results
-
-=head1 SYNOPSIS
-
-The interface to this module is undocumented and liable to change.
-
-=head1 DESCRIPTION
-
-Data and functions for describing GetInfo results
-
-=cut
-
-use DBI::Const::GetInfoType;
-
-use DBI::Const::GetInfo::ANSI ();
-use DBI::Const::GetInfo::ODBC ();
-
-%GetInfoReturnTypes =
-(
- %DBI::Const::GetInfo::ANSI::ReturnTypes
-, %DBI::Const::GetInfo::ODBC::ReturnTypes
-);
-
-%GetInfoReturnValues = ();
-{
- my $A = \%DBI::Const::GetInfo::ANSI::ReturnValues;
- my $O = \%DBI::Const::GetInfo::ODBC::ReturnValues;
- while ( my ($k, $v) = each %$A ) {
- my %h = ( exists $O->{$k} ) ? ( %$v, %{$O->{$k}} ) : %$v;
- $GetInfoReturnValues{$k} = \%h;
- }
- while ( my ($k, $v) = each %$O ) {
- next if exists $A->{$k};
- my %h = %$v;
- $GetInfoReturnValues{$k} = \%h;
- }
-}
-
-# -----------------------------------------------------------------------------
-
-sub Format {
- my $InfoType = shift;
- my $Value = shift;
-
- return '' unless defined $Value;
-
- my $ReturnType = $GetInfoReturnTypes{$InfoType};
-
- return sprintf '0x%08X', $Value if $ReturnType eq 'SQLUINTEGER bitmask';
- return sprintf '0x%08X', $Value if $ReturnType eq 'SQLINTEGER bitmask';
-# return '"' . $Value . '"' if $ReturnType eq 'SQLCHAR';
- return $Value;
-}
-
-
-sub Explain {
- my $InfoType = shift;
- my $Value = shift;
-
- return '' unless defined $Value;
- return '' unless exists $GetInfoReturnValues{$InfoType};
-
- $Value = int $Value;
- my $ReturnType = $GetInfoReturnTypes{$InfoType};
- my %h = reverse %{$GetInfoReturnValues{$InfoType}};
-
- if ( $ReturnType eq 'SQLUINTEGER bitmask'|| $ReturnType eq 'SQLINTEGER bitmask') {
- my @a = ();
- for my $k ( sort { $a <=> $b } keys %h ) {
- push @a, $h{$k} if $Value & $k;
- }
- return wantarray ? @a : join(' ', @a );
- }
- else {
- return $h{$Value} ||'?';
- }
-}
-
-1;
+++ /dev/null
-# $Id: GetInfoType.pm 8696 2007-01-24 23:12:38Z Tim $
-#
-# Copyright (c) 2002 Tim Bunce Ireland
-#
-# Constant data describing info type codes for the DBI getinfo function.
-#
-# You may distribute under the terms of either the GNU General Public
-# License or the Artistic License, as specified in the Perl README file.
-
-package DBI::Const::GetInfoType;
-
-use strict;
-
-use Exporter ();
-
-use vars qw(@ISA @EXPORT @EXPORT_OK %GetInfoType);
-
-@ISA = qw(Exporter);
-@EXPORT = qw(%GetInfoType);
-
-my
-$VERSION = "2.008697";
-
-=head1 NAME
-
-DBI::Const::GetInfoType - Data describing GetInfo type codes
-
-=head1 SYNOPSIS
-
- use DBI::Const::GetInfoType;
-
-=head1 DESCRIPTION
-
-Imports a %GetInfoType hash which maps names for GetInfo Type Codes
-into their corresponding numeric values. For example:
-
- $database_version = $dbh->get_info( $GetInfoType{SQL_DBMS_VER} );
-
-The interface to this module is new and nothing beyond what is
-written here is guaranteed.
-
-=cut
-
-use DBI::Const::GetInfo::ANSI (); # liable to change
-use DBI::Const::GetInfo::ODBC (); # liable to change
-
-%GetInfoType =
-(
- %DBI::Const::GetInfo::ANSI::InfoTypes # liable to change
-, %DBI::Const::GetInfo::ODBC::InfoTypes # liable to change
-);
-
-1;
+++ /dev/null
-package DBI::DBD;
-# vim:ts=8:sw=4
-use strict;
-use vars qw($VERSION); # set $VERSION early so we don't confuse PAUSE/CPAN etc
-
-# don't use Revision here because that's not in svn:keywords so that the
-# examples that use it below won't be messed up
-$VERSION = "12.015129";
-
-# $Id: DBD.pm 15128 2012-02-04 20:51:39Z Tim $
-#
-# Copyright (c) 1997-2006 Jonathan Leffler, Jochen Wiedmann, Steffen
-# Goeldner and Tim Bunce
-#
-# You may distribute under the terms of either the GNU General Public
-# License or the Artistic License, as specified in the Perl README file.
-
-=head1 NAME
-
-DBI::DBD - Perl DBI Database Driver Writer's Guide
-
-=head1 SYNOPSIS
-
- perldoc DBI::DBD
-
-=head2 Version and volatility
-
-This document is I<still> a minimal draft which is in need of further work.
-
-Please read the B<DBI> documentation first and fully. Then look at the
-implementation of some high-profile and regularly maintained drivers like
-DBD::Oracle, DBD::ODBC, DBD::Pg etc. (Those are no no particular order.)
-
-Then reread the B<DBI> specification and the code of those drivers again as
-you're reading this. It'll help. Where this document and the driver code
-differ it's likely that the driver code is more correct, especially if multiple
-drivers do the same thing.
-
-This document is a patchwork of contributions from various authors.
-More contributions (preferably as patches) are very welcome.
-
-=head1 DESCRIPTION
-
-This document is primarily intended to help people writing new
-database drivers for the Perl Database Interface (Perl DBI).
-It may also help others interested in discovering why the internals of
-a B<DBD> driver are written the way they are.
-
-This is a guide. Few (if any) of the statements in it are completely
-authoritative under all possible circumstances. This means you will
-need to use judgement in applying the guidelines in this document.
-If in I<any> doubt at all, please do contact the I<dbi-dev> mailing list
-(details given below) where Tim Bunce and other driver authors can help.
-
-=head1 CREATING A NEW DRIVER
-
-The first rule for creating a new database driver for the Perl DBI is
-very simple: B<DON'T!>
-
-There is usually a driver already available for the database you want
-to use, almost regardless of which database you choose. Very often, the
-database will provide an ODBC driver interface, so you can often use
-B<DBD::ODBC> to access the database. This is typically less convenient
-on a Unix box than on a Microsoft Windows box, but there are numerous
-options for ODBC driver managers on Unix too, and very often the ODBC
-driver is provided by the database supplier.
-
-Before deciding that you need to write a driver, do your homework to
-ensure that you are not wasting your energies.
-
-[As of December 2002, the consensus is that if you need an ODBC driver
-manager on Unix, then the unixODBC driver (available from
-L<http://www.unixodbc.org/>) is the way to go.]
-
-The second rule for creating a new database driver for the Perl DBI is
-also very simple: B<Don't -- get someone else to do it for you!>
-
-Nevertheless, there are occasions when it is necessary to write a new
-driver, often to use a proprietary language or API to access the
-database more swiftly, or more comprehensively, than an ODBC driver can.
-Then you should read this document very carefully, but with a suitably
-sceptical eye.
-
-If there is something in here that does not make any sense, question it.
-You might be right that the information is bogus, but don't come to that
-conclusion too quickly.
-
-=head2 URLs and mailing lists
-
-The primary web-site for locating B<DBI> software and information is
-
- http://dbi.perl.org/
-
-There are two main and one auxiliary mailing lists for people working
-with B<DBI>. The primary lists are I<dbi-users@perl.org> for general users
-of B<DBI> and B<DBD> drivers, and I<dbi-dev@perl.org> mainly for B<DBD> driver
-writers (don't join the I<dbi-dev> list unless you have a good reason).
-The auxiliary list is I<dbi-announce@perl.org> for announcing new
-releases of B<DBI> or B<DBD> drivers.
-
-You can join these lists by accessing the web-site L<http://dbi.perl.org/>.
-The lists are closed so you cannot send email to any of the lists
-unless you join the list first.
-
-You should also consider monitoring the I<comp.lang.perl.*> newsgroups,
-especially I<comp.lang.perl.modules>.
-
-=head2 The Cheetah book
-
-The definitive book on Perl DBI is the Cheetah book, so called because
-of the picture on the cover. Its proper title is 'I<Programming the
-Perl DBI: Database programming with Perl>' by Alligator Descartes
-and Tim Bunce, published by O'Reilly Associates, February 2000, ISBN
-1-56592-699-4. Buy it now if you have not already done so, and read it.
-
-=head2 Locating drivers
-
-Before writing a new driver, it is in your interests to find out
-whether there already is a driver for your database. If there is such
-a driver, it would be much easier to make use of it than to write your
-own!
-
-The primary web-site for locating Perl software is
-L<http://search.cpan.org/>. You should look under the various
-modules listings for the software you are after. For example:
-
- http://search.cpan.org/modlist/Database_Interfaces
-
-Follow the B<DBD::> and B<DBIx::> links at the top to see those subsets.
-
-See the B<DBI> docs for information on B<DBI> web sites and mailing lists.
-
-=head2 Registering a new driver
-
-Before going through any official registration process, you will need
-to establish that there is no driver already in the works. You'll do
-that by asking the B<DBI> mailing lists whether there is such a driver
-available, or whether anybody is working on one.
-
-When you get the go ahead, you will need to establish the name of the
-driver and a prefix for the driver. Typically, the name is based on the
-name of the database software it uses, and the prefix is a contraction
-of that. Hence, B<DBD::Oracle> has the name I<Oracle> and the prefix
-'I<ora_>'. The prefix must be lowercase and contain no underscores other
-than the one at the end.
-
-This information will be recorded in the B<DBI> module. Apart from
-documentation purposes, registration is a prerequisite for
-L<installing private methods|DBI/install_method>.
-
-If you are writing a driver which will not be distributed on CPAN, then
-you should choose a prefix beginning with 'I<x_>', to avoid potential
-prefix collisions with drivers registered in the future. Thus, if you
-wrote a non-CPAN distributed driver called B<DBD::CustomDB>, the prefix
-might be 'I<x_cdb_>'.
-
-This document assumes you are writing a driver called B<DBD::Driver>, and
-that the prefix 'I<drv_>' is assigned to the driver.
-
-=head2 Two styles of database driver
-
-There are two distinct styles of database driver that can be written to
-work with the Perl DBI.
-
-Your driver can be written in pure Perl, requiring no C compiler.
-When feasible, this is the best solution, but most databases are not
-written in such a way that this can be done. Some examples of pure
-Perl drivers are B<DBD::File> and B<DBD::CSV>.
-
-Alternatively, and most commonly, your driver will need to use some C
-code to gain access to the database. This will be classified as a C/XS
-driver.
-
-=head2 What code will you write?
-
-There are a number of files that need to be written for either a pure
-Perl driver or a C/XS driver. There are no extra files needed only by
-a pure Perl driver, but there are several extra files needed only by a
-C/XS driver.
-
-=head3 Files common to pure Perl and C/XS drivers
-
-Assuming that your driver is called B<DBD::Driver>, these files are:
-
-=over 4
-
-=item * F<Makefile.PL>
-
-=item * F<META.yml>
-
-=item * F<README>
-
-=item * F<MANIFEST>
-
-=item * F<Driver.pm>
-
-=item * F<lib/Bundle/DBD/Driver.pm>
-
-=item * F<lib/DBD/Driver/Summary.pm>
-
-=item * F<t/*.t>
-
-=back
-
-The first four files are mandatory. F<Makefile.PL> is used to control
-how the driver is built and installed. The F<README> file tells people
-who download the file about how to build the module and any prerequisite
-software that must be installed. The F<MANIFEST> file is used by the
-standard Perl module distribution mechanism. It lists all the source
-files that need to be distributed with your module. F<Driver.pm> is what
-is loaded by the B<DBI> code; it contains the methods peculiar to your
-driver.
-
-Although the F<META.yml> file is not B<required> you are advised to
-create one. Of particular importance are the I<build_requires> and
-I<configure_requires> attributes which newer CPAN modules understand.
-You use these to tell the CPAN module (and CPANPLUS) that your build
-and configure mechanisms require DBI. The best reference for META.yml
-(at the time of writing) is
-L<http://module-build.sourceforge.net/META-spec-v1.4.html>. You can find
-a reasonable example of a F<META.yml> in DBD::ODBC.
-
-The F<lib/Bundle/DBD/Driver.pm> file allows you to specify other Perl
-modules on which yours depends in a format that allows someone to type a
-simple command and ensure that all the pre-requisites are in place as
-well as building your driver.
-
-The F<lib/DBD/Driver/Summary.pm> file contains (an updated version of) the
-information that was included - or that would have been included - in
-the appendices of the Cheetah book as a summary of the abilities of your
-driver and the associated database.
-
-The files in the F<t> subdirectory are unit tests for your driver.
-You should write your tests as stringently as possible, while taking
-into account the diversity of installations that you can encounter:
-
-=over 4
-
-=item *
-
-Your tests should not casually modify operational databases.
-
-=item *
-
-You should never damage existing tables in a database.
-
-=item *
-
-You should code your tests to use a constrained name space within the
-database. For example, the tables (and all other named objects) that are
-created could all begin with 'I<dbd_drv_>'.
-
-=item *
-
-At the end of a test run, there should be no testing objects left behind
-in the database.
-
-=item *
-
-If you create any databases, you should remove them.
-
-=item *
-
-If your database supports temporary tables that are automatically
-removed at the end of a session, then exploit them as often as possible.
-
-=item *
-
-Try to make your tests independent of each other. If you have a
-test F<t/t11dowhat.t> that depends upon the successful running
-of F<t/t10thingamy.t>, people cannot run the single test case
-F<t/t11dowhat.t>. Further, running F<t/t11dowhat.t> twice in a row is
-likely to fail (at least, if F<t/t11dowhat.t> modifies the database at
-all) because the database at the start of the second run is not what you
-saw at the start of the first run.
-
-=item *
-
-Document in your F<README> file what you do, and what privileges people
-need to do it.
-
-=item *
-
-You can, and probably should, sequence your tests by including a test
-number before an abbreviated version of the test name; the tests are run
-in the order in which the names are expanded by shell-style globbing.
-
-=item *
-
-It is in your interests to ensure that your tests work as widely
-as possible.
-
-=back
-
-Many drivers also install sub-modules B<DBD::Driver::SubModule>
-for any of a variety of different reasons, such as to support
-the metadata methods (see the discussion of L</METADATA METHODS>
-below). Such sub-modules are conventionally stored in the directory
-F<lib/DBD/Driver>. The module itself would usually be in a file
-F<SubModule.pm>. All such sub-modules should themselves be version
-stamped (see the discussions far below).
-
-=head3 Extra files needed by C/XS drivers
-
-The software for a C/XS driver will typically contain at least four
-extra files that are not relevant to a pure Perl driver.
-
-=over 4
-
-=item * F<Driver.xs>
-
-=item * F<Driver.h>
-
-=item * F<dbdimp.h>
-
-=item * F<dbdimp.c>
-
-=back
-
-The F<Driver.xs> file is used to generate C code that Perl can call to gain
-access to the C functions you write that will, in turn, call down onto
-your database software.
-
-The F<Driver.h> header is a stylized header that ensures you can access the
-necessary Perl and B<DBI> macros, types, and function declarations.
-
-The F<dbdimp.h> is used to specify which functions have been implemented by
-your driver.
-
-The F<dbdimp.c> file is where you write the C code that does the real work
-of translating between Perl-ish data types and what the database expects
-to use and return.
-
-There are some (mainly small, but very important) differences between
-the contents of F<Makefile.PL> and F<Driver.pm> for pure Perl and C/XS
-drivers, so those files are described both in the section on creating a
-pure Perl driver and in the section on creating a C/XS driver.
-
-Obviously, you can add extra source code files to the list.
-
-=head2 Requirements on a driver and driver writer
-
-To be remotely useful, your driver must be implemented in a format that
-allows it to be distributed via CPAN, the Comprehensive Perl Archive
-Network (L<http://www.cpan.org/> and L<http://search.cpan.org>).
-Of course, it is easier if you do not have to meet this criterion, but
-you will not be able to ask for much help if you do not do so, and
-no-one is likely to want to install your module if they have to learn a
-new installation mechanism.
-
-=head1 CREATING A PURE PERL DRIVER
-
-Writing a pure Perl driver is surprisingly simple. However, there are
-some problems you should be aware of. The best option is of course
-picking up an existing driver and carefully modifying one method
-after the other.
-
-Also look carefully at B<DBD::AnyData> and B<DBD::Template>.
-
-As an example we take a look at the B<DBD::File> driver, a driver for
-accessing plain files as tables, which is part of the B<DBD::CSV> package.
-
-The minimal set of files we have to implement are F<Makefile.PL>,
-F<README>, F<MANIFEST> and F<Driver.pm>.
-
-=head2 Pure Perl version of Makefile.PL
-
-You typically start with writing F<Makefile.PL>, a Makefile
-generator. The contents of this file are described in detail in
-the L<ExtUtils::MakeMaker> man pages. It is definitely a good idea
-if you start reading them. At least you should know about the
-variables I<CONFIGURE>, I<DEFINED>, I<PM>, I<DIR>, I<EXE_FILES>,
-I<INC>, I<LIBS>, I<LINKTYPE>, I<NAME>, I<OPTIMIZE>, I<PL_FILES>,
-I<VERSION>, I<VERSION_FROM>, I<clean>, I<depend>, I<realclean> from
-the L<ExtUtils::MakeMaker> man page: these are used in almost any
-F<Makefile.PL>.
-
-Additionally read the section on I<Overriding MakeMaker Methods> and the
-descriptions of the I<distcheck>, I<disttest> and I<dist> targets: They
-will definitely be useful for you.
-
-Of special importance for B<DBI> drivers is the I<postamble> method from
-the L<ExtUtils::MM_Unix> man page.
-
-For Emacs users, I recommend the I<libscan> method, which removes
-Emacs backup files (file names which end with a tilde '~') from lists of
-files.
-
-Now an example, I use the word C<Driver> wherever you should insert
-your driver's name:
-
- # -*- perl -*-
-
- use ExtUtils::MakeMaker;
-
- WriteMakefile(
- dbd_edit_mm_attribs( {
- 'NAME' => 'DBD::Driver',
- 'VERSION_FROM' => 'Driver.pm',
- 'INC' => '',
- 'dist' => { 'SUFFIX' => '.gz',
- 'COMPRESS' => 'gzip -9f' },
- 'realclean' => { FILES => '*.xsi' },
- 'PREREQ_PM' => '1.03',
- 'CONFIGURE' => sub {
- eval {require DBI::DBD;};
- if ($@) {
- warn $@;
- exit 0;
- }
- my $dbi_arch_dir = dbd_dbi_arch_dir();
- if (exists($opts{INC})) {
- return {INC => "$opts{INC} -I$dbi_arch_dir"};
- } else {
- return {INC => "-I$dbi_arch_dir"};
- }
- }
- },
- { create_pp_tests => 1})
- );
-
- package MY;
- sub postamble { return main::dbd_postamble(@_); }
- sub libscan {
- my ($self, $path) = @_;
- ($path =~ m/\~$/) ? undef : $path;
- }
-
-Note the calls to C<dbd_edit_mm_attribs()> and C<dbd_postamble()>.
-
-The second hash reference in the call to C<dbd_edit_mm_attribs()>
-(containing C<create_pp_tests()>) is optional; you should not use it
-unless your driver is a pure Perl driver (that is, it does not use C and
-XS code). Therefore, the call to C<dbd_edit_mm_attribs()> is not
-relevant for C/XS drivers and may be omitted; simply use the (single)
-hash reference containing NAME etc as the only argument to C<WriteMakefile()>.
-
-Note that the C<dbd_edit_mm_attribs()> code will fail if you do not have a
-F<t> sub-directory containing at least one test case.
-
-I<PREREQ_PM> tells MakeMaker that DBI (version 1.03 in this case) is
-required for this module. This will issue a warning that DBI 1.03 is
-missing if someone attempts to install your DBD without DBI 1.03. See
-I<CONFIGURE> below for why this does not work reliably in stopping cpan
-testers failing your module if DBI is not installed.
-
-I<CONFIGURE> is a subroutine called by MakeMaker during
-C<WriteMakefile>. By putting the C<require DBI::DBD> in this section
-we can attempt to load DBI::DBD but if it is missing we exit with
-success. As we exit successfully without creating a Makefile when
-DBI::DBD is missing cpan testers will not report a failure. This may
-seem at odds with I<PREREQ_PM> but I<PREREQ_PM> does not cause
-C<WriteMakefile> to fail (unless you also specify PREREQ_FATAL which
-is strongly discouraged by MakeMaker) so C<WriteMakefile> would
-continue to call C<dbd_dbi_arch_dir> and fail.
-
-All drivers must use C<dbd_postamble()> or risk running into problems.
-
-Note the specification of I<VERSION_FROM>; the named file
-(F<Driver.pm>) will be scanned for the first line that looks like an
-assignment to I<$VERSION>, and the subsequent text will be used to
-determine the version number. Note the commentary in
-L<ExtUtils::MakeMaker> on the subject of correctly formatted version
-numbers.
-
-If your driver depends upon external software (it usually will), you
-will need to add code to ensure that your environment is workable
-before the call to C<WriteMakefile()>. If you need to check for the
-existence of an external library and perhaps modify I<INC> to include
-the paths to where the external library header files are located and
-you cannot find the library or header files make sure you output a
-message saying they cannot be found but C<exit 0> (success) B<before>
-calling C<WriteMakefile> or CPAN testers will fail your module if the
-external library is not found.
-
-A full-fledged I<Makefile.PL> can be quite large (for example, the
-files for B<DBD::Oracle> and B<DBD::Informix> are both over 1000 lines
-long, and the Informix one uses - and creates - auxiliary modules
-too).
-
-See also L<ExtUtils::MakeMaker> and L<ExtUtils::MM_Unix>. Consider using
-L<CPAN::MakeMaker> in place of I<ExtUtils::MakeMaker>.
-
-=head2 README
-
-The L<README> file should describe what the driver is for, the
-pre-requisites for the build process, the actual build process, how to
-report errors, and who to report them to.
-
-Users will find ways of breaking the driver build and test process
-which you would never even have dreamed to be possible in your worst
-nightmares. Therefore, you need to write this document defensively,
-precisely and concisely.
-
-As always, use the F<README> from one of the established drivers as a basis
-for your own; the version in B<DBD::Informix> is worth a look as it has
-been quite successful in heading off problems.
-
-=over 4
-
-=item *
-
-Note that users will have versions of Perl and B<DBI> that are both older
-and newer than you expected, but this will seldom cause much trouble.
-When it does, it will be because you are using features of B<DBI> that are
-not supported in the version they are using.
-
-=item *
-
-Note that users will have versions of the database software that are
-both older and newer than you expected. You will save yourself time in
-the long run if you can identify the range of versions which have been
-tested and warn about versions which are not known to be OK.
-
-=item *
-
-Note that many people trying to install your driver will not be experts
-in the database software.
-
-=item *
-
-Note that many people trying to install your driver will not be experts
-in C or Perl.
-
-=back
-
-=head2 MANIFEST
-
-The F<MANIFEST> will be used by the Makefile's dist target to build the
-distribution tar file that is uploaded to CPAN. It should list every
-file that you want to include in your distribution, one per line.
-
-=head2 lib/Bundle/DBD/Driver.pm
-
-The CPAN module provides an extremely powerful bundle mechanism that
-allows you to specify pre-requisites for your driver.
-
-The primary pre-requisite is B<Bundle::DBI>; you may want or need to add
-some more. With the bundle set up correctly, the user can type:
-
- perl -MCPAN -e 'install Bundle::DBD::Driver'
-
-and Perl will download, compile, test and install all the Perl modules
-needed to build your driver.
-
-The prerequisite modules are listed in the C<CONTENTS> section, with the
-official name of the module followed by a dash and an informal name or
-description.
-
-=over 4
-
-=item *
-
-Listing B<Bundle::DBI> as the main pre-requisite simplifies life.
-
-=item *
-
-Don't forget to list your driver.
-
-=item *
-
-Note that unless the DBMS is itself a Perl module, you cannot list it as
-a pre-requisite in this file.
-
-=item *
-
-You should keep the version of the bundle the same as the version of
-your driver.
-
-=item *
-
-You should add configuration management, copyright, and licencing
-information at the top.
-
-=back
-
-A suitable skeleton for this file is shown below.
-
- package Bundle::DBD::Driver;
-
- $VERSION = '0.01';
-
- 1;
-
- __END__
-
- =head1 NAME
-
- Bundle::DBD::Driver - A bundle to install all DBD::Driver related modules
-
- =head1 SYNOPSIS
-
- C<perl -MCPAN -e 'install Bundle::DBD::Driver'>
-
- =head1 CONTENTS
-
- Bundle::DBI - Bundle for DBI by TIMB (Tim Bunce)
-
- DBD::Driver - DBD::Driver by YOU (Your Name)
-
- =head1 DESCRIPTION
-
- This bundle includes all the modules used by the Perl Database
- Interface (DBI) driver for Driver (DBD::Driver), assuming the
- use of DBI version 1.13 or later, created by Tim Bunce.
-
- If you've not previously used the CPAN module to install any
- bundles, you will be interrogated during its setup phase.
- But when you've done it once, it remembers what you told it.
- You could start by running:
-
- C<perl -MCPAN -e 'install Bundle::CPAN'>
-
- =head1 SEE ALSO
-
- Bundle::DBI
-
- =head1 AUTHOR
-
- Your Name E<lt>F<you@yourdomain.com>E<gt>
-
- =head1 THANKS
-
- This bundle was created by ripping off Bundle::libnet created by
- Graham Barr E<lt>F<gbarr@ti.com>E<gt>, and radically simplified
- with some information from Jochen Wiedmann E<lt>F<joe@ispsoft.de>E<gt>.
- The template was then included in the DBI::DBD documentation by
- Jonathan Leffler E<lt>F<jleffler@informix.com>E<gt>.
-
- =cut
-
-=head2 lib/DBD/Driver/Summary.pm
-
-There is no substitute for taking the summary file from a driver that
-was documented in the Perl book (such as B<DBD::Oracle> or B<DBD::Informix> or
-B<DBD::ODBC>, to name but three), and adapting it to describe the
-facilities available via B<DBD::Driver> when accessing the Driver database.
-
-=head2 Pure Perl version of Driver.pm
-
-The F<Driver.pm> file defines the Perl module B<DBD::Driver> for your driver.
-It will define a package B<DBD::Driver> along with some version information,
-some variable definitions, and a function C<driver()> which will have a more
-or less standard structure.
-
-It will also define three sub-packages of B<DBD::Driver>:
-
-=over 4
-
-=item DBD::Driver::dr
-
-with methods C<connect()>, C<data_sources()> and C<disconnect_all()>;
-
-=item DBD::Driver::db
-
-with methods such as C<prepare()>;
-
-=item DBD::Driver::st
-
-with methods such as C<execute()> and C<fetch()>.
-
-=back
-
-The F<Driver.pm> file will also contain the documentation specific to
-B<DBD::Driver> in the format used by perldoc.
-
-In a pure Perl driver, the F<Driver.pm> file is the core of the
-implementation. You will need to provide all the key methods needed by B<DBI>.
-
-Now let's take a closer look at an excerpt of F<File.pm> as an example.
-We ignore things that are common to any module (even non-DBI modules)
-or really specific to the B<DBD::File> package.
-
-=head3 The DBD::Driver package
-
-=head4 The header
-
- package DBD::File;
-
- use strict;
- use vars qw($VERSION $drh);
-
- $VERSION = "1.23.00" # Version number of DBD::File
-
-This is where the version number of your driver is specified, and is
-where F<Makefile.PL> looks for this information. Please ensure that any
-other modules added with your driver are also version stamped so that
-CPAN does not get confused.
-
-It is recommended that you use a two-part (1.23) or three-part (1.23.45)
-version number. Also consider the CPAN system, which gets confused and
-considers version 1.10 to precede version 1.9, so that using a raw CVS,
-RCS or SCCS version number is probably not appropriate (despite being
-very common).
-
-For Subversion you could use:
-
- $VERSION = "12.012346";
-
-(use lots of leading zeros on the second portion so if you move the code to a
-shared repository like svn.perl.org the much larger revision numbers won't
-cause a problem, at least not for a few years). For RCS or CVS you can use:
-
- $VERSION = "11.22";
-
-which pads out the fractional part with leading zeros so all is well
-(so long as you don't go past x.99)
-
- $drh = undef; # holds driver handle once initialized
-
-This is where the driver handle will be stored, once created.
-Note that you may assume there is only one handle for your driver.
-
-=head4 The driver constructor
-
-The C<driver()> method is the driver handle constructor. Note that
-the C<driver()> method is in the B<DBD::Driver> package, not in
-one of the sub-packages B<DBD::Driver::dr>, B<DBD::Driver::db>, or
-B<DBD::Driver::db>.
-
- sub driver
- {
- return $drh if $drh; # already created - return same one
- my ($class, $attr) = @_;
-
- $class .= "::dr";
-
- DBD::Driver::db->install_method('drv_example_dbh_method');
- DBD::Driver::st->install_method('drv_example_sth_method');
-
- # not a 'my' since we use it above to prevent multiple drivers
- $drh = DBI::_new_drh($class, {
- 'Name' => 'File',
- 'Version' => $VERSION,
- 'Attribution' => 'DBD::File by Jochen Wiedmann',
- })
- or return undef;
-
- return $drh;
- }
-
-This is a reasonable example of how B<DBI> implements its handles. There
-are three kinds: B<driver handles> (typically stored in I<$drh>; from
-now on called I<drh> or I<$drh>), B<database handles> (from now on
-called I<dbh> or I<$dbh>) and B<statement handles> (from now on called
-I<sth> or I<$sth>).
-
-The prototype of C<DBI::_new_drh()> is
-
- $drh = DBI::_new_drh($class, $public_attrs, $private_attrs);
-
-with the following arguments:
-
-=over 4
-
-=item I<$class>
-
-is typically the class for your driver, (for example, "DBD::File::dr"),
-passed as the first argument to the C<driver()> method.
-
-=item I<$public_attrs>
-
-is a hash ref to attributes like I<Name>, I<Version>, and I<Attribution>.
-These are processed and used by B<DBI>. You had better not make any
-assumptions about them nor should you add private attributes here.
-
-=item I<$private_attrs>
-
-This is another (optional) hash ref with your private attributes.
-B<DBI> will store them and otherwise leave them alone.
-
-=back
-
-The C<DBI::_new_drh()> method and the C<driver()> method both return C<undef>
-for failure (in which case you must look at I<$DBI::err> and I<$DBI::errstr>
-for the failure information, because you have no driver handle to use).
-
-
-=head4 Using install_method() to expose driver-private methods
-
- DBD::Foo::db->install_method($method_name, \%attr);
-
-Installs the driver-private method named by $method_name into the
-DBI method dispatcher so it can be called directly, avoiding the
-need to use the func() method.
-
-It is called as a static method on the driver class to which the
-method belongs. The method name must begin with the corresponding
-registered driver-private prefix. For example, for DBD::Oracle
-$method_name must being with 'C<ora_>', and for DBD::AnyData it
-must begin with 'C<ad_>'.
-
-The C<\%attr> attributes can be used to provide fine control over how the DBI
-dispatcher handles the dispatching of the method. However it's undocumented
-at the moment. See the IMA_* #define's in DBI.xs and the O=>0x000x values in
-the initialization of %DBI::DBI_methods in DBI.pm. (Volunteers to polish up
-and document the interface are very welcome to get in touch via dbi-dev@perl.org).
-
-Methods installed using install_method default to the standard error
-handling behaviour for DBI methods: clearing err and errstr before
-calling the method, and checking for errors to trigger RaiseError
-etc. on return. This differs from the default behaviour of func().
-
-Note for driver authors: The DBD::Foo::xx->install_method call won't
-work until the class-hierarchy has been setup. Normally the DBI
-looks after that just after the driver is loaded. This means
-install_method() can't be called at the time the driver is loaded
-unless the class-hierarchy is set up first. The way to do that is
-to call the setup_driver() method:
-
- DBI->setup_driver('DBD::Foo');
-
-before using install_method().
-
-
-=head4 The CLONE special subroutine
-
-Also needed here, in the B<DBD::Driver> package, is a C<CLONE()> method
-that will be called by perl when an interpreter is cloned. All your
-C<CLONE()> method needs to do, currently, is clear the cached I<$drh> so
-the new interpreter won't start using the cached I<$drh> from the old
-interpreter:
-
- sub CLONE {
- undef $drh;
- }
-
-See L<http://search.cpan.org/dist/perl/pod/perlmod.pod#Making_your_module_threadsafe>
-for details.
-
-=head3 The DBD::Driver::dr package
-
-The next lines of code look as follows:
-
- package DBD::Driver::dr; # ====== DRIVER ======
-
- $DBD::Driver::dr::imp_data_size = 0;
-
-Note that no I<@ISA> is needed here, or for the other B<DBD::Driver::*>
-classes, because the B<DBI> takes care of that for you when the driver is
-loaded.
-
- *FIX ME* Explain what the imp_data_size is, so that implementors aren't
- practicing cargo-cult programming.
-
-=head4 The database handle constructor
-
-The database handle constructor is the driver's (hence the changed
-namespace) C<connect()> method:
-
- sub connect
- {
- my ($drh, $dr_dsn, $user, $auth, $attr) = @_;
-
- # Some database specific verifications, default settings
- # and the like can go here. This should only include
- # syntax checks or similar stuff where it's legal to
- # 'die' in case of errors.
- # For example, many database packages requires specific
- # environment variables to be set; this could be where you
- # validate that they are set, or default them if they are not set.
-
- my $driver_prefix = "drv_"; # the assigned prefix for this driver
-
- # Process attributes from the DSN; we assume ODBC syntax
- # here, that is, the DSN looks like var1=val1;...;varN=valN
- foreach my $var ( split /;/, $dr_dsn ) {
- my ($attr_name, $attr_value) = split '=', $var, 2;
- return $drh->set_err($DBI::stderr, "Can't parse DSN part '$var'")
- unless defined $attr_value;
-
- # add driver prefix to attribute name if it doesn't have it already
- $attr_name = $driver_prefix.$attr_name
- unless $attr_name =~ /^$driver_prefix/o;
-
- # Store attribute into %$attr, replacing any existing value.
- # The DBI will STORE() these into $dbh after we've connected
- $attr->{$attr_name} = $attr_value;
- }
-
- # Get the attributes we'll use to connect.
- # We use delete here because these no need to STORE them
- my $db = delete $attr->{drv_database} || delete $attr->{drv_db}
- or return $drh->set_err($DBI::stderr, "No database name given in DSN '$dr_dsn'");
- my $host = delete $attr->{drv_host} || 'localhost';
- my $port = delete $attr->{drv_port} || 123456;
-
- # Assume you can attach to your database via drv_connect:
- my $connection = drv_connect($db, $host, $port, $user, $auth)
- or return $drh->set_err($DBI::stderr, "Can't connect to $dr_dsn: ...");
-
- # create a 'blank' dbh (call superclass constructor)
- my ($outer, $dbh) = DBI::_new_dbh($drh, { Name => $dr_dsn });
-
- $dbh->STORE('Active', 1 );
- $dbh->{drv_connection} = $connection;
-
- return $outer;
- }
-
-This is mostly the same as in the I<driver handle constructor> above.
-The arguments are described in L<DBI>.
-
-The constructor C<DBI::_new_dbh()> is called, returning a database handle.
-The constructor's prototype is:
-
- ($outer, $inner) = DBI::_new_dbh($drh, $public_attr, $private_attr);
-
-with similar arguments to those in the I<driver handle constructor>,
-except that the I<$class> is replaced by I<$drh>. The I<Name> attribute
-is a standard B<DBI> attribute (see L<DBI/Database Handle Attributes>).
-
-In scalar context, only the outer handle is returned.
-
-Note the use of the C<STORE()> method for setting the I<dbh> attributes.
-That's because within the driver code, the handle object you have is
-the 'inner' handle of a tied hash, not the outer handle that the
-users of your driver have.
-
-Because you have the inner handle, tie magic doesn't get invoked
-when you get or set values in the hash. This is often very handy for
-speed when you want to get or set simple non-special driver-specific
-attributes.
-
-However, some attribute values, such as those handled by the B<DBI> like
-I<PrintError>, don't actually exist in the hash and must be read via
-C<$h-E<gt>FETCH($attrib)> and set via C<$h-E<gt>STORE($attrib, $value)>.
-If in any doubt, use these methods.
-
-=head4 The data_sources() method
-
-The C<data_sources()> method must populate and return a list of valid data
-sources, prefixed with the "I<dbi:Driver>" incantation that allows them to
-be used in the first argument of the C<DBI-E<gt>connect()> method.
-An example of this might be scanning the F<$HOME/.odbcini> file on Unix
-for ODBC data sources (DSNs).
-
-As a trivial example, consider a fixed list of data sources:
-
- sub data_sources
- {
- my($drh, $attr) = @_;
- my(@list) = ();
- # You need more sophisticated code than this to set @list...
- push @list, "dbi:Driver:abc";
- push @list, "dbi:Driver:def";
- push @list, "dbi:Driver:ghi";
- # End of code to set @list
- return @list;
- }
-
-=head4 The disconnect_all() method
-
-If you need to release any resources when the driver is unloaded, you
-can provide a disconnect_all method.
-
-=head4 Other driver handle methods
-
-If you need any other driver handle methods, they can follow here.
-
-=head4 Error handling
-
-It is quite likely that something fails in the connect method.
-With B<DBD::File> for example, you might catch an error when setting the
-current directory to something not existent by using the
-(driver-specific) I<f_dir> attribute.
-
-To report an error, you use the C<set_err()> method:
-
- $h->set_err($err, $errmsg, $state);
-
-This will ensure that the error is recorded correctly and that
-I<RaiseError> and I<PrintError> etc are handled correctly.
-
-Typically you'll always use the method instance, aka your method's first
-argument.
-
-As C<set_err()> always returns C<undef> your error handling code can
-usually be simplified to something like this:
-
- return $h->set_err($err, $errmsg, $state) if ...;
-
-=head3 The DBD::Driver::db package
-
- package DBD::Driver::db; # ====== DATABASE ======
-
- $DBD::Driver::db::imp_data_size = 0;
-
-=head4 The statement handle constructor
-
-There's nothing much new in the statement handle constructor, which
-is the C<prepare()> method:
-
- sub prepare
- {
- my ($dbh, $statement, @attribs) = @_;
-
- # create a 'blank' sth
- my ($outer, $sth) = DBI::_new_sth($dbh, { Statement => $statement });
-
- $sth->STORE('NUM_OF_PARAMS', ($statement =~ tr/?//));
-
- $sth->{drv_params} = [];
-
- return $outer;
- }
-
-This is still the same -- check the arguments and call the super class
-constructor C<DBI::_new_sth()>. Again, in scalar context, only the outer
-handle is returned. The I<Statement> attribute should be cached as
-shown.
-
-Note the prefix I<drv_> in the attribute names: it is required that
-all your private attributes use a lowercase prefix unique to your driver.
-As mentioned earlier in this document, the B<DBI> contains a registry of
-known driver prefixes and may one day warn about unknown attributes
-that don't have a registered prefix.
-
-Note that we parse the statement here in order to set the attribute
-I<NUM_OF_PARAMS>. The technique illustrated is not very reliable; it can
-be confused by question marks appearing in quoted strings, delimited
-identifiers or in SQL comments that are part of the SQL statement. We
-could set I<NUM_OF_PARAMS> in the C<execute()> method instead because
-the B<DBI> specification explicitly allows a driver to defer this, but then
-the user could not call C<bind_param()>.
-
-=head4 Transaction handling
-
-Pure Perl drivers will rarely support transactions. Thus your C<commit()>
-and C<rollback()> methods will typically be quite simple:
-
- sub commit
- {
- my ($dbh) = @_;
- if ($dbh->FETCH('Warn')) {
- warn("Commit ineffective while AutoCommit is on");
- }
- 0;
- }
-
- sub rollback {
- my ($dbh) = @_;
- if ($dbh->FETCH('Warn')) {
- warn("Rollback ineffective while AutoCommit is on");
- }
- 0;
- }
-
-Or even simpler, just use the default methods provided by the B<DBI> that
-do nothing except return C<undef>.
-
-The B<DBI>'s default C<begin_work()> method can be used by inheritance.
-
-=head4 The STORE() and FETCH() methods
-
-These methods (that we have already used, see above) are called for
-you, whenever the user does a:
-
- $dbh->{$attr} = $val;
-
-or, respectively,
-
- $val = $dbh->{$attr};
-
-See L<perltie> for details on tied hash refs to understand why these
-methods are required.
-
-The B<DBI> will handle most attributes for you, in particular attributes
-like I<RaiseError> or I<PrintError>. All you have to do is handle your
-driver's private attributes and any attributes, like I<AutoCommit> and
-I<ChopBlanks>, that the B<DBI> can't handle for you.
-
-A good example might look like this:
-
- sub STORE
- {
- my ($dbh, $attr, $val) = @_;
- if ($attr eq 'AutoCommit') {
- # AutoCommit is currently the only standard attribute we have
- # to consider.
- if (!$val) { die "Can't disable AutoCommit"; }
- return 1;
- }
- if ($attr =~ m/^drv_/) {
- # Handle only our private attributes here
- # Note that we could trigger arbitrary actions.
- # Ideally we should warn about unknown attributes.
- $dbh->{$attr} = $val; # Yes, we are allowed to do this,
- return 1; # but only for our private attributes
- }
- # Else pass up to DBI to handle for us
- $dbh->SUPER::STORE($attr, $val);
- }
-
- sub FETCH
- {
- my ($dbh, $attr) = @_;
- if ($attr eq 'AutoCommit') { return 1; }
- if ($attr =~ m/^drv_/) {
- # Handle only our private attributes here
- # Note that we could trigger arbitrary actions.
- return $dbh->{$attr}; # Yes, we are allowed to do this,
- # but only for our private attributes
- }
- # Else pass up to DBI to handle
- $dbh->SUPER::FETCH($attr);
- }
-
-The B<DBI> will actually store and fetch driver-specific attributes (with all
-lowercase names) without warning or error, so there's actually no need to
-implement driver-specific any code in your C<FETCH()> and C<STORE()>
-methods unless you need extra logic/checks, beyond getting or setting
-the value.
-
-Unless your driver documentation indicates otherwise, the return value of
-the C<STORE()> method is unspecified and the caller shouldn't use that value.
-
-=head4 Other database handle methods
-
-As with the driver package, other database handle methods may follow here.
-In particular you should consider a (possibly empty) C<disconnect()>
-method and possibly a C<quote()> method if B<DBI>'s default isn't correct for
-you. You may also need the C<type_info_all()> and C<get_info()> methods,
-as described elsewhere in this document.
-
-Where reasonable use C<$h-E<gt>SUPER::foo()> to call the B<DBI>'s method in
-some or all cases and just wrap your custom behavior around that.
-
-If you want to use private trace flags you'll probably want to be
-able to set them by name. To do that you'll need to define a
-C<parse_trace_flag()> method (note that's "parse_trace_flag", singular,
-not "parse_trace_flags", plural).
-
- sub parse_trace_flag {
- my ($h, $name) = @_;
- return 0x01000000 if $name eq 'foo';
- return 0x02000000 if $name eq 'bar';
- return 0x04000000 if $name eq 'baz';
- return 0x08000000 if $name eq 'boo';
- return 0x10000000 if $name eq 'bop';
- return $h->SUPER::parse_trace_flag($name);
- }
-
-All private flag names must be lowercase, and all private flags
-must be in the top 8 of the 32 bits.
-
-=head3 The DBD::Driver::st package
-
-This package follows the same pattern the others do:
-
- package DBD::Driver::st;
-
- $DBD::Driver::st::imp_data_size = 0;
-
-=head4 The execute() and bind_param() methods
-
-This is perhaps the most difficult method because we have to consider
-parameter bindings here. In addition to that, there are a number of
-statement attributes which must be set for inherited B<DBI> methods to
-function correctly (see L</Statement attributes> below).
-
-We present a simplified implementation by using the I<drv_params>
-attribute from above:
-
- sub bind_param
- {
- my ($sth, $pNum, $val, $attr) = @_;
- my $type = (ref $attr) ? $attr->{TYPE} : $attr;
- if ($type) {
- my $dbh = $sth->{Database};
- $val = $dbh->quote($sth, $type);
- }
- my $params = $sth->{drv_params};
- $params->[$pNum-1] = $val;
- 1;
- }
-
- sub execute
- {
- my ($sth, @bind_values) = @_;
-
- # start of by finishing any previous execution if still active
- $sth->finish if $sth->FETCH('Active');
-
- my $params = (@bind_values) ?
- \@bind_values : $sth->{drv_params};
- my $numParam = $sth->FETCH('NUM_OF_PARAMS');
- return $sth->set_err($DBI::stderr, "Wrong number of parameters")
- if @$params != $numParam;
- my $statement = $sth->{'Statement'};
- for (my $i = 0; $i < $numParam; $i++) {
- $statement =~ s/?/$params->[$i]/; # XXX doesn't deal with quoting etc!
- }
- # Do anything ... we assume that an array ref of rows is
- # created and store it:
- $sth->{'drv_data'} = $data;
- $sth->{'drv_rows'} = @$data; # number of rows
- $sth->STORE('NUM_OF_FIELDS') = $numFields;
- $sth->{Active} = 1;
- @$data || '0E0';
- }
-
-There are a number of things you should note here.
-
-We initialize the I<NUM_OF_FIELDS> and I<Active> attributes here,
-because they are essential for C<bind_columns()> to work.
-
-We use attribute C<$sth-E<gt>{Statement}> which we created
-within C<prepare()>. The attribute C<$sth-E<gt>{Database}>, which is
-nothing else than the I<dbh>, was automatically created by B<DBI>.
-
-Finally, note that (as specified in the B<DBI> specification) we return the
-string C<'0E0'> instead of the number 0, so that the result tests true but
-equal to zero.
-
- $sth->execute() or die $sth->errstr;
-
-=head4 The execute_array(), execute_for_fetch() and bind_param_array() methods
-
-In general, DBD's only need to implement C<execute_for_fetch()> and
-C<bind_param_array>. DBI's default C<execute_array()> will invoke the
-DBD's C<execute_for_fetch()> as needed.
-
-The following sequence describes the interaction between
-DBI C<execute_array> and a DBD's C<execute_for_fetch>:
-
-=over
-
-=item 1
-
-App calls C<$sth-E<gt>execute_array(\%attrs, @array_of_arrays)>
-
-=item 2
-
-If C<@array_of_arrays> was specified, DBI processes C<@array_of_arrays> by calling
-DBD's C<bind_param_array()>. Alternately, App may have directly called
-C<bind_param_array()>
-
-=item 3
-
-DBD validates and binds each array
-
-=item 4
-
-DBI retrieves the validated param arrays from DBD's ParamArray attribute
-
-=item 5
-
-DBI calls DBD's C<execute_for_fetch($fetch_tuple_sub, \@tuple_status)>,
-where C<&$fetch_tuple_sub> is a closure to iterate over the
-returned ParamArray values, and C<\@tuple_status> is an array to receive
-the disposition status of each tuple.
-
-=item 6
-
-DBD iteratively calls C<&$fetch_tuple_sub> to retrieve parameter tuples
-to be added to its bulk database operation/request.
-
-=item 7
-
-when DBD reaches the limit of tuples it can handle in a single database
-operation/request, or the C<&$fetch_tuple_sub> indicates no more
-tuples by returning undef, the DBD executes the bulk operation, and
-reports the disposition of each tuple in \@tuple_status.
-
-=item 8
-
-DBD repeats steps 6 and 7 until all tuples are processed.
-
-=back
-
-E.g., here's the essence of L<DBD::Oracle>'s execute_for_fetch:
-
- while (1) {
- my @tuple_batch;
- for (my $i = 0; $i < $batch_size; $i++) {
- push @tuple_batch, [ @{$fetch_tuple_sub->() || last} ];
- }
- last unless @tuple_batch;
- my $res = ora_execute_array($sth, \@tuple_batch,
- scalar(@tuple_batch), $tuple_batch_status);
- push @$tuple_status, @$tuple_batch_status;
- }
-
-Note that DBI's default execute_array()/execute_for_fetch() implementation
-requires the use of positional (i.e., '?') placeholders. Drivers
-which B<require> named placeholders must either emulate positional
-placeholders (e.g., see L<DBD::Oracle>), or must implement their own
-execute_array()/execute_for_fetch() methods to properly sequence bound
-parameter arrays.
-
-=head4 Fetching data
-
-Only one method needs to be written for fetching data, C<fetchrow_arrayref()>.
-The other methods, C<fetchrow_array()>, C<fetchall_arrayref()>, etc, as well
-as the database handle's C<select*> methods are part of B<DBI>, and call
-C<fetchrow_arrayref()> as necessary.
-
- sub fetchrow_arrayref
- {
- my ($sth) = @_;
- my $data = $sth->{drv_data};
- my $row = shift @$data;
- if (!$row) {
- $sth->STORE(Active => 0); # mark as no longer active
- return undef;
- }
- if ($sth->FETCH('ChopBlanks')) {
- map { $_ =~ s/\s+$//; } @$row;
- }
- return $sth->_set_fbav($row);
- }
- *fetch = \&fetchrow_arrayref; # required alias for fetchrow_arrayref
-
-Note the use of the method C<_set_fbav()> -- this is required so that
-C<bind_col()> and C<bind_columns()> work.
-
-If an error occurs which leaves the I<$sth> in a state where remaining rows
-can't be fetched then I<Active> should be turned off before the method returns.
-
-The C<rows()> method for this driver can be implemented like this:
-
- sub rows { shift->{drv_rows} }
-
-because it knows in advance how many rows it has fetched.
-Alternatively you could delete that method and so fallback
-to the B<DBI>'s own method which does the right thing based
-on the number of calls to C<_set_fbav()>.
-
-=head4 The more_results method
-
-If your driver doesn't support multiple result sets, then don't even implement this method.
-
-Otherwise, this method needs to get the statement handle ready to fetch results
-from the next result set, if there is one. Typically you'd start with:
-
- $sth->finish;
-
-then you should delete all the attributes from the attribute cache that may no
-longer be relevant for the new result set:
-
- delete $sth->{$_}
- for qw(NAME TYPE PRECISION SCALE ...);
-
-for drivers written in C use:
-
- hv_delete((HV*)SvRV(sth), "NAME", 4, G_DISCARD);
- hv_delete((HV*)SvRV(sth), "NULLABLE", 8, G_DISCARD);
- hv_delete((HV*)SvRV(sth), "NUM_OF_FIELDS", 13, G_DISCARD);
- hv_delete((HV*)SvRV(sth), "PRECISION", 9, G_DISCARD);
- hv_delete((HV*)SvRV(sth), "SCALE", 5, G_DISCARD);
- hv_delete((HV*)SvRV(sth), "TYPE", 4, G_DISCARD);
-
-Don't forget to also delete, or update, any driver-private attributes that may
-not be correct for the next resultset.
-
-The NUM_OF_FIELDS attribute is a special case. It should be set using STORE:
-
- $sth->STORE(NUM_OF_FIELDS => 0); /* for DBI <= 1.53 */
- $sth->STORE(NUM_OF_FIELDS => $new_value);
-
-for drivers written in C use this incantation:
-
- /* Adjust NUM_OF_FIELDS - which also adjusts the row buffer size */
- DBIc_NUM_FIELDS(imp_sth) = 0; /* for DBI <= 1.53 */
- DBIc_STATE(imp_xxh)->set_attr_k(sth, sv_2mortal(newSVpvn("NUM_OF_FIELDS",13)), 0,
- sv_2mortal(newSViv(mysql_num_fields(imp_sth->result)))
- );
-
-For DBI versions prior to 1.54 you'll also need to explicitly adjust the
-number of elements in the row buffer array (C<DBIc_FIELDS_AV(imp_sth)>)
-to match the new result set. Fill any new values with newSV(0) not &sv_undef.
-Alternatively you could free DBIc_FIELDS_AV(imp_sth) and set it to null,
-but that would mean bind_columns() wouldn't work across result sets.
-
-
-=head4 Statement attributes
-
-The main difference between I<dbh> and I<sth> attributes is, that you
-should implement a lot of attributes here that are required by
-the B<DBI>, such as I<NAME>, I<NULLABLE>, I<TYPE>, etc. See
-L<DBI/Statement Handle Attributes> for a complete list.
-
-Pay attention to attributes which are marked as read only, such as
-I<NUM_OF_PARAMS>. These attributes can only be set the first time
-a statement is executed. If a statement is prepared, then executed
-multiple times, warnings may be generated.
-
-You can protect against these warnings, and prevent the recalculation
-of attributes which might be expensive to calculate (such as the
-I<NAME> and I<NAME_*> attributes):
-
- my $storedNumParams = $sth->FETCH('NUM_OF_PARAMS');
- if (!defined $storedNumParams or $storedNumFields < 0) {
- $sth->STORE('NUM_OF_PARAMS') = $numParams;
-
- # Set other useful attributes that only need to be set once
- # for a statement, like $sth->{NAME} and $sth->{TYPE}
- }
-
-One particularly important attribute to set correctly (mentioned in
-L<DBI/ATTRIBUTES COMMON TO ALL HANDLES> is I<Active>. Many B<DBI> methods,
-including C<bind_columns()>, depend on this attribute.
-
-Besides that the C<STORE()> and C<FETCH()> methods are mainly the same
-as above for I<dbh>'s.
-
-=head4 Other statement methods
-
-A trivial C<finish()> method to discard stored data, reset any attributes
-(such as I<Active>) and do C<$sth-E<gt>SUPER::finish()>.
-
-If you've defined a C<parse_trace_flag()> method in B<::db> you'll also want
-it in B<::st>, so just alias it in:
-
- *parse_trace_flag = \&DBD::foo:db::parse_trace_flag;
-
-And perhaps some other methods that are not part of the B<DBI>
-specification, in particular to make metadata available.
-Remember that they must have names that begin with your drivers
-registered prefix so they can be installed using C<install_method()>.
-
-If C<DESTROY()> is called on a statement handle that's still active
-(C<$sth-E<gt>{Active}> is true) then it should effectively call C<finish()>.
-
- sub DESTROY {
- my $sth = shift;
- $sth->finish if $sth->FETCH('Active');
- }
-
-=head2 Tests
-
-The test process should conform as closely as possibly to the Perl
-standard test harness.
-
-In particular, most (all) of the tests should be run in the F<t> sub-directory,
-and should simply produce an C<ok> when run under C<make test>.
-For details on how this is done, see the Camel book and the section in
-Chapter 7, "The Standard Perl Library" on L<Test::Harness>.
-
-The tests may need to adapt to the type of database which is being used
-for testing, and to the privileges of the user testing the driver. For
-example, the B<DBD::Informix> test code has to adapt in a number of
-places to the type of database to which it is connected as different
-Informix databases have different capabilities: some of the tests are
-for databases without transaction logs; others are for databases with a
-transaction log; some versions of the server have support for blobs, or
-stored procedures, or user-defined data types, and others do not.
-
-When a complete file of tests must be skipped, you can provide a reason
-in a pseudo-comment:
-
- if ($no_transactions_available)
- {
- print "1..0 # Skip: No transactions available\n";
- exit 0;
- }
-
-Consider downloading the B<DBD::Informix> code and look at the code in
-F<DBD/Informix/TestHarness.pm> which is used throughout the
-B<DBD::Informix> tests in the F<t> sub-directory.
-
-=head1 CREATING A C/XS DRIVER
-
-Please also see the section under L<CREATING A PURE PERL DRIVER>
-regarding the creation of the F<Makefile.PL>.
-
-Creating a new C/XS driver from scratch will always be a daunting task.
-You can and should greatly simplify your task by taking a good
-reference driver implementation and modifying that to match the
-database product for which you are writing a driver.
-
-The de facto reference driver has been the one for B<DBD::Oracle> written
-by Tim Bunce, who is also the author of the B<DBI> package. The B<DBD::Oracle>
-module is a good example of a driver implemented around a C-level API.
-
-Nowadays it it seems better to base on B<DBD::ODBC>, another driver
-maintained by Tim and Jeff Urlwin, because it offers a lot of metadata
-and seems to become the guideline for the future development. (Also as
-B<DBD::Oracle> digs deeper into the Oracle 8 OCI interface it'll get even
-more hairy than it is now.)
-
-The B<DBD::Informix> driver is one driver implemented using embedded SQL
-instead of a function-based API.
-B<DBD::Ingres> may also be worth a look.
-
-=head2 C/XS version of Driver.pm
-
-A lot of the code in the F<Driver.pm> file is very similar to the code for pure Perl modules
-- see above. However,
-there are also some subtle (and not so subtle) differences, including:
-
-=over 8
-
-=item *
-
-The variables I<$DBD::Driver::{dr|db|st}::imp_data_size> are not defined
-here, but in the XS code, because they declare the size of certain
-C structures.
-
-=item *
-
-Some methods are typically moved to the XS code, in particular
-C<prepare()>, C<execute()>, C<disconnect()>, C<disconnect_all()> and the
-C<STORE()> and C<FETCH()> methods.
-
-=item *
-
-Other methods are still part of F<Driver.pm>, but have callbacks to
-the XS code.
-
-=item *
-
-If the driver-specific parts of the I<imp_drh_t> structure need to be
-formally initialized (which does not seem to be a common requirement),
-then you need to add a call to an appropriate XS function in the driver
-method of C<DBD::Driver::driver()>, and you define the corresponding function
-in F<Driver.xs>, and you define the C code in F<dbdimp.c> and the prototype in
-F<dbdimp.h>.
-
-For example, B<DBD::Informix> has such a requirement, and adds the
-following call after the call to C<_new_drh()> in F<Informix.pm>:
-
- DBD::Informix::dr::driver_init($drh);
-
-and the following code in F<Informix.xs>:
-
- # Initialize the DBD::Informix driver data structure
- void
- driver_init(drh)
- SV *drh
- CODE:
- ST(0) = dbd_ix_dr_driver_init(drh) ? &sv_yes : &sv_no;
-
-and the code in F<dbdimp.h> declares:
-
- extern int dbd_ix_dr_driver_init(SV *drh);
-
-and the code in F<dbdimp.ec> (equivalent to F<dbdimp.c>) defines:
-
- /* Formally initialize the DBD::Informix driver structure */
- int
- dbd_ix_dr_driver(SV *drh)
- {
- D_imp_drh(drh);
- imp_drh->n_connections = 0; /* No active connections */
- imp_drh->current_connection = 0; /* No current connection */
- imp_drh->multipleconnections = (ESQLC_VERSION >= 600) ? True : False;
- dbd_ix_link_newhead(&imp_drh->head); /* Empty linked list of connections */
- return 1;
- }
-
-B<DBD::Oracle> has a similar requirement but gets around it by checking
-whether the private data part of the driver handle is all zeroed out,
-rather than add extra functions.
-
-=back
-
-Now let's take a closer look at an excerpt from F<Oracle.pm> (revised
-heavily to remove idiosyncrasies) as an example, ignoring things that
-were already discussed for pure Perl drivers.
-
-=head3 The connect method
-
-The connect method is the database handle constructor.
-You could write either of two versions of this method: either one which
-takes connection attributes (new code) and one which ignores them (old
-code only).
-
-If you ignore the connection attributes, then you omit all mention of
-the I<$auth> variable (which is a reference to a hash of attributes), and
-the XS system manages the differences for you.
-
- sub connect
- {
- my ($drh, $dbname, $user, $auth, $attr) = @_;
-
- # Some database specific verifications, default settings
- # and the like following here. This should only include
- # syntax checks or similar stuff where it's legal to
- # 'die' in case of errors.
-
- my $dbh = DBI::_new_dbh($drh, {
- 'Name' => $dbname,
- })
- or return undef;
-
- # Call the driver-specific function _login in Driver.xs file which
- # calls the DBMS-specific function(s) to connect to the database,
- # and populate internal handle data.
- DBD::Driver::db::_login($dbh, $dbname, $user, $auth, $attr)
- or return undef;
-
- $dbh;
- }
-
-This is mostly the same as in the pure Perl case, the exception being
-the use of the private C<_login()> callback, which is the function
-that will really connect to the database. It is implemented in
-F<Driver.xst> (you should not implement it) and calls
-C<dbd_db_login6()> or C<dbd_db_login6_sv> from F<dbdimp.c>. See below
-for details.
-
-If your driver has driver-specific attributes which may be passed in the
-connect method and hence end up in C<$attr> in C<dbd_db_login6> then it
-is best to delete any you process so DBI does not send them again
-via STORE after connect. You can do this in C like this:
-
- DBD_ATTRIB_DELETE(attr, "my_attribute_name",
- strlen("my_attribute_name"));
-
-However, prior to DBI subversion version 11605 (and fixed post 1.607)
-DBD_ATTRIB_DELETE segfaulted so if you cannot guarantee the DBI version
-will be post 1.607 you need to use:
-
- hv_delete((HV*)SvRV(attr), "my_attribute_name",
- strlen("my_attribute_name"), G_DISCARD);
-
- *FIX ME* Discuss removing attributes in Perl code.
-
-=head3 The disconnect_all method
-
- *FIX ME* T.B.S
-
-=head3 The data_sources method
-
-If your C<data_sources()> method can be implemented in pure Perl, then do
-so because it is easier than doing it in XS code (see the section above
-for pure Perl drivers).
-
-If your C<data_sources()> method must call onto compiled functions, then
-you will need to define I<dbd_dr_data_sources> in your F<dbdimp.h> file, which
-will trigger F<Driver.xst> (in B<DBI> v1.33 or greater) to generate the XS
-code that calls your actual C function (see the discussion below for
-details) and you do not code anything in F<Driver.pm> to handle it.
-
-=head3 The prepare method
-
-The prepare method is the statement handle constructor, and most of it
-is not new. Like the C<connect()> method, it now has a C callback:
-
- package DBD::Driver::db; # ====== DATABASE ======
- use strict;
-
- sub prepare
- {
- my ($dbh, $statement, $attribs) = @_;
-
- # create a 'blank' sth
- my $sth = DBI::_new_sth($dbh, {
- 'Statement' => $statement,
- })
- or return undef;
-
- # Call the driver-specific function _prepare in Driver.xs file
- # which calls the DBMS-specific function(s) to prepare a statement
- # and populate internal handle data.
- DBD::Driver::st::_prepare($sth, $statement, $attribs)
- or return undef;
- $sth;
- }
-
-=head3 The execute method
-
- *FIX ME* T.B.S
-
-=head3 The fetchrow_arrayref method
-
- *FIX ME* T.B.S
-
-=head3 Other methods?
-
- *FIX ME* T.B.S
-
-=head2 Driver.xs
-
-F<Driver.xs> should look something like this:
-
- #include "Driver.h"
-
- DBISTATE_DECLARE;
-
- INCLUDE: Driver.xsi
-
- MODULE = DBD::Driver PACKAGE = DBD::Driver::dr
-
- /* Non-standard drh XS methods following here, if any. */
- /* If none (the usual case), omit the MODULE line above too. */
-
- MODULE = DBD::Driver PACKAGE = DBD::Driver::db
-
- /* Non-standard dbh XS methods following here, if any. */
- /* Currently this includes things like _list_tables from */
- /* DBD::mSQL and DBD::mysql. */
-
- MODULE = DBD::Driver PACKAGE = DBD::Driver::st
-
- /* Non-standard sth XS methods following here, if any. */
- /* In particular this includes things like _list_fields from */
- /* DBD::mSQL and DBD::mysql for accessing metadata. */
-
-Note especially the include of F<Driver.xsi> here: B<DBI> inserts stub
-functions for almost all private methods here which will typically do
-much work for you.
-
-Wherever you really have to implement something, it will call a private
-function in F<dbdimp.c>, and this is what you have to implement.
-
-You need to set up an extra routine if your driver needs to export
-constants of its own, analogous to the SQL types available when you say:
-
- use DBI qw(:sql_types);
-
- *FIX ME* T.B.S
-
-=head2 Driver.h
-
-F<Driver.h> is very simple and the operational contents should look like this:
-
- #ifndef DRIVER_H_INCLUDED
- #define DRIVER_H_INCLUDED
-
- #define NEED_DBIXS_VERSION 93 /* 93 for DBI versions 1.00 to 1.51+ */
- #define PERL_NO_GET_CONTEXT /* if used require DBI 1.51+ */
-
- #include <DBIXS.h> /* installed by the DBI module */
-
- #include "dbdimp.h"
-
- #include "dbivport.h" /* see below */
-
- #include <dbd_xsh.h> /* installed by the DBI module */
-
- #endif /* DRIVER_H_INCLUDED */
-
-The F<DBIXS.h> header defines most of the interesting information that
-the writer of a driver needs.
-
-The file F<dbd_xsh.h> header provides prototype declarations for the C
-functions that you might decide to implement. Note that you should
-normally only define one of C<dbd_db_login()>, C<dbd_db_login6()> or
-C<dbd_db_login6_sv> unless you are intent on supporting really old
-versions of B<DBI> (prior to B<DBI> 1.06) as well as modern
-versions. The only standard, B<DBI>-mandated functions that you need
-write are those specified in the F<dbd_xsh.h> header. You might also
-add extra driver-specific functions in F<Driver.xs>.
-
-The F<dbivport.h> file should be I<copied> from the latest B<DBI> release
-into your distribution each time you modify your driver. Its job is to
-allow you to enhance your code to work with the latest B<DBI> API while
-still allowing your driver to be compiled and used with older versions
-of the B<DBI> (for example, when the C<DBIh_SET_ERR_CHAR()> macro was added
-to B<DBI> 1.41, an emulation of it was added to F<dbivport.h>). This makes
-users happy and your life easier. Always read the notes in F<dbivport.h>
-to check for any limitations in the emulation that you should be aware
-of.
-
-With B<DBI> v1.51 or better I recommend that the driver defines
-I<PERL_NO_GET_CONTEXT> before F<DBIXS.h> is included. This can significantly
-improve efficiency when running under a thread enabled perl. (Remember that
-the standard perl in most Linux distributions is built with threads enabled.
-So is ActiveState perl for Windows, and perl built for Apache mod_perl2.)
-If you do this there are some things to keep in mind:
-
-=over 4
-
-=item *
-
-If I<PERL_NO_GET_CONTEXT> is defined, then every function that calls the Perl
-API will need to start out with a C<dTHX;> declaration.
-
-=item *
-
-You'll know which functions need this, because the C compiler will
-complain that the undeclared identifier C<my_perl> is used if I<and only if>
-the perl you are using to develop and test your driver has threads enabled.
-
-=item *
-
-If you don't remember to test with a thread-enabled perl before making
-a release it's likely that you'll get failure reports from users who are.
-
-=item *
-
-For driver private functions it is possible to gain even more
-efficiency by replacing C<dTHX;> with C<pTHX_> prepended to the
-parameter list and then C<aTHX_> prepended to the argument list where
-the function is called.
-
-=back
-
-See L<perlguts/How multiple interpreters and concurrency are supported> for
-additional information about I<PERL_NO_GET_CONTEXT>.
-
-=head2 Implementation header dbdimp.h
-
-This header file has two jobs:
-
-First it defines data structures for your private part of the handles.
-Note that the DBI provides many common fields for you. For example
-the statement handle (imp_sth) already has a row_count field with an IV type
-that accessed via the DBIc_ROW_COUNT(imp_sth) macro. Using this is strongly
-recommended as it's built in to some DBI internals so the DBI can 'just work'
-in more cases and you'll have less driver-specific code to write.
-Study DBIXS.h to see what's included with each type of handle.
-
-Second it defines macros that rename the generic names like
-C<dbd_db_login()> to database specific names like C<ora_db_login()>. This
-avoids name clashes and enables use of different drivers when you work
-with a statically linked perl.
-
-It also will have the important task of disabling XS methods that you
-don't want to implement.
-
-Finally, the macros will also be used to select alternate
-implementations of some functions. For example, the C<dbd_db_login()>
-function is not passed the attribute hash.
-
-Since B<DBI> v1.06, if a C<dbd_db_login6()> macro is defined (for a function
-with 6 arguments), it will be used instead with the attribute hash
-passed as the sixth argument.
-
-Since B<DBI> post v1.607, if a C<dbd_db_login6_sv()> macro is defined (for
-a function like dbd_db_login6 but with scalar pointers for the dbname,
-username and password), it will be used instead. This will allow your
-login6 function to see if there are any Unicode characters in the
-dbname.
-
-Similarly defining dbd_db_do4_iv is preferred over dbd_db_do4, dbd_st_rows_iv
-over dbd_st_rows, and dbd_st_execute_iv over dbd_st_execute. The *_iv forms are
-declared to return the IV type instead of an int.
-
-People used to just pick Oracle's F<dbdimp.c> and use the same names,
-structures and types. I strongly recommend against that. At first glance
-this saves time, but your implementation will be less readable. It was
-just hell when I had to separate B<DBI> specific parts, Oracle specific
-parts, mSQL specific parts and mysql specific parts in B<DBD::mysql>'s
-I<dbdimp.h> and I<dbdimp.c>. (B<DBD::mysql> was a port of B<DBD::mSQL>
-which was based on B<DBD::Oracle>.) [Seconded, based on the experience
-taking B<DBD::Informix> apart, even though the version inherited in 1996
-was only based on B<DBD::Oracle>.]
-
-This part of the driver is I<your exclusive part>. Rewrite it from
-scratch, so it will be clean and short: in other words, a better piece
-of code. (Of course keep an eye on other people's work.)
-
- struct imp_drh_st {
- dbih_drc_t com; /* MUST be first element in structure */
- /* Insert your driver handle attributes here */
- };
-
- struct imp_dbh_st {
- dbih_dbc_t com; /* MUST be first element in structure */
- /* Insert your database handle attributes here */
- };
-
- struct imp_sth_st {
- dbih_stc_t com; /* MUST be first element in structure */
- /* Insert your statement handle attributes here */
- };
-
- /* Rename functions for avoiding name clashes; prototypes are */
- /* in dbd_xsh.h */
- #define dbd_init drv_dr_init
- #define dbd_db_login6_sv drv_db_login_sv
- #define dbd_db_do drv_db_do
- ... many more here ...
-
-These structures implement your private part of the handles.
-
-You I<have> to use the name C<imp_dbh_{dr|db|st}> and the first field
-I<must> be of type I<dbih_drc_t|_dbc_t|_stc_t> and I<must> be called
-C<com>.
-
-You should never access these fields directly, except by using the
-I<DBIc_xxx()> macros below.
-
-=head2 Implementation source dbdimp.c
-
-Conventionally, F<dbdimp.c> is the main implementation file (but
-B<DBD::Informix> calls the file F<dbdimp.ec>). This section includes a
-short note on each function that is used in the F<Driver.xsi> template
-and thus I<has> to be implemented.
-
-Of course, you will probably also need to implement other support
-functions, which should usually be file static if they are placed in
-F<dbdimp.c>. If they are placed in other files, you need to list those
-files in F<Makefile.PL> (and F<MANIFEST>) to handle them correctly.
-
-It is wise to adhere to a namespace convention for your functions to
-avoid conflicts. For example, for a driver with prefix I<drv_>, you
-might call externally visible functions I<dbd_drv_xxxx>. You should also
-avoid non-constant global variables as much as possible to improve the
-support for threading.
-
-Since Perl requires support for function prototypes (ANSI or ISO or
-Standard C), you should write your code using function prototypes too.
-
-It is possible to use either the unmapped names such as C<dbd_init()> or
-the mapped names such as C<dbd_ix_dr_init()> in the F<dbdimp.c> file.
-B<DBD::Informix> uses the mapped names which makes it easier to identify
-where to look for linkage problems at runtime (which will report errors
-using the mapped names).
-
-Most other drivers, and in particular B<DBD::Oracle>, use the unmapped
-names in the source code which makes it a little easier to compare code
-between drivers and eases discussions on the I<dbi-dev> mailing list.
-The majority of the code fragments here will use the unmapped names.
-
-Ultimately, you should provide implementations for most of the
-functions listed in the F<dbd_xsh.h> header. The exceptions are
-optional functions (such as C<dbd_st_rows()>) and those functions with
-alternative signatures, such as C<dbd_db_login6_sv>,
-C<dbd_db_login6()> and I<dbd_db_login()>. Then you should only
-implement one of the alternatives, and generally the newer one of the
-alternatives.
-
-=head3 The dbd_init method
-
- #include "Driver.h"
-
- DBISTATE_DECLARE;
-
- void dbd_init(dbistate_t* dbistate)
- {
- DBISTATE_INIT; /* Initialize the DBI macros */
- }
-
-The C<dbd_init()> function will be called when your driver is first
-loaded; the bootstrap command in C<DBD::Driver::dr::driver()> triggers this,
-and the call is generated in the I<BOOT> section of F<Driver.xst>.
-These statements are needed to allow your driver to use the B<DBI> macros.
-They will include your private header file F<dbdimp.h> in turn.
-Note that I<DBISTATE_INIT> requires the name of the argument to C<dbd_init()>
-to be called C<dbistate()>.
-
-=head3 The dbd_drv_error method
-
-You need a function to record errors so B<DBI> can access them properly.
-You can call it whatever you like, but we'll call it C<dbd_drv_error()>
-here.
-
-The argument list depends on your database software; different systems
-provide different ways to get at error information.
-
- static void dbd_drv_error(SV *h, int rc, const char *what)
- {
-
-Note that I<h> is a generic handle, may it be a driver handle, a
-database or a statement handle.
-
- D_imp_xxh(h);
-
-This macro will declare and initialize a variable I<imp_xxh> with
-a pointer to your private handle pointer. You may cast this to
-to I<imp_drh_t>, I<imp_dbh_t> or I<imp_sth_t>.
-
-To record the error correctly, equivalent to the C<set_err()> method,
-use one of the C<DBIh_SET_ERR_CHAR(...)> or C<DBIh_SET_ERR_SV(...)> macros,
-which were added in B<DBI> 1.41:
-
- DBIh_SET_ERR_SV(h, imp_xxh, err, errstr, state, method);
- DBIh_SET_ERR_CHAR(h, imp_xxh, err_c, err_i, errstr, state, method);
-
-For C<DBIh_SET_ERR_SV> the I<err>, I<errstr>, I<state>, and I<method>
-parameters are C<SV*> (use &sv_undef instead of NULL).
-
-For C<DBIh_SET_ERR_CHAR> the I<err_c>, I<errstr>, I<state>, I<method>
-parameters are C<char*>.
-
-The I<err_i> parameter is an C<IV> that's used instead of I<err_c> if
-I<err_c> is C<Null>.
-
-The I<method> parameter can be ignored.
-
-The C<DBIh_SET_ERR_CHAR> macro is usually the simplest to use when you
-just have an integer error code and an error message string:
-
- DBIh_SET_ERR_CHAR(h, imp_xxh, Nullch, rc, what, Nullch, Nullch);
-
-As you can see, any parameters that aren't relevant to you can be C<Null>.
-
-To make drivers compatible with B<DBI> < 1.41 you should be using F<dbivport.h>
-as described in L</Driver.h> above.
-
-The (obsolete) macros such as C<DBIh_EVENT2> should be removed from drivers.
-
-The names C<dbis> and C<DBIS>, which were used in previous versions of
-this document, should be replaced with the C<DBIc_DBISTATE(imp_xxh)> macro.
-
-The name C<DBILOGFP>, which was also used in previous versions of this
-document, should be replaced by C<DBIc_LOGPIO(imp_xxh)>.
-
-Your code should not call the C C<E<lt>stdio.hE<gt>> I/O functions; you
-should use C<PerlIO_printf()> as shown:
-
- if (DBIc_TRACE_LEVEL(imp_xxh) >= 2)
- PerlIO_printf(DBIc_LOGPIO(imp_xxh), "foobar %s: %s\n",
- foo, neatsvpv(errstr,0));
-
-That's the first time we see how tracing works within a B<DBI> driver. Make
-use of this as often as you can, but don't output anything at a trace
-level less than 3. Levels 1 and 2 are reserved for the B<DBI>.
-
-You can define up to 8 private trace flags using the top 8 bits
-of C<DBIc_TRACE_FLAGS(imp)>, that is: C<0xFF000000>. See the
-C<parse_trace_flag()> method elsewhere in this document.
-
-=head3 The dbd_dr_data_sources method
-
-This method is optional; the support for it was added in B<DBI> v1.33.
-
-As noted in the discussion of F<Driver.pm>, if the data sources
-can be determined by pure Perl code, do it that way. If, as in
-B<DBD::Informix>, the information is obtained by a C function call, then
-you need to define a function that matches the prototype:
-
- extern AV *dbd_dr_data_sources(SV *drh, imp_drh_t *imp_drh, SV *attrs);
-
-An outline implementation for B<DBD::Informix> follows, assuming that the
-C<sqgetdbs()> function call shown will return up to 100 databases names,
-with the pointers to each name in the array dbsname and the name strings
-themselves being stores in dbsarea.
-
- AV *dbd_dr_data_sources(SV *drh, imp_drh_t *imp_drh, SV *attr)
- {
- int ndbs;
- int i;
- char *dbsname[100];
- char dbsarea[10000];
- AV *av = Nullav;
-
- if (sqgetdbs(&ndbs, dbsname, 100, dbsarea, sizeof(dbsarea)) == 0)
- {
- av = NewAV();
- av_extend(av, (I32)ndbs);
- sv_2mortal((SV *)av);
- for (i = 0; i < ndbs; i++)
- av_store(av, i, newSVpvf("dbi:Informix:%s", dbsname[i]));
- }
- return(av);
- }
-
-The actual B<DBD::Informix> implementation has a number of extra lines of
-code, logs function entry and exit, reports the error from C<sqgetdbs()>,
-and uses C<#define>'d constants for the array sizes.
-
-=head3 The dbd_db_login6 method
-
- int dbd_db_login6_sv(SV* dbh, imp_dbh_t* imp_dbh, SV* dbname,
- SV* user, SV* auth, SV *attr);
-
- or
-
- int dbd_db_login6(SV* dbh, imp_dbh_t* imp_dbh, char* dbname,
- char* user, char* auth, SV *attr);
-
-This function will really connect to the database. The argument I<dbh>
-is the database handle. I<imp_dbh> is the pointer to the handles private
-data, as is I<imp_xxx> in C<dbd_drv_error()> above. The arguments
-I<dbname>, I<user>, I<auth> and I<attr> correspond to the arguments of
-the driver handle's C<connect()> method.
-
-You will quite often use database specific attributes here, that are
-specified in the DSN. I recommend you parse the DSN (using Perl) within
-the C<connect()> method and pass the segments of the DSN via the
-attributes parameter through C<_login()> to C<dbd_db_login6()>.
-
-Here's how you fetch them; as an example we use I<hostname> attribute,
-which can be up to 12 characters long excluding null terminator:
-
- SV** svp;
- STRLEN len;
- char* hostname;
-
- if ( (svp = DBD_ATTRIB_GET_SVP(attr, "drv_hostname", 12)) && SvTRUE(*svp)) {
- hostname = SvPV(*svp, len);
- DBD_ATTRIB_DELETE(attr, "drv_hostname", 12); /* avoid later STORE */
- } else {
- hostname = "localhost";
- }
-
-If you handle any driver specific attributes in the dbd_db_login6
-method you probably want to delete them from C<attr> (as above with
-DBD_ATTRIB_DELETE). If you don't delete your handled attributes DBI
-will call C<STORE> for each attribute after the connect/login and this
-is at best redundant for attributes you have already processed.
-
-B<Note: Until revision 11605 (post DBI 1.607), there was a problem with
-DBD_ATTRIBUTE_DELETE so unless you require a DBI version after 1.607
-you need to replace each DBD_ATTRIBUTE_DELETE call with:>
-
- hv_delete((HV*)SvRV(attr), key, key_len, G_DISCARD)
-
-Note that you can also obtain standard attributes such as I<AutoCommit> and
-I<ChopBlanks> from the attributes parameter, using C<DBD_ATTRIB_GET_IV> for
-integer attributes.
-
-If, for example, your database does not support transactions but
-I<AutoCommit> is set off (requesting transaction support), then you can
-emulate a 'failure to connect'.
-
-Now you should really connect to the database. In general, if the
-connection fails, it is best to ensure that all allocated resources are
-released so that the handle does not need to be destroyed separately. If
-you are successful (and possibly even if you fail but you have allocated
-some resources), you should use the following macros:
-
- DBIc_IMPSET_on(imp_dbh);
-
-This indicates that the driver (implementor) has allocated resources in
-the I<imp_dbh> structure and that the implementors private C<dbd_db_destroy()>
-function should be called when the handle is destroyed.
-
- DBIc_ACTIVE_on(imp_dbh);
-
-This indicates that the handle has an active connection to the server
-and that the C<dbd_db_disconnect()> function should be called before the
-handle is destroyed.
-
-Note that if you do need to fail, you should report errors via the I<drh>
-or I<imp_drh> rather than via I<dbh> or I<imp_dbh> because I<imp_dbh> will be
-destroyed by the failure, so errors recorded in that handle will not be
-visible to B<DBI>, and hence not the user either.
-
-Note too, that the function is passed I<dbh> and I<imp_dbh>, and there
-is a macro C<D_imp_drh_from_dbh> which can recover the I<imp_drh> from
-the I<imp_dbh>. However, there is no B<DBI> macro to provide you with the
-I<drh> given either the I<imp_dbh> or the I<dbh> or the I<imp_drh> (and
-there's no way to recover the I<dbh> given just the I<imp_dbh>).
-
-This suggests that, despite the above notes about C<dbd_drv_error()>
-taking an C<SV *>, it may be better to have two error routines, one
-taking I<imp_dbh> and one taking I<imp_drh> instead. With care, you can
-factor most of the formatting code out so that these are small routines
-calling a common error formatter. See the code in B<DBD::Informix>
-1.05.00 for more information.
-
-The C<dbd_db_login6()> function should return I<TRUE> for success,
-I<FALSE> otherwise.
-
-Drivers implemented long ago may define the five-argument function
-C<dbd_db_login()> instead of C<dbd_db_login6()>. The missing argument is
-the attributes. There are ways to work around the missing attributes,
-but they are ungainly; it is much better to use the 6-argument form.
-Even later drivers will use C<dbd_db_login6_sv()> which provides the
-dbname, username and password as SVs.
-
-=head3 The dbd_db_commit and dbd_db_rollback methods
-
- int dbd_db_commit(SV *dbh, imp_dbh_t *imp_dbh);
- int dbd_db_rollback(SV* dbh, imp_dbh_t* imp_dbh);
-
-These are used for commit and rollback. They should return I<TRUE> for
-success, I<FALSE> for error.
-
-The arguments I<dbh> and I<imp_dbh> are the same as for C<dbd_db_login6()>
-above; I will omit describing them in what follows, as they appear
-always.
-
-These functions should return I<TRUE> for success, I<FALSE> otherwise.
-
-=head3 The dbd_db_disconnect method
-
-This is your private part of the C<disconnect()> method. Any I<dbh> with
-the I<ACTIVE> flag on must be disconnected. (Note that you have to set
-it in C<dbd_db_connect()> above.)
-
- int dbd_db_disconnect(SV* dbh, imp_dbh_t* imp_dbh);
-
-The database handle will return I<TRUE> for success, I<FALSE> otherwise.
-In any case it should do a:
-
- DBIc_ACTIVE_off(imp_dbh);
-
-before returning so B<DBI> knows that C<dbd_db_disconnect()> was executed.
-
-Note that there's nothing to stop a I<dbh> being I<disconnected> while
-it still have active children. If your database API reacts badly to
-trying to use an I<sth> in this situation then you'll need to add code
-like this to all I<sth> methods:
-
- if (!DBIc_ACTIVE(DBIc_PARENT_COM(imp_sth)))
- return 0;
-
-Alternatively, you can add code to your driver to keep explicit track of
-the statement handles that exist for each database handle and arrange
-to destroy those handles before disconnecting from the database. There
-is code to do this in B<DBD::Informix>. Similar comments apply to the
-driver handle keeping track of all the database handles.
-
-Note that the code which destroys the subordinate handles should only
-release the associated database resources and mark the handles inactive;
-it does not attempt to free the actual handle structures.
-
-This function should return I<TRUE> for success, I<FALSE> otherwise, but
-it is not clear what anything can do about a failure.
-
-=head3 The dbd_db_discon_all method
-
- int dbd_discon_all (SV *drh, imp_drh_t *imp_drh);
-
-This function may be called at shutdown time. It should make
-best-efforts to disconnect all database handles - if possible. Some
-databases don't support that, in which case you can do nothing
-but return 'success'.
-
-This function should return I<TRUE> for success, I<FALSE> otherwise, but
-it is not clear what anything can do about a failure.
-
-=head3 The dbd_db_destroy method
-
-This is your private part of the database handle destructor. Any I<dbh> with
-the I<IMPSET> flag on must be destroyed, so that you can safely free
-resources. (Note that you have to set it in C<dbd_db_connect()> above.)
-
- void dbd_db_destroy(SV* dbh, imp_dbh_t* imp_dbh)
- {
- DBIc_IMPSET_off(imp_dbh);
- }
-
-The B<DBI> F<Driver.xst> code will have called C<dbd_db_disconnect()> for you,
-if the handle is still 'active', before calling C<dbd_db_destroy()>.
-
-Before returning the function must switch I<IMPSET> to off, so B<DBI> knows
-that the destructor was called.
-
-A B<DBI> handle doesn't keep references to its children. But children
-do keep references to their parents. So a database handle won't be
-C<DESTROY>'d until all its children have been C<DESTROY>'d.
-
-=head3 The dbd_db_STORE_attrib method
-
-This function handles
-
- $dbh->{$key} = $value;
-
-Its prototype is:
-
- int dbd_db_STORE_attrib(SV* dbh, imp_dbh_t* imp_dbh, SV* keysv,
- SV* valuesv);
-
-You do not handle all attributes; on the contrary, you should not handle
-B<DBI> attributes here: leave this to B<DBI>. (There are two exceptions,
-I<AutoCommit> and I<ChopBlanks>, which you should care about.)
-
-The return value is I<TRUE> if you have handled the attribute or I<FALSE>
-otherwise. If you are handling an attribute and something fails, you
-should call C<dbd_drv_error()>, so B<DBI> can raise exceptions, if desired.
-If C<dbd_drv_error()> returns, however, you have a problem: the user will
-never know about the error, because he typically will not check
-C<$dbh-E<gt>errstr()>.
-
-I cannot recommend a general way of going on, if C<dbd_drv_error()> returns,
-but there are examples where even the B<DBI> specification expects that
-you C<croak()>. (See the I<AutoCommit> method in L<DBI>.)
-
-If you have to store attributes, you should either use your private
-data structure I<imp_xxx>, the handle hash (via C<(HV*)SvRV(dbh)>), or use
-the private I<imp_data>.
-
-The first is best for internal C values like integers or pointers and
-where speed is important within the driver. The handle hash is best for
-values the user may want to get/set via driver-specific attributes.
-The private I<imp_data> is an additional C<SV> attached to the handle. You
-could think of it as an unnamed handle attribute. It's not normally used.
-
-=head3 The dbd_db_FETCH_attrib method
-
-This is the counterpart of C<dbd_db_STORE_attrib()>, needed for:
-
- $value = $dbh->{$key};
-
-Its prototype is:
-
- SV* dbd_db_FETCH_attrib(SV* dbh, imp_dbh_t* imp_dbh, SV* keysv);
-
-Unlike all previous methods this returns an C<SV> with the value. Note
-that you should normally execute C<sv_2mortal()>, if you return a nonconstant
-value. (Constant values are C<&sv_undef>, C<&sv_no> and C<&sv_yes>.)
-
-Note, that B<DBI> implements a caching algorithm for attribute values.
-If you think, that an attribute may be fetched, you store it in the
-I<dbh> itself:
-
- if (cacheit) /* cache value for later DBI 'quick' fetch? */
- hv_store((HV*)SvRV(dbh), key, kl, cachesv, 0);
-
-=head3 The dbd_st_prepare method
-
-This is the private part of the C<prepare()> method. Note that you
-B<must not> really execute the statement here. You may, however,
-preparse and validate the statement, or do similar things.
-
- int dbd_st_prepare(SV* sth, imp_sth_t* imp_sth, char* statement,
- SV* attribs);
-
-A typical, simple, possibility is to do nothing and rely on the perl
-C<prepare()> code that set the I<Statement> attribute on the handle. This
-attribute can then be used by C<dbd_st_execute()>.
-
-If the driver supports placeholders then the I<NUM_OF_PARAMS> attribute
-must be set correctly by C<dbd_st_prepare()>:
-
- DBIc_NUM_PARAMS(imp_sth) = ...
-
-If you can, you should also setup attributes like I<NUM_OF_FIELDS>, I<NAME>,
-etc. here, but B<DBI> doesn't require that - they can be deferred until
-execute() is called. However, if you do, document it.
-
-In any case you should set the I<IMPSET> flag, as you did in
-C<dbd_db_connect()> above:
-
- DBIc_IMPSET_on(imp_sth);
-
-=head3 The dbd_st_execute method
-
-This is where a statement will really be executed.
-
- int dbd_st_execute(SV* sth, imp_sth_t* imp_sth);
-
-C<dbd_st_execute> should return -2 for any error, -1 if the number of
-rows affected is unknown else it should be the number of affected
-(updated, inserted) rows.
-
-Note that you must be aware a statement may be executed repeatedly.
-Also, you should not expect that C<finish()> will be called between two
-executions, so you might need code, like the following, near the start
-of the function:
-
- if (DBIc_ACTIVE(imp_sth))
- dbd_st_finish(h, imp_sth);
-
-If your driver supports the binding of parameters (it should!), but the
-database doesn't, you must do it here. This can be done as follows:
-
- SV *svp;
- char* statement = DBD_ATTRIB_GET_PV(h, "Statement", 9, svp, "");
- int numParam = DBIc_NUM_PARAMS(imp_sth);
- int i;
-
- for (i = 0; i < numParam; i++)
- {
- char* value = dbd_db_get_param(sth, imp_sth, i);
- /* It is your drivers task to implement dbd_db_get_param, */
- /* it must be setup as a counterpart of dbd_bind_ph. */
- /* Look for '?' and replace it with 'value'. Difficult */
- /* task, note that you may have question marks inside */
- /* quotes and comments the like ... :-( */
- /* See DBD::mysql for an example. (Don't look too deep into */
- /* the example, you will notice where I was lazy ...) */
- }
-
-The next thing is to really execute the statement.
-
-Note that you must set the attributes I<NUM_OF_FIELDS>, I<NAME>, etc
-when the statement is successfully executed if the driver has not
-already done so: they may be used even before a potential C<fetchrow()>.
-In particular you have to tell B<DBI> the number of fields that the
-statement has, because it will be used by B<DBI> internally. Thus the
-function will typically ends with:
-
- if (isSelectStatement) {
- DBIc_NUM_FIELDS(imp_sth) = numFields;
- DBIc_ACTIVE_on(imp_sth);
- }
-
-It is important that the I<ACTIVE> flag only be set for C<SELECT>
-statements (or any other statements that can return many
-values from the database using a cursor-like mechanism). See
-C<dbd_db_connect()> above for more explanations.
-
-There plans for a preparse function to be provided by B<DBI>, but this has
-not reached fruition yet.
-Meantime, if you want to know how ugly it can get, try looking at the
-C<dbd_ix_preparse()> in B<DBD::Informix> F<dbdimp.ec> and the related
-functions in F<iustoken.c> and F<sqltoken.c>.
-
-=head3 The dbd_st_fetch method
-
-This function fetches a row of data. The row is stored in in an array,
-of C<SV>'s that B<DBI> prepares for you. This has two advantages: it is fast
-(you even reuse the C<SV>'s, so they don't have to be created after the
-first C<fetchrow()>), and it guarantees that B<DBI> handles C<bind_cols()> for
-you.
-
-What you do is the following:
-
- AV* av;
- int numFields = DBIc_NUM_FIELDS(imp_sth); /* Correct, if NUM_FIELDS
- is constant for this statement. There are drivers where this is
- not the case! */
- int chopBlanks = DBIc_is(imp_sth, DBIcf_ChopBlanks);
- int i;
-
- if (!fetch_new_row_of_data(...)) {
- ... /* check for error or end-of-data */
- DBIc_ACTIVE_off(imp_sth); /* turn off Active flag automatically */
- return Nullav;
- }
- /* get the fbav (field buffer array value) for this row */
- /* it is very important to only call this after you know */
- /* that you have a row of data to return. */
- av = DBIc_DBISTATE(imp_sth)->get_fbav(imp_sth);
- for (i = 0; i < numFields; i++) {
- SV* sv = fetch_a_field(..., i);
- if (chopBlanks && SvOK(sv) && type_is_blank_padded(field_type[i])) {
- /* Remove white space from end (only) of sv */
- }
- sv_setsv(AvARRAY(av)[i], sv); /* Note: (re)use! */
- }
- return av;
-
-There's no need to use a C<fetch_a_field()> function returning an C<SV*>.
-It's more common to use your database API functions to fetch the
-data as character strings and use code like this:
-
- sv_setpvn(AvARRAY(av)[i], char_ptr, char_count);
-
-C<NULL> values must be returned as C<undef>. You can use code like this:
-
- SvOK_off(AvARRAY(av)[i]);
-
-The function returns the C<AV> prepared by B<DBI> for success or C<Nullav>
-otherwise.
-
- *FIX ME* Discuss what happens when there's no more data to fetch.
- Are errors permitted if another fetch occurs after the first fetch
- that reports no more data. (Permitted, not required.)
-
-If an error occurs which leaves the I<$sth> in a state where remaining
-rows can't be fetched then I<Active> should be turned off before the
-method returns.
-
-=head3 The dbd_st_finish3 method
-
-The C<$sth-E<gt>finish()> method can be called if the user wishes to
-indicate that no more rows will be fetched even if the database has more
-rows to offer, and the B<DBI> code can call the function when handles are
-being destroyed. See the B<DBI> specification for more background details.
-
-In both circumstances, the B<DBI> code ends up calling the
-C<dbd_st_finish3()> method (if you provide a mapping for
-C<dbd_st_finish3()> in F<dbdimp.h>), or C<dbd_st_finish()> otherwise.
-The difference is that C<dbd_st_finish3()> takes a third argument which
-is an C<int> with the value 1 if it is being called from a C<destroy()>
-method and 0 otherwise.
-
-Note that B<DBI> v1.32 and earlier test on C<dbd_db_finish3()> to call
-C<dbd_st_finish3()>; if you provide C<dbd_st_finish3()>, either define
-C<dbd_db_finish3()> too, or insist on B<DBI> v1.33 or later.
-
-All it I<needs> to do is turn off the I<Active> flag for the I<sth>.
-It will only be called by F<Driver.xst> code, if the driver has set I<ACTIVE>
-to on for the I<sth>.
-
-Outline example:
-
- int dbd_st_finish3(SV* sth, imp_sth_t* imp_sth, int from_destroy) {
- if (DBIc_ACTIVE(imp_sth))
- {
- /* close cursor or equivalent action */
- DBIc_ACTIVE_off(imp_sth);
- }
- return 1;
- }
-
-The from_destroy parameter is true if C<dbd_st_finish3()> is being called
-from C<DESTROY()> - and so the statement is about to be destroyed.
-For many drivers there is no point in doing anything more than turning off
-the I<Active> flag in this case.
-
-The function returns I<TRUE> for success, I<FALSE> otherwise, but there isn't
-a lot anyone can do to recover if there is an error.
-
-=head3 The dbd_st_destroy method
-
-This function is the private part of the statement handle destructor.
-
- void dbd_st_destroy(SV* sth, imp_sth_t* imp_sth) {
- ... /* any clean-up that's needed */
- DBIc_IMPSET_off(imp_sth); /* let DBI know we've done it */
- }
-
-The B<DBI> F<Driver.xst> code will call C<dbd_st_finish()> for you, if the
-I<sth> has the I<ACTIVE> flag set, before calling C<dbd_st_destroy()>.
-
-=head3 The dbd_st_STORE_attrib and dbd_st_FETCH_attrib methods
-
-These functions correspond to C<dbd_db_STORE()> and C<dbd_db_FETCH()> attrib
-above, except that they are for statement handles.
-See above.
-
- int dbd_st_STORE_attrib(SV* sth, imp_sth_t* imp_sth, SV* keysv,
- SV* valuesv);
- SV* dbd_st_FETCH_attrib(SV* sth, imp_sth_t* imp_sth, SV* keysv);
-
-=head3 The dbd_bind_ph method
-
-This function is internally used by the C<bind_param()> method, the
-C<bind_param_inout()> method and by the B<DBI> F<Driver.xst> code if
-C<execute()> is called with any bind parameters.
-
- int dbd_bind_ph (SV *sth, imp_sth_t *imp_sth, SV *param,
- SV *value, IV sql_type, SV *attribs,
- int is_inout, IV maxlen);
-
-The I<param> argument holds an C<IV> with the parameter number (1, 2, ...).
-The I<value> argument is the parameter value and I<sql_type> is its type.
-
-If your driver does not support C<bind_param_inout()> then you should
-ignore I<maxlen> and croak if I<is_inout> is I<TRUE>.
-
-If your driver I<does> support C<bind_param_inout()> then you should
-note that I<value> is the C<SV> I<after> dereferencing the reference
-passed to C<bind_param_inout()>.
-
-In drivers of simple databases the function will, for example, store
-the value in a parameter array and use it later in C<dbd_st_execute()>.
-See the B<DBD::mysql> driver for an example.
-
-=head3 Implementing bind_param_inout support
-
-To provide support for parameters bound by reference rather than by
-value, the driver must do a number of things. First, and most
-importantly, it must note the references and stash them in its own
-driver structure. Secondly, when a value is bound to a column, the
-driver must discard any previous reference bound to the column. On
-each execute, the driver must evaluate the references and internally
-bind the values resulting from the references. This is only applicable
-if the user writes:
-
- $sth->execute;
-
-If the user writes:
-
- $sth->execute(@values);
-
-then B<DBI> automatically calls the binding code for each element of
-I<@values>. These calls are indistinguishable from explicit user calls to
-C<bind_param()>.
-
-=head2 C/XS version of Makefile.PL
-
-The F<Makefile.PL> file for a C/XS driver is similar to the code needed
-for a pure Perl driver, but there are a number of extra bits of
-information needed by the build system.
-
-For example, the attributes list passed to C<WriteMakefile()> needs
-to specify the object files that need to be compiled and built into
-the shared object (DLL). This is often, but not necessarily, just
-F<dbdimp.o> (unless that should be F<dbdimp.obj> because you're building
-on MS Windows).
-
-Note that you can reliably determine the extension of the object files
-from the I<$Config{obj_ext}> values, and there are many other useful pieces
-of configuration information lurking in that hash.
-You get access to it with:
-
- use Config;
-
-=head2 Methods which do not need to be written
-
-The B<DBI> code implements the majority of the methods which are accessed
-using the notation C<DBI-E<gt>function()>, the only exceptions being
-C<DBI-E<gt>connect()> and C<DBI-E<gt>data_sources()> which require
-support from the driver.
-
-The B<DBI> code implements the following documented driver, database and
-statement functions which do not need to be written by the B<DBD> driver
-writer.
-
-=over 4
-
-=item $dbh->do()
-
-The default implementation of this function prepares, executes and
-destroys the statement. This can be replaced if there is a better
-way to implement this, such as C<EXECUTE IMMEDIATE> which can
-sometimes be used if there are no parameters.
-
-=item $h->errstr()
-
-=item $h->err()
-
-=item $h->state()
-
-=item $h->trace()
-
-The B<DBD> driver does not need to worry about these routines at all.
-
-=item $h->{ChopBlanks}
-
-This attribute needs to be honored during C<fetch()> operations, but does
-not need to be handled by the attribute handling code.
-
-=item $h->{RaiseError}
-
-The B<DBD> driver does not need to worry about this attribute at all.
-
-=item $h->{PrintError}
-
-The B<DBD> driver does not need to worry about this attribute at all.
-
-=item $sth->bind_col()
-
-Assuming the driver uses the C<DBIc_DBISTATE(imp_xxh)-E<gt>get_fbav()>
-function (C drivers, see below), or the C<$sth-E<gt>_set_fbav($data)>
-method (Perl drivers) the driver does not need to do anything about this
-routine.
-
-=item $sth->bind_columns()
-
-Regardless of whether the driver uses
-C<DBIc_DBISTATE(imp_xxh)-E<gt>get_fbav()>, the driver does not need
-to do anything about this routine as it simply iteratively calls
-C<$sth-E<gt>bind_col()>.
-
-=back
-
-The B<DBI> code implements a default implementation of the following
-functions which do not need to be written by the B<DBD> driver writer
-unless the default implementation is incorrect for the Driver.
-
-=over 4
-
-=item $dbh->quote()
-
-This should only be written if the database does not accept the ANSI
-SQL standard for quoting strings, with the string enclosed in single
-quotes and any embedded single quotes replaced by two consecutive
-single quotes.
-
-For the two argument form of quote, you need to implement the
-C<type_info()> method to provide the information that quote needs.
-
-=item $dbh->ping()
-
-This should be implemented as a simple efficient way to determine
-whether the connection to the database is still alive. Typically
-code like this:
-
- sub ping {
- my $dbh = shift;
- $sth = $dbh->prepare_cached(q{
- select * from A_TABLE_NAME where 1=0
- }) or return 0;
- $sth->execute or return 0;
- $sth->finish;
- return 1;
- }
-
-where I<A_TABLE_NAME> is the name of a table that always exists (such as a
-database system catalogue).
-
-=item $drh->default_user
-
-The default implementation of default_user will get the database
-username and password fields from C<$ENV{DBI_USER}> and
-C<$ENV{DBI_PASS}>. You can override this method. It is called as
-follows:
-
- ($user, $pass) = $drh->default_user($user, $pass, $attr)
-
-=back
-
-=head1 METADATA METHODS
-
-The exposition above ignores the B<DBI> MetaData methods.
-The metadata methods are all associated with a database handle.
-
-=head2 Using DBI::DBD::Metadata
-
-The B<DBI::DBD::Metadata> module is a good semi-automatic way for the
-developer of a B<DBD> module to write the C<get_info()> and C<type_info()>
-functions quickly and accurately.
-
-=head3 Generating the get_info method
-
-Prior to B<DBI> v1.33, this existed as the method C<write_getinfo_pm()>
-in the B<DBI::DBD> module. From B<DBI> v1.33, it exists as the method
-C<write_getinfo_pm()> in the B<DBI::DBD::Metadata> module. This
-discussion assumes you have B<DBI> v1.33 or later.
-
-You examine the documentation for C<write_getinfo_pm()> using:
-
- perldoc DBI::DBD::Metadata
-
-To use it, you need a Perl B<DBI> driver for your database which implements
-the C<get_info()> method. In practice, this means you need to install
-B<DBD::ODBC>, an ODBC driver manager, and an ODBC driver for your
-database.
-
-With the pre-requisites in place, you might type:
-
- perl -MDBI::DBD::Metadata -we \
- "write_getinfo_pm (qw{ dbi:ODBC:foo_db username password Driver })"
-
-The procedure writes to standard output the code that should be added to
-your F<Driver.pm> file and the code that should be written to
-F<lib/DBD/Driver/GetInfo.pm>.
-
-You should review the output to ensure that it is sensible.
-
-=head3 Generating the type_info method
-
-Given the idea of the C<write_getinfo_pm()> method, it was not hard
-to devise a parallel method, C<write_typeinfo_pm()>, which does the
-analogous job for the B<DBI> C<type_info_all()> metadata method. The
-C<write_typeinfo_pm()> method was added to B<DBI> v1.33.
-
-You examine the documentation for C<write_typeinfo_pm()> using:
-
- perldoc DBI::DBD::Metadata
-
-The setup is exactly analogous to the mechanism described in
-L</Generating the get_info method>.
-
-With the pre-requisites in place, you might type:
-
- perl -MDBI::DBD::Metadata -we \
- "write_typeinfo_pm (qw{ dbi:ODBC:foo_db username password Driver })"
-
-The procedure writes to standard output the code that should be added to
-your F<Driver.pm> file and the code that should be written to
-F<lib/DBD/Driver/TypeInfo.pm>.
-
-You should review the output to ensure that it is sensible.
-
-=head2 Writing DBD::Driver::db::get_info
-
-If you use the B<DBI::DBD::Metadata> module, then the code you need is
-generated for you.
-
-If you decide not to use the B<DBI::DBD::Metadata> module, you
-should probably borrow the code from a driver that has done so (eg
-B<DBD::Informix> from version 1.05 onwards) and crib the code from
-there, or look at the code that generates that module and follow
-that. The method in F<Driver.pm> will be very simple; the method in
-F<lib/DBD/Driver/GetInfo.pm> is not very much more complex unless your
-DBMS itself is much more complex.
-
-Note that some of the B<DBI> utility methods rely on information from the
-C<get_info()> method to perform their operations correctly. See, for
-example, the C<quote_identifier()> and quote methods, discussed below.
-
-=head2 Writing DBD::Driver::db::type_info_all
-
-If you use the C<DBI::DBD::Metadata> module, then the code you need is
-generated for you.
-
-If you decide not to use the C<DBI::DBD::Metadata> module, you
-should probably borrow the code from a driver that has done so (eg
-C<DBD::Informix> from version 1.05 onwards) and crib the code from
-there, or look at the code that generates that module and follow
-that. The method in F<Driver.pm> will be very simple; the method in
-F<lib/DBD/Driver/TypeInfo.pm> is not very much more complex unless your
-DBMS itself is much more complex.
-
-=head2 Writing DBD::Driver::db::type_info
-
-The guidelines on writing this method are still not really clear.
-No sample implementation is available.
-
-=head2 Writing DBD::Driver::db::table_info
-
- *FIX ME* The guidelines on writing this method have not been written yet.
- No sample implementation is available.
-
-=head2 Writing DBD::Driver::db::column_info
-
- *FIX ME* The guidelines on writing this method have not been written yet.
- No sample implementation is available.
-
-=head2 Writing DBD::Driver::db::primary_key_info
-
- *FIX ME* The guidelines on writing this method have not been written yet.
- No sample implementation is available.
-
-=head2 Writing DBD::Driver::db::primary_key
-
- *FIX ME* The guidelines on writing this method have not been written yet.
- No sample implementation is available.
-
-=head2 Writing DBD::Driver::db::foreign_key_info
-
- *FIX ME* The guidelines on writing this method have not been written yet.
- No sample implementation is available.
-
-=head2 Writing DBD::Driver::db::tables
-
-This method generates an array of names in a format suitable for being
-embedded in SQL statements in places where a table name is expected.
-
-If your database hews close enough to the SQL standard or if you have
-implemented an appropriate C<table_info()> function and and the appropriate
-C<quote_identifier()> function, then the B<DBI> default version of this method
-will work for your driver too.
-
-Otherwise, you have to write a function yourself, such as:
-
- sub tables
- {
- my($dbh, $cat, $sch, $tab, $typ) = @_;
- my(@res);
- my($sth) = $dbh->table_info($cat, $sch, $tab, $typ);
- my(@arr);
- while (@arr = $sth->fetchrow_array)
- {
- push @res, $dbh->quote_identifier($arr[0], $arr[1], $arr[2]);
- }
- return @res;
- }
-
-See also the default implementation in F<DBI.pm>.
-
-=head2 Writing DBD::Driver::db::quote
-
-This method takes a value and converts it into a string suitable for
-embedding in an SQL statement as a string literal.
-
-If your DBMS accepts the SQL standard notation for strings (single
-quotes around the string as a whole with any embedded single quotes
-doubled up), then you do not need to write this method as B<DBI> provides a
-default method that does it for you.
-
-If your DBMS uses an alternative notation or escape mechanism, then you
-need to provide an equivalent function. For example, suppose your DBMS
-used C notation with double quotes around the string and backslashes
-escaping both double quotes and backslashes themselves. Then you might
-write the function as:
-
- sub quote
- {
- my($dbh, $str) = @_;
- $str =~ s/["\\]/\\$&/gmo;
- return qq{"$str"};
- }
-
-Handling newlines and other control characters is left as an exercise
-for the reader.
-
-This sample method ignores the I<$data_type> indicator which is the
-optional second argument to the method.
-
-=head2 Writing DBD::Driver::db::quote_identifier
-
-This method is called to ensure that the name of the given table (or
-other database object) can be embedded into an SQL statement without
-danger of misinterpretation. The result string should be usable in the
-text of an SQL statement as the identifier for a table.
-
-If your DBMS accepts the SQL standard notation for quoted identifiers
-(which uses double quotes around the identifier as a whole, with any
-embedded double quotes doubled up) and accepts I<"schema"."identifier">
-(and I<"catalog"."schema"."identifier"> when a catalog is specified), then
-you do not need to write this method as B<DBI> provides a default method
-that does it for you.
-
-In fact, even if your DBMS does not handle exactly that notation but
-you have implemented the C<get_info()> method and it gives the correct
-responses, then it will work for you. If your database is fussier, then
-you need to implement your own version of the function.
-
-For example, B<DBD::Informix> has to deal with an environment variable
-I<DELIMIDENT>. If it is not set, then the DBMS treats names enclosed in
-double quotes as strings rather than names, which is usually a syntax
-error. Additionally, the catalog portion of the name is separated from
-the schema and table by a different delimiter (colon instead of dot),
-and the catalog portion is never enclosed in quotes. (Fortunately,
-valid strings for the catalog will never contain weird characters that
-might need to be escaped, unless you count dots, dashes, slashes and
-at-signs as weird.) Finally, an Informix database can contain objects
-that cannot be accessed because they were created by a user with the
-I<DELIMIDENT> environment variable set, but the current user does not
-have it set. By design choice, the C<quote_identifier()> method encloses
-those identifiers in double quotes anyway, which generally triggers a
-syntax error, and the metadata methods which generate lists of tables
-etc omit those identifiers from the result sets.
-
- sub quote_identifier
- {
- my($dbh, $cat, $sch, $obj) = @_;
- my($rv) = "";
- my($qq) = (defined $ENV{DELIMIDENT}) ? '"' : '';
- $rv .= qq{$cat:} if (defined $cat);
- if (defined $sch)
- {
- if ($sch !~ m/^\w+$/o)
- {
- $qq = '"';
- $sch =~ s/$qq/$qq$qq/gm;
- }
- $rv .= qq{$qq$sch$qq.};
- }
- if (defined $obj)
- {
- if ($obj !~ m/^\w+$/o)
- {
- $qq = '"';
- $obj =~ s/$qq/$qq$qq/gm;
- }
- $rv .= qq{$qq$obj$qq};
- }
- return $rv;
- }
-
-Handling newlines and other control characters is left as an exercise
-for the reader.
-
-Note that there is an optional fourth parameter to this function which
-is a reference to a hash of attributes; this sample implementation
-ignores that.
-
-This sample implementation also ignores the single-argument variant of
-the method.
-
-=head1 TRACING
-
-Tracing in DBI is controlled with a combination of a trace level and a
-set of flags which together are known as the trace settings. The trace
-settings are stored in a single integer and divided into levels and
-flags by a set of masks (C<DBIc_TRACE_LEVEL_MASK> and
-C<DBIc_TRACE_FLAGS_MASK>).
-
-Each handle has it's own trace settings and so does the DBI. When you
-call a method the DBI merges the handles settings into its own for the
-duration of the call: the trace flags of the handle are OR'd into the
-trace flags of the DBI, and if the handle has a higher trace level
-then the DBI trace level is raised to match it. The previous DBI trace
-settings are restored when the called method returns.
-
-=head2 Trace Level
-
-The trace level is the first 4 bits of the trace settings (masked by
-C<DBIc_TRACE_FLAGS_MASK>) and represents trace levels of 1 to 15. Do
-not output anything at trace levels less than 3 as they are reserved
-for DBI.
-
-For advice on what to output at each level see "Trace Levels" in
-L<DBI>.
-
-To test for a trace level you can use the C<DBIc_TRACE_LEVEL> macro
-like this:
-
- if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) {
- PerlIO_printf(DBIc_LOGPIO(imp_xxh), "foobar");
- }
-
-Also B<note> the use of PerlIO_printf which you should always use for
-tracing and never the C C<stdio.h> I/O functions.
-
-=head2 Trace Flags
-
-Trace flags are used to enable tracing of specific activities within
-the DBI and drivers. The DBI defines some trace flags and drivers can
-define others. DBI trace flag names begin with a capital letter and
-driver specific names begin with a lowercase letter. For a list of DBI
-defined trace flags see "Trace Flags" in L<DBI>.
-
-If you want to use private trace flags you'll probably want to be able
-to set them by name. Drivers are expected to override the
-parse_trace_flag (note the singular) and check if $trace_flag_name is
-a driver specific trace flags and, if not, then call the DBIs default
-parse_trace_flag(). To do that you'll need to define a
-parse_trace_flag() method like this:
-
- sub parse_trace_flag {
- my ($h, $name) = @_;
- return 0x01000000 if $name eq 'foo';
- return 0x02000000 if $name eq 'bar';
- return 0x04000000 if $name eq 'baz';
- return 0x08000000 if $name eq 'boo';
- return 0x10000000 if $name eq 'bop';
- return $h->SUPER::parse_trace_flag($name);
- }
-
-All private flag names must be lowercase, and all private flags must
-be in the top 8 of the 32 bits of C<DBIc_TRACE_FLAGS(imp)> i.e.,
-0xFF000000.
-
-If you've defined a parse_trace_flag() method in ::db you'll also want
-it in ::st, so just alias it in:
-
- *parse_trace_flag = \&DBD::foo:db::parse_trace_flag;
-
-You may want to act on the current 'SQL' trace flag that DBI defines
-to output SQL prepared/executed as DBI currently does not do SQL
-tracing.
-
-=head2 Trace Macros
-
-Access to the trace level and trace flags is via a set of macros.
-
- DBIc_TRACE_SETTINGS(imp) returns the trace settings
- DBIc_TRACE_LEVEL(imp) returns the trace level
- DBIc_TRACE_FLAGS(imp) returns the trace flags
- DBIc_TRACE(imp, flags, flaglevel, level)
-
- e.g.,
-
- DBIc_TRACE(imp, 0, 0, 4)
- if level >= 4
-
- DBIc_TRACE(imp, DBDtf_FOO, 2, 4)
- if tracing DBDtf_FOO & level>=2 or level>=4
-
- DBIc_TRACE(imp, DBDtf_FOO, 2, 0)
- as above but never trace just due to level
-
-=head1 WRITING AN EMULATION LAYER FOR AN OLD PERL INTERFACE
-
-Study F<Oraperl.pm> (supplied with B<DBD::Oracle>) and F<Ingperl.pm> (supplied
-with B<DBD::Ingres>) and the corresponding I<dbdimp.c> files for ideas.
-
-Note that the emulation code sets C<$dbh-E<gt>{CompatMode} = 1;> for each
-connection so that the internals of the driver can implement behaviour
-compatible with the old interface when dealing with those handles.
-
-=head2 Setting emulation perl variables
-
-For example, ingperl has a I<$sql_rowcount> variable. Rather than try
-to manually update this in F<Ingperl.pm> it can be done faster in C code.
-In C<dbd_init()>:
-
- sql_rowcount = perl_get_sv("Ingperl::sql_rowcount", GV_ADDMULTI);
-
-In the relevant places do:
-
- if (DBIc_COMPAT(imp_sth)) /* only do this for compatibility mode handles */
- sv_setiv(sql_rowcount, the_row_count);
-
-=head1 OTHER MISCELLANEOUS INFORMATION
-
-=head2 The imp_xyz_t types
-
-Any handle has a corresponding C structure filled with private data.
-Some of this data is reserved for use by B<DBI> (except for using the
-DBIc macros below), some is for you. See the description of the
-F<dbdimp.h> file above for examples. Most functions in F<dbdimp.c>
-are passed both the handle C<xyz> and a pointer to C<imp_xyz>. In
-rare cases, however, you may use the following macros:
-
-=over 4
-
-=item D_imp_dbh(dbh)
-
-Given a function argument I<dbh>, declare a variable I<imp_dbh> and
-initialize it with a pointer to the handles private data. Note: This
-must be a part of the function header, because it declares a variable.
-
-=item D_imp_sth(sth)
-
-Likewise for statement handles.
-
-=item D_imp_xxx(h)
-
-Given any handle, declare a variable I<imp_xxx> and initialize it
-with a pointer to the handles private data. It is safe, for example,
-to cast I<imp_xxx> to C<imp_dbh_t*>, if C<DBIc_TYPE(imp_xxx) == DBIt_DB>.
-(You can also call C<sv_derived_from(h, "DBI::db")>, but that's much
-slower.)
-
-=item D_imp_dbh_from_sth
-
-Given a I<imp_sth>, declare a variable I<imp_dbh> and initialize it with a
-pointer to the parent database handle's implementors structure.
-
-=back
-
-=head2 Using DBIc_IMPSET_on
-
-The driver code which initializes a handle should use C<DBIc_IMPSET_on()>
-as soon as its state is such that the cleanup code must be called.
-When this happens is determined by your driver code.
-
-B<Failure to call this can lead to corruption of data structures.>
-
-For example, B<DBD::Informix> maintains a linked list of database
-handles in the driver, and within each handle, a linked list of
-statements. Once a statement is added to the linked list, it is crucial
-that it is cleaned up (removed from the list). When I<DBIc_IMPSET_on()>
-was being called too late, it was able to cause all sorts of problems.
-
-=head2 Using DBIc_is(), DBIc_has(), DBIc_on() and DBIc_off()
-
-Once upon a long time ago, the only way of handling the internal B<DBI>
-boolean flags/attributes was through macros such as:
-
- DBIc_WARN DBIc_WARN_on DBIc_WARN_off
- DBIc_COMPAT DBIc_COMPAT_on DBIc_COMPAT_off
-
-Each of these took an I<imp_xxh> pointer as an argument.
-
-Since then, new attributes have been added such as I<ChopBlanks>,
-I<RaiseError> and I<PrintError>, and these do not have the full set of
-macros. The approved method for handling these is now the four macros:
-
- DBIc_is(imp, flag)
- DBIc_has(imp, flag) an alias for DBIc_is
- DBIc_on(imp, flag)
- DBIc_off(imp, flag)
- DBIc_set(imp, flag, on) set if on is true, else clear
-
-Consequently, the C<DBIc_XXXXX> family of macros is now mostly deprecated
-and new drivers should avoid using them, even though the older drivers
-will probably continue to do so for quite a while yet. However...
-
-There is an I<important exception> to that. The I<ACTIVE> and I<IMPSET>
-flags should be set via the C<DBIc_ACTIVE_on()> and C<DBIc_IMPSET_on()> macros,
-and unset via the C<DBIc_ACTIVE_off()> and C<DBIc_IMPSET_off()> macros.
-
-=head2 Using the get_fbav() method
-
-B<THIS IS CRITICAL for C/XS drivers>.
-
-The C<$sth-E<gt>bind_col()> and C<$sth-E<gt>bind_columns()> documented
-in the B<DBI> specification do not have to be implemented by the driver
-writer because B<DBI> takes care of the details for you.
-
-However, the key to ensuring that bound columns work is to call the
-function C<DBIc_DBISTATE(imp_xxh)-E<gt>get_fbav()> in the code which
-fetches a row of data.
-
-This returns an C<AV>, and each element of the C<AV> contains the C<SV> which
-should be set to contain the returned data.
-
-The pure Perl equivalent is the C<$sth-E<gt>_set_fbav($data)> method, as
-described in the part on pure Perl drivers.
-
-=head2 Casting strings to Perl types based on a SQL type
-
-DBI from 1.611 (and DBIXS_REVISION 13606) defines the
-sql_type_cast_svpv method which may be used to cast a string
-representation of a value to a more specific Perl type based on a SQL
-type. You should consider using this method when processing bound
-column data as it provides some support for the TYPE bind_col
-attribute which is rarely used in drivers.
-
- int sql_type_cast_svpv(pTHX_ SV *sv, int sql_type, U32 flags, void *v)
-
-C<sv> is what you would like cast, C<sql_type> is one of the DBI defined
-SQL types (e.g., C<SQL_INTEGER>) and C<flags> is a bitmask as follows:
-
-=over
-
-=item DBIstcf_STRICT
-
-If set this indicates you want an error state returned if the cast
-cannot be performed.
-
-=item DBIstcf_DISCARD_STRING
-
-If set and the pv portion of the C<sv> is cast then this will cause
-sv's pv to be freed up.
-
-=back
-
-sql_type_cast_svpv returns the following states:
-
- -2 sql_type is not handled - sv not changed
- -1 sv is undef, sv not changed
- 0 sv could not be cast cleanly and DBIstcf_STRICT was specified
- 1 sv could not be case cleanly and DBIstcf_STRICT was not specified
- 2 sv was cast ok
-
-The current implementation of sql_type_cast_svpv supports
-C<SQL_INTEGER>, C<SQL_DOUBLE> and C<SQL_NUMERIC>. C<SQL_INTEGER> uses
-sv_2iv and hence may set IV, UV or NV depending on the
-number. C<SQL_DOUBLE> uses sv_2nv so may set NV and C<SQL_NUMERIC>
-will set IV or UV or NV.
-
-DBIstcf_STRICT should be implemented as the StrictlyTyped attribute
-and DBIstcf_DISCARD_STRING implemented as the DiscardString attribute
-to the bind_col method and both default to off.
-
-See DBD::Oracle for an example of how this is used.
-
-=head1 SUBCLASSING DBI DRIVERS
-
-This is definitely an open subject. It can be done, as demonstrated by
-the B<DBD::File> driver, but it is not as simple as one might think.
-
-(Note that this topic is different from subclassing the B<DBI>. For an
-example of that, see the F<t/subclass.t> file supplied with the B<DBI>.)
-
-The main problem is that the I<dbh>'s and I<sth>'s that your C<connect()> and
-C<prepare()> methods return are not instances of your B<DBD::Driver::db>
-or B<DBD::Driver::st> packages, they are not even derived from it.
-Instead they are instances of the B<DBI::db> or B<DBI::st> classes or
-a derived subclass. Thus, if you write a method C<mymethod()> and do a
-
- $dbh->mymethod()
-
-then the autoloader will search for that method in the package B<DBI::db>.
-Of course you can instead to a
-
- $dbh->func('mymethod')
-
-and that will indeed work, even if C<mymethod()> is inherited, but not
-without additional work. Setting I<@ISA> is not sufficient.
-
-=head2 Overwriting methods
-
-The first problem is, that the C<connect()> method has no idea of
-subclasses. For example, you cannot implement base class and subclass
-in the same file: The C<install_driver()> method wants to do a
-
- require DBD::Driver;
-
-In particular, your subclass B<has> to be a separate driver, from
-the view of B<DBI>, and you cannot share driver handles.
-
-Of course that's not much of a problem. You should even be able
-to inherit the base classes C<connect()> method. But you cannot
-simply overwrite the method, unless you do something like this,
-quoted from B<DBD::CSV>:
-
- sub connect ($$;$$$) {
- my ($drh, $dbname, $user, $auth, $attr) = @_;
-
- my $this = $drh->DBD::File::dr::connect($dbname, $user, $auth, $attr);
- if (!exists($this->{csv_tables})) {
- $this->{csv_tables} = {};
- }
-
- $this;
- }
-
-Note that we cannot do a
-
- $drh->SUPER::connect($dbname, $user, $auth, $attr);
-
-as we would usually do in a an OO environment, because I<$drh> is an instance
-of B<DBI::dr>. And note, that the C<connect()> method of B<DBD::File> is
-able to handle subclass attributes. See the description of Pure Perl
-drivers above.
-
-It is essential that you always call superclass method in the above
-manner. However, that should do.
-
-=head2 Attribute handling
-
-Fortunately the B<DBI> specifications allow a simple, but still
-performant way of handling attributes. The idea is based on the
-convention that any driver uses a prefix I<driver_> for its private
-methods. Thus it's always clear whether to pass attributes to the super
-class or not. For example, consider this C<STORE()> method from the
-B<DBD::CSV> class:
-
- sub STORE {
- my ($dbh, $attr, $val) = @_;
- if ($attr !~ /^driver_/) {
- return $dbh->DBD::File::db::STORE($attr, $val);
- }
- if ($attr eq 'driver_foo') {
- ...
- }
-
-=cut
-
-use Exporter ();
-use Config qw(%Config);
-use Carp;
-use Cwd;
-use File::Spec;
-use strict;
-use vars qw(
- @ISA @EXPORT
- $is_dbi
-);
-
-BEGIN {
- if ($^O eq 'VMS') {
- require vmsish;
- import vmsish;
- require VMS::Filespec;
- import VMS::Filespec;
- }
- else {
- *vmsify = sub { return $_[0] };
- *unixify = sub { return $_[0] };
- }
-}
-
-@ISA = qw(Exporter);
-
-@EXPORT = qw(
- dbd_dbi_dir
- dbd_dbi_arch_dir
- dbd_edit_mm_attribs
- dbd_postamble
-);
-
-BEGIN {
- $is_dbi = (-r 'DBI.pm' && -r 'DBI.xs' && -r 'DBIXS.h');
- require DBI unless $is_dbi;
-}
-
-my $done_inst_checks;
-
-sub _inst_checks {
- return if $done_inst_checks++;
- my $cwd = cwd();
- if ($cwd =~ /\Q$Config{path_sep}/) {
- warn "*** Warning: Path separator characters (`$Config{path_sep}') ",
- "in the current directory path ($cwd) may cause problems\a\n\n";
- sleep 2;
- }
- if ($cwd =~ /\s/) {
- warn "*** Warning: whitespace characters ",
- "in the current directory path ($cwd) may cause problems\a\n\n";
- sleep 2;
- }
- if ( $^O eq 'MSWin32'
- && $Config{cc} eq 'cl'
- && !(exists $ENV{'LIB'} && exists $ENV{'INCLUDE'}))
- {
- die <<EOT;
-*** You're using Microsoft Visual C++ compiler or similar but
- the LIB and INCLUDE environment variables are not both set.
-
- You need to run the VCVARS32.BAT batch file that was supplied
- with the compiler before you can use it.
-
- A copy of vcvars32.bat can typically be found in the following
- directories under your Visual Studio install directory:
- Visual C++ 6.0: vc98\\bin
- Visual Studio .NET: vc7\\bin
-
- Find it, run it, then retry this.
-
- If you think this error is not correct then just set the LIB and
- INCLUDE environment variables to some value to disable the check.
-EOT
- }
-}
-
-sub dbd_edit_mm_attribs {
- # this both edits the attribs in-place and returns the flattened attribs
- my $mm_attr = shift;
- my $dbd_attr = shift || {};
- croak "dbd_edit_mm_attribs( \%makemaker [, \%other ]): too many parameters"
- if @_;
- _inst_checks();
-
- # what can be done
- my %test_variants = (
- p => { name => "DBI::PurePerl",
- match => qr/^\d/,
- add => [ '$ENV{DBI_PUREPERL} = 2',
- 'END { delete $ENV{DBI_PUREPERL}; }' ],
- },
- g => { name => "DBD::Gofer",
- match => qr/^\d/,
- add => [ q{$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic'},
- q|END { delete $ENV{DBI_AUTOPROXY}; }| ],
- },
- n => { name => "DBI::SQL::Nano",
- match => qr/^(?:48dbi_dbd_sqlengine|49dbd_file|5\ddbm_\w+|85gofer)\.t$/,
- add => [ q{$ENV{DBI_SQL_NANO} = 1},
- q|END { delete $ENV{DBI_SQL_NANO}; }| ],
- },
- # mx => { name => "DBD::Multiplex",
- # add => [ q{local $ENV{DBI_AUTOPROXY} = 'dbi:Multiplex:';} ],
- # }
- # px => { name => "DBD::Proxy",
- # need mechanism for starting/stopping the proxy server
- # add => [ q{local $ENV{DBI_AUTOPROXY} = 'dbi:Proxy:XXX';} ],
- # }
- );
-
- # decide what needs doing
- $dbd_attr->{create_pp_tests} or delete $test_variants{p};
- $dbd_attr->{create_nano_tests} or delete $test_variants{n};
- $dbd_attr->{create_gap_tests} or delete $test_variants{g};
-
- # expand for all combinations
- my @all_keys = my @tv_keys = sort keys %test_variants;
- while( @tv_keys ) {
- my $cur_key = shift @tv_keys;
- last if( 1 < length $cur_key );
- my @new_keys;
- foreach my $remain (@tv_keys) {
- push @new_keys, $cur_key . $remain unless $remain =~ /$cur_key/;
- }
- push @tv_keys, @new_keys;
- push @all_keys, @new_keys;
- }
-
- my %uniq_keys;
- foreach my $key (@all_keys) {
- @tv_keys = sort split //, $key;
- my $ordered = join( '', @tv_keys );
- $uniq_keys{$ordered} = 1;
- }
- @all_keys = sort { length $a <=> length $b or $a cmp $b } keys %uniq_keys;
-
- # do whatever needs doing
- if( keys %test_variants ) {
- # XXX need to convert this to work within the generated Makefile
- # so 'make' creates them and 'make clean' deletes them
- opendir DIR, 't' or die "Can't read 't' directory: $!";
- my @tests = grep { /\.t$/ } readdir DIR;
- closedir DIR;
-
- foreach my $test_combo (@all_keys) {
- @tv_keys = split //, $test_combo;
- my @test_names = map { $test_variants{$_}->{name} } @tv_keys;
- printf "Creating test wrappers for " . join( " + ", @test_names ) . ":\n";
- my @test_matches = map { $test_variants{$_}->{match} } @tv_keys;
- my @test_adds;
- foreach my $test_add ( map { $test_variants{$_}->{add} } @tv_keys) {
- push @test_adds, @$test_add;
- }
- my $v_type = $test_combo;
- $v_type = 'x' . $v_type if length( $v_type ) > 1;
-
- TEST:
- foreach my $test (sort @tests) {
- foreach my $match (@test_matches) {
- next TEST if $test !~ $match;
- }
- my $usethr = ($test =~ /(\d+|\b)thr/ && $] >= 5.008 && $Config{useithreads});
- my $v_test = "t/zv${v_type}_$test";
- my $v_perl = ($test =~ /taint/) ? "perl -wT" : "perl -w";
- printf "%s %s\n", $v_test, ($usethr) ? "(use threads)" : "";
- open PPT, ">$v_test" or warn "Can't create $v_test: $!";
- print PPT "#!$v_perl\n";
- print PPT "use threads;\n" if $usethr;
- print PPT "$_;\n" foreach @test_adds;
- print PPT "require './t/$test'; # or warn \$!;\n";
- close PPT or warn "Error writing $v_test: $!";
- }
- }
- }
- return %$mm_attr;
-}
-
-sub dbd_dbi_dir {
- _inst_checks();
- return '.' if $is_dbi;
- my $dbidir = $INC{'DBI.pm'} || die "DBI.pm not in %INC!";
- $dbidir =~ s:/DBI\.pm$::;
- return $dbidir;
-}
-
-sub dbd_dbi_arch_dir {
- _inst_checks();
- return '$(INST_ARCHAUTODIR)' if $is_dbi;
- my $dbidir = dbd_dbi_dir();
- my %seen;
- my @try = grep { not $seen{$_}++ } map { vmsify( unixify($_) . "/auto/DBI/" ) } @INC;
- my @xst = grep { -f vmsify( unixify($_) . "/Driver.xst" ) } @try;
- Carp::croak("Unable to locate Driver.xst in @try") unless @xst;
- Carp::carp( "Multiple copies of Driver.xst found in: @xst") if @xst > 1;
- print "Using DBI $DBI::VERSION (for perl $] on $Config{archname}) installed in $xst[0]\n";
- return File::Spec->canonpath($xst[0]);
-}
-
-sub dbd_postamble {
- my $self = shift;
- _inst_checks();
- my $dbi_instarch_dir = ($is_dbi) ? "." : dbd_dbi_arch_dir();
- my $dbi_driver_xst= File::Spec->catfile($dbi_instarch_dir, 'Driver.xst');
- my $xstf_h = File::Spec->catfile($dbi_instarch_dir, 'Driver_xst.h');
-
- # we must be careful of quotes, especially for Win32 here.
- return '
-# --- This section was generated by DBI::DBD::dbd_postamble()
-DBI_INSTARCH_DIR='.$dbi_instarch_dir.'
-DBI_DRIVER_XST='.$dbi_driver_xst.'
-
-# The main dependency (technically correct but probably not used)
-$(BASEEXT).c: $(BASEEXT).xsi
-
-# This dependency is needed since MakeMaker uses the .xs.o rule
-$(BASEEXT)$(OBJ_EXT): $(BASEEXT).xsi
-
-$(BASEEXT).xsi: $(DBI_DRIVER_XST) '.$xstf_h.'
- $(PERL) -p -e "s/~DRIVER~/$(BASEEXT)/g" $(DBI_DRIVER_XST) > $(BASEEXT).xsi
-
-# ---
-';
-}
-
-package DBDI; # just to reserve it via PAUSE for the future
-
-1;
-
-__END__
-
-=head1 AUTHORS
-
-Jonathan Leffler <jleffler@us.ibm.com> (previously <jleffler@informix.com>),
-Jochen Wiedmann <joe@ispsoft.de>,
-Steffen Goeldner <sgoeldner@cpan.org>,
-and Tim Bunce <dbi-users@perl.org>.
-
-=cut
+++ /dev/null
-package DBI::DBD::Metadata;
-
-# $Id: Metadata.pm 14213 2010-06-30 19:29:18Z Martin $
-#
-# Copyright (c) 1997-2003 Jonathan Leffler, Jochen Wiedmann,
-# Steffen Goeldner and Tim Bunce
-#
-# You may distribute under the terms of either the GNU General Public
-# License or the Artistic License, as specified in the Perl README file.
-
-use strict;
-
-use Exporter ();
-use Carp;
-
-use DBI;
-use DBI::Const::GetInfoType qw(%GetInfoType);
-
-our @ISA = qw(Exporter);
-our @EXPORT = qw(write_getinfo_pm write_typeinfo_pm);
-
-our $VERSION = "2.014214";
-
-
-=head1 NAME
-
-DBI::DBD::Metadata - Generate the code and data for some DBI metadata methods
-
-=head1 SYNOPSIS
-
-The idea is to extract metadata information from a good quality
-ODBC driver and use it to generate code and data to use in your own
-DBI driver for the same database.
-
-To generate code to support the get_info method:
-
- perl -MDBI::DBD::Metadata -e "write_getinfo_pm('dbi:ODBC:dsn-name','user','pass','Driver')"
-
- perl -MDBI::DBD::Metadata -e write_getinfo_pm dbi:ODBC:foo_db username password Driver
-
-To generate code to support the type_info method:
-
- perl -MDBI::DBD::Metadata -e "write_typeinfo_pm('dbi:ODBC:dsn-name','user','pass','Driver')"
-
- perl -MDBI::DBD::Metadata -e write_typeinfo_pm dbi:ODBC:dsn-name user pass Driver
-
-Where C<dbi:ODBC:dsn-name> is the connection to use to extract the
-data, and C<Driver> is the name of the driver you want the code
-generated for (the driver name gets embedded into the output in
-numerous places).
-
-=head1 Generating a GetInfo package for a driver
-
-The C<write_getinfo_pm> in the DBI::DBD::Metadata module generates a
-DBD::Driver::GetInfo package on standard output.
-
-This method generates a DBD::Driver::GetInfo package from the data
-source you specified in the parameter list or in the environment
-variable DBI_DSN.
-DBD::Driver::GetInfo should help a DBD author implement the DBI
-get_info() method.
-Because you are just creating this package, it is very unlikely that
-DBD::Driver already provides a good implementation for get_info().
-Thus you will probably connect via DBD::ODBC.
-
-Once you are sure that it is producing reasonably sane data, you should
-typically redirect the standard output to lib/DBD/Driver/GetInfo.pm, and
-then hand edit the result.
-Do not forget to update your Makefile.PL and MANIFEST to include this as
-an extra PM file that should be installed.
-
-If you connect via DBD::ODBC, you should use version 0.38 or greater;
-
-Please take a critical look at the data returned!
-ODBC drivers vary dramatically in their quality.
-
-The generator assumes that most values are static and places these
-values directly in the %info hash.
-A few examples show the use of CODE references and the implementation
-via subroutines.
-It is very likely that you will have to write additional subroutines for
-values depending on the session state or server version, e.g.
-SQL_DBMS_VER.
-
-A possible implementation of DBD::Driver::db::get_info() may look like:
-
- sub get_info {
- my($dbh, $info_type) = @_;
- require DBD::Driver::GetInfo;
- my $v = $DBD::Driver::GetInfo::info{int($info_type)};
- $v = $v->($dbh) if ref $v eq 'CODE';
- return $v;
- }
-
-Please replace Driver (or "<foo>") with the name of your driver.
-Note that this stub function is generated for you by write_getinfo_pm
-function, but you must manually transfer the code to Driver.pm.
-
-=cut
-
-sub write_getinfo_pm
-{
- my ($dsn, $user, $pass, $driver) = @_ ? @_ : @ARGV;
- my $dbh = DBI->connect($dsn, $user, $pass, {RaiseError=>1});
- $driver = "<foo>" unless defined $driver;
-
- print <<PERL;
-
-# Transfer this to ${driver}.pm
-
-# The get_info function was automatically generated by
-# DBI::DBD::Metadata::write_getinfo_pm v$DBI::DBD::Metadata::VERSION.
-
-package DBD::${driver}::db; # This line can be removed once transferred.
-
- sub get_info {
- my(\$dbh, \$info_type) = \@_;
- require DBD::${driver}::GetInfo;
- my \$v = \$DBD::${driver}::GetInfo::info{int(\$info_type)};
- \$v = \$v->(\$dbh) if ref \$v eq 'CODE';
- return \$v;
- }
-
-# Transfer this to lib/DBD/${driver}/GetInfo.pm
-
-# The \%info hash was automatically generated by
-# DBI::DBD::Metadata::write_getinfo_pm v$DBI::DBD::Metadata::VERSION.
-
-package DBD::${driver}::GetInfo;
-
-use strict;
-use DBD::${driver};
-
-# Beware: not officially documented interfaces...
-# use DBI::Const::GetInfoType qw(\%GetInfoType);
-# use DBI::Const::GetInfoReturn qw(\%GetInfoReturnTypes \%GetInfoReturnValues);
-
-my \$sql_driver = '${driver}';
-my \$sql_ver_fmt = '%02d.%02d.%04d'; # ODBC version string: ##.##.#####
-my \$sql_driver_ver = sprintf \$sql_ver_fmt, split (/\\./, \$DBD::${driver}::VERSION);
-PERL
-
-my $kw_map = 0;
-{
-# Informix CLI (ODBC) v3.81.0000 does not return a list of keywords.
- local $\ = "\n";
- local $, = "\n";
- my ($kw) = $dbh->get_info($GetInfoType{SQL_KEYWORDS});
- if ($kw)
- {
- print "\nmy \@Keywords = qw(\n";
- print sort split /,/, $kw;
- print ");\n\n";
- print "sub sql_keywords {\n";
- print q% return join ',', @Keywords;%;
- print "\n}\n\n";
- $kw_map = 1;
- }
-}
-
- print <<'PERL';
-
-sub sql_data_source_name {
- my $dbh = shift;
- return "dbi:$sql_driver:" . $dbh->{Name};
-}
-
-sub sql_user_name {
- my $dbh = shift;
- # CURRENT_USER is a non-standard attribute, probably undef
- # Username is a standard DBI attribute
- return $dbh->{CURRENT_USER} || $dbh->{Username};
-}
-
-PERL
-
- print "\nour \%info = (\n";
- foreach my $key (sort keys %GetInfoType)
- {
- my $num = $GetInfoType{$key};
- my $val = eval { $dbh->get_info($num); };
- if ($key eq 'SQL_DATA_SOURCE_NAME') {
- $val = '\&sql_data_source_name';
- }
- elsif ($key eq 'SQL_KEYWORDS') {
- $val = ($kw_map) ? '\&sql_keywords' : 'undef';
- }
- elsif ($key eq 'SQL_DRIVER_NAME') {
- $val = "\$INC{'DBD/$driver.pm'}";
- }
- elsif ($key eq 'SQL_DRIVER_VER') {
- $val = '$sql_driver_ver';
- }
- elsif ($key eq 'SQL_USER_NAME') {
- $val = '\&sql_user_name';
- }
- elsif (not defined $val) {
- $val = 'undef';
- }
- elsif ($val eq '') {
- $val = "''";
- }
- elsif ($val =~ /\D/) {
- $val =~ s/\\/\\\\/g;
- $val =~ s/'/\\'/g;
- $val = "'$val'";
- }
- printf "%s %5d => %-30s # %s\n", (($val eq 'undef') ? '#' : ' '), $num, "$val,", $key;
- }
- print ");\n\n1;\n\n__END__\n";
-}
-
-
-
-=head1 Generating a TypeInfo package for a driver
-
-The C<write_typeinfo_pm> function in the DBI::DBD::Metadata module generates
-on standard output the data needed for a driver's type_info_all method.
-It also provides default implementations of the type_info_all
-method for inclusion in the driver's main implementation file.
-
-The driver parameter is the name of the driver for which the methods
-will be generated; for the sake of examples, this will be "Driver".
-Typically, the dsn parameter will be of the form "dbi:ODBC:odbc_dsn",
-where the odbc_dsn is a DSN for one of the driver's databases.
-The user and pass parameters are the other optional connection
-parameters that will be provided to the DBI connect method.
-
-Once you are sure that it is producing reasonably sane data, you should
-typically redirect the standard output to lib/DBD/Driver/TypeInfo.pm,
-and then hand edit the result if necessary.
-Do not forget to update your Makefile.PL and MANIFEST to include this as
-an extra PM file that should be installed.
-
-Please take a critical look at the data returned!
-ODBC drivers vary dramatically in their quality.
-
-The generator assumes that all the values are static and places these
-values directly in the %info hash.
-
-A possible implementation of DBD::Driver::type_info_all() may look like:
-
- sub type_info_all {
- my ($dbh) = @_;
- require DBD::Driver::TypeInfo;
- return [ @$DBD::Driver::TypeInfo::type_info_all ];
- }
-
-Please replace Driver (or "<foo>") with the name of your driver.
-Note that this stub function is generated for you by the write_typeinfo_pm
-function, but you must manually transfer the code to Driver.pm.
-
-=cut
-
-
-# These two are used by fmt_value...
-my %dbi_inv;
-my %sql_type_inv;
-
-#-DEBUGGING-#
-#sub print_hash
-#{
-# my ($name, %hash) = @_;
-# print "Hash: $name\n";
-# foreach my $key (keys %hash)
-# {
-# print "$key => $hash{$key}\n";
-# }
-#}
-#-DEBUGGING-#
-
-sub inverse_hash
-{
- my (%hash) = @_;
- my (%inv);
- foreach my $key (keys %hash)
- {
- my $val = $hash{$key};
- die "Double mapping for key value $val ($inv{$val}, $key)!"
- if (defined $inv{$val});
- $inv{$val} = $key;
- }
- return %inv;
-}
-
-sub fmt_value
-{
- my ($num, $val) = @_;
- if (!defined $val)
- {
- $val = "undef";
- }
- elsif ($val !~ m/^[-+]?\d+$/)
- {
- # All the numbers in type_info_all are integers!
- # Anything that isn't an integer is a string.
- # Ensure that no double quotes screw things up.
- $val =~ s/"/\\"/g if ($val =~ m/"/o);
- $val = qq{"$val"};
- }
- elsif ($dbi_inv{$num} =~ m/^(SQL_)?DATA_TYPE$/)
- {
- # All numeric...
- $val = $sql_type_inv{$val}
- if (defined $sql_type_inv{$val});
- }
- return $val;
-}
-
-sub write_typeinfo_pm
-{
- my ($dsn, $user, $pass, $driver) = @_ ? @_ : @ARGV;
- my $dbh = DBI->connect($dsn, $user, $pass, {AutoCommit=>1, RaiseError=>1});
- $driver = "<foo>" unless defined $driver;
-
- print <<PERL;
-
-# Transfer this to ${driver}.pm
-
-# The type_info_all function was automatically generated by
-# DBI::DBD::Metadata::write_typeinfo_pm v$DBI::DBD::Metadata::VERSION.
-
-package DBD::${driver}::db; # This line can be removed once transferred.
-
- sub type_info_all
- {
- my (\$dbh) = \@_;
- require DBD::${driver}::TypeInfo;
- return [ \@\$DBD::${driver}::TypeInfo::type_info_all ];
- }
-
-# Transfer this to lib/DBD/${driver}/TypeInfo.pm.
-# Don't forget to add version and intellectual property control information.
-
-# The \%type_info_all hash was automatically generated by
-# DBI::DBD::Metadata::write_typeinfo_pm v$DBI::DBD::Metadata::VERSION.
-
-package DBD::${driver}::TypeInfo;
-
-{
- require Exporter;
- require DynaLoader;
- \@ISA = qw(Exporter DynaLoader);
- \@EXPORT = qw(type_info_all);
- use DBI qw(:sql_types);
-
-PERL
-
- # Generate SQL type name mapping hashes.
- # See code fragment in DBI specification.
- my %sql_type_map;
- foreach (@{$DBI::EXPORT_TAGS{sql_types}})
- {
- no strict 'refs';
- $sql_type_map{$_} = &{"DBI::$_"}();
- $sql_type_inv{$sql_type_map{$_}} = $_;
- }
- #-DEBUG-# print_hash("sql_type_map", %sql_type_map);
- #-DEBUG-# print_hash("sql_type_inv", %sql_type_inv);
-
- my %dbi_map =
- (
- TYPE_NAME => 0,
- DATA_TYPE => 1,
- COLUMN_SIZE => 2,
- LITERAL_PREFIX => 3,
- LITERAL_SUFFIX => 4,
- CREATE_PARAMS => 5,
- NULLABLE => 6,
- CASE_SENSITIVE => 7,
- SEARCHABLE => 8,
- UNSIGNED_ATTRIBUTE => 9,
- FIXED_PREC_SCALE => 10,
- AUTO_UNIQUE_VALUE => 11,
- LOCAL_TYPE_NAME => 12,
- MINIMUM_SCALE => 13,
- MAXIMUM_SCALE => 14,
- SQL_DATA_TYPE => 15,
- SQL_DATETIME_SUB => 16,
- NUM_PREC_RADIX => 17,
- INTERVAL_PRECISION => 18,
- );
-
- #-DEBUG-# print_hash("dbi_map", %dbi_map);
-
- %dbi_inv = inverse_hash(%dbi_map);
-
- #-DEBUG-# print_hash("dbi_inv", %dbi_inv);
-
- my $maxlen = 0;
- foreach my $key (keys %dbi_map)
- {
- $maxlen = length($key) if length($key) > $maxlen;
- }
-
- # Print the name/value mapping entry in the type_info_all array;
- my $fmt = " \%-${maxlen}s => \%2d,\n";
- my $numkey = 0;
- my $maxkey = 0;
- print " \$type_info_all = [\n {\n";
- foreach my $i (sort { $a <=> $b } keys %dbi_inv)
- {
- printf($fmt, $dbi_inv{$i}, $i);
- $numkey++;
- $maxkey = $i;
- }
- print " },\n";
-
- print STDERR "### WARNING - Non-dense set of keys ($numkey keys, $maxkey max key)\n"
- unless $numkey = $maxkey + 1;
-
- my $h = $dbh->type_info_all;
- my @tia = @$h;
- my %odbc_map = map { uc $_ => $tia[0]->{$_} } keys %{$tia[0]};
- shift @tia; # Remove the mapping reference.
- my $numtyp = $#tia;
-
- #-DEBUG-# print_hash("odbc_map", %odbc_map);
-
- # In theory, the key/number mapping sequence for %dbi_map
- # should be the same as the one from the ODBC driver. However, to
- # prevent the possibility of mismatches, and to deal with older
- # missing attributes or unexpected new ones, we chase back through
- # the %dbi_inv and %odbc_map hashes, generating @dbi_to_odbc
- # to map our new key number to the old one.
- # Report if @dbi_to_odbc is not an identity mapping.
- my @dbi_to_odbc;
- foreach my $num (sort { $a <=> $b } keys %dbi_inv)
- {
- # Find the name in %dbi_inv that matches this index number.
- my $dbi_key = $dbi_inv{$num};
- #-DEBUG-# print "dbi_key = $dbi_key\n";
- #-DEBUG-# print "odbc_key = $odbc_map{$dbi_key}\n";
- # Find the index in %odbc_map that has this key.
- $dbi_to_odbc[$num] = (defined $odbc_map{$dbi_key}) ? $odbc_map{$dbi_key} : undef;
- }
-
- # Determine the length of the longest formatted value in each field
- my @len;
- for (my $i = 0; $i <= $numtyp; $i++)
- {
- my @odbc_val = @{$tia[$i]};
- for (my $num = 0; $num <= $maxkey; $num++)
- {
- # Find the value of the entry in the @odbc_val array.
- my $val = (defined $dbi_to_odbc[$num]) ? $odbc_val[$dbi_to_odbc[$num]] : undef;
- $val = fmt_value($num, $val);
- #-DEBUG-# print "val = $val\n";
- $val = "$val,";
- $len[$num] = length($val) if !defined $len[$num] || length($val) > $len[$num];
- }
- }
-
- # Generate format strings to left justify each string in maximum field width.
- my @fmt;
- for (my $i = 0; $i <= $maxkey; $i++)
- {
- $fmt[$i] = "%-$len[$i]s";
- #-DEBUG-# print "fmt[$i] = $fmt[$i]\n";
- }
-
- # Format the data from type_info_all
- for (my $i = 0; $i <= $numtyp; $i++)
- {
- my @odbc_val = @{$tia[$i]};
- print " [ ";
- for (my $num = 0; $num <= $maxkey; $num++)
- {
- # Find the value of the entry in the @odbc_val array.
- my $val = (defined $dbi_to_odbc[$num]) ? $odbc_val[$dbi_to_odbc[$num]] : undef;
- $val = fmt_value($num, $val);
- printf $fmt[$num], "$val,";
- }
- print " ],\n";
- }
-
- print " ];\n\n 1;\n}\n\n__END__\n";
-
-}
-
-1;
-
-__END__
-
-=head1 AUTHORS
-
-Jonathan Leffler <jleffler@us.ibm.com> (previously <jleffler@informix.com>),
-Jochen Wiedmann <joe@ispsoft.de>,
-Steffen Goeldner <sgoeldner@cpan.org>,
-and Tim Bunce <dbi-users@perl.org>.
-
-=cut
+++ /dev/null
-# -*- perl -*-
-#
-# DBI::DBD::SqlEngine - A base class for implementing DBI drivers that
-# have not an own SQL engine
-#
-# This module is currently maintained by
-#
-# H.Merijn Brand & Jens Rehsack
-#
-# The original author is Jochen Wiedmann.
-#
-# Copyright (C) 2009-2013 by H.Merijn Brand & Jens Rehsack
-# Copyright (C) 2004 by Jeff Zucker
-# Copyright (C) 1998 by Jochen Wiedmann
-#
-# All rights reserved.
-#
-# You may distribute this module under the terms of either the GNU
-# General Public License or the Artistic License, as specified in
-# the Perl README file.
-
-require 5.008;
-
-use strict;
-
-use DBI ();
-require DBI::SQL::Nano;
-
-package DBI::DBD::SqlEngine;
-
-use strict;
-
-use Carp;
-use vars qw( @ISA $VERSION $drh %methods_installed);
-
-$VERSION = "0.06";
-
-$drh = undef; # holds driver handle(s) once initialized
-
-DBI->setup_driver("DBI::DBD::SqlEngine"); # only needed once but harmless to repeat
-
-my %accessors = (
- versions => "get_driver_versions",
- new_meta => "new_sql_engine_meta",
- get_meta => "get_sql_engine_meta",
- set_meta => "set_sql_engine_meta",
- clear_meta => "clear_sql_engine_meta",
- );
-
-sub driver ($;$)
-{
- my ( $class, $attr ) = @_;
-
- # Drivers typically use a singleton object for the $drh
- # We use a hash here to have one singleton per subclass.
- # (Otherwise DBD::CSV and DBD::DBM, for example, would
- # share the same driver object which would cause problems.)
- # An alternative would be to not cache the $drh here at all
- # and require that subclasses do that. Subclasses should do
- # their own caching, so caching here just provides extra safety.
- $drh->{$class} and return $drh->{$class};
-
- $attr ||= {};
- {
- no strict "refs";
- unless ( $attr->{Attribution} )
- {
- $class eq "DBI::DBD::SqlEngine"
- and $attr->{Attribution} = "$class by Jens Rehsack";
- $attr->{Attribution} ||= ${ $class . "::ATTRIBUTION" }
- || "oops the author of $class forgot to define this";
- }
- $attr->{Version} ||= ${ $class . "::VERSION" };
- $attr->{Name} or ( $attr->{Name} = $class ) =~ s/^DBD\:\://;
- }
-
- $drh->{$class} = DBI::_new_drh( $class . "::dr", $attr );
- $drh->{$class}->STORE( ShowErrorStatement => 1 );
-
- my $prefix = DBI->driver_prefix($class);
- if ($prefix)
- {
- my $dbclass = $class . "::db";
- while ( my ( $accessor, $funcname ) = each %accessors )
- {
- my $method = $prefix . $accessor;
- $dbclass->can($method) and next;
- my $inject = sprintf <<'EOI', $dbclass, $method, $dbclass, $funcname;
-sub %s::%s
-{
- my $func = %s->can (q{%s});
- goto &$func;
- }
-EOI
- eval $inject;
- $dbclass->install_method($method);
- }
- }
- else
- {
- warn "Using DBI::DBD::SqlEngine with unregistered driver $class.\n"
- . "Reading documentation how to prevent is strongly recommended.\n";
-
- }
-
- # XXX inject DBD::XXX::Statement unless exists
-
- my $stclass = $class . "::st";
- $stclass->install_method("sql_get_colnames") unless ( $methods_installed{__PACKAGE__}++ );
-
- return $drh->{$class};
-} # driver
-
-sub CLONE
-{
- undef $drh;
-} # CLONE
-
-# ====== DRIVER ================================================================
-
-package DBI::DBD::SqlEngine::dr;
-
-use strict;
-use warnings;
-
-use vars qw(@ISA $imp_data_size);
-
-use Carp qw/carp/;
-
-$imp_data_size = 0;
-
-sub connect ($$;$$$)
-{
- my ( $drh, $dbname, $user, $auth, $attr ) = @_;
-
- # create a 'blank' dbh
- my $dbh = DBI::_new_dbh(
- $drh,
- {
- Name => $dbname,
- USER => $user,
- CURRENT_USER => $user,
- }
- );
-
- if ($dbh)
- {
- # must be done first, because setting flags implicitly calls $dbdname::db->STORE
- $dbh->func( 0, "init_default_attributes" );
- my $two_phased_init;
- defined $dbh->{sql_init_phase} and $two_phased_init = ++$dbh->{sql_init_phase};
- my %second_phase_attrs;
- my @func_inits;
-
- # this must be done to allow DBI.pm reblessing got handle after successful connecting
- exists $attr->{RootClass} and $second_phase_attrs{RootClass} = delete $attr->{RootClass};
-
- my ( $var, $val );
- while ( length $dbname )
- {
- if ( $dbname =~ s/^((?:[^\\;]|\\.)*?);//s )
- {
- $var = $1;
- }
- else
- {
- $var = $dbname;
- $dbname = "";
- }
-
- if ( $var =~ m/^(.+?)=(.*)/s )
- {
- $var = $1;
- ( $val = $2 ) =~ s/\\(.)/$1/g;
- exists $attr->{$var}
- and carp("$var is given in DSN *and* \$attr during DBI->connect()")
- if ($^W);
- exists $attr->{$var} or $attr->{$var} = $val;
- }
- elsif ( $var =~ m/^(.+?)=>(.*)/s )
- {
- $var = $1;
- ( $val = $2 ) =~ s/\\(.)/$1/g;
- my $ref = eval $val;
- # $dbh->$var($ref);
- push( @func_inits, $var, $ref );
- }
- }
-
- # The attributes need to be sorted in a specific way as the
- # assignment is through tied hashes and calls STORE on each
- # attribute. Some attributes require to be called prior to
- # others
- # e.g. f_dir *must* be done before xx_tables in DBD::File
- # The dbh attribute sql_init_order is a hash with the order
- # as key (low is first, 0 .. 100) and the attributes that
- # are set to that oreder as anon-list as value:
- # { 0 => [qw( AutoCommit PrintError RaiseError Profile ... )],
- # 10 => [ list of attr to be dealt with immediately after first ],
- # 50 => [ all fields that are unspecified or default sort order ],
- # 90 => [ all fields that are needed after other initialisation ],
- # }
-
- my %order = map {
- my $order = $_;
- map { ( $_ => $order ) } @{ $dbh->{sql_init_order}{$order} };
- } sort { $a <=> $b } keys %{ $dbh->{sql_init_order} || {} };
- my @ordered_attr =
- map { $_->[0] }
- sort { $a->[1] <=> $b->[1] }
- map { [ $_, defined $order{$_} ? $order{$_} : 50 ] }
- keys %$attr;
-
- # initialize given attributes ... lower weighted before higher weighted
- foreach my $a (@ordered_attr)
- {
- exists $attr->{$a} or next;
- $two_phased_init and eval {
- $dbh->{$a} = $attr->{$a};
- delete $attr->{$a};
- };
- $@ and $second_phase_attrs{$a} = delete $attr->{$a};
- $two_phased_init or $dbh->STORE( $a, delete $attr->{$a} );
- }
-
- $two_phased_init and $dbh->func( 1, "init_default_attributes" );
- %$attr = %second_phase_attrs;
-
- for ( my $i = 0; $i < scalar(@func_inits); $i += 2 )
- {
- my $func = $func_inits[$i];
- my $arg = $func_inits[ $i + 1 ];
- $dbh->$func($arg);
- }
-
- $dbh->func("init_done");
-
- $dbh->STORE( Active => 1 );
- }
-
- return $dbh;
-} # connect
-
-sub data_sources ($;$)
-{
- my ( $drh, $attr ) = @_;
-
- my $tbl_src;
- $attr
- and defined $attr->{sql_table_source}
- and $attr->{sql_table_source}->isa('DBI::DBD::SqlEngine::TableSource')
- and $tbl_src = $attr->{sql_table_source};
-
- !defined($tbl_src)
- and $drh->{ImplementorClass}->can('default_table_source')
- and $tbl_src = $drh->{ImplementorClass}->default_table_source();
- defined($tbl_src) or return;
-
- $tbl_src->data_sources( $drh, $attr );
-} # data_sources
-
-sub disconnect_all
-{
-} # disconnect_all
-
-sub DESTROY
-{
- undef;
-} # DESTROY
-
-# ====== DATABASE ==============================================================
-
-package DBI::DBD::SqlEngine::db;
-
-use strict;
-use warnings;
-
-use vars qw(@ISA $imp_data_size);
-
-use Carp;
-
-if ( eval { require Clone; } )
-{
- Clone->import("clone");
-}
-else
-{
- require Storable; # in CORE since 5.7.3
- *clone = \&Storable::dclone;
-}
-
-$imp_data_size = 0;
-
-sub ping
-{
- ( $_[0]->FETCH("Active") ) ? 1 : 0;
-} # ping
-
-sub data_sources
-{
- my ( $dbh, $attr, @other ) = @_;
- my $drh = $dbh->{Driver}; # XXX proxy issues?
- ref($attr) eq 'HASH' or $attr = {};
- defined( $attr->{sql_table_source} ) or $attr->{sql_table_source} = $dbh->{sql_table_source};
- return $drh->data_sources( $attr, @other );
-}
-
-sub prepare ($$;@)
-{
- my ( $dbh, $statement, @attribs ) = @_;
-
- # create a 'blank' sth
- my $sth = DBI::_new_sth( $dbh, { Statement => $statement } );
-
- if ($sth)
- {
- my $class = $sth->FETCH("ImplementorClass");
- $class =~ s/::st$/::Statement/;
- my $stmt;
-
- # if using SQL::Statement version > 1
- # cache the parser object if the DBD supports parser caching
- # SQL::Nano and older SQL::Statements don't support this
-
- if ( $class->isa("SQL::Statement") )
- {
- my $parser = $dbh->{sql_parser_object};
- $parser ||= eval { $dbh->func("sql_parser_object") };
- if ($@)
- {
- $stmt = eval { $class->new($statement) };
- }
- else
- {
- $stmt = eval { $class->new( $statement, $parser ) };
- }
- }
- else
- {
- $stmt = eval { $class->new($statement) };
- }
- if ( $@ || $stmt->{errstr} )
- {
- $dbh->set_err( $DBI::stderr, $@ || $stmt->{errstr} );
- undef $sth;
- }
- else
- {
- $sth->STORE( "sql_stmt", $stmt );
- $sth->STORE( "sql_params", [] );
- $sth->STORE( "NUM_OF_PARAMS", scalar( $stmt->params() ) );
- my @colnames = $sth->sql_get_colnames();
- $sth->STORE( "NUM_OF_FIELDS", scalar @colnames );
- }
- }
- return $sth;
-} # prepare
-
-sub set_versions
-{
- my $dbh = $_[0];
- $dbh->{sql_engine_version} = $DBI::DBD::SqlEngine::VERSION;
- for (qw( nano_version statement_version ))
- {
- defined $DBI::SQL::Nano::versions->{$_} or next;
- $dbh->{"sql_$_"} = $DBI::SQL::Nano::versions->{$_};
- }
- $dbh->{sql_handler} =
- $dbh->{sql_statement_version}
- ? "SQL::Statement"
- : "DBI::SQL::Nano";
-
- return $dbh;
-} # set_versions
-
-sub init_valid_attributes
-{
- my $dbh = $_[0];
-
- $dbh->{sql_valid_attrs} = {
- sql_engine_version => 1, # DBI::DBD::SqlEngine version
- sql_handler => 1, # Nano or S:S
- sql_nano_version => 1, # Nano version
- sql_statement_version => 1, # S:S version
- sql_flags => 1, # flags for SQL::Parser
- sql_dialect => 1, # dialect for SQL::Parser
- sql_quoted_identifier_case => 1, # case for quoted identifiers
- sql_identifier_case => 1, # case for non-quoted identifiers
- sql_parser_object => 1, # SQL::Parser instance
- sql_sponge_driver => 1, # Sponge driver for table_info ()
- sql_valid_attrs => 1, # SQL valid attributes
- sql_readonly_attrs => 1, # SQL readonly attributes
- sql_init_phase => 1, # Only during initialization
- sql_meta => 1, # meta data for tables
- sql_meta_map => 1, # mapping table for identifier case
- sql_data_source => 1, # reasonable datasource class
- };
- $dbh->{sql_readonly_attrs} = {
- sql_engine_version => 1, # DBI::DBD::SqlEngine version
- sql_handler => 1, # Nano or S:S
- sql_nano_version => 1, # Nano version
- sql_statement_version => 1, # S:S version
- sql_quoted_identifier_case => 1, # case for quoted identifiers
- sql_parser_object => 1, # SQL::Parser instance
- sql_sponge_driver => 1, # Sponge driver for table_info ()
- sql_valid_attrs => 1, # SQL valid attributes
- sql_readonly_attrs => 1, # SQL readonly attributes
- };
-
- return $dbh;
-} # init_valid_attributes
-
-sub init_default_attributes
-{
- my ( $dbh, $phase ) = @_;
- my $given_phase = $phase;
-
- unless ( defined($phase) )
- {
- # we have an "old" driver here
- $phase = defined $dbh->{sql_init_phase};
- $phase and $phase = $dbh->{sql_init_phase};
- }
-
- if ( 0 == $phase )
- {
- # must be done first, because setting flags implicitly calls $dbdname::db->STORE
- $dbh->func("init_valid_attributes");
-
- $dbh->func("set_versions");
-
- $dbh->{sql_identifier_case} = 2; # SQL_IC_LOWER
- $dbh->{sql_quoted_identifier_case} = 3; # SQL_IC_SENSITIVE
-
- $dbh->{sql_dialect} = "CSV";
-
- $dbh->{sql_init_phase} = $given_phase;
-
- # complete derived attributes, if required
- ( my $drv_class = $dbh->{ImplementorClass} ) =~ s/::db$//;
- my $drv_prefix = DBI->driver_prefix($drv_class);
- my $valid_attrs = $drv_prefix . "valid_attrs";
- my $ro_attrs = $drv_prefix . "readonly_attrs";
-
- # check whether we're running in a Gofer server or not (see
- # validate_FETCH_attr for details)
- $dbh->{sql_engine_in_gofer} =
- ( defined $INC{"DBD/Gofer.pm"} && ( caller(5) )[0] eq "DBI::Gofer::Execute" );
- $dbh->{sql_meta} = {};
- $dbh->{sql_meta_map} = {}; # choose new name because it contains other keys
-
- # init_default_attributes calls inherited routine before derived DBD's
- # init their default attributes, so we don't override something here
- #
- # defining an order of attribute initialization from connect time
- # specified ones with a magic baarier (see next statement)
- my $drv_pfx_meta = $drv_prefix . "meta";
- $dbh->{sql_init_order} = {
- 0 => [qw( Profile RaiseError PrintError AutoCommit )],
- 90 => [ "sql_meta", $dbh->{$drv_pfx_meta} ? $dbh->{$drv_pfx_meta} : () ],
- };
- # ensuring Profile, RaiseError, PrintError, AutoCommit are initialized
- # first when initializing attributes from connect time specified
- # attributes
- # further, initializations to predefined tables are happens after any
- # unspecified attribute initialization (that default to order 50)
-
- my @comp_attrs = qw(valid_attrs version readonly_attrs);
-
- if ( exists $dbh->{$drv_pfx_meta} and !$dbh->{sql_engine_in_gofer} )
- {
- my $attr = $dbh->{$drv_pfx_meta};
- defined $attr
- and defined $dbh->{$valid_attrs}
- and !defined $dbh->{$valid_attrs}{$attr}
- and $dbh->{$valid_attrs}{$attr} = 1;
-
- my %h;
- tie %h, "DBI::DBD::SqlEngine::TieTables", $dbh;
- $dbh->{$attr} = \%h;
-
- push @comp_attrs, "meta";
- }
-
- foreach my $comp_attr (@comp_attrs)
- {
- my $attr = $drv_prefix . $comp_attr;
- defined $dbh->{$valid_attrs}
- and !defined $dbh->{$valid_attrs}{$attr}
- and $dbh->{$valid_attrs}{$attr} = 1;
- defined $dbh->{$ro_attrs}
- and !defined $dbh->{$ro_attrs}{$attr}
- and $dbh->{$ro_attrs}{$attr} = 1;
- }
- }
-
- return $dbh;
-} # init_default_attributes
-
-sub init_done
-{
- defined $_[0]->{sql_init_phase} and delete $_[0]->{sql_init_phase};
- delete $_[0]->{sql_valid_attrs}->{sql_init_phase};
- return;
-}
-
-sub sql_parser_object
-{
- my $dbh = $_[0];
- my $dialect = $dbh->{sql_dialect} || "CSV";
- my $parser = {
- RaiseError => $dbh->FETCH("RaiseError"),
- PrintError => $dbh->FETCH("PrintError"),
- };
- my $sql_flags = $dbh->FETCH("sql_flags") || {};
- %$parser = ( %$parser, %$sql_flags );
- $parser = SQL::Parser->new( $dialect, $parser );
- $dbh->{sql_parser_object} = $parser;
- return $parser;
-} # sql_parser_object
-
-sub sql_sponge_driver
-{
- my $dbh = $_[0];
- my $dbh2 = $dbh->{sql_sponge_driver};
- unless ($dbh2)
- {
- $dbh2 = $dbh->{sql_sponge_driver} = DBI->connect("DBI:Sponge:");
- unless ($dbh2)
- {
- $dbh->set_err( $DBI::stderr, $DBI::errstr );
- return;
- }
- }
-}
-
-sub disconnect ($)
-{
- %{ $_[0]->{sql_meta} } = ();
- %{ $_[0]->{sql_meta_map} } = ();
- $_[0]->STORE( Active => 0 );
- return 1;
-} # disconnect
-
-sub validate_FETCH_attr
-{
- my ( $dbh, $attrib ) = @_;
-
- # If running in a Gofer server, access to our tied compatibility hash
- # would force Gofer to serialize the tieing object including it's
- # private $dbh reference used to do the driver function calls.
- # This will result in nasty exceptions. So return a copy of the
- # sql_meta structure instead, which is the source of for the compatibility
- # tie-hash. It's not as good as liked, but the best we can do in this
- # situation.
- if ( $dbh->{sql_engine_in_gofer} )
- {
- ( my $drv_class = $dbh->{ImplementorClass} ) =~ s/::db$//;
- my $drv_prefix = DBI->driver_prefix($drv_class);
- exists $dbh->{ $drv_prefix . "meta" } && $attrib eq $dbh->{ $drv_prefix . "meta" }
- and $attrib = "sql_meta";
- }
-
- return $attrib;
-}
-
-sub FETCH ($$)
-{
- my ( $dbh, $attrib ) = @_;
- $attrib eq "AutoCommit"
- and return 1;
-
- # Driver private attributes are lower cased
- if ( $attrib eq ( lc $attrib ) )
- {
- # first let the implementation deliver an alias for the attribute to fetch
- # after it validates the legitimation of the fetch request
- $attrib = $dbh->func( $attrib, "validate_FETCH_attr" ) or return;
-
- my $attr_prefix;
- $attrib =~ m/^([a-z]+_)/ and $attr_prefix = $1;
- unless ($attr_prefix)
- {
- ( my $drv_class = $dbh->{ImplementorClass} ) =~ s/::db$//;
- $attr_prefix = DBI->driver_prefix($drv_class);
- $attrib = $attr_prefix . $attrib;
- }
- my $valid_attrs = $attr_prefix . "valid_attrs";
- my $ro_attrs = $attr_prefix . "readonly_attrs";
-
- exists $dbh->{$valid_attrs}
- and ( $dbh->{$valid_attrs}{$attrib}
- or return $dbh->set_err( $DBI::stderr, "Invalid attribute '$attrib'" ) );
- exists $dbh->{$ro_attrs}
- and $dbh->{$ro_attrs}{$attrib}
- and defined $dbh->{$attrib}
- and refaddr( $dbh->{$attrib} )
- and return clone( $dbh->{$attrib} );
-
- return $dbh->{$attrib};
- }
- # else pass up to DBI to handle
- return $dbh->SUPER::FETCH($attrib);
-} # FETCH
-
-sub validate_STORE_attr
-{
- my ( $dbh, $attrib, $value ) = @_;
-
- if ( $attrib eq "sql_identifier_case" || $attrib eq "sql_quoted_identifier_case"
- and $value < 1 || $value > 4 )
- {
- croak "attribute '$attrib' must have a value from 1 .. 4 (SQL_IC_UPPER .. SQL_IC_MIXED)";
- # XXX correctly a remap of all entries in sql_meta/sql_meta_map is required here
- }
-
- ( my $drv_class = $dbh->{ImplementorClass} ) =~ s/::db$//;
- my $drv_prefix = DBI->driver_prefix($drv_class);
-
- exists $dbh->{ $drv_prefix . "meta" }
- and $attrib eq $dbh->{ $drv_prefix . "meta" }
- and $attrib = "sql_meta";
-
- return ( $attrib, $value );
-}
-
-# the ::db::STORE method is what gets called when you set
-# a lower-cased database handle attribute such as $dbh->{somekey}=$someval;
-#
-# STORE should check to make sure that "somekey" is a valid attribute name
-# but only if it is really one of our attributes (starts with dbm_ or foo_)
-# You can also check for valid values for the attributes if needed
-# and/or perform other operations
-#
-sub STORE ($$$)
-{
- my ( $dbh, $attrib, $value ) = @_;
-
- if ( $attrib eq "AutoCommit" )
- {
- $value and return 1; # is already set
- croak "Can't disable AutoCommit";
- }
-
- if ( $attrib eq lc $attrib )
- {
- # Driver private attributes are lower cased
-
- ( $attrib, $value ) = $dbh->func( $attrib, $value, "validate_STORE_attr" );
- $attrib or return;
-
- my $attr_prefix;
- $attrib =~ m/^([a-z]+_)/ and $attr_prefix = $1;
- unless ($attr_prefix)
- {
- ( my $drv_class = $dbh->{ImplementorClass} ) =~ s/::db$//;
- $attr_prefix = DBI->driver_prefix($drv_class);
- $attrib = $attr_prefix . $attrib;
- }
- my $valid_attrs = $attr_prefix . "valid_attrs";
- my $ro_attrs = $attr_prefix . "readonly_attrs";
-
- exists $dbh->{$valid_attrs}
- and ( $dbh->{$valid_attrs}{$attrib}
- or return $dbh->set_err( $DBI::stderr, "Invalid attribute '$attrib'" ) );
- exists $dbh->{$ro_attrs}
- and $dbh->{$ro_attrs}{$attrib}
- and defined $dbh->{$attrib}
- and return $dbh->set_err( $DBI::stderr,
- "attribute '$attrib' is readonly and must not be modified" );
-
- if ( $attrib eq "sql_meta" )
- {
- while ( my ( $k, $v ) = each %$value )
- {
- $dbh->{$attrib}{$k} = $v;
- }
- }
- else
- {
- $dbh->{$attrib} = $value;
- }
-
- return 1;
- }
-
- return $dbh->SUPER::STORE( $attrib, $value );
-} # STORE
-
-sub get_driver_versions
-{
- my ( $dbh, $table ) = @_;
- my %vsn = (
- OS => "$^O ($Config::Config{osvers})",
- Perl => "$] ($Config::Config{archname})",
- DBI => $DBI::VERSION,
- );
- my %vmp;
-
- my $sql_engine_verinfo =
- join " ",
- $dbh->{sql_engine_version}, "using", $dbh->{sql_handler},
- $dbh->{sql_handler} eq "SQL::Statement"
- ? $dbh->{sql_statement_version}
- : $dbh->{sql_nano_version};
-
- my $indent = 0;
- my @deriveds = ( $dbh->{ImplementorClass} );
- while (@deriveds)
- {
- my $derived = shift @deriveds;
- $derived eq "DBI::DBD::SqlEngine::db" and last;
- $derived->isa("DBI::DBD::SqlEngine::db") or next;
- #no strict 'refs';
- eval "push \@deriveds, \@${derived}::ISA";
- #use strict;
- ( my $drv_class = $derived ) =~ s/::db$//;
- my $drv_prefix = DBI->driver_prefix($drv_class);
- my $ddgv = $dbh->{ImplementorClass}->can("get_${drv_prefix}versions");
- my $drv_version = $ddgv ? &$ddgv( $dbh, $table ) : $dbh->{ $drv_prefix . "version" };
- $drv_version ||=
- eval { $derived->VERSION() }; # XXX access $drv_class::VERSION via symbol table
- $vsn{$drv_class} = $drv_version;
- $indent and $vmp{$drv_class} = " " x $indent . $drv_class;
- $indent += 2;
- }
-
- $vsn{"DBI::DBD::SqlEngine"} = $sql_engine_verinfo;
- $indent and $vmp{"DBI::DBD::SqlEngine"} = " " x $indent . "DBI::DBD::SqlEngine";
-
- $DBI::PurePerl and $vsn{"DBI::PurePerl"} = $DBI::PurePerl::VERSION;
-
- $indent += 20;
- my @versions = map { sprintf "%-${indent}s %s", $vmp{$_} || $_, $vsn{$_} }
- sort {
- $a->isa($b) and return -1;
- $b->isa($a) and return 1;
- $a->isa("DBI::DBD::SqlEngine") and return -1;
- $b->isa("DBI::DBD::SqlEngine") and return 1;
- return $a cmp $b;
- } keys %vsn;
-
- return wantarray ? @versions : join "\n", @versions;
-} # get_versions
-
-sub get_single_table_meta
-{
- my ( $dbh, $table, $attr ) = @_;
- my $meta;
-
- $table eq "."
- and return $dbh->FETCH($attr);
-
- ( my $class = $dbh->{ImplementorClass} ) =~ s/::db$/::Table/;
- ( undef, $meta ) = $class->get_table_meta( $dbh, $table, 1 );
- $meta or croak "No such table '$table'";
-
- # prevent creation of undef attributes
- return $class->get_table_meta_attr( $meta, $attr );
-} # get_single_table_meta
-
-sub get_sql_engine_meta
-{
- my ( $dbh, $table, $attr ) = @_;
-
- my $gstm = $dbh->{ImplementorClass}->can("get_single_table_meta");
-
- $table eq "*"
- and $table = [ ".", keys %{ $dbh->{sql_meta} } ];
- $table eq "+"
- and $table = [ grep { m/^[_A-Za-z0-9]+$/ } keys %{ $dbh->{sql_meta} } ];
- ref $table eq "Regexp"
- and $table = [ grep { $_ =~ $table } keys %{ $dbh->{sql_meta} } ];
-
- ref $table || ref $attr
- or return $gstm->( $dbh, $table, $attr );
-
- ref $table or $table = [$table];
- ref $attr or $attr = [$attr];
- "ARRAY" eq ref $table
- or return
- $dbh->set_err( $DBI::stderr,
- "Invalid argument for \$table - SCALAR, Regexp or ARRAY expected but got " . ref $table );
- "ARRAY" eq ref $attr
- or return $dbh->set_err(
- "Invalid argument for \$attr - SCALAR or ARRAY expected but got " . ref $attr );
-
- my %results;
- foreach my $tname ( @{$table} )
- {
- my %tattrs;
- foreach my $aname ( @{$attr} )
- {
- $tattrs{$aname} = $gstm->( $dbh, $tname, $aname );
- }
- $results{$tname} = \%tattrs;
- }
-
- return \%results;
-} # get_sql_engine_meta
-
-sub new_sql_engine_meta
-{
- my ( $dbh, $table, $values ) = @_;
- my $respect_case = 0;
-
- "HASH" eq ref $values
- or croak "Invalid argument for \$values - SCALAR or HASH expected but got " . ref $values;
-
- $table =~ s/^\"// and $respect_case = 1; # handle quoted identifiers
- $table =~ s/\"$//;
-
- unless ($respect_case)
- {
- defined $dbh->{sql_meta_map}{$table} and $table = $dbh->{sql_meta_map}{$table};
- }
-
- $dbh->{sql_meta}{$table} = { %{$values} };
- my $class;
- defined $values->{sql_table_class} and $class = $values->{sql_table_class};
- defined $class or ( $class = $dbh->{ImplementorClass} ) =~ s/::db$/::Table/;
- # XXX we should never hit DBD::File::Table::get_table_meta here ...
- my ( undef, $meta ) = $class->get_table_meta( $dbh, $table, $respect_case );
- 1;
-} # new_sql_engine_meta
-
-sub set_single_table_meta
-{
- my ( $dbh, $table, $attr, $value ) = @_;
- my $meta;
-
- $table eq "."
- and return $dbh->STORE( $attr, $value );
-
- ( my $class = $dbh->{ImplementorClass} ) =~ s/::db$/::Table/;
- ( undef, $meta ) = $class->get_table_meta( $dbh, $table, 1 ); # 1 means: respect case
- $meta or croak "No such table '$table'";
- $class->set_table_meta_attr( $meta, $attr, $value );
-
- return $dbh;
-} # set_single_table_meta
-
-sub set_sql_engine_meta
-{
- my ( $dbh, $table, $attr, $value ) = @_;
-
- my $sstm = $dbh->{ImplementorClass}->can("set_single_table_meta");
-
- $table eq "*"
- and $table = [ ".", keys %{ $dbh->{sql_meta} } ];
- $table eq "+"
- and $table = [ grep { m/^[_A-Za-z0-9]+$/ } keys %{ $dbh->{sql_meta} } ];
- ref($table) eq "Regexp"
- and $table = [ grep { $_ =~ $table } keys %{ $dbh->{sql_meta} } ];
-
- ref $table || ref $attr
- or return $sstm->( $dbh, $table, $attr, $value );
-
- ref $table or $table = [$table];
- ref $attr or $attr = { $attr => $value };
- "ARRAY" eq ref $table
- or croak "Invalid argument for \$table - SCALAR, Regexp or ARRAY expected but got "
- . ref $table;
- "HASH" eq ref $attr
- or croak "Invalid argument for \$attr - SCALAR or HASH expected but got " . ref $attr;
-
- foreach my $tname ( @{$table} )
- {
- while ( my ( $aname, $aval ) = each %$attr )
- {
- $sstm->( $dbh, $tname, $aname, $aval );
- }
- }
-
- return $dbh;
-} # set_file_meta
-
-sub clear_sql_engine_meta
-{
- my ( $dbh, $table ) = @_;
-
- ( my $class = $dbh->{ImplementorClass} ) =~ s/::db$/::Table/;
- my ( undef, $meta ) = $class->get_table_meta( $dbh, $table, 1 );
- $meta and %{$meta} = ();
-
- return;
-} # clear_file_meta
-
-sub DESTROY ($)
-{
- my $dbh = shift;
- $dbh->SUPER::FETCH("Active") and $dbh->disconnect;
- undef $dbh->{sql_parser_object};
-} # DESTROY
-
-sub type_info_all ($)
-{
- [
- {
- TYPE_NAME => 0,
- DATA_TYPE => 1,
- PRECISION => 2,
- LITERAL_PREFIX => 3,
- LITERAL_SUFFIX => 4,
- CREATE_PARAMS => 5,
- NULLABLE => 6,
- CASE_SENSITIVE => 7,
- SEARCHABLE => 8,
- UNSIGNED_ATTRIBUTE => 9,
- MONEY => 10,
- AUTO_INCREMENT => 11,
- LOCAL_TYPE_NAME => 12,
- MINIMUM_SCALE => 13,
- MAXIMUM_SCALE => 14,
- },
- [
- "VARCHAR", DBI::SQL_VARCHAR(), undef, "'", "'", undef, 0, 1, 1, 0, 0, 0, undef, 1, 999999,
- ],
- [ "CHAR", DBI::SQL_CHAR(), undef, "'", "'", undef, 0, 1, 1, 0, 0, 0, undef, 1, 999999, ],
- [ "INTEGER", DBI::SQL_INTEGER(), undef, "", "", undef, 0, 0, 1, 0, 0, 0, undef, 0, 0, ],
- [ "REAL", DBI::SQL_REAL(), undef, "", "", undef, 0, 0, 1, 0, 0, 0, undef, 0, 0, ],
- [
- "BLOB", DBI::SQL_LONGVARBINARY(), undef, "'", "'", undef, 0, 1, 1, 0, 0, 0, undef, 1,
- 999999,
- ],
- [
- "BLOB", DBI::SQL_LONGVARBINARY(), undef, "'", "'", undef, 0, 1, 1, 0, 0, 0, undef, 1,
- 999999,
- ],
- [
- "TEXT", DBI::SQL_LONGVARCHAR(), undef, "'", "'", undef, 0, 1, 1, 0, 0, 0, undef, 1,
- 999999,
- ],
- ];
-} # type_info_all
-
-sub get_avail_tables
-{
- my $dbh = $_[0];
- my @tables = ();
-
- if ( $dbh->{sql_handler} eq "SQL::Statement" and $dbh->{sql_ram_tables} )
- {
- # XXX map +[ undef, undef, $_, "TABLE", "TEMP" ], keys %{...}
- foreach my $table ( keys %{ $dbh->{sql_ram_tables} } )
- {
- push @tables, [ undef, undef, $table, "TABLE", "TEMP" ];
- }
- }
-
- my $tbl_src;
- defined $dbh->{sql_table_source}
- and $dbh->{sql_table_source}->isa('DBI::DBD::SqlEngine::TableSource')
- and $tbl_src = $dbh->{sql_table_source};
-
- !defined($tbl_src)
- and $dbh->{Driver}->{ImplementorClass}->can('default_table_source')
- and $tbl_src = $dbh->{Driver}->{ImplementorClass}->default_table_source();
- defined($tbl_src) and push( @tables, $tbl_src->avail_tables($dbh) );
-
- return @tables;
-} # get_avail_tables
-
-{
- my $names = [qw( TABLE_QUALIFIER TABLE_OWNER TABLE_NAME TABLE_TYPE REMARKS )];
-
- sub table_info ($)
- {
- my $dbh = shift;
-
- my @tables = $dbh->func("get_avail_tables");
-
- # Temporary kludge: DBD::Sponge dies if @tables is empty. :-(
- # this no longer seems to be true @tables or return;
-
- my $dbh2 = $dbh->func("sql_sponge_driver");
- my $sth = $dbh2->prepare(
- "TABLE_INFO",
- {
- rows => \@tables,
- NAME => $names,
- }
- );
- $sth or return $dbh->set_err( $DBI::stderr, $dbh2->errstr );
- $sth->execute or return;
- return $sth;
- } # table_info
-}
-
-sub list_tables ($)
-{
- my $dbh = shift;
- my @table_list;
-
- my @tables = $dbh->func("get_avail_tables") or return;
- foreach my $ref (@tables)
- {
- # rt69260 and rt67223 - the same issue in 2 different queues
- push @table_list, $ref->[2];
- }
-
- return @table_list;
-} # list_tables
-
-sub quote ($$;$)
-{
- my ( $self, $str, $type ) = @_;
- defined $str or return "NULL";
- defined $type && ( $type == DBI::SQL_NUMERIC()
- || $type == DBI::SQL_DECIMAL()
- || $type == DBI::SQL_INTEGER()
- || $type == DBI::SQL_SMALLINT()
- || $type == DBI::SQL_FLOAT()
- || $type == DBI::SQL_REAL()
- || $type == DBI::SQL_DOUBLE()
- || $type == DBI::SQL_TINYINT() )
- and return $str;
-
- $str =~ s/\\/\\\\/sg;
- $str =~ s/\0/\\0/sg;
- $str =~ s/\'/\\\'/sg;
- $str =~ s/\n/\\n/sg;
- $str =~ s/\r/\\r/sg;
- return "'$str'";
-} # quote
-
-sub commit ($)
-{
- my $dbh = shift;
- $dbh->FETCH("Warn")
- and carp "Commit ineffective while AutoCommit is on", -1;
- return 1;
-} # commit
-
-sub rollback ($)
-{
- my $dbh = shift;
- $dbh->FETCH("Warn")
- and carp "Rollback ineffective while AutoCommit is on", -1;
- return 0;
-} # rollback
-
-# ====== Tie-Meta ==============================================================
-
-package DBI::DBD::SqlEngine::TieMeta;
-
-use Carp qw(croak);
-require Tie::Hash;
-@DBI::DBD::SqlEngine::TieMeta::ISA = qw(Tie::Hash);
-
-sub TIEHASH
-{
- my ( $class, $tblClass, $tblMeta ) = @_;
-
- my $self = bless(
- {
- tblClass => $tblClass,
- tblMeta => $tblMeta,
- },
- $class
- );
- return $self;
-} # new
-
-sub STORE
-{
- my ( $self, $meta_attr, $meta_val ) = @_;
-
- $self->{tblClass}->set_table_meta_attr( $self->{tblMeta}, $meta_attr, $meta_val );
-
- return;
-} # STORE
-
-sub FETCH
-{
- my ( $self, $meta_attr ) = @_;
-
- return $self->{tblClass}->get_table_meta_attr( $self->{tblMeta}, $meta_attr );
-} # FETCH
-
-sub FIRSTKEY
-{
- my $a = scalar keys %{ $_[0]->{tblMeta} };
- each %{ $_[0]->{tblMeta} };
-} # FIRSTKEY
-
-sub NEXTKEY
-{
- each %{ $_[0]->{tblMeta} };
-} # NEXTKEY
-
-sub EXISTS
-{
- exists $_[0]->{tblMeta}{ $_[1] };
-} # EXISTS
-
-sub DELETE
-{
- croak "Can't delete single attributes from table meta structure";
-} # DELETE
-
-sub CLEAR
-{
- %{ $_[0]->{tblMeta} } = ();
-} # CLEAR
-
-sub SCALAR
-{
- scalar %{ $_[0]->{tblMeta} };
-} # SCALAR
-
-# ====== Tie-Tables ============================================================
-
-package DBI::DBD::SqlEngine::TieTables;
-
-use Carp qw(croak);
-require Tie::Hash;
-@DBI::DBD::SqlEngine::TieTables::ISA = qw(Tie::Hash);
-
-sub TIEHASH
-{
- my ( $class, $dbh ) = @_;
-
- ( my $tbl_class = $dbh->{ImplementorClass} ) =~ s/::db$/::Table/;
- my $self = bless(
- {
- dbh => $dbh,
- tblClass => $tbl_class,
- },
- $class
- );
- return $self;
-} # new
-
-sub STORE
-{
- my ( $self, $table, $tbl_meta ) = @_;
-
- "HASH" eq ref $tbl_meta
- or croak "Invalid data for storing as table meta data (must be hash)";
-
- ( undef, my $meta ) = $self->{tblClass}->get_table_meta( $self->{dbh}, $table, 1 );
- $meta or croak "Invalid table name '$table'";
-
- while ( my ( $meta_attr, $meta_val ) = each %$tbl_meta )
- {
- $self->{tblClass}->set_table_meta_attr( $meta, $meta_attr, $meta_val );
- }
-
- return;
-} # STORE
-
-sub FETCH
-{
- my ( $self, $table ) = @_;
-
- ( undef, my $meta ) = $self->{tblClass}->get_table_meta( $self->{dbh}, $table, 1 );
- $meta or croak "Invalid table name '$table'";
-
- my %h;
- tie %h, "DBI::DBD::SqlEngine::TieMeta", $self->{tblClass}, $meta;
-
- return \%h;
-} # FETCH
-
-sub FIRSTKEY
-{
- my $a = scalar keys %{ $_[0]->{dbh}->{sql_meta} };
- each %{ $_[0]->{dbh}->{sql_meta} };
-} # FIRSTKEY
-
-sub NEXTKEY
-{
- each %{ $_[0]->{dbh}->{sql_meta} };
-} # NEXTKEY
-
-sub EXISTS
-{
- exists $_[0]->{dbh}->{sql_meta}->{ $_[1] }
- or exists $_[0]->{dbh}->{sql_meta_map}->{ $_[1] };
-} # EXISTS
-
-sub DELETE
-{
- my ( $self, $table ) = @_;
-
- ( undef, my $meta ) = $self->{tblClass}->get_table_meta( $self->{dbh}, $table, 1 );
- $meta or croak "Invalid table name '$table'";
-
- delete $_[0]->{dbh}->{sql_meta}->{ $meta->{table_name} };
-} # DELETE
-
-sub CLEAR
-{
- %{ $_[0]->{dbh}->{sql_meta} } = ();
- %{ $_[0]->{dbh}->{sql_meta_map} } = ();
-} # CLEAR
-
-sub SCALAR
-{
- scalar %{ $_[0]->{dbh}->{sql_meta} };
-} # SCALAR
-
-# ====== STATEMENT =============================================================
-
-package DBI::DBD::SqlEngine::st;
-
-use strict;
-use warnings;
-
-use vars qw(@ISA $imp_data_size);
-
-$imp_data_size = 0;
-
-sub bind_param ($$$;$)
-{
- my ( $sth, $pNum, $val, $attr ) = @_;
- if ( $attr && defined $val )
- {
- my $type = ref $attr eq "HASH" ? $attr->{TYPE} : $attr;
- if ( $type == DBI::SQL_BIGINT()
- || $type == DBI::SQL_INTEGER()
- || $type == DBI::SQL_SMALLINT()
- || $type == DBI::SQL_TINYINT() )
- {
- $val += 0;
- }
- elsif ( $type == DBI::SQL_DECIMAL()
- || $type == DBI::SQL_DOUBLE()
- || $type == DBI::SQL_FLOAT()
- || $type == DBI::SQL_NUMERIC()
- || $type == DBI::SQL_REAL() )
- {
- $val += 0.;
- }
- else
- {
- $val = "$val";
- }
- }
- $sth->{sql_params}[ $pNum - 1 ] = $val;
- return 1;
-} # bind_param
-
-sub execute
-{
- my $sth = shift;
- my $params = @_ ? ( $sth->{sql_params} = [@_] ) : $sth->{sql_params};
-
- $sth->finish;
- my $stmt = $sth->{sql_stmt};
-
- # must not proved when already executed - SQL::Statement modifies
- # received params
- unless ( $sth->{sql_params_checked}++ )
- {
- # SQL::Statement and DBI::SQL::Nano will return the list of required params
- # when called in list context. Do not look into the several items, they're
- # implementation specific and may change without warning
- unless ( ( my $req_prm = $stmt->params() ) == ( my $nparm = @$params ) )
- {
- my $msg = "You passed $nparm parameters where $req_prm required";
- return $sth->set_err( $DBI::stderr, $msg );
- }
- }
-
- my @err;
- my $result;
- eval {
- local $SIG{__WARN__} = sub { push @err, @_ };
- $result = $stmt->execute( $sth, $params );
- };
- unless ( defined $result )
- {
- $sth->set_err( $DBI::stderr, $@ || $stmt->{errstr} || $err[0] );
- return;
- }
-
- if ( $stmt->{NUM_OF_FIELDS} )
- { # is a SELECT statement
- $sth->STORE( Active => 1 );
- $sth->FETCH("NUM_OF_FIELDS")
- or $sth->STORE( "NUM_OF_FIELDS", $stmt->{NUM_OF_FIELDS} );
- }
- return $result;
-} # execute
-
-sub finish
-{
- my $sth = $_[0];
- $sth->SUPER::STORE( Active => 0 );
- delete $sth->{sql_stmt}{data};
- return 1;
-} # finish
-
-sub fetch ($)
-{
- my $sth = $_[0];
- my $data = $sth->{sql_stmt}{data};
- if ( !$data || ref $data ne "ARRAY" )
- {
- $sth->set_err(
- $DBI::stderr,
- "Attempt to fetch row without a preceding execute () call or from a non-SELECT statement"
- );
- return;
- }
- my $dav = shift @$data;
- unless ($dav)
- {
- $sth->finish;
- return;
- }
- if ( $sth->FETCH("ChopBlanks") ) # XXX: (TODO) Only chop on CHAR fields,
- { # not on VARCHAR or NUMERIC (see DBI docs)
- $_ && $_ =~ s/ +$// for @$dav;
- }
- return $sth->_set_fbav($dav);
-} # fetch
-
-no warnings 'once';
-*fetchrow_arrayref = \&fetch;
-
-use warnings;
-
-sub sql_get_colnames
-{
- my $sth = $_[0];
- # Being a bit dirty here, as neither SQL::Statement::Structure nor
- # DBI::SQL::Nano::Statement_ does not offer an interface to the
- # required data
- my @colnames;
- if ( $sth->{sql_stmt}->{NAME} and "ARRAY" eq ref( $sth->{sql_stmt}->{NAME} ) )
- {
- @colnames = @{ $sth->{sql_stmt}->{NAME} };
- }
- elsif ( $sth->{sql_stmt}->isa('SQL::Statement') )
- {
- my $stmt = $sth->{sql_stmt} || {};
- my @coldefs = @{ $stmt->{column_defs} || [] };
- @colnames = map { $_->{name} || $_->{value} } @coldefs;
- }
- @colnames = $sth->{sql_stmt}->column_names() unless (@colnames);
-
- @colnames = () if ( grep { m/\*/ } @colnames );
-
- return @colnames;
-}
-
-sub FETCH ($$)
-{
- my ( $sth, $attrib ) = @_;
-
- $attrib eq "NAME" and return [ $sth->sql_get_colnames() ];
-
- $attrib eq "TYPE" and return [ ( DBI::SQL_VARCHAR() ) x scalar $sth->sql_get_colnames() ];
- $attrib eq "TYPE_NAME" and return [ ("VARCHAR") x scalar $sth->sql_get_colnames() ];
- $attrib eq "PRECISION" and return [ (0) x scalar $sth->sql_get_colnames() ];
- $attrib eq "NULLABLE" and return [ (1) x scalar $sth->sql_get_colnames() ];
-
- if ( $attrib eq lc $attrib )
- {
- # Private driver attributes are lower cased
- return $sth->{$attrib};
- }
-
- # else pass up to DBI to handle
- return $sth->SUPER::FETCH($attrib);
-} # FETCH
-
-sub STORE ($$$)
-{
- my ( $sth, $attrib, $value ) = @_;
- if ( $attrib eq lc $attrib ) # Private driver attributes are lower cased
- {
- $sth->{$attrib} = $value;
- return 1;
- }
- return $sth->SUPER::STORE( $attrib, $value );
-} # STORE
-
-sub DESTROY ($)
-{
- my $sth = shift;
- $sth->SUPER::FETCH("Active") and $sth->finish;
- undef $sth->{sql_stmt};
- undef $sth->{sql_params};
-} # DESTROY
-
-sub rows ($)
-{
- return $_[0]->{sql_stmt}{NUM_OF_ROWS};
-} # rows
-
-# ====== TableSource ===========================================================
-
-package DBI::DBD::SqlEngine::TableSource;
-
-use strict;
-use warnings;
-
-use Carp;
-
-sub data_sources ($;$)
-{
- my ( $class, $drh, $attrs ) = @_;
- croak( ( ref( $_[0] ) ? ref( $_[0] ) : $_[0] ) . " must implement data_sources" );
-}
-
-sub avail_tables
-{
- my ( $self, $dbh ) = @_;
- croak( ( ref( $_[0] ) ? ref( $_[0] ) : $_[0] ) . " must implement avail_tables" );
-}
-
-# ====== DataSource ============================================================
-
-package DBI::DBD::SqlEngine::DataSource;
-
-use strict;
-use warnings;
-
-use Carp;
-
-sub complete_table_name ($$;$)
-{
- my ( $self, $meta, $table, $respect_case ) = @_;
- croak( ( ref( $_[0] ) ? ref( $_[0] ) : $_[0] ) . " must implement complete_table_name" );
-}
-
-sub open_data ($)
-{
- my ( $self, $meta, $attrs, $flags ) = @_;
- croak( ( ref( $_[0] ) ? ref( $_[0] ) : $_[0] ) . " must implement open_data" );
-}
-
-# ====== SQL::STATEMENT ========================================================
-
-package DBI::DBD::SqlEngine::Statement;
-
-use strict;
-use warnings;
-
-use Carp;
-
-@DBI::DBD::SqlEngine::Statement::ISA = qw(DBI::SQL::Nano::Statement);
-
-sub open_table ($$$$$)
-{
- my ( $self, $data, $table, $createMode, $lockMode ) = @_;
-
- my $class = ref $self;
- $class =~ s/::Statement/::Table/;
-
- my $flags = {
- createMode => $createMode,
- lockMode => $lockMode,
- };
- $self->{command} eq "DROP" and $flags->{dropMode} = 1;
-
- my ( $tblnm, $table_meta ) = $class->get_table_meta( $data->{Database}, $table, 1 )
- or croak "Cannot find appropriate meta for table '$table'";
-
- defined $table_meta->{sql_table_class} and $class = $table_meta->{sql_table_class};
-
- # because column name mapping is initialized in constructor ...
- # and therefore specific opening operations might be done before
- # reaching DBI::DBD::SqlEngine::Table->new(), we need to intercept
- # ReadOnly here
- my $write_op = $createMode || $lockMode || $flags->{dropMode};
- if ($write_op)
- {
- $table_meta->{readonly}
- and croak "Table '$table' is marked readonly - "
- . $self->{command}
- . ( $lockMode ? " with locking" : "" )
- . " command forbidden";
- }
-
- return $class->new( $data, { table => $table }, $flags );
-} # open_table
-
-# ====== SQL::TABLE ============================================================
-
-package DBI::DBD::SqlEngine::Table;
-
-use strict;
-use warnings;
-
-use Carp;
-
-@DBI::DBD::SqlEngine::Table::ISA = qw(DBI::SQL::Nano::Table);
-
-sub bootstrap_table_meta
-{
- my ( $self, $dbh, $meta, $table ) = @_;
-
- defined $dbh->{ReadOnly}
- and !defined( $meta->{readonly} )
- and $meta->{readonly} = $dbh->{ReadOnly};
- defined $meta->{sql_identifier_case}
- or $meta->{sql_identifier_case} = $dbh->{sql_identifier_case};
-
- exists $meta->{sql_data_source} or $meta->{sql_data_source} = $dbh->{sql_data_source};
-
- $meta;
-}
-
-sub init_table_meta
-{
- my ( $self, $dbh, $meta, $table ) = @_ if (0);
-
- return;
-} # init_table_meta
-
-sub get_table_meta ($$$;$)
-{
- my ( $self, $dbh, $table, $respect_case, @other ) = @_;
- unless ( defined $respect_case )
- {
- $respect_case = 0;
- $table =~ s/^\"// and $respect_case = 1; # handle quoted identifiers
- $table =~ s/\"$//;
- }
-
- unless ($respect_case)
- {
- defined $dbh->{sql_meta_map}{$table} and $table = $dbh->{sql_meta_map}{$table};
- }
-
- my $meta = {};
- defined $dbh->{sql_meta}{$table} and $meta = $dbh->{sql_meta}{$table};
-
- do_initialize:
- unless ( $meta->{initialized} )
- {
- $self->bootstrap_table_meta( $dbh, $meta, $table, @other );
- $meta->{sql_data_source}->complete_table_name( $meta, $table, $respect_case, @other )
- or return;
-
- if ( defined $meta->{table_name} and $table ne $meta->{table_name} )
- {
- $dbh->{sql_meta_map}{$table} = $meta->{table_name};
- $table = $meta->{table_name};
- }
-
- # now we know a bit more - let's check if user can't use consequent spelling
- # XXX add know issue about reset sql_identifier_case here ...
- if ( defined $dbh->{sql_meta}{$table} )
- {
- $meta = delete $dbh->{sql_meta}{$table}; # avoid endless loop
- $meta->{initialized}
- or goto do_initialize;
- #or $meta->{sql_data_source}->complete_table_name( $meta, $table, $respect_case, @other )
- #or return;
- }
-
- unless ( $dbh->{sql_meta}{$table}{initialized} )
- {
- $self->init_table_meta( $dbh, $meta, $table );
- $meta->{initialized} = 1;
- $dbh->{sql_meta}{$table} = $meta;
- }
- }
-
- return ( $table, $meta );
-} # get_table_meta
-
-my %reset_on_modify = ();
-my %compat_map = ();
-
-sub register_reset_on_modify
-{
- my ( $proto, $extra_resets ) = @_;
- foreach my $cv ( keys %$extra_resets )
- {
- #%reset_on_modify = ( %reset_on_modify, %$extra_resets );
- push @{ $reset_on_modify{$cv} },
- ref $extra_resets->{$cv} ? @{ $extra_resets->{$cv} } : ( $extra_resets->{$cv} );
- }
- return;
-} # register_reset_on_modify
-
-sub register_compat_map
-{
- my ( $proto, $extra_compat_map ) = @_;
- %compat_map = ( %compat_map, %$extra_compat_map );
- return;
-} # register_compat_map
-
-sub get_table_meta_attr
-{
- my ( $class, $meta, $attrib ) = @_;
- exists $compat_map{$attrib}
- and $attrib = $compat_map{$attrib};
- exists $meta->{$attrib}
- and return $meta->{$attrib};
- return;
-} # get_table_meta_attr
-
-sub set_table_meta_attr
-{
- my ( $class, $meta, $attrib, $value ) = @_;
- exists $compat_map{$attrib}
- and $attrib = $compat_map{$attrib};
- $class->table_meta_attr_changed( $meta, $attrib, $value );
- $meta->{$attrib} = $value;
-} # set_table_meta_attr
-
-sub table_meta_attr_changed
-{
- my ( $class, $meta, $attrib, $value ) = @_;
- defined $reset_on_modify{$attrib}
- and delete @$meta{ @{ $reset_on_modify{$attrib} } }
- and $meta->{initialized} = 0;
-} # table_meta_attr_changed
-
-sub open_data
-{
- my ( $self, $meta, $attrs, $flags ) = @_;
-
- $meta->{sql_data_source}
- or croak "Table " . $meta->{table_name} . " not completely initialized";
- $meta->{sql_data_source}->open_data( $meta, $attrs, $flags );
-
- return;
-} # open_data
-
-# ====== SQL::Eval API =========================================================
-
-sub new
-{
- my ( $className, $data, $attrs, $flags ) = @_;
- my $dbh = $data->{Database};
-
- my ( $tblnm, $meta ) = $className->get_table_meta( $dbh, $attrs->{table}, 1 )
- or croak "Cannot find appropriate table '$attrs->{table}'";
- $attrs->{table} = $tblnm;
-
- # Being a bit dirty here, as SQL::Statement::Structure does not offer
- # me an interface to the data I want
- $flags->{createMode} && $data->{sql_stmt}{table_defs}
- and $meta->{table_defs} = $data->{sql_stmt}{table_defs};
-
- # open_file must be called before inherited new is invoked
- # because column name mapping is initialized in constructor ...
- $className->open_data( $meta, $attrs, $flags );
-
- my $tbl = {
- %{$attrs},
- meta => $meta,
- col_names => $meta->{col_names} || [],
- };
- return $className->SUPER::new($tbl);
-} # new
-
-sub DESTROY
-{
- my $self = shift;
- my $meta = $self->{meta};
- $self->{row} and undef $self->{row};
- ()
-}
-
-1;
-
-=pod
-
-=head1 NAME
-
-DBI::DBD::SqlEngine - Base class for DBI drivers without their own SQL engine
-
-=head1 SYNOPSIS
-
- package DBD::myDriver;
-
- use base qw(DBI::DBD::SqlEngine);
-
- sub driver
- {
- ...
- my $drh = $proto->SUPER::driver($attr);
- ...
- return $drh->{class};
- }
-
- package DBD::myDriver::dr;
-
- @ISA = qw(DBI::DBD::SqlEngine::dr);
-
- sub data_sources { ... }
- ...
-
- package DBD::myDriver::db;
-
- @ISA = qw(DBI::DBD::SqlEngine::db);
-
- sub init_valid_attributes { ... }
- sub init_default_attributes { ... }
- sub set_versions { ... }
- sub validate_STORE_attr { my ($dbh, $attrib, $value) = @_; ... }
- sub validate_FETCH_attr { my ($dbh, $attrib) = @_; ... }
- sub get_myd_versions { ... }
- sub get_avail_tables { ... }
-
- package DBD::myDriver::st;
-
- @ISA = qw(DBI::DBD::SqlEngine::st);
-
- sub FETCH { ... }
- sub STORE { ... }
-
- package DBD::myDriver::Statement;
-
- @ISA = qw(DBI::DBD::SqlEngine::Statement);
-
- sub open_table { ... }
-
- package DBD::myDriver::Table;
-
- @ISA = qw(DBI::DBD::SqlEngine::Table);
-
- sub new { ... }
-
-=head1 DESCRIPTION
-
-DBI::DBD::SqlEngine abstracts the usage of SQL engines from the
-DBD. DBD authors can concentrate on the data retrieval they want to
-provide.
-
-It is strongly recommended that you read L<DBD::File::Developers> and
-L<DBD::File::Roadmap>, because many of the DBD::File API is provided
-by DBI::DBD::SqlEngine.
-
-Currently the API of DBI::DBD::SqlEngine is experimental and will
-likely change in the near future to provide the table meta data basics
-like DBD::File.
-
-DBI::DBD::SqlEngine expects that any driver in inheritance chain has
-a L<DBI prefix|DBI::DBD/The_database_handle_constructor>.
-
-=head2 Metadata
-
-The following attributes are handled by DBI itself and not by
-DBI::DBD::SqlEngine, thus they all work as expected:
-
- Active
- ActiveKids
- CachedKids
- CompatMode (Not used)
- InactiveDestroy
- AutoInactiveDestroy
- Kids
- PrintError
- RaiseError
- Warn (Not used)
-
-=head3 The following DBI attributes are handled by DBI::DBD::SqlEngine:
-
-=head4 AutoCommit
-
-Always on.
-
-=head4 ChopBlanks
-
-Works.
-
-=head4 NUM_OF_FIELDS
-
-Valid after C<< $sth->execute >>.
-
-=head4 NUM_OF_PARAMS
-
-Valid after C<< $sth->prepare >>.
-
-=head4 NAME
-
-Valid after C<< $sth->execute >>; probably undef for Non-Select statements.
-
-=head4 NULLABLE
-
-Not really working, always returns an array ref of ones, as DBD::CSV
-does not verify input data. Valid after C<< $sth->execute >>; undef for
-non-select statements.
-
-=head3 The following DBI attributes and methods are not supported:
-
-=over 4
-
-=item bind_param_inout
-
-=item CursorName
-
-=item LongReadLen
-
-=item LongTruncOk
-
-=back
-
-=head3 DBI::DBD::SqlEngine specific attributes
-
-In addition to the DBI attributes, you can use the following dbh
-attributes:
-
-=head4 sql_engine_version
-
-Contains the module version of this driver (B<readonly>)
-
-=head4 sql_nano_version
-
-Contains the module version of DBI::SQL::Nano (B<readonly>)
-
-=head4 sql_statement_version
-
-Contains the module version of SQL::Statement, if available (B<readonly>)
-
-=head4 sql_handler
-
-Contains the SQL Statement engine, either DBI::SQL::Nano or SQL::Statement
-(B<readonly>).
-
-=head4 sql_parser_object
-
-Contains an instantiated instance of SQL::Parser (B<readonly>).
-This is filled when used first time (only when used with SQL::Statement).
-
-=head4 sql_sponge_driver
-
-Contains an internally used DBD::Sponge handle (B<readonly>).
-
-=head4 sql_valid_attrs
-
-Contains the list of valid attributes for each DBI::DBD::SqlEngine based
-driver (B<readonly>).
-
-=head4 sql_readonly_attrs
-
-Contains the list of those attributes which are readonly (B<readonly>).
-
-=head4 sql_identifier_case
-
-Contains how DBI::DBD::SqlEngine deals with non-quoted SQL identifiers:
-
- * SQL_IC_UPPER (1) means all identifiers are internally converted
- into upper-cased pendants
- * SQL_IC_LOWER (2) means all identifiers are internally converted
- into lower-cased pendants
- * SQL_IC_MIXED (4) means all identifiers are taken as they are
-
-These conversions happen if (and only if) no existing identifier matches.
-Once existing identifier is used as known.
-
-The SQL statement execution classes doesn't have to care, so don't expect
-C<sql_identifier_case> affects column names in statements like
-
- SELECT * FROM foo
-
-=head4 sql_quoted_identifier_case
-
-Contains how DBI::DBD::SqlEngine deals with quoted SQL identifiers
-(B<readonly>). It's fixated to SQL_IC_SENSITIVE (3), which is interpreted
-as SQL_IC_MIXED.
-
-=head4 sql_flags
-
-Contains additional flags to instantiate an SQL::Parser. Because an
-SQL::Parser is instantiated only once, it's recommended to set this flag
-before any statement is executed.
-
-=head4 sql_dialect
-
-Controls the dialect understood by SQL::Parser. Possible values (delivery
-state of SQL::Statement):
-
- * ANSI
- * CSV
- * AnyData
-
-Defaults to "CSV". Because an SQL::Parser is instantiated only once and
-SQL::Parser doesn't allow one to modify the dialect once instantiated,
-it's strongly recommended to set this flag before any statement is
-executed (best place is connect attribute hash).
-
-=head4 sql_engine_in_gofer
-
-This value has a true value in case of this driver is operated via
-L<DBD::Gofer>. The impact of being operated via Gofer is a read-only
-driver (not read-only databases!), so you cannot modify any attributes
-later - neither any table settings. B<But> you won't get an error in
-cases you modify table attributes, so please carefully watch
-C<sql_engine_in_gofer>.
-
-=head4 sql_meta
-
-Private data area which contains information about the tables this
-module handles. Table meta data might not be available until the
-table has been accessed for the first time e.g., by issuing a select
-on it however it is possible to pre-initialize attributes for each table
-you use.
-
-DBI::DBD::SqlEngine recognizes the (public) attributes C<col_names>,
-C<table_name>, C<readonly>, C<sql_data_source> and C<sql_identifier_case>.
-Be very careful when modifying attributes you do not know, the consequence
-might be a destroyed or corrupted table.
-
-While C<sql_meta> is a private and readonly attribute (which means, you
-cannot modify it's values), derived drivers might provide restricted
-write access through another attribute. Well known accessors are
-C<csv_tables> for L<DBD::CSV>, C<ad_tables> for L<DBD::AnyData> and
-C<dbm_tables> for L<DBD::DBM>.
-
-=head4 sql_table_source
-
-Controls the class which will be used for fetching available tables.
-
-See L</DBI::DBD::SqlEngine::TableSource> for details.
-
-=head4 sql_data_source
-
-Contains the class name to be used for opening tables.
-
-See L</DBI::DBD::SqlEngine::DataSource> for details.
-
-=head2 Driver private methods
-
-=head3 Default DBI methods
-
-=head4 data_sources
-
-The C<data_sources> method returns a list of subdirectories of the current
-directory in the form "dbi:CSV:f_dir=$dirname".
-
-If you want to read the subdirectories of another directory, use
-
- my ($drh) = DBI->install_driver ("CSV");
- my (@list) = $drh->data_sources (f_dir => "/usr/local/csv_data");
-
-=head4 list_tables
-
-This method returns a list of file names inside $dbh->{f_dir}.
-Example:
-
- my ($dbh) = DBI->connect ("dbi:CSV:f_dir=/usr/local/csv_data");
- my (@list) = $dbh->func ("list_tables");
-
-Note that the list includes all files contained in the directory, even
-those that have non-valid table names, from the view of SQL.
-
-=head3 Additional methods
-
-The following methods are only available via their documented name when
-DBI::DBD::SQlEngine is used directly. Because this is only reasonable for
-testing purposes, the real names must be used instead. Those names can be
-computed by replacing the C<sql_> in the method name with the driver prefix.
-
-=head4 sql_versions
-
-Signature:
-
- sub sql_versions (;$) {
- my ($table_name) = @_;
- $table_name ||= ".";
- ...
- }
-
-Returns the versions of the driver, including the DBI version, the Perl
-version, DBI::PurePerl version (if DBI::PurePerl is active) and the version
-of the SQL engine in use.
-
- my $dbh = DBI->connect ("dbi:File:");
- my $sql_versions = $dbh->func( "sql_versions" );
- print "$sql_versions\n";
- __END__
- # DBI::DBD::SqlEngine 0.05 using SQL::Statement 1.402
- # DBI 1.623
- # OS netbsd (6.99.12)
- # Perl 5.016002 (x86_64-netbsd-thread-multi)
-
-Called in list context, sql_versions will return an array containing each
-line as single entry.
-
-Some drivers might use the optional (table name) argument and modify
-version information related to the table (e.g. DBD::DBM provides storage
-backend information for the requested table, when it has a table name).
-
-=head4 sql_get_meta
-
-Signature:
-
- sub sql_get_meta ($$)
- {
- my ($table_name, $attrib) = @_;
- ...
- }
-
-Returns the value of a meta attribute set for a specific table, if any.
-See L<sql_meta> for the possible attributes.
-
-A table name of C<"."> (single dot) is interpreted as the default table.
-This will retrieve the appropriate attribute globally from the dbh.
-This has the same restrictions as C<< $dbh->{$attrib} >>.
-
-=head4 sql_set_meta
-
-Signature:
-
- sub sql_set_meta ($$$)
- {
- my ($table_name, $attrib, $value) = @_;
- ...
- }
-
-Sets the value of a meta attribute set for a specific table.
-See L<sql_meta> for the possible attributes.
-
-A table name of C<"."> (single dot) is interpreted as the default table
-which will set the specified attribute globally for the dbh.
-This has the same restrictions as C<< $dbh->{$attrib} = $value >>.
-
-=head4 sql_clear_meta
-
-Signature:
-
- sub sql_clear_meta ($)
- {
- my ($table_name) = @_;
- ...
- }
-
-Clears the table specific meta information in the private storage of the
-dbh.
-
-=head2 Extensibility
-
-=head3 DBI::DBD::SqlEngine::TableSource
-
-Provides data sources and table information on database driver and database
-handle level.
-
- package DBI::DBD::SqlEngine::TableSource;
-
- sub data_sources ($;$)
- {
- my ( $class, $drh, $attrs ) = @_;
- ...
- }
-
- sub avail_tables
- {
- my ( $class, $drh ) = @_;
- ...
- }
-
-The C<data_sources> method is called when the user invokes any of the
-following:
-
- @ary = DBI->data_sources($driver);
- @ary = DBI->data_sources($driver, \%attr);
-
- @ary = $dbh->data_sources();
- @ary = $dbh->data_sources(\%attr);
-
-The C<avail_tables> method is called when the user invokes any of the
-following:
-
- @names = $dbh->tables( $catalog, $schema, $table, $type );
-
- $sth = $dbh->table_info( $catalog, $schema, $table, $type );
- $sth = $dbh->table_info( $catalog, $schema, $table, $type, \%attr );
-
- $dbh->func( "list_tables" );
-
-Every time where an C<\%attr> argument can be specified, this C<\%attr>
-object's C<sql_table_source> attribute is preferred over the C<$dbh>
-attribute or the driver default, eg.
-
- @ary = DBI->data_sources("dbi:CSV:", {
- f_dir => "/your/csv/tables",
- # note: this class doesn't comes with DBI
- sql_table_source => "DBD::File::Archive::Tar::TableSource",
- # scan tarballs instead of directories
- });
-
-When you're going to implement such a DBD::File::Archive::Tar::TableSource
-class, remember to add correct attributes (including C<sql_table_source>
-and C<sql_data_source>) to the returned DSN's.
-
-=head3 DBI::DBD::SqlEngine::DataSource
-
-Provides base functionality for dealing with tables. It is primarily
-designed for allowing transparent access to files on disk or already
-opened (file-)streams (eg. for DBD::CSV).
-
-Derived classes shall be restricted to similar functionality, too (eg.
-opening streams from an archive, transparently compress/uncompress
-log files before parsing them,
-
- package DBI::DBD::SqlEngine::DataSource;
-
- sub complete_table_name ($$;$)
- {
- my ( $self, $meta, $table, $respect_case ) = @_;
- ...
- }
-
-The method C<complete_table_name> is called when first setting up the
-I<meta information> for a table:
-
- "SELECT user.id, user.name, user.shell FROM user WHERE ..."
-
-results in opening the table C<user>. First step of the table open
-process is completing the name. Let's imagine you're having a L<DBD::CSV>
-handle with following settings:
-
- $dbh->{sql_identifier_case} = SQL_IC_LOWER;
- $dbh->{f_ext} = '.lst';
- $dbh->{f_dir} = '/data/web/adrmgr';
-
-Those settings will result in looking for files matching
-C<[Uu][Ss][Ee][Rr](\.lst)?$> in C</data/web/adrmgr/>. The scanning of the
-directory C</data/web/adrmgr/> and the pattern match check will be done
-in C<DBD::File::DataSource::File> by the C<complete_table_name> method.
-
-If you intend to provide other sources of data streams than files, in
-addition to provide an appropriate C<complete_table_name> method, a method
-to open the resource is required:
-
- package DBI::DBD::SqlEngine::DataSource;
-
- sub open_data ($)
- {
- my ( $self, $meta, $attrs, $flags ) = @_;
- ...
- }
-
-After the method C<open_data> has been run successfully, the table's meta
-information are in a state which allowes the table's data accessor methods
-will be able to fetch/store row information. Implementation details heavily
-depends on the table implementation, whereby the most famous is surely
-L<DBD::File::Table|DBD::File/DBD::File::Table>.
-
-=head1 SQL ENGINES
-
-DBI::DBD::SqlEngine currently supports two SQL engines:
-L<SQL::Statement|SQL::Statement> and
-L<DBI::SQL::Nano::Statement_|DBI::SQL::Nano>. DBI::SQL::Nano supports a
-I<very> limited subset of SQL statements, but it might be faster for some
-very simple tasks. SQL::Statement in contrast supports a much larger subset
-of ANSI SQL.
-
-To use SQL::Statement, you need at least version 1.401 of
-SQL::Statement and the environment variable C<DBI_SQL_NANO> must not
-be set to a true value.
-
-=head1 SUPPORT
-
-You can find documentation for this module with the perldoc command.
-
- perldoc DBI::DBD::SqlEngine
-
-You can also look for information at:
-
-=over 4
-
-=item * RT: CPAN's request tracker
-
-L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=DBI>
-L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=SQL-Statement>
-
-=item * AnnoCPAN: Annotated CPAN documentation
-
-L<http://annocpan.org/dist/DBI>
-L<http://annocpan.org/dist/SQL-Statement>
-
-=item * CPAN Ratings
-
-L<http://cpanratings.perl.org/d/DBI>
-
-=item * Search CPAN
-
-L<http://search.cpan.org/dist/DBI/>
-
-=back
-
-=head2 Where can I go for more help?
-
-For questions about installation or usage, please ask on the
-dbi-dev@perl.org mailing list.
-
-If you have a bug report, patch or suggestion, please open
-a new report ticket on CPAN, if there is not already one for
-the issue you want to report. Of course, you can mail any of the
-module maintainers, but it is less likely to be missed if
-it is reported on RT.
-
-Report tickets should contain a detailed description of the bug or
-enhancement request you want to report and at least an easy way to
-verify/reproduce the issue and any supplied fix. Patches are always
-welcome, too.
-
-=head1 ACKNOWLEDGEMENTS
-
-Thanks to Tim Bunce, Martin Evans and H.Merijn Brand for their continued
-support while developing DBD::File, DBD::DBM and DBD::AnyData.
-Their support, hints and feedback helped to design and implement this
-module.
-
-=head1 AUTHOR
-
-This module is currently maintained by
-
-H.Merijn Brand < h.m.brand at xs4all.nl > and
-Jens Rehsack < rehsack at googlemail.com >
-
-The original authors are Jochen Wiedmann and Jeff Zucker.
-
-=head1 COPYRIGHT AND LICENSE
-
- Copyright (C) 2009-2013 by H.Merijn Brand & Jens Rehsack
- Copyright (C) 2004-2009 by Jeff Zucker
- Copyright (C) 1998-2004 by Jochen Wiedmann
-
-All rights reserved.
-
-You may freely distribute and/or modify this module under the terms of
-either the GNU General Public License (GPL) or the Artistic License, as
-specified in the Perl README file.
-
-=head1 SEE ALSO
-
-L<DBI>, L<DBD::File>, L<DBD::AnyData> and L<DBD::Sys>.
-
-=cut
+++ /dev/null
-=head1 NAME
-
-DBI::DBD::SqlEngine::Developers - Developers documentation for DBI::DBD::SqlEngine
-
-=head1 SYNOPSIS
-
- package DBD::myDriver;
-
- use base qw(DBI::DBD::SqlEngine);
-
- sub driver
- {
- ...
- my $drh = $proto->SUPER::driver($attr);
- ...
- return $drh->{class};
- }
-
- sub CLONE { ... }
-
- package DBD::myDriver::dr;
-
- @ISA = qw(DBI::DBD::SqlEngine::dr);
-
- sub data_sources { ... }
- ...
-
- package DBD::myDriver::db;
-
- @ISA = qw(DBI::DBD::SqlEngine::db);
-
- sub init_valid_attributes { ... }
- sub init_default_attributes { ... }
- sub set_versions { ... }
- sub validate_STORE_attr { my ($dbh, $attrib, $value) = @_; ... }
- sub validate_FETCH_attr { my ($dbh, $attrib) = @_; ... }
- sub get_myd_versions { ... }
- sub get_avail_tables { ... }
-
- package DBD::myDriver::st;
-
- @ISA = qw(DBI::DBD::SqlEngine::st);
-
- sub FETCH { ... }
- sub STORE { ... }
-
- package DBD::myDriver::Statement;
-
- @ISA = qw(DBI::DBD::SqlEngine::Statement);
-
- sub open_table { ... }
-
- package DBD::myDriver::Table;
-
- @ISA = qw(DBI::DBD::SqlEngine::Table);
-
- my %reset_on_modify = (
- myd_abc => "myd_foo",
- myd_mno => "myd_bar",
- );
- __PACKAGE__->register_reset_on_modify( \%reset_on_modify );
- my %compat_map = (
- abc => 'foo_abc',
- xyz => 'foo_xyz',
- );
- __PACKAGE__->register_compat_map( \%compat_map );
-
- sub bootstrap_table_meta { ... }
- sub init_table_meta { ... }
- sub table_meta_attr_changed { ... }
- sub open_data { ... }
-
- sub new { ... }
-
- sub fetch_row { ... }
- sub push_row { ... }
- sub push_names { ... }
- sub seek { ... }
- sub truncate { ... }
- sub drop { ... }
-
- # optimize the SQL engine by add one or more of
- sub update_current_row { ... }
- # or
- sub update_specific_row { ... }
- # or
- sub update_one_row { ... }
- # or
- sub insert_new_row { ... }
- # or
- sub delete_current_row { ... }
- # or
- sub delete_one_row { ... }
-
-=head1 DESCRIPTION
-
-This document describes the interface of DBI::DBD::SqlEngine for DBD
-developers who write DBI::DBD::SqlEngine based DBI drivers. It supplements
-L<DBI::DBD> and L<DBI::DBD::SqlEngine::HowTo>, which you should read first.
-
-=head1 CLASSES
-
-Each DBI driver must provide a package global C<< driver >> method and
-three DBI related classes:
-
-=over 4
-
-=item DBI::DBD::SqlEngine::dr
-
-Driver package, contains the methods DBI calls indirectly via DBI
-interface:
-
- DBI->connect ('DBI:DBM:', undef, undef, {})
-
- # invokes
- package DBD::DBM::dr;
- @DBD::DBM::dr::ISA = qw(DBI::DBD::SqlEngine::dr);
-
- sub connect ($$;$$$)
- {
- ...
- }
-
-Similar for C<data_sources ()> and C<disconnect_all()>.
-
-Pure Perl DBI drivers derived from DBI::DBD::SqlEngine usually don't need to
-override any of the methods provided through the DBD::XXX::dr package.
-However if you need additional initialization not fitting in
-C<init_valid_attributes()> and C<init_default_attributes()> of you're ::db
-class, the connect method might be the final place to be modified.
-
-=item DBI::DBD::SqlEngine::db
-
-Contains the methods which are called through DBI database handles
-(C<< $dbh >>). e.g.,
-
- $sth = $dbh->prepare ("select * from foo");
- # returns the f_encoding setting for table foo
- $dbh->csv_get_meta ("foo", "f_encoding");
-
-DBI::DBD::SqlEngine provides the typical methods required here. Developers who
-write DBI drivers based on DBI::DBD::SqlEngine need to override the methods
-C<< set_versions >> and C<< init_valid_attributes >>.
-
-=item DBI::DBD::SqlEngine::TieMeta;
-
-Provides the tie-magic for C<< $dbh->{$drv_pfx . "_meta"} >>. Routes
-C<STORE> through C<< $drv->set_sql_engine_meta() >> and C<FETCH> through
-C<< $drv->get_sql_engine_meta() >>. C<DELETE> is not supported, you have
-to execute a C<DROP TABLE> statement, where applicable.
-
-=item DBI::DBD::SqlEngine::TieTables;
-
-Provides the tie-magic for tables in C<< $dbh->{$drv_pfx . "_meta"} >>.
-Routes C<STORE> though C<< $tblClass->set_table_meta_attr() >> and C<FETCH>
-though C<< $tblClass->get_table_meta_attr() >>. C<DELETE> removes an
-attribute from the I<meta object> retrieved by
-C<< $tblClass->get_table_meta() >>.
-
-=item DBI::DBD::SqlEngine::st
-
-Contains the methods to deal with prepared statement handles. e.g.,
-
- $sth->execute () or die $sth->errstr;
-
-=item DBI::DBD::SqlEngine::TableSource;
-
-Base class for 3rd party table sources:
-
- $dbh->{sql_table_source} = "DBD::Foo::TableSource";
-
-=item DBI::DBD::SqlEngine::DataSource;
-
-Base class for 3rd party data sources:
-
- $dbh->{sql_data_source} = "DBD::Foo::DataSource";
-
-=item DBI::DBD::SqlEngine::Statement;
-
-Base class for derived drivers statement engine. Implements C<open_table>.
-
-=item DBI::DBD::SqlEngine::Table;
-
-Contains tailoring between SQL engine's requirements and
-C<DBI::DBD::SqlEngine> magic for finding the right tables and storage.
-Builds bridges between C<sql_meta> handling of C<DBI::DBD::SqlEngine::db>,
-table initialization for SQL engines and I<meta object>'s attribute
-management for derived drivers.
-
-=back
-
-=head2 DBI::DBD::SqlEngine
-
-This is the main package containing the routines to initialize
-DBI::DBD::SqlEngine based DBI drivers. Primarily the
-C<< DBI::DBD::SqlEngine::driver >> method is invoked, either directly
-from DBI when the driver is initialized or from the derived class.
-
- package DBD::DBM;
-
- use base qw( DBI::DBD::SqlEngine );
-
- sub driver
- {
- my ( $class, $attr ) = @_;
- ...
- my $drh = $class->SUPER::driver( $attr );
- ...
- return $drh;
- }
-
-It is not necessary to implement your own driver method as long as
-additional initialization (e.g. installing more private driver
-methods) is not required. You do not need to call C<< setup_driver >>
-as DBI::DBD::SqlEngine takes care of it.
-
-=head2 DBI::DBD::SqlEngine::dr
-
-The driver package contains the methods DBI calls indirectly via the DBI
-interface (see L<DBI/DBI Class Methods>).
-
-DBI::DBD::SqlEngine based DBI drivers usually do not need to implement anything here,
-it is enough to do the basic initialization:
-
- package DBD:XXX::dr;
-
- @DBD::XXX::dr::ISA = qw (DBI::DBD::SqlEngine::dr);
- $DBD::XXX::dr::imp_data_size = 0;
- $DBD::XXX::dr::data_sources_attr = undef;
- $DBD::XXX::ATTRIBUTION = "DBD::XXX $DBD::XXX::VERSION by Hans Mustermann";
-
-=head3 Methods provided by C<< DBI::DBD::SqlEngine::dr >>:
-
-=over 4
-
-=item connect
-
-Supervises the driver bootstrap when calling
-
- DBI->connect( "dbi:Foo", , , { ... } );
-
-First it instantiates a new driver using C<DBI::_new_dbh>. After that,
-initial bootstrap of the newly instantiated driver is done by
-
- $dbh->func( 0, "init_default_attributes" );
-
-The first argument (C<0>) signals that this is the very first call to
-C<init_default_attributes>. Modern drivers understand that and do early
-stage setup here after calling
-
- package DBD::Foo::db;
- our @DBD::Foo::db::ISA = qw(DBI::DBD::SqlEngine::db);
-
- sub init_default_attributes
- {
- my ($dbh, $phase) = @_;
- $dbh->SUPER::init_default_attributes($phase);
- ...; # own setup code, maybe separated by phases
- }
-
-When the C<$phase> argument is passed down until
-C<DBI::DBD::SqlEngine::db::init_default_attributes>, C<connect()> recognizes
-a I<modern> driver and initializes the attributes from I<DSN> and I<$attr>
-arguments passed via C<< DBI->connect( $dsn, $user, $pass, \%attr ) >>.
-
-At the end of the attribute initialization after I<phase 0>, C<connect()>
-invoked C<init_default_attributes> again for I<phase 1>:
-
- $dbh->func( 1, "init_default_attributes" );
-
-=item data_sources
-
-Returns a list of I<DSN>'s using the C<data_sources> method of the
-class specified in C<< $dbh->{sql_table_source} >> or via C<\%attr>:
-
- @ary = DBI->data_sources($driver);
- @ary = DBI->data_sources($driver, \%attr);
-
-=item disconnect_all
-
-C<DBI::DBD::SqlEngine> doesn't have an overall driver cache, so nothing
-happens here at all.
-
-=back
-
-=head2 DBI::DBD::SqlEngine::db
-
-This package defines the database methods, which are called via the DBI
-database handle C<< $dbh >>.
-
-=head3 Methods provided by C<< DBI::DBD::SqlEngine::db >>:
-
-=over 4
-
-=item ping
-
-Simply returns the content of the C<< Active >> attribute. Override
-when your driver needs more complicated actions here.
-
-=item prepare
-
-Prepares a new SQL statement to execute. Returns a statement handle,
-C<< $sth >> - instance of the DBD:XXX::st. It is neither required nor
-recommended to override this method.
-
-=item validate_FETCH_attr
-
-Called by C<FETCH> to allow inherited drivers do their own attribute
-name validation. Calling convention is similar to C<FETCH> and the
-return value is the approved attribute name.
-
- return $validated_attribute_name;
-
-In case of validation fails (e.g. accessing private attribute or similar),
-C<validate_FETCH_attr> is permitted to throw an exception.
-
-=item FETCH
-
-Fetches an attribute of a DBI database object. Private handle attributes
-must have a prefix (this is mandatory). If a requested attribute is
-detected as a private attribute without a valid prefix, the driver prefix
-(written as C<$drv_prefix>) is added.
-
-The driver prefix is extracted from the attribute name and verified against
-C<< $dbh->{ $drv_prefix . "valid_attrs" } >> (when it exists). If the
-requested attribute value is not listed as a valid attribute, this method
-croaks. If the attribute is valid and readonly (listed in C<< $dbh->{
-$drv_prefix . "readonly_attrs" } >> when it exists), a real copy of the
-attribute value is returned. So it's not possible to modify
-C<f_valid_attrs> from outside of DBI::DBD::SqlEngine::db or a derived class.
-
-=item validate_STORE_attr
-
-Called by C<STORE> to allow inherited drivers do their own attribute
-name validation. Calling convention is similar to C<STORE> and the
-return value is the approved attribute name followed by the approved
-new value.
-
- return ($validated_attribute_name, $validated_attribute_value);
-
-In case of validation fails (e.g. accessing private attribute or similar),
-C<validate_STORE_attr> is permitted to throw an exception
-(C<DBI::DBD::SqlEngine::db::validate_STORE_attr> throws an exception when
-someone tries to assign value other than C<SQL_IC_UPPER .. SQL_IC_MIXED>
-to C<< $dbh->{sql_identifier_case} >> or
-C<< $dbh->{sql_quoted_identifier_case} >>).
-
-=item STORE
-
-Stores a database private attribute. Private handle attributes must have a
-prefix (this is mandatory). If a requested attribute is detected as a private
-attribute without a valid prefix, the driver prefix (written as
-C<$drv_prefix>) is added. If the database handle has an attribute
-C<${drv_prefix}_valid_attrs> - for attribute names which are not listed in
-that hash, this method croaks. If the database handle has an attribute
-C<${drv_prefix}_readonly_attrs>, only attributes which are not listed there
-can be stored (once they are initialized). Trying to overwrite such an
-immutable attribute forces this method to croak.
-
-An example of a valid attributes list can be found in
-C<< DBI::DBD::SqlEngine::db::init_valid_attributes >>.
-
-=item set_versions
-
-This method sets the attributes C<< f_version >>, C<< sql_nano_version >>,
-C<< sql_statement_version >> and (if not prohibited by a restrictive
-C<< ${prefix}_valid_attrs >>) C<< ${prefix}_version >>.
-
-This method is called at the end of the C<< connect () >> phase.
-
-When overriding this method, do not forget to invoke the superior one.
-
-=item init_valid_attributes
-
-This method is called after the database handle is instantiated as the
-first attribute initialization.
-
-C<< DBI::DBD::SqlEngine::db::init_valid_attributes >> initializes the
-attributes C<sql_valid_attrs> and C<sql_readonly_attrs>.
-
-When overriding this method, do not forget to invoke the superior one,
-preferably before doing anything else.
-
-=item init_default_attributes
-
-This method is called after the database handle is instantiated to
-initialize the default attributes. It expects one argument: C<$phase>.
-If C<$phase> is not given, C<connect> of C<DBI::DBD::SqlEngine::dr>
-expects this is an old-fashioned driver which isn't capable of multi-phased
-initialization.
-
-C<< DBI::DBD::SqlEngine::db::init_default_attributes >> initializes the
-attributes C<sql_identifier_case>, C<sql_quoted_identifier_case>,
-C<sql_handler>, C<sql_init_order>, C<sql_meta>, C<sql_engine_version>,
-C<sql_nano_version> and C<sql_statement_version> when L<SQL::Statement>
-is available.
-
-It sets C<sql_init_order> to the given C<$phase>.
-
-When the derived implementor class provides the attribute to validate
-attributes (e.g. C<< $dbh->{dbm_valid_attrs} = {...}; >>) or the attribute
-containing the immutable attributes (e.g. C<< $dbh->{dbm_readonly_attrs}
-= {...}; >>), the attributes C<drv_valid_attrs>, C<drv_readonly_attrs> and
-C<drv_version> are added (when available) to the list of valid and
-immutable attributes (where C<drv_> is interpreted as the driver prefix).
-
-=item get_versions
-
-This method is called by the code injected into the instantiated driver to
-provide the user callable driver method C<< ${prefix}versions >> (e.g.
-C<< dbm_versions >>, C<< csv_versions >>, ...).
-
-The DBI::DBD::SqlEngine implementation returns all version information known by
-DBI::DBD::SqlEngine (e.g. DBI version, Perl version, DBI::DBD::SqlEngine version and
-the SQL handler version).
-
-C<get_versions> takes the C<$dbh> as the first argument and optionally a
-second argument containing a table name. The second argument is not
-evaluated in C<< DBI::DBD::SqlEngine::db::get_versions >> itself - but
-might be in the future.
-
-If the derived implementor class provides a method named
-C<get_${drv_prefix}versions>, this is invoked and the return value of
-it is associated to the derived driver name:
-
- if (my $dgv = $dbh->{ImplementorClass}->can ("get_" . $drv_prefix . "versions") {
- (my $derived_driver = $dbh->{ImplementorClass}) =~ s/::db$//;
- $versions{$derived_driver} = &$dgv ($dbh, $table);
- }
-
-Override it to add more version information about your module, (e.g.
-some kind of parser version in case of DBD::CSV, ...), if one line is not
-enough room to provide all relevant information.
-
-=item sql_parser_object
-
-Returns a L<SQL::Parser> instance, when C<< sql_handler >> is set to
-"SQL::Statement". The parser instance is stored in C<< sql_parser_object >>.
-
-It is not recommended to override this method.
-
-=item disconnect
-
-Disconnects from a database. All local table information is discarded and
-the C<< Active >> attribute is set to 0.
-
-=item type_info_all
-
-Returns information about all the types supported by DBI::DBD::SqlEngine.
-
-=item table_info
-
-Returns a statement handle which is prepared to deliver information about
-all known tables.
-
-=item list_tables
-
-Returns a list of all known table names.
-
-=item quote
-
-Quotes a string for use in SQL statements.
-
-=item commit
-
-Warns about a useless call (if warnings enabled) and returns.
-DBI::DBD::SqlEngine is typically a driver which commits every action
-instantly when executed.
-
-=item rollback
-
-Warns about a useless call (if warnings enabled) and returns.
-DBI::DBD::SqlEngine is typically a driver which commits every action
-instantly when executed.
-
-=back
-
-=head3 Attributes used by C<< DBI::DBD::SqlEngine::db >>:
-
-This section describes attributes which are important to developers of DBI
-Database Drivers derived from C<DBI::DBD::SqlEngine>.
-
-=over 4
-
-=item sql_init_order
-
-This attribute contains a hash with priorities as key and an array
-containing the C<$dbh> attributes to be initialized during before/after
-other attributes.
-
-C<DBI::DBD::SqlEngine> initializes following attributes:
-
- $dbh->{sql_init_order} = {
- 0 => [qw( Profile RaiseError PrintError AutoCommit )],
- 90 => [ "sql_meta", $dbh->{$drv_pfx_meta} ? $dbh->{$drv_pfx_meta} : () ]
- }
-
-The default priority of not listed attribute keys is C<50>. It is well
-known that a lot of attributes needed to be set before some table settings
-are initialized. For example, for L<DBD::DBM>, when using
-
- my $dbh = DBI->connect( "dbi:DBM:", undef, undef, {
- f_dir => "/path/to/dbm/databases",
- dbm_type => "BerkeleyDB",
- dbm_mldbm => "JSON", # use MLDBM::Serializer::JSON
- dbm_tables => {
- quick => {
- dbm_type => "GDBM_File",
- dbm_MLDBM => "FreezeThaw"
- }
- }
- });
-
-This defines a known table C<quick> which uses the L<GDBM_File> backend and
-L<FreezeThaw> as serializer instead of the overall default L<BerkeleyDB> and
-L<JSON>. B<But> all files containing the table data have to be searched in
-C<< $dbh->{f_dir} >>, which requires C<< $dbh->{f_dir} >> must be initialized
-before C<< $dbh->{sql_meta}->{quick} >> is initialized by
-C<bootstrap_table_meta> method of L</DBI::DBD::SqlEngine::Table> to get
-C<< $dbh->{sql_meta}->{quick}->{f_dir} >> being initialized properly.
-
-=item sql_init_phase
-
-This attribute is only set during the initialization steps of the DBI
-Database Driver. It contains the value of the currently run initialization
-phase. Currently supported phases are I<phase 0> and I<phase 1>. This
-attribute is set in C<init_default_attributes> and removed in C<init_done>.
-
-=item sql_engine_in_gofer
-
-This value has a true value in case of this driver is operated via
-L<DBD::Gofer>. The impact of being operated via Gofer is a read-only
-driver (not read-only databases!), so you cannot modify any attributes
-later - neither any table settings. B<But> you won't get an error in
-cases you modify table attributes, so please carefully watch
-C<sql_engine_in_gofer>.
-
-=item sql_table_source
-
-Names a class which is responsible for delivering I<data sources> and
-I<available tables> (Database Driver related). I<data sources> here
-refers to L<DBI/data_sources>, not C<sql_data_source>.
-
-See L</DBI::DBD::SqlEngine::TableSource> for details.
-
-=item sql_data_source
-
-Name a class which is responsible for handling table resources open
-and completing table names requested via SQL statements.
-
-See L</DBI::DBD::SqlEngine::DataSource> for details.
-
-=item sql_dialect
-
-Controls the dialect understood by SQL::Parser. Possible values (delivery
-state of SQL::Statement):
-
- * ANSI
- * CSV
- * AnyData
-
-Defaults to "CSV". Because an SQL::Parser is instantiated only once and
-SQL::Parser doesn't allow one to modify the dialect once instantiated,
-it's strongly recommended to set this flag before any statement is
-executed (best place is connect attribute hash).
-
-=back
-
-=head2 DBI::DBD::SqlEngine::st
-
-Contains the methods to deal with prepared statement handles:
-
-=over 4
-
-=item bind_param
-
-Common routine to bind placeholders to a statement for execution. It
-is dangerous to override this method without detailed knowledge about
-the DBI::DBD::SqlEngine internal storage structure.
-
-=item execute
-
-Executes a previously prepared statement (with placeholders, if any).
-
-=item finish
-
-Finishes a statement handle, discards all buffered results. The prepared
-statement is not discarded so the statement can be executed again.
-
-=item fetch
-
-Fetches the next row from the result-set. This method may be rewritten
-in a later version and if it's overridden in a derived class, the
-derived implementation should not rely on the storage details.
-
-=item fetchrow_arrayref
-
-Alias for C<< fetch >>.
-
-=item FETCH
-
-Fetches statement handle attributes. Supported attributes (for full overview
-see L<DBI/Statement Handle Attributes>) are C<NAME>, C<TYPE>, C<PRECISION>
-and C<NULLABLE>. Each column is returned as C<NULLABLE> which might be wrong
-depending on the derived backend storage. If the statement handle has
-private attributes, they can be fetched using this method, too. B<Note> that
-statement attributes are not associated with any table used in this statement.
-
-This method usually requires extending in a derived implementation.
-See L<DBD::CSV> or L<DBD::DBM> for some example.
-
-=item STORE
-
-Allows storing of statement private attributes. No special handling is
-currently implemented here.
-
-=item rows
-
-Returns the number of rows affected by the last execute. This method might
-return C<undef>.
-
-=back
-
-=head2 DBI::DBD::SqlEngine::TableSource
-
-Provides data sources and table information on database driver and database
-handle level.
-
- package DBI::DBD::SqlEngine::TableSource;
-
- sub data_sources ($;$)
- {
- my ( $class, $drh, $attrs ) = @_;
- ...
- }
-
- sub avail_tables
- {
- my ( $class, $drh ) = @_;
- ...
- }
-
-The C<data_sources> method is called when the user invokes any of the
-following:
-
- @ary = DBI->data_sources($driver);
- @ary = DBI->data_sources($driver, \%attr);
-
- @ary = $dbh->data_sources();
- @ary = $dbh->data_sources(\%attr);
-
-The C<avail_tables> method is called when the user invokes any of the
-following:
-
- @names = $dbh->tables( $catalog, $schema, $table, $type );
-
- $sth = $dbh->table_info( $catalog, $schema, $table, $type );
- $sth = $dbh->table_info( $catalog, $schema, $table, $type, \%attr );
-
- $dbh->func( "list_tables" );
-
-Every time where an C<\%attr> argument can be specified, this C<\%attr>
-object's C<sql_table_source> attribute is preferred over the C<$dbh>
-attribute or the driver default.
-
-=head2 DBI::DBD::SqlEngine::DataSource
-
-Provides base functionality for dealing with tables. It is primarily
-designed for allowing transparent access to files on disk or already
-opened (file-)streams (e.g. for DBD::CSV).
-
-Derived classes shall be restricted to similar functionality, too (e.g.
-opening streams from an archive, transparently compress/uncompress
-log files before parsing them,
-
- package DBI::DBD::SqlEngine::DataSource;
-
- sub complete_table_name ($$;$)
- {
- my ( $self, $meta, $table, $respect_case ) = @_;
- ...
- }
-
-The method C<complete_table_name> is called when first setting up the
-I<meta information> for a table:
-
- "SELECT user.id, user.name, user.shell FROM user WHERE ..."
-
-results in opening the table C<user>. First step of the table open
-process is completing the name. Let's imagine you're having a L<DBD::CSV>
-handle with following settings:
-
- $dbh->{sql_identifier_case} = SQL_IC_LOWER;
- $dbh->{f_ext} = '.lst';
- $dbh->{f_dir} = '/data/web/adrmgr';
-
-Those settings will result in looking for files matching
-C<[Uu][Ss][Ee][Rr](\.lst)?$> in C</data/web/adrmgr/>. The scanning of the
-directory C</data/web/adrmgr/> and the pattern match check will be done
-in C<DBD::File::DataSource::File> by the C<complete_table_name> method.
-
-If you intend to provide other sources of data streams than files, in
-addition to provide an appropriate C<complete_table_name> method, a method
-to open the resource is required:
-
- package DBI::DBD::SqlEngine::DataSource;
-
- sub open_data ($)
- {
- my ( $self, $meta, $attrs, $flags ) = @_;
- ...
- }
-
-After the method C<open_data> has been run successfully, the table's meta
-information are in a state which allows the table's data accessor methods
-will be able to fetch/store row information. Implementation details heavily
-depends on the table implementation, whereby the most famous is surely
-L<DBD::File::Table|DBD::File/DBD::File::Table>.
-
-=head2 DBI::DBD::SqlEngine::Statement
-
-Derives from DBI::SQL::Nano::Statement for unified naming when deriving
-new drivers. No additional feature is provided from here.
-
-=head2 DBI::DBD::SqlEngine::Table
-
-Derives from DBI::SQL::Nano::Table for unified naming when deriving
-new drivers.
-
-You should consult the documentation of C<< SQL::Eval::Table >> (see
-L<SQL::Eval>) to get more information about the abstract methods of the
-table's base class you have to override and a description of the table
-meta information expected by the SQL engines.
-
-=over 4
-
-=item bootstrap_table_meta
-
-Initializes a table meta structure. Can be safely overridden in a
-derived class, as long as the C<< SUPER >> method is called at the end
-of the overridden method.
-
-It copies the following attributes from the database into the table meta data
-C<< $dbh->{ReadOnly} >> into C<< $meta->{readonly} >>, C<sql_identifier_case>
-and C<sql_data_source> and makes them sticky to the table.
-
-This method should be called before you attempt to map between file
-name and table name to ensure the correct directory, extension etc. are
-used.
-
-=item init_table_meta
-
-Initializes more attributes of the table meta data - usually more
-expensive ones (e.g. those which require class instantiations) - when
-the file name and the table name could mapped.
-
-=item get_table_meta
-
-Returns the table meta data. If there are none for the required table,
-a new one is initialized. When after bootstrapping a new I<table_meta>
-and L<completing the table name|/DBI::DBD::SqlEngine::DataSource> a
-mapping can be established between an existing I<table_meta> and the
-new bootstrapped one, the already existing is used and a mapping
-shortcut between the recent used table name and the already known
-table name is hold in C<< $dbh->{sql_meta_map} >>. When it fails,
-nothing is returned. On success, the name of the table and the meta data
-structure is returned.
-
-=item get_table_meta_attr
-
-Returns a single attribute from the table meta data. If the attribute
-name appears in C<%compat_map>, the attribute name is updated from
-there.
-
-=item set_table_meta_attr
-
-Sets a single attribute in the table meta data. If the attribute
-name appears in C<%compat_map>, the attribute name is updated from
-there.
-
-=item table_meta_attr_changed
-
-Called when an attribute of the meta data is modified.
-
-If the modified attribute requires to reset a calculated attribute, the
-calculated attribute is reset (deleted from meta data structure) and
-the I<initialized> flag is removed, too. The decision is made based on
-C<%register_reset_on_modify>.
-
-=item register_reset_on_modify
-
-Allows C<set_table_meta_attr> to reset meta attributes when special
-attributes are modified. For DBD::File, modifying one of C<f_file>, C<f_dir>,
-C<f_ext> or C<f_lockfile> will reset C<f_fqfn>. DBD::DBM extends the
-list for C<dbm_type> and C<dbm_mldbm> to reset the value of C<dbm_tietype>.
-
-If your DBD has calculated values in the meta data area, then call
-C<register_reset_on_modify>:
-
- my %reset_on_modify = ( "xxx_foo" => "xxx_bar" );
- __PACKAGE__->register_reset_on_modify( \%reset_on_modify );
-
-=item register_compat_map
-
-Allows C<get_table_meta_attr> and C<set_table_meta_attr> to update the
-attribute name to the current favored one:
-
- # from DBD::DBM
- my %compat_map = ( "dbm_ext" => "f_ext" );
- __PACKAGE__->register_compat_map( \%compat_map );
-
-=item open_data
-
-Called to open the table's data storage. This is silently forwarded
-to C<< $meta->{sql_data_source}->open_data() >>.
-
-After this is done, a derived class might add more steps in an overridden
-C<< open_file >> method.
-
-=item new
-
-Instantiates the table. This is done in 3 steps:
-
- 1. get the table meta data
- 2. open the data file
- 3. bless the table data structure using inherited constructor new
-
-It is not recommended to override the constructor of the table class.
-Find a reasonable place to add you extensions in one of the above four
-methods.
-
-=back
-
-=head1 AUTHOR
-
-The module DBI::DBD::SqlEngine is currently maintained by
-
-H.Merijn Brand < h.m.brand at xs4all.nl > and
-Jens Rehsack < rehsack at googlemail.com >
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright (C) 2010 by H.Merijn Brand & Jens Rehsack
-
-All rights reserved.
-
-You may freely distribute and/or modify this module under the terms of
-either the GNU General Public License (GPL) or the Artistic License, as
-specified in the Perl README file.
-
-=cut
+++ /dev/null
-=head1 NAME
-
-DBI::DBD::SqlEngine::HowTo - Guide to create DBI::DBD::SqlEngine based driver
-
-=head1 SYNOPSIS
-
- perldoc DBI::DBD::SqlEngine::HowTo
- perldoc DBI
- perldoc DBI::DBD
- perldoc DBI::DBD::SqlEngine::Developers
- perldoc SQL::Eval
- perldoc DBI::DBD::SqlEngine
- perldoc DBI::DBD::SqlEngine::HowTo
- perldoc SQL::Statement::Embed
-
-=head1 DESCRIPTION
-
-This document provides a step-by-step guide, how to create a new
-C<DBI::DBD::SqlEngine> based DBD. It expects that you carefully read the
-L<DBI> documentation and that you're familiar with L<DBI::DBD> and had
-read and understood L<DBD::ExampleP>.
-
-This document addresses experienced developers who are really sure that
-they need to invest time when writing a new DBI Driver. Writing a DBI
-Driver is neither a weekend project nor an easy job for hobby coders
-after work. Expect one or two man-month of time for the first start.
-
-Those who are still reading, should be able to sing the rules of
-L<DBI::DBD/CREATING A NEW DRIVER>.
-
-=head1 CREATING DRIVER CLASSES
-
-Do you have an entry in DBI's DBD registry? DBI::DBD::SqlEngine expect
-having a unique prefix for every driver class in inheritance chain.
-
-It's easy to get a prefix - just drop the DBI team a note
-(L<DBI/GETTING_HELP>). If you want for some reason hide your work, take
-a look at L<Class::Method::Modifiers> how to wrap a private prefix method
-around existing C<driver_prefix>.
-
-For this guide, a prefix of C<foo_> is assumed.
-
-=head2 Sample Skeleton
-
- package DBD::Foo;
-
- use strict;
- use warnings;
- use vars qw($VERSION);
- use base qw(DBI::DBD::SqlEngine);
-
- use DBI ();
-
- $VERSION = "0.001";
-
- package DBD::Foo::dr;
-
- use vars qw(@ISA $imp_data_size);
-
- @ISA = qw(DBI::DBD::SqlEngine::dr);
- $imp_data_size = 0;
-
- package DBD::Foo::db;
-
- use vars qw(@ISA $imp_data_size);
-
- @ISA = qw(DBI::DBD::SqlEngine::db);
- $imp_data_size = 0;
-
- package DBD::Foo::st;
-
- use vars qw(@ISA $imp_data_size);
-
- @ISA = qw(DBI::DBD::SqlEngine::st);
- $imp_data_size = 0;
-
- package DBD::Foo::Statement;
-
- use vars qw(@ISA);
-
- @ISA = qw(DBI::DBD::SqlEngine::Statement);
-
- package DBD::Foo::Table;
-
- use vars qw(@ISA);
-
- @ISA = qw(DBI::DBD::SqlEngine::Table);
-
- 1;
-
-Tiny, eh? And all you have now is a DBD named foo which will is able to
-deal with temporary tables, as long as you use L<SQL::Statement>. In
-L<DBI::SQL::Nano> environments, this DBD can do nothing.
-
-=head2 Deal with own attributes
-
-Before we start doing usable stuff with our DBI driver, we need to think
-about what we want to do and how we want to do it.
-
-Do we need tunable knobs accessible by users? Do we need status
-information? All this is handled in attributes of the database handles (be
-careful when your DBD is running "behind" a L<DBD::Gofer> proxy).
-
-How come the attributes into the DBD and how are they fetchable by the
-user? Good question, but you should know because you've read the L<DBI>
-documentation.
-
-C<DBI::DBD::SqlEngine::db::FETCH> and C<DBI::DBD::SqlEngine::db::STORE>
-taking care for you - all they need to know is which attribute names
-are valid and mutable or immutable. Tell them by adding
-C<init_valid_attributes> to your db class:
-
- sub init_valid_attributes
- {
- my $dbh = $_[0];
-
- $dbh->SUPER::init_valid_attributes ();
-
- $dbh->{foo_valid_attrs} = {
- foo_version => 1, # contains version of this driver
- foo_valid_attrs => 1, # contains the valid attributes of foo drivers
- foo_readonly_attrs => 1, # contains immutable attributes of foo drivers
- foo_bar => 1, # contains the bar attribute
- foo_baz => 1, # contains the baz attribute
- foo_manager => 1, # contains the manager of the driver instance
- foo_manager_type => 1, # contains the manager class of the driver instance
- };
- $dbh->{foo_readonly_attrs} = {
- foo_version => 1, # ensure no-one modifies the driver version
- foo_valid_attrs => 1, # do not permit one to add more valid attributes ...
- foo_readonly_attrs => 1, # ... or make the immutable mutable
- foo_manager => 1, # manager is set internally only
- };
-
- return $dbh;
- }
-
-Woooho - but now the user cannot assign new managers? This is intended,
-overwrite C<STORE> to handle it!
-
- sub STORE ($$$)
- {
- my ( $dbh, $attrib, $value ) = @_;
-
- $dbh->SUPER::STORE( $attrib, $value );
-
- # we're still alive, so no exception is thrown ...
- # by DBI::DBD::SqlEngine::db::STORE
- if ( $attrib eq "foo_manager_type" )
- {
- $dbh->{foo_manager} = $dbh->{foo_manager_type}->new();
- # ... probably correct some states based on the new
- # foo_manager_type - see DBD::Sys for an example
- }
- }
-
-But ... my driver runs without a manager until someone first assignes
-a C<foo_manager_type>. Well, no - there're two places where you can
-initialize defaults:
-
- sub init_default_attributes
- {
- my ($dbh, $phase) = @_;
-
- $dbh->SUPER::init_default_attributes($phase);
-
- if( 0 == $phase )
- {
- # init all attributes which have no knowledge about
- # user settings from DSN or the attribute hash
- $dbh->{foo_manager_type} = "DBD::Foo::Manager";
- }
- elsif( 1 == $phase )
- {
- # init phase with more knowledge from DSN or attribute
- # hash
- $dbh->{foo_manager} = $dbh->{foo_manager_type}->new();
- }
-
- return $dbh;
- }
-
-So far we can prevent the users to use our database driver as data
-storage for anything and everything. We care only about the real important
-stuff for peace on earth and alike attributes. But in fact, the driver
-still can't do anything. It can do less than nothing - meanwhile it's
-not a stupid storage area anymore.
-
-=head2 User comfort
-
-C<DBI::DBD::SqlEngine> since C<0.05> consolidates all persistent meta data
-of a table into a single structure stored in C<< $dbh->{sql_meta} >>. While
-DBI::DBD::SqlEngine provides only readonly access to this structure,
-modifications are still allowed.
-
-Primarily DBI::DBD::SqlEngine provides access via the setters
-C<new_sql_engine_meta>, C<get_sql_engine_meta>, C<get_single_table_meta>,
-C<set_single_table_meta>, C<set_sql_engine_meta> and C<clear_sql_engine_meta>.
-Those methods are easily accessible by the users via the C<< $dbh->func () >>
-interface provided by DBI. Well, many users don't feel comfortize when calling
-
- # don't require extension for tables cars
- $dbh->func ("cars", "f_ext", ".csv", "set_sql_engine_meta");
-
-DBI::DBD::SqlEngine will inject a method into your driver to increase the
-user comfort to allow:
-
- # don't require extension for tables cars
- $dbh->foo_set_meta ("cars", "f_ext", ".csv");
-
-Better, but here and there users likes to do:
-
- # don't require extension for tables cars
- $dbh->{foo_tables}->{cars}->{f_ext} = ".csv";
-
-This interface is provided when derived DBD's define following in
-C<init_valid_attributes> (re-capture L</Deal with own attributes>):
-
- sub init_valid_attributes
- {
- my $dbh = $_[0];
-
- $dbh->SUPER::init_valid_attributes ();
-
- $dbh->{foo_valid_attrs} = {
- foo_version => 1, # contains version of this driver
- foo_valid_attrs => 1, # contains the valid attributes of foo drivers
- foo_readonly_attrs => 1, # contains immutable attributes of foo drivers
- foo_bar => 1, # contains the bar attribute
- foo_baz => 1, # contains the baz attribute
- foo_manager => 1, # contains the manager of the driver instance
- foo_manager_type => 1, # contains the manager class of the driver instance
- foo_meta => 1, # contains the public interface to modify table meta attributes
- };
- $dbh->{foo_readonly_attrs} = {
- foo_version => 1, # ensure no-one modifies the driver version
- foo_valid_attrs => 1, # do not permit one to add more valid attributes ...
- foo_readonly_attrs => 1, # ... or make the immutable mutable
- foo_manager => 1, # manager is set internally only
- foo_meta => 1, # ensure public interface to modify table meta attributes are immutable
- };
-
- $dbh->{foo_meta} = "foo_tables";
-
- return $dbh;
- }
-
-This provides a tied hash in C<< $dbh->{foo_tables} >> and a tied hash for
-each table's meta data in C<< $dbh->{foo_tables}->{$table_name} >>.
-Modifications on the table meta attributes are done using the table
-methods:
-
- sub get_table_meta_attr { ... }
- sub set_table_meta_attr { ... }
-
-Both methods can adjust the attribute name for compatibility reasons, e.g.
-when former versions of the DBD allowed different names to be used for the
-same flag:
-
- my %compat_map = (
- abc => 'foo_abc',
- xyz => 'foo_xyz',
- );
- __PACKAGE__->register_compat_map( \%compat_map );
-
-If any user modification on a meta attribute needs reinitialization of
-the meta structure (in case of C<DBI::DBD::SqlEngine> these are the attributes
-C<f_file>, C<f_dir>, C<f_ext> and C<f_lockfile>), inform DBI::DBD::SqlEngine by
-doing
-
- my %reset_on_modify = (
- foo_xyz => "foo_bar",
- foo_abc => "foo_bar",
- );
- __PACKAGE__->register_reset_on_modify( \%reset_on_modify );
-
-The next access to the table meta data will force DBI::DBD::SqlEngine to re-do the
-entire meta initialization process.
-
-Any further action which needs to be taken can handled in
-C<table_meta_attr_changed>:
-
- sub table_meta_attr_changed
- {
- my ($class, $meta, $attrib, $value) = @_;
- ...
- $class->SUPER::table_meta_attr_changed ($meta, $attrib, $value);
- }
-
-This is done before the new value is set in C<$meta>, so the attribute
-changed handler can act depending on the old value.
-
-=head2 Dealing with Tables
-
-Let's put some life into it - it's going to be time for it.
-
-This is a good point where a quick side step to L<SQL::Statement::Embed>
-will help to shorten the next paragraph. The documentation in
-SQL::Statement::Embed regarding embedding in own DBD's works pretty
-fine with SQL::Statement and DBI::SQL::Nano.
-
-Second look should go to L<DBI::DBD::SqlEngine::Developers> to get a
-picture over the driver part of the table API. Usually there isn't much
-to do for an easy driver.
-
-=head2 Testing
-
-Now you should have your first own DBD. Was easy, wasn't it? But does
-it work well? Prove it by writing tests and remember to use
-dbd_edit_mm_attribs from L<DBI::DBD> to ensure testing even rare cases.
-
-=head1 AUTHOR
-
-This guide is written by Jens Rehsack. DBI::DBD::SqlEngine is written by
-Jens Rehsack using code from DBD::File originally written by Jochen
-Wiedmann and Jeff Zucker.
-
-The module DBI::DBD::SqlEngine is currently maintained by
-
-H.Merijn Brand < h.m.brand at xs4all.nl > and
-Jens Rehsack < rehsack at googlemail.com >
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright (C) 2010 by H.Merijn Brand & Jens Rehsack
-
-All rights reserved.
-
-You may freely distribute and/or modify this module under the terms of
-either the GNU General Public License (GPL) or the Artistic License, as
-specified in the Perl README file.
-
-=cut
+++ /dev/null
-package DBI::Gofer::Execute;
-
-# $Id: Execute.pm 14282 2010-07-26 00:12:54Z David $
-#
-# Copyright (c) 2007, Tim Bunce, Ireland
-#
-# You may distribute under the terms of either the GNU General Public
-# License or the Artistic License, as specified in the Perl README file.
-
-use strict;
-use warnings;
-
-use Carp;
-
-use DBI qw(dbi_time);
-use DBI::Gofer::Request;
-use DBI::Gofer::Response;
-
-use base qw(DBI::Util::_accessor);
-
-our $VERSION = "0.014283";
-
-our @all_dbh_methods = sort map { keys %$_ } $DBI::DBI_methods{db}, $DBI::DBI_methods{common};
-our %all_dbh_methods = map { $_ => (DBD::_::db->can($_)||undef) } @all_dbh_methods;
-
-our $local_log = $ENV{DBI_GOFER_LOCAL_LOG}; # do extra logging to stderr
-
-our $current_dbh; # the dbh we're using for this request
-
-
-# set trace for server-side gofer
-# Could use DBI_TRACE env var when it's an unrelated separate process
-# but using DBI_GOFER_TRACE makes testing easier for subprocesses (eg stream)
-DBI->trace(split /=/, $ENV{DBI_GOFER_TRACE}, 2) if $ENV{DBI_GOFER_TRACE};
-
-
-# define valid configuration attributes (args to new())
-# the values here indicate the basic type of values allowed
-my %configuration_attributes = (
- gofer_execute_class => 1,
- default_connect_dsn => 1,
- forced_connect_dsn => 1,
- default_connect_attributes => {},
- forced_connect_attributes => {},
- track_recent => 1,
- check_request_sub => sub {},
- check_response_sub => sub {},
- forced_single_resultset => 1,
- max_cached_dbh_per_drh => 1,
- max_cached_sth_per_dbh => 1,
- forced_response_attributes => {},
- forced_gofer_random => 1,
- stats => {},
-);
-
-__PACKAGE__->mk_accessors(
- keys %configuration_attributes
-);
-
-
-
-sub new {
- my ($self, $args) = @_;
- $args->{default_connect_attributes} ||= {};
- $args->{forced_connect_attributes} ||= {};
- $args->{max_cached_sth_per_dbh} ||= 1000;
- $args->{stats} ||= {};
- return $self->SUPER::new($args);
-}
-
-
-sub valid_configuration_attributes {
- my $self = shift;
- return { %configuration_attributes };
-}
-
-
-my %extra_attr = (
- # Only referenced if the driver doesn't support private_attribute_info method.
- # What driver-specific attributes should be returned for the driver being used?
- # keyed by $dbh->{Driver}{Name}
- # XXX for sth should split into attr specific to resultsets (where NUM_OF_FIELDS > 0) and others
- # which would reduce processing/traffic for non-select statements
- mysql => {
- dbh => [qw(
- mysql_errno mysql_error mysql_hostinfo mysql_info mysql_insertid
- mysql_protoinfo mysql_serverinfo mysql_stat mysql_thread_id
- )],
- sth => [qw(
- mysql_is_blob mysql_is_key mysql_is_num mysql_is_pri_key mysql_is_auto_increment
- mysql_length mysql_max_length mysql_table mysql_type mysql_type_name mysql_insertid
- )],
- # XXX this dbh_after_sth stuff is a temporary, but important, hack.
- # should be done via hash instead of arrays where the hash value contains
- # flags that can indicate which attributes need to be handled in this way
- dbh_after_sth => [qw(
- mysql_insertid
- )],
- },
- Pg => {
- dbh => [qw(
- pg_protocol pg_lib_version pg_server_version
- pg_db pg_host pg_port pg_default_port
- pg_options pg_pid
- )],
- sth => [qw(
- pg_size pg_type pg_oid_status pg_cmd_status
- )],
- },
- Sybase => {
- dbh => [qw(
- syb_dynamic_supported syb_oc_version syb_server_version syb_server_version_string
- )],
- sth => [qw(
- syb_types syb_proc_status syb_result_type
- )],
- },
- SQLite => {
- dbh => [qw(
- sqlite_version
- )],
- sth => [qw(
- )],
- },
- ExampleP => {
- dbh => [qw(
- examplep_private_dbh_attrib
- )],
- sth => [qw(
- examplep_private_sth_attrib
- )],
- dbh_after_sth => [qw(
- examplep_insertid
- )],
- },
-);
-
-
-sub _connect {
- my ($self, $request) = @_;
-
- my $stats = $self->{stats};
-
- # discard CachedKids from time to time
- if (++$stats->{_requests_served} % 1000 == 0 # XXX config?
- and my $max_cached_dbh_per_drh = $self->{max_cached_dbh_per_drh}
- ) {
- my %drivers = DBI->installed_drivers();
- while ( my ($driver, $drh) = each %drivers ) {
- next unless my $CK = $drh->{CachedKids};
- next unless keys %$CK > $max_cached_dbh_per_drh;
- next if $driver eq 'Gofer'; # ie transport=null when testing
- DBI->trace_msg(sprintf "Clearing %d cached dbh from $driver",
- scalar keys %$CK, $self->{max_cached_dbh_per_drh});
- $_->{Active} && $_->disconnect for values %$CK;
- %$CK = ();
- }
- }
-
- # local $ENV{...} can leak, so only do it if required
- local $ENV{DBI_AUTOPROXY} if $ENV{DBI_AUTOPROXY};
-
- my ($connect_method, $dsn, $username, $password, $attr) = @{ $request->dbh_connect_call };
- $connect_method ||= 'connect_cached';
- $stats->{method_calls_dbh}->{$connect_method}++;
-
- # delete attributes we don't want to affect the server-side
- # (Could just do this on client-side and trust the client. DoS?)
- delete @{$attr}{qw(Profile InactiveDestroy AutoInactiveDestroy HandleError HandleSetErr TraceLevel Taint TaintIn TaintOut)};
-
- $dsn = $self->forced_connect_dsn || $dsn || $self->default_connect_dsn
- or die "No forced_connect_dsn, requested dsn, or default_connect_dsn for request";
-
- my $random = $self->{forced_gofer_random} || $ENV{DBI_GOFER_RANDOM} || '';
-
- my $connect_attr = {
-
- # the configured default attributes, if any
- %{ $self->default_connect_attributes },
-
- # pass username and password as attributes
- # then they can be overridden by forced_connect_attributes
- Username => $username,
- Password => $password,
-
- # the requested attributes
- %$attr,
-
- # force some attributes the way we'd like them
- PrintWarn => $local_log,
- PrintError => $local_log,
-
- # the configured default attributes, if any
- %{ $self->forced_connect_attributes },
-
- # RaiseError must be enabled
- RaiseError => 1,
-
- # reset Executed flag (of the cached handle) so we can use it to tell
- # if errors happened before the main part of the request was executed
- Executed => 0,
-
- # ensure this connect_cached doesn't have the same args as the client
- # because that causes subtle issues if in the same process (ie transport=null)
- # include pid to avoid problems with forking (ie null transport in mod_perl)
- # include gofer-random to avoid random behaviour leaking to other handles
- dbi_go_execute_unique => join("|", __PACKAGE__, $$, $random),
- };
-
- # XXX implement our own private connect_cached method? (with rate-limited ping)
- my $dbh = DBI->$connect_method($dsn, undef, undef, $connect_attr);
-
- $dbh->{ShowErrorStatement} = 1 if $local_log;
-
- # XXX should probably just be a Callbacks => arg to connect_cached
- # with a cache of pre-built callback hooks (memoized, without $self)
- if (my $random = $self->{forced_gofer_random} || $ENV{DBI_GOFER_RANDOM}) {
- $self->_install_rand_callbacks($dbh, $random);
- }
-
- my $CK = $dbh->{CachedKids};
- if ($CK && keys %$CK > $self->{max_cached_sth_per_dbh}) {
- %$CK = (); # clear all statement handles
- }
-
- #$dbh->trace(0);
- $current_dbh = $dbh;
- return $dbh;
-}
-
-
-sub reset_dbh {
- my ($self, $dbh) = @_;
- $dbh->set_err(undef, undef); # clear any error state
-}
-
-
-sub new_response_with_err {
- my ($self, $rv, $eval_error, $dbh) = @_;
- # this is the usual way to create a response for both success and failure
- # capture err+errstr etc and merge in $eval_error ($@)
-
- my ($err, $errstr, $state) = ($DBI::err, $DBI::errstr, $DBI::state);
-
- if ($eval_error) {
- $err ||= $DBI::stderr || 1; # ensure err is true
- if ($errstr) {
- $eval_error =~ s/(?: : \s)? \Q$errstr//x if $errstr;
- chomp $errstr;
- $errstr .= "; $eval_error";
- }
- else {
- $errstr = $eval_error;
- }
- }
- chomp $errstr if $errstr;
-
- my $flags;
- # (XXX if we ever add transaction support then we'll need to take extra
- # steps because the commit/rollback would reset Executed before we get here)
- $flags |= GOf_RESPONSE_EXECUTED if $dbh && $dbh->{Executed};
-
- my $response = DBI::Gofer::Response->new({
- rv => $rv,
- err => $err,
- errstr => $errstr,
- state => $state,
- flags => $flags,
- });
-
- return $response;
-}
-
-
-sub execute_request {
- my ($self, $request) = @_;
- # should never throw an exception
-
- DBI->trace_msg("-----> execute_request\n");
-
- my @warnings;
- local $SIG{__WARN__} = sub {
- push @warnings, @_;
- warn @_ if $local_log;
- };
-
- my $response = eval {
-
- if (my $check_request_sub = $self->check_request_sub) {
- $request = $check_request_sub->($request, $self)
- or die "check_request_sub failed";
- }
-
- my $version = $request->version || 0;
- die ref($request)." version $version is not supported"
- if $version < 0.009116 or $version >= 1;
-
- ($request->is_sth_request)
- ? $self->execute_sth_request($request)
- : $self->execute_dbh_request($request);
- };
- $response ||= $self->new_response_with_err(undef, $@, $current_dbh);
-
- if (my $check_response_sub = $self->check_response_sub) {
- # not protected with an eval so it can choose to throw an exception
- my $new = $check_response_sub->($response, $self, $request);
- $response = $new if ref $new;
- }
-
- undef $current_dbh;
-
- $response->warnings(\@warnings) if @warnings;
- DBI->trace_msg("<----- execute_request\n");
- return $response;
-}
-
-
-sub execute_dbh_request {
- my ($self, $request) = @_;
- my $stats = $self->{stats};
-
- my $dbh;
- my $rv_ref = eval {
- $dbh = $self->_connect($request);
- my $args = $request->dbh_method_call; # [ wantarray, 'method_name', @args ]
- my $wantarray = shift @$args;
- my $meth = shift @$args;
- $stats->{method_calls_dbh}->{$meth}++;
- my @rv = ($wantarray)
- ? $dbh->$meth(@$args)
- : scalar $dbh->$meth(@$args);
- \@rv;
- } || [];
- my $response = $self->new_response_with_err($rv_ref, $@, $dbh);
-
- return $response if not $dbh;
-
- # does this request also want any dbh attributes returned?
- if (my $dbh_attributes = $request->dbh_attributes) {
- $response->dbh_attributes( $self->gather_dbh_attributes($dbh, $dbh_attributes) );
- }
-
- if ($rv_ref and my $lid_args = $request->dbh_last_insert_id_args) {
- $stats->{method_calls_dbh}->{last_insert_id}++;
- my $id = $dbh->last_insert_id( @$lid_args );
- $response->last_insert_id( $id );
- }
-
- if ($rv_ref and UNIVERSAL::isa($rv_ref->[0],'DBI::st')) {
- # dbh_method_call was probably a metadata method like table_info
- # that returns a statement handle, so turn the $sth into resultset
- my $sth = $rv_ref->[0];
- $response->sth_resultsets( $self->gather_sth_resultsets($sth, $request, $response) );
- $response->rv("(sth)"); # don't try to return actual sth
- }
-
- # we're finished with this dbh for this request
- $self->reset_dbh($dbh);
-
- return $response;
-}
-
-
-sub gather_dbh_attributes {
- my ($self, $dbh, $dbh_attributes) = @_;
- my @req_attr_names = @$dbh_attributes;
- if ($req_attr_names[0] eq '*') { # auto include std + private
- shift @req_attr_names;
- push @req_attr_names, @{ $self->_std_response_attribute_names($dbh) };
- }
- my %dbh_attr_values;
- @dbh_attr_values{@req_attr_names} = $dbh->FETCH_many(@req_attr_names);
-
- # XXX piggyback installed_methods onto dbh_attributes for now
- $dbh_attr_values{dbi_installed_methods} = { DBI->installed_methods };
-
- # XXX piggyback default_methods onto dbh_attributes for now
- $dbh_attr_values{dbi_default_methods} = _get_default_methods($dbh);
-
- return \%dbh_attr_values;
-}
-
-
-sub _std_response_attribute_names {
- my ($self, $h) = @_;
- $h = tied(%$h) || $h; # switch to inner handle
-
- # cache the private_attribute_info data for each handle
- # XXX might be better to cache it in the executor
- # as it's unlikely to change
- # or perhaps at least cache it in the dbh even for sth
- # as the sth are typically very short lived
-
- my ($dbh, $h_type, $driver_name, @attr_names);
-
- if ($dbh = $h->{Database}) { # is an sth
-
- # does the dbh already have the answer cached?
- return $dbh->{private_gofer_std_attr_names_sth} if $dbh->{private_gofer_std_attr_names_sth};
-
- ($h_type, $driver_name) = ('sth', $dbh->{Driver}{Name});
- push @attr_names, qw(NUM_OF_PARAMS NUM_OF_FIELDS NAME TYPE NULLABLE PRECISION SCALE);
- }
- else { # is a dbh
- return $h->{private_gofer_std_attr_names_dbh} if $h->{private_gofer_std_attr_names_dbh};
-
- ($h_type, $driver_name, $dbh) = ('dbh', $h->{Driver}{Name}, $h);
- # explicitly add these because drivers may have different defaults
- # add Name so the client gets the real Name of the connection
- push @attr_names, qw(ChopBlanks LongReadLen LongTruncOk ReadOnly Name);
- }
-
- if (my $pai = $h->private_attribute_info) {
- push @attr_names, keys %$pai;
- }
- else {
- push @attr_names, @{ $extra_attr{ $driver_name }{$h_type} || []};
- }
- if (my $fra = $self->{forced_response_attributes}) {
- push @attr_names, @{ $fra->{ $driver_name }{$h_type} || []}
- }
- $dbh->trace_msg("_std_response_attribute_names for $driver_name $h_type: @attr_names\n");
-
- # cache into the dbh even for sth, as the dbh is usually longer lived
- return $dbh->{"private_gofer_std_attr_names_$h_type"} = \@attr_names;
-}
-
-
-sub execute_sth_request {
- my ($self, $request) = @_;
- my $dbh;
- my $sth;
- my $last_insert_id;
- my $stats = $self->{stats};
-
- my $rv = eval {
- $dbh = $self->_connect($request);
-
- my $args = $request->dbh_method_call; # [ wantarray, 'method_name', @args ]
- shift @$args; # discard wantarray
- my $meth = shift @$args;
- $stats->{method_calls_sth}->{$meth}++;
- $sth = $dbh->$meth(@$args);
- my $last = '(sth)'; # a true value (don't try to return actual sth)
-
- # execute methods on the sth, e.g., bind_param & execute
- if (my $calls = $request->sth_method_calls) {
- for my $meth_call (@$calls) {
- my $method = shift @$meth_call;
- $stats->{method_calls_sth}->{$method}++;
- $last = $sth->$method(@$meth_call);
- }
- }
-
- if (my $lid_args = $request->dbh_last_insert_id_args) {
- $stats->{method_calls_sth}->{last_insert_id}++;
- $last_insert_id = $dbh->last_insert_id( @$lid_args );
- }
-
- $last;
- };
- my $response = $self->new_response_with_err($rv, $@, $dbh);
-
- return $response if not $dbh;
-
- $response->last_insert_id( $last_insert_id )
- if defined $last_insert_id;
-
- # even if the eval failed we still want to try to gather attribute values
- # (XXX would be nice to be able to support streaming of results.
- # which would reduce memory usage and latency for large results)
- if ($sth) {
- $response->sth_resultsets( $self->gather_sth_resultsets($sth, $request, $response) );
- $sth->finish;
- }
-
- # does this request also want any dbh attributes returned?
- my $dbh_attr_set;
- if (my $dbh_attributes = $request->dbh_attributes) {
- $dbh_attr_set = $self->gather_dbh_attributes($dbh, $dbh_attributes);
- }
- # XXX needs to be integrated with private_attribute_info() etc
- if (my $dbh_attr = $extra_attr{$dbh->{Driver}{Name}}{dbh_after_sth}) {
- @{$dbh_attr_set}{@$dbh_attr} = $dbh->FETCH_many(@$dbh_attr);
- }
- $response->dbh_attributes($dbh_attr_set) if $dbh_attr_set && %$dbh_attr_set;
-
- $self->reset_dbh($dbh);
-
- return $response;
-}
-
-
-sub gather_sth_resultsets {
- my ($self, $sth, $request, $response) = @_;
- my $resultsets = eval {
-
- my $attr_names = $self->_std_response_attribute_names($sth);
- my $sth_attr = {};
- $sth_attr->{$_} = 1 for @$attr_names;
-
- # let the client add/remove sth attributes
- if (my $sth_result_attr = $request->sth_result_attr) {
- $sth_attr->{$_} = $sth_result_attr->{$_}
- for keys %$sth_result_attr;
- }
- my @sth_attr = grep { $sth_attr->{$_} } keys %$sth_attr;
-
- my $row_count = 0;
- my $rs_list = [];
- while (1) {
- my $rs = $self->fetch_result_set($sth, \@sth_attr);
- push @$rs_list, $rs;
- if (my $rows = $rs->{rowset}) {
- $row_count += @$rows;
- }
- last if $self->{forced_single_resultset};
- last if !($sth->more_results || $sth->{syb_more_results});
- }
-
- my $stats = $self->{stats};
- $stats->{rows_returned_total} += $row_count;
- $stats->{rows_returned_max} = $row_count
- if $row_count > ($stats->{rows_returned_max}||0);
-
- $rs_list;
- };
- $response->add_err(1, $@) if $@;
- return $resultsets;
-}
-
-
-sub fetch_result_set {
- my ($self, $sth, $sth_attr) = @_;
- my %meta;
- eval {
- @meta{ @$sth_attr } = $sth->FETCH_many(@$sth_attr);
- # we assume @$sth_attr contains NUM_OF_FIELDS
- $meta{rowset} = $sth->fetchall_arrayref()
- if (($meta{NUM_OF_FIELDS}||0) > 0); # is SELECT
- # the fetchall_arrayref may fail with a 'not executed' kind of error
- # because gather_sth_resultsets/fetch_result_set are called even if
- # execute() failed, or even if there was no execute() call at all.
- # The corresponding error goes into the resultset err, not the top-level
- # response err, so in most cases this resultset err is never noticed.
- };
- if ($@) {
- chomp $@;
- $meta{err} = $DBI::err || 1;
- $meta{errstr} = $DBI::errstr || $@;
- $meta{state} = $DBI::state;
- }
- return \%meta;
-}
-
-
-sub _get_default_methods {
- my ($dbh) = @_;
- # returns a ref to a hash of dbh method names for methods which the driver
- # hasn't overridden i.e., quote(). These don't need to be forwarded via gofer.
- my $ImplementorClass = $dbh->{ImplementorClass} or die;
- my %default_methods;
- for my $method (@all_dbh_methods) {
- my $dbi_sub = $all_dbh_methods{$method} || 42;
- my $imp_sub = $ImplementorClass->can($method) || 42;
- next if $imp_sub != $dbi_sub;
- #warn("default $method\n");
- $default_methods{$method} = 1;
- }
- return \%default_methods;
-}
-
-
-# XXX would be nice to make this a generic DBI module
-sub _install_rand_callbacks {
- my ($self, $dbh, $dbi_gofer_random) = @_;
-
- my $callbacks = $dbh->{Callbacks} || {};
- my $prev = $dbh->{private_gofer_rand_fail_callbacks} || {};
-
- # return if we've already setup this handle with callbacks for these specs
- return if (($callbacks->{_dbi_gofer_random_spec}||'') eq $dbi_gofer_random);
- #warn "$dbh # $callbacks->{_dbi_gofer_random_spec}";
- $callbacks->{_dbi_gofer_random_spec} = $dbi_gofer_random;
-
- my ($fail_percent, $fail_err, $delay_percent, $delay_duration, %spec_part, @spec_note);
- my @specs = split /,/, $dbi_gofer_random;
- for my $spec (@specs) {
- if ($spec =~ m/^fail=(-?[.\d]+)%?$/) {
- $fail_percent = $1;
- $spec_part{fail} = $spec;
- next;
- }
- if ($spec =~ m/^err=(-?\d+)$/) {
- $fail_err = $1;
- $spec_part{err} = $spec;
- next;
- }
- if ($spec =~ m/^delay([.\d]+)=(-?[.\d]+)%?$/) {
- $delay_duration = $1;
- $delay_percent = $2;
- $spec_part{delay} = $spec;
- next;
- }
- elsif ($spec !~ m/^(\w+|\*)$/) {
- warn "Ignored DBI_GOFER_RANDOM item '$spec' which isn't a config or a dbh method name";
- next;
- }
-
- my $method = $spec;
- if ($callbacks->{$method} && $prev->{$method} && $callbacks->{$method} != $prev->{$method}) {
- warn "Callback for $method method already installed so DBI_GOFER_RANDOM callback not installed\n";
- next;
- }
- unless (defined $fail_percent or defined $delay_percent) {
- warn "Ignored DBI_GOFER_RANDOM item '$spec' because not preceded by 'fail=N' and/or 'delayN=N'";
- next;
- }
-
- push @spec_note, join(",", values(%spec_part), $method);
- $callbacks->{$method} = $self->_mk_rand_callback($method, $fail_percent, $delay_percent, $delay_duration, $fail_err);
- }
- warn "DBI_GOFER_RANDOM failures/delays enabled: @spec_note\n"
- if @spec_note;
- $dbh->{Callbacks} = $callbacks;
- $dbh->{private_gofer_rand_fail_callbacks} = $callbacks;
-}
-
-my %_mk_rand_callback_seqn;
-
-sub _mk_rand_callback {
- my ($self, $method, $fail_percent, $delay_percent, $delay_duration, $fail_err) = @_;
- my ($fail_modrate, $delay_modrate);
- $fail_percent ||= 0; $fail_modrate = int(1/(-$fail_percent )*100) if $fail_percent;
- $delay_percent ||= 0; $delay_modrate = int(1/(-$delay_percent)*100) if $delay_percent;
- # note that $method may be "*" but that's not recommended or documented or wise
- return sub {
- my ($h) = @_;
- my $seqn = ++$_mk_rand_callback_seqn{$method};
- my $delay = ($delay_percent > 0) ? rand(100) < $delay_percent :
- ($delay_percent < 0) ? !($seqn % $delay_modrate): 0;
- my $fail = ($fail_percent > 0) ? rand(100) < $fail_percent :
- ($fail_percent < 0) ? !($seqn % $fail_modrate) : 0;
- #no warnings 'uninitialized';
- #warn "_mk_rand_callback($fail_percent:$fail_modrate, $delay_percent:$delay_modrate): seqn=$seqn fail=$fail delay=$delay";
- if ($delay) {
- my $msg = "DBI_GOFER_RANDOM delaying execution of $method() by $delay_duration seconds\n";
- # Note what's happening in a trace message. If the delay percent is an even
- # number then use warn() instead so it's sent back to the client.
- ($delay_percent % 2 == 1) ? warn($msg) : $h->trace_msg($msg);
- select undef, undef, undef, $delay_duration; # allows floating point value
- }
- if ($fail) {
- undef $_; # tell DBI to not call the method
- # the "induced by DBI_GOFER_RANDOM" is special and must be included in errstr
- # as it's checked for in a few places, such as the gofer retry logic
- return $h->set_err($fail_err || $DBI::stderr,
- "fake error from $method method induced by DBI_GOFER_RANDOM env var ($fail_percent%)");
- }
- return;
- }
-}
-
-
-sub update_stats {
- my ($self,
- $request, $response,
- $frozen_request, $frozen_response,
- $time_received,
- $store_meta, $other_meta,
- ) = @_;
-
- # should always have a response object here
- carp("No response object provided") unless $request;
-
- my $stats = $self->{stats};
- $stats->{frozen_request_max_bytes} = length($frozen_request)
- if $frozen_request
- && length($frozen_request) > ($stats->{frozen_request_max_bytes}||0);
- $stats->{frozen_response_max_bytes} = length($frozen_response)
- if $frozen_response
- && length($frozen_response) > ($stats->{frozen_response_max_bytes}||0);
-
- my $recent;
- if (my $track_recent = $self->{track_recent}) {
- $recent = {
- request => $frozen_request,
- response => $frozen_response,
- time_received => $time_received,
- duration => dbi_time()-$time_received,
- # for any other info
- ($store_meta) ? (meta => $store_meta) : (),
- };
- $recent->{request_object} = $request
- if !$frozen_request && $request;
- $recent->{response_object} = $response
- if !$frozen_response;
- my @queues = ($stats->{recent_requests} ||= []);
- push @queues, ($stats->{recent_errors} ||= [])
- if !$response or $response->err;
- for my $queue (@queues) {
- push @$queue, $recent;
- shift @$queue if @$queue > $track_recent;
- }
- }
- return $recent;
-}
-
-
-1;
-__END__
-
-=head1 NAME
-
-DBI::Gofer::Execute - Executes Gofer requests and returns Gofer responses
-
-=head1 SYNOPSIS
-
- $executor = DBI::Gofer::Execute->new( { ...config... });
-
- $response = $executor->execute_request( $request );
-
-=head1 DESCRIPTION
-
-Accepts a DBI::Gofer::Request object, executes the requested DBI method calls,
-and returns a DBI::Gofer::Response object.
-
-Any error, including any internal 'fatal' errors are caught and converted into
-a DBI::Gofer::Response object.
-
-This module is usually invoked by a 'server-side' Gofer transport module.
-They usually have names in the "C<DBI::Gofer::Transport::*>" namespace.
-Examples include: L<DBI::Gofer::Transport::stream> and L<DBI::Gofer::Transport::mod_perl>.
-
-=head1 CONFIGURATION
-
-=head2 check_request_sub
-
-If defined, it must be a reference to a subroutine that will 'check' the request.
-It is passed the request object and the executor as its only arguments.
-
-The subroutine can either return the original request object or die with a
-suitable error message (which will be turned into a Gofer response).
-
-It can also construct and return a new request that should be executed instead
-of the original request.
-
-=head2 check_response_sub
-
-If defined, it must be a reference to a subroutine that will 'check' the response.
-It is passed the response object, the executor, and the request object.
-The sub may alter the response object and return undef, or return a new response object.
-
-This mechanism can be used to, for example, terminate the service if specific
-database errors are seen.
-
-=head2 forced_connect_dsn
-
-If set, this DSN is always used instead of the one in the request.
-
-=head2 default_connect_dsn
-
-If set, this DSN is used if C<forced_connect_dsn> is not set and the request does not contain a DSN itself.
-
-=head2 forced_connect_attributes
-
-A reference to a hash of connect() attributes. Individual attributes in
-C<forced_connect_attributes> will take precedence over corresponding attributes
-in the request.
-
-=head2 default_connect_attributes
-
-A reference to a hash of connect() attributes. Individual attributes in the
-request take precedence over corresponding attributes in C<default_connect_attributes>.
-
-=head2 max_cached_dbh_per_drh
-
-If set, the loaded drivers will be checked to ensure they don't have more than
-this number of cached connections. There is no default value. This limit is not
-enforced for every request.
-
-=head2 max_cached_sth_per_dbh
-
-If set, all the cached statement handles will be cleared once the number of
-cached statement handles rises above this limit. The default is 1000.
-
-=head2 forced_single_resultset
-
-If true, then only the first result set will be fetched and returned in the response.
-
-=head2 forced_response_attributes
-
-A reference to a data structure that can specify extra attributes to be returned in responses.
-
- forced_response_attributes => {
- DriverName => {
- dbh => [ qw(dbh_attrib_name) ],
- sth => [ qw(sth_attrib_name) ],
- },
- },
-
-This can be useful in cases where the driver has not implemented the
-private_attribute_info() method and DBI::Gofer::Execute's own fallback list of
-private attributes doesn't include the driver or attributes you need.
-
-=head2 track_recent
-
-If set, specifies the number of recent requests and responses that should be
-kept by the update_stats() method for diagnostics. See L<DBI::Gofer::Transport::mod_perl>.
-
-Note that this setting can significantly increase memory use. Use with caution.
-
-=head2 forced_gofer_random
-
-Enable forced random failures and/or delays for testing. See L</DBI_GOFER_RANDOM> below.
-
-=head1 DRIVER-SPECIFIC ISSUES
-
-Gofer needs to know about any driver-private attributes that should have their
-values sent back to the client.
-
-If the driver doesn't support private_attribute_info() method, and very few do,
-then the module fallsback to using some hard-coded details, if available, for
-the driver being used. Currently hard-coded details are available for the
-mysql, Pg, Sybase, and SQLite drivers.
-
-=head1 TESTING
-
-DBD::Gofer, DBD::Execute and related packages are well tested by executing the
-DBI test suite with DBI_AUTOPROXY configured to route all DBI calls via DBD::Gofer.
-
-Because Gofer includes timeout and 'retry on error' mechanisms there is a need
-for some way to trigger delays and/or errors. This can be done via the
-C<forced_gofer_random> configuration item, or else the DBI_GOFER_RANDOM environment
-variable.
-
-=head2 DBI_GOFER_RANDOM
-
-The value of the C<forced_gofer_random> configuration item (or else the
-DBI_GOFER_RANDOM environment variable) is treated as a series of tokens
-separated by commas.
-
-The tokens can be one of three types:
-
-=over 4
-
-=item fail=R%
-
-Set the current failure rate to R where R is a percentage.
-The value R can be floating point, e.g., C<fail=0.05%>.
-Negative values for R have special meaning, see below.
-
-=item err=N
-
-Sets the current failure err value to N (instead of the DBI's default 'standard
-err value' of 2000000000). This is useful when you want to simulate a
-specific error.
-
-=item delayN=R%
-
-Set the current random delay rate to R where R is a percentage, and set the
-current delay duration to N seconds. The values of R and N can be floating point,
-e.g., C<delay0.5=0.2%>. Negative values for R have special meaning, see below.
-
-If R is an odd number (R % 2 == 1) then a message is logged via warn() which
-will be returned to, and echoed at, the client.
-
-=item methodname
-
-Applies the current fail, err, and delay values to the named method.
-If neither a fail nor delay have been set yet then a warning is generated.
-
-=back
-
-For example:
-
- $executor = DBI::Gofer::Execute->new( {
- forced_gofer_random => "fail=0.01%,do,delay60=1%,execute",
- });
-
-will cause the do() method to fail for 0.01% of calls, and the execute() method to
-fail 0.01% of calls and be delayed by 60 seconds on 1% of calls.
-
-If the percentage value (C<R>) is negative then instead of the failures being
-triggered randomly (via the rand() function) they are triggered via a sequence
-number. In other words "C<fail=-20%>" will mean every fifth call will fail.
-Each method has a distinct sequence number.
-
-=head1 AUTHOR
-
-Tim Bunce, L<http://www.tim.bunce.name>
-
-=head1 LICENCE AND COPYRIGHT
-
-Copyright (c) 2007, Tim Bunce, Ireland. All rights reserved.
-
-This module is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself. See L<perlartistic>.
-
-=cut
+++ /dev/null
-package DBI::Gofer::Request;
-
-# $Id: Request.pm 12536 2009-02-24 22:37:09Z Tim $
-#
-# Copyright (c) 2007, Tim Bunce, Ireland
-#
-# You may distribute under the terms of either the GNU General Public
-# License or the Artistic License, as specified in the Perl README file.
-
-use strict;
-
-use DBI qw(neat neat_list);
-
-use base qw(DBI::Util::_accessor);
-
-our $VERSION = "0.012537";
-
-use constant GOf_REQUEST_IDEMPOTENT => 0x0001;
-use constant GOf_REQUEST_READONLY => 0x0002;
-
-our @EXPORT = qw(GOf_REQUEST_IDEMPOTENT GOf_REQUEST_READONLY);
-
-
-__PACKAGE__->mk_accessors(qw(
- version
- flags
- dbh_connect_call
- dbh_method_call
- dbh_attributes
- dbh_last_insert_id_args
- sth_method_calls
- sth_result_attr
-));
-__PACKAGE__->mk_accessors_using(make_accessor_autoviv_hashref => qw(
- meta
-));
-
-
-sub new {
- my ($self, $args) = @_;
- $args->{version} ||= $VERSION;
- return $self->SUPER::new($args);
-}
-
-
-sub reset {
- my ($self, $flags) = @_;
- # remove everything except connect and version
- %$self = (
- version => $self->{version},
- dbh_connect_call => $self->{dbh_connect_call},
- );
- $self->{flags} = $flags if $flags;
-}
-
-
-sub init_request {
- my ($self, $method_and_args, $dbh) = @_;
- $self->reset( $dbh->{ReadOnly} ? GOf_REQUEST_READONLY : 0 );
- $self->dbh_method_call($method_and_args);
-}
-
-
-sub is_sth_request {
- return shift->{sth_result_attr};
-}
-
-
-sub statements {
- my $self = shift;
- my @statements;
- if (my $dbh_method_call = $self->dbh_method_call) {
- my $statement_method_regex = qr/^(?:do|prepare)$/;
- my (undef, $method, $arg1) = @$dbh_method_call;
- push @statements, $arg1 if $method && $method =~ $statement_method_regex;
- }
- return @statements;
-}
-
-
-sub is_idempotent {
- my $self = shift;
-
- if (my $flags = $self->flags) {
- return 1 if $flags & (GOf_REQUEST_IDEMPOTENT|GOf_REQUEST_READONLY);
- }
-
- # else check if all statements are SELECT statement that don't include FOR UPDATE
- my @statements = $self->statements;
- # XXX this is very minimal for now, doesn't even allow comments before the select
- # (and can't ever work for "exec stored_procedure_name" kinds of statements)
- # XXX it also doesn't deal with multiple statements: prepare("select foo; update bar")
- return 1 if @statements == grep {
- m/^ \s* SELECT \b /xmsi && !m/ \b FOR \s+ UPDATE \b /xmsi
- } @statements;
-
- return 0;
-}
-
-
-sub summary_as_text {
- my $self = shift;
- my ($context) = @_;
- my @s = '';
-
- if ($context && %$context) {
- my @keys = sort keys %$context;
- push @s, join(", ", map { "$_=>".$context->{$_} } @keys);
- }
-
- my ($method, $dsn, $user, $pass, $attr) = @{ $self->dbh_connect_call };
- $method ||= 'connect_cached';
- $pass = '***' if defined $pass;
- my $tmp = '';
- if ($attr) {
- $tmp = { %{$attr||{}} }; # copy so we can edit
- $tmp->{Password} = '***' if exists $tmp->{Password};
- $tmp = "{ ".neat_list([ %$tmp ])." }";
- }
- push @s, sprintf "dbh= $method(%s, %s)", neat_list([$dsn, $user, $pass]), $tmp;
-
- if (my $flags = $self->flags) {
- push @s, sprintf "flags: 0x%x", $flags;
- }
-
- if (my $dbh_attr = $self->dbh_attributes) {
- push @s, sprintf "dbh->FETCH: %s", @$dbh_attr
- if @$dbh_attr;
- }
-
- my ($wantarray, $meth, @args) = @{ $self->dbh_method_call };
- my $args = neat_list(\@args);
- $args =~ s/\n+/ /g;
- push @s, sprintf "dbh->%s(%s)", $meth, $args;
-
- if (my $lii_args = $self->dbh_last_insert_id_args) {
- push @s, sprintf "dbh->last_insert_id(%s)", neat_list($lii_args);
- }
-
- for my $call (@{ $self->sth_method_calls || [] }) {
- my ($meth, @args) = @$call;
- ($args = neat_list(\@args)) =~ s/\n+/ /g;
- push @s, sprintf "sth->%s(%s)", $meth, $args;
- }
-
- if (my $sth_attr = $self->sth_result_attr) {
- push @s, sprintf "sth->FETCH: %s", %$sth_attr
- if %$sth_attr;
- }
-
- return join("\n\t", @s) . "\n";
-}
-
-
-sub outline_as_text { # one-line version of summary_as_text
- my $self = shift;
- my @s = '';
- my $neatlen = 80;
-
- if (my $flags = $self->flags) {
- push @s, sprintf "flags=0x%x", $flags;
- }
-
- my (undef, $meth, @args) = @{ $self->dbh_method_call };
- push @s, sprintf "%s(%s)", $meth, neat_list(\@args, $neatlen);
-
- for my $call (@{ $self->sth_method_calls || [] }) {
- my ($meth, @args) = @$call;
- push @s, sprintf "%s(%s)", $meth, neat_list(\@args, $neatlen);
- }
-
- my ($method, $dsn) = @{ $self->dbh_connect_call };
- push @s, "$method($dsn,...)"; # dsn last as it's usually less interesting
-
- (my $outline = join("; ", @s)) =~ s/\s+/ /g; # squish whitespace, incl newlines
- return $outline;
-}
-
-1;
-
-=head1 NAME
-
-DBI::Gofer::Request - Encapsulate a request from DBD::Gofer to DBI::Gofer::Execute
-
-=head1 DESCRIPTION
-
-This is an internal class.
-
-=head1 AUTHOR
-
-Tim Bunce, L<http://www.tim.bunce.name>
-
-=head1 LICENCE AND COPYRIGHT
-
-Copyright (c) 2007, Tim Bunce, Ireland. All rights reserved.
-
-This module is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself. See L<perlartistic>.
-
-=cut
+++ /dev/null
-package DBI::Gofer::Response;
-
-# $Id: Response.pm 11565 2008-07-22 20:17:33Z Tim $
-#
-# Copyright (c) 2007, Tim Bunce, Ireland
-#
-# You may distribute under the terms of either the GNU General Public
-# License or the Artistic License, as specified in the Perl README file.
-
-use strict;
-
-use Carp;
-use DBI qw(neat neat_list);
-
-use base qw(DBI::Util::_accessor Exporter);
-
-our $VERSION = "0.011566";
-
-use constant GOf_RESPONSE_EXECUTED => 0x0001;
-
-our @EXPORT = qw(GOf_RESPONSE_EXECUTED);
-
-
-__PACKAGE__->mk_accessors(qw(
- version
- rv
- err
- errstr
- state
- flags
- last_insert_id
- dbh_attributes
- sth_resultsets
- warnings
-));
-__PACKAGE__->mk_accessors_using(make_accessor_autoviv_hashref => qw(
- meta
-));
-
-
-sub new {
- my ($self, $args) = @_;
- $args->{version} ||= $VERSION;
- chomp $args->{errstr} if $args->{errstr};
- return $self->SUPER::new($args);
-}
-
-
-sub err_errstr_state {
- my $self = shift;
- return @{$self}{qw(err errstr state)};
-}
-
-sub executed_flag_set {
- my $flags = shift->flags
- or return 0;
- return $flags & GOf_RESPONSE_EXECUTED;
-}
-
-
-sub add_err {
- my ($self, $err, $errstr, $state, $trace) = @_;
-
- # acts like the DBI's set_err method.
- # this code copied from DBI::PurePerl's set_err method.
-
- chomp $errstr if $errstr;
- $state ||= '';
- carp ref($self)."->add_err($err, $errstr, $state)"
- if $trace and defined($err) || $errstr;
-
- my ($r_err, $r_errstr, $r_state) = ($self->{err}, $self->{errstr}, $self->{state});
-
- if ($r_errstr) {
- $r_errstr .= sprintf " [err was %s now %s]", $r_err, $err
- if $r_err && $err && $r_err ne $err;
- $r_errstr .= sprintf " [state was %s now %s]", $r_state, $state
- if $r_state and $r_state ne "S1000" && $state && $r_state ne $state;
- $r_errstr .= "\n$errstr" if $r_errstr ne $errstr;
- }
- else {
- $r_errstr = $errstr;
- }
-
- # assign if higher priority: err > "0" > "" > undef
- my $err_changed;
- if ($err # new error: so assign
- or !defined $r_err # no existing warn/info: so assign
- # new warn ("0" len 1) > info ("" len 0): so assign
- or defined $err && length($err) > length($r_err)
- ) {
- $r_err = $err;
- ++$err_changed;
- }
-
- $r_state = ($state eq "00000") ? "" : $state
- if $state && $err_changed;
-
- ($self->{err}, $self->{errstr}, $self->{state}) = ($r_err, $r_errstr, $r_state);
-
- return undef;
-}
-
-
-sub summary_as_text {
- my $self = shift;
- my ($context) = @_;
-
- my ($rv, $err, $errstr, $state) = ($self->{rv}, $self->{err}, $self->{errstr}, $self->{state});
-
- my @s = sprintf("\trv=%s", (ref $rv) ? "[".neat_list($rv)."]" : neat($rv));
- $s[-1] .= sprintf(", err=%s, errstr=%s", $err, neat($errstr))
- if defined $err;
- $s[-1] .= sprintf(", flags=0x%x", $self->{flags})
- if defined $self->{flags};
-
- push @s, "last_insert_id=%s", $self->last_insert_id
- if defined $self->last_insert_id;
-
- if (my $dbh_attr = $self->dbh_attributes) {
- my @keys = sort keys %$dbh_attr;
- push @s, sprintf "dbh= { %s }", join(", ", map { "$_=>".neat($dbh_attr->{$_},100) } @keys)
- if @keys;
- }
-
- for my $rs (@{$self->sth_resultsets || []}) {
- my ($rowset, $err, $errstr, $state)
- = @{$rs}{qw(rowset err errstr state)};
- my $summary = "rowset: ";
- my $NUM_OF_FIELDS = $rs->{NUM_OF_FIELDS} || 0;
- my $rows = $rowset ? @$rowset : 0;
- if ($rowset || $NUM_OF_FIELDS > 0) {
- $summary .= sprintf "%d rows, %d columns", $rows, $NUM_OF_FIELDS;
- }
- $summary .= sprintf ", err=%s, errstr=%s", $err, neat($errstr) if defined $err;
- if ($rows) {
- my $NAME = $rs->{NAME};
- # generate
- my @colinfo = map { "$NAME->[$_]=".neat($rowset->[0][$_], 30) } 0..@{$NAME}-1;
- $summary .= sprintf " [%s]", join ", ", @colinfo;
- $summary .= ",..." if $rows > 1;
- # we can be a little more helpful for Sybase/MSSQL user
- $summary .= " syb_result_type=$rs->{syb_result_type}"
- if $rs->{syb_result_type} and $rs->{syb_result_type} != 4040;
- }
- push @s, $summary;
- }
- for my $w (@{$self->warnings || []}) {
- chomp $w;
- push @s, "warning: $w";
- }
- if ($context && %$context) {
- my @keys = sort keys %$context;
- push @s, join(", ", map { "$_=>".$context->{$_} } @keys);
- }
- return join("\n\t", @s). "\n";
-}
-
-
-sub outline_as_text { # one-line version of summary_as_text
- my $self = shift;
- my ($context) = @_;
-
- my ($rv, $err, $errstr, $state) = ($self->{rv}, $self->{err}, $self->{errstr}, $self->{state});
-
- my $s = sprintf("rv=%s", (ref $rv) ? "[".neat_list($rv)."]" : neat($rv));
- $s .= sprintf(", err=%s %s", $err, neat($errstr))
- if defined $err;
- $s .= sprintf(", flags=0x%x", $self->{flags})
- if $self->{flags};
-
- if (my $sth_resultsets = $self->sth_resultsets) {
- $s .= sprintf(", %d resultsets ", scalar @$sth_resultsets);
-
- my @rs;
- for my $rs (@{$self->sth_resultsets || []}) {
- my $summary = "";
- my ($rowset, $err, $errstr)
- = @{$rs}{qw(rowset err errstr)};
- my $NUM_OF_FIELDS = $rs->{NUM_OF_FIELDS} || 0;
- my $rows = $rowset ? @$rowset : 0;
- if ($rowset || $NUM_OF_FIELDS > 0) {
- $summary .= sprintf "%dr x %dc", $rows, $NUM_OF_FIELDS;
- }
- $summary .= sprintf "%serr %s %s", ($summary?", ":""), $err, neat($errstr)
- if defined $err;
- push @rs, $summary;
- }
- $s .= join "; ", map { "[$_]" } @rs;
- }
-
- return $s;
-}
-
-
-1;
-
-=head1 NAME
-
-DBI::Gofer::Response - Encapsulate a response from DBI::Gofer::Execute to DBD::Gofer
-
-=head1 DESCRIPTION
-
-This is an internal class.
-
-=head1 AUTHOR
-
-Tim Bunce, L<http://www.tim.bunce.name>
-
-=head1 LICENCE AND COPYRIGHT
-
-Copyright (c) 2007, Tim Bunce, Ireland. All rights reserved.
-
-This module is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself. See L<perlartistic>.
-
-=cut
-
+++ /dev/null
-package DBI::Gofer::Serializer::Base;
-
-# $Id: Base.pm 9949 2007-09-18 09:38:15Z Tim $
-#
-# Copyright (c) 2007, Tim Bunce, Ireland
-#
-# You may distribute under the terms of either the GNU General Public
-# License or the Artistic License, as specified in the Perl README file.
-
-=head1 NAME
-
-DBI::Gofer::Serializer::Base - base class for Gofer serialization
-
-=head1 SYNOPSIS
-
- $serializer = $serializer_class->new();
-
- $string = $serializer->serialize( $data );
- ($string, $deserializer_class) = $serializer->serialize( $data );
-
- $data = $serializer->deserialize( $string );
-
-=head1 DESCRIPTION
-
-DBI::Gofer::Serializer::* classes implement a very minimal subset of the L<Data::Serializer> API.
-
-Gofer serializers are expected to be very fast and are not required to deal
-with anything other than non-blessed references to arrays and hashes, and plain scalars.
-
-=cut
-
-
-use strict;
-use warnings;
-
-use Carp qw(croak);
-
-our $VERSION = "0.009950";
-
-
-sub new {
- my $class = shift;
- my $deserializer_class = $class->deserializer_class;
- return bless { deserializer_class => $deserializer_class } => $class;
-}
-
-sub deserializer_class {
- my $self = shift;
- my $class = ref($self) || $self;
- $class =~ s/^DBI::Gofer::Serializer:://;
- return $class;
-}
-
-sub serialize {
- my $self = shift;
- croak ref($self)." has not implemented the serialize method";
-}
-
-sub deserialize {
- my $self = shift;
- croak ref($self)." has not implemented the deserialize method";
-}
-
-1;
+++ /dev/null
-package DBI::Gofer::Serializer::DataDumper;
-
-use strict;
-use warnings;
-
-our $VERSION = "0.009950";
-
-# $Id: DataDumper.pm 9949 2007-09-18 09:38:15Z Tim $
-#
-# Copyright (c) 2007, Tim Bunce, Ireland
-#
-# You may distribute under the terms of either the GNU General Public
-# License or the Artistic License, as specified in the Perl README file.
-
-=head1 NAME
-
-DBI::Gofer::Serializer::DataDumper - Gofer serialization using DataDumper
-
-=head1 SYNOPSIS
-
- $serializer = DBI::Gofer::Serializer::DataDumper->new();
-
- $string = $serializer->serialize( $data );
-
-=head1 DESCRIPTION
-
-Uses DataDumper to serialize. Deserialization is not supported.
-The output of this class is only meant for human consumption.
-
-See also L<DBI::Gofer::Serializer::Base>.
-
-=cut
-
-use Data::Dumper;
-
-use base qw(DBI::Gofer::Serializer::Base);
-
-
-sub serialize {
- my $self = shift;
- local $Data::Dumper::Indent = 1;
- local $Data::Dumper::Terse = 1;
- local $Data::Dumper::Useqq = 0; # enabling this disables xs
- local $Data::Dumper::Sortkeys = 1;
- local $Data::Dumper::Quotekeys = 0;
- local $Data::Dumper::Deparse = 0;
- local $Data::Dumper::Purity = 0;
- my $frozen = Data::Dumper::Dumper(shift);
- return $frozen unless wantarray;
- return ($frozen, $self->{deserializer_class});
-}
-
-1;
+++ /dev/null
-package DBI::Gofer::Serializer::Storable;
-
-use strict;
-use warnings;
-
-use base qw(DBI::Gofer::Serializer::Base);
-
-# $Id: Storable.pm 15585 2013-03-22 20:31:22Z Tim $
-#
-# Copyright (c) 2007, Tim Bunce, Ireland
-#
-# You may distribute under the terms of either the GNU General Public
-# License or the Artistic License, as specified in the Perl README file.
-
-=head1 NAME
-
-DBI::Gofer::Serializer::Storable - Gofer serialization using Storable
-
-=head1 SYNOPSIS
-
- $serializer = DBI::Gofer::Serializer::Storable->new();
-
- $string = $serializer->serialize( $data );
- ($string, $deserializer_class) = $serializer->serialize( $data );
-
- $data = $serializer->deserialize( $string );
-
-=head1 DESCRIPTION
-
-Uses Storable::nfreeze() to serialize and Storable::thaw() to deserialize.
-
-The serialize() method sets local $Storable::forgive_me = 1; so it doesn't
-croak if it encounters any data types that can't be serialized, such as code refs.
-
-See also L<DBI::Gofer::Serializer::Base>.
-
-=cut
-
-use Storable qw(nfreeze thaw);
-
-our $VERSION = "0.015586";
-
-use base qw(DBI::Gofer::Serializer::Base);
-
-
-sub serialize {
- my $self = shift;
- local $Storable::forgive_me = 1; # for CODE refs etc
- local $Storable::canonical = 1; # for go_cache
- my $frozen = nfreeze(shift);
- return $frozen unless wantarray;
- return ($frozen, $self->{deserializer_class});
-}
-
-sub deserialize {
- my $self = shift;
- return thaw(shift);
-}
-
-1;
+++ /dev/null
-package DBI::Gofer::Transport::Base;
-
-# $Id: Base.pm 12536 2009-02-24 22:37:09Z Tim $
-#
-# Copyright (c) 2007, Tim Bunce, Ireland
-#
-# You may distribute under the terms of either the GNU General Public
-# License or the Artistic License, as specified in the Perl README file.
-
-use strict;
-use warnings;
-
-use DBI;
-
-use base qw(DBI::Util::_accessor);
-
-use DBI::Gofer::Serializer::Storable;
-use DBI::Gofer::Serializer::DataDumper;
-
-our $VERSION = "0.012537";
-
-__PACKAGE__->mk_accessors(qw(
- trace
- keep_meta_frozen
- serializer_obj
-));
-
-
-# see also $ENV{DBI_GOFER_TRACE} in DBI::Gofer::Execute
-sub _init_trace { (split(/=/,$ENV{DBI_GOFER_TRACE}||0))[0] }
-
-
-sub new {
- my ($class, $args) = @_;
- $args->{trace} ||= $class->_init_trace;
- $args->{serializer_obj} ||= DBI::Gofer::Serializer::Storable->new();
- my $self = bless {}, $class;
- $self->$_( $args->{$_} ) for keys %$args;
- $self->trace_msg("$class->new({ @{[ %$args ]} })\n") if $self->trace;
- return $self;
-}
-
-my $packet_header_text = "GoFER1:";
-my $packet_header_regex = qr/^GoFER(\d+):/;
-
-
-sub _freeze_data {
- my ($self, $data, $serializer, $skip_trace) = @_;
- my $frozen = eval {
- $self->_dump("freezing $self->{trace} ".ref($data), $data)
- if !$skip_trace and $self->trace;
-
- local $data->{meta}; # don't include meta in serialization
- $serializer ||= $self->{serializer_obj};
- my ($data, $deserializer_class) = $serializer->serialize($data);
-
- $packet_header_text . $data;
- };
- if ($@) {
- chomp $@;
- die "Error freezing ".ref($data)." object: $@";
- }
-
- # stash the frozen data into the data structure itself
- # to make life easy for the client caching code in DBD::Gofer::Transport::Base
- $data->{meta}{frozen} = $frozen if $self->keep_meta_frozen;
-
- return $frozen;
-}
-# public aliases used by subclasses
-*freeze_request = \&_freeze_data;
-*freeze_response = \&_freeze_data;
-
-
-sub _thaw_data {
- my ($self, $frozen_data, $serializer, $skip_trace) = @_;
- my $data;
- eval {
- # check for and extract our gofer header and the info it contains
- (my $frozen = $frozen_data) =~ s/$packet_header_regex//o
- or die "does not have gofer header\n";
- my ($t_version) = $1;
- $serializer ||= $self->{serializer_obj};
- $data = $serializer->deserialize($frozen);
- die ref($serializer)."->deserialize didn't return a reference"
- unless ref $data;
- $data->{_transport}{version} = $t_version;
-
- $data->{meta}{frozen} = $frozen_data if $self->keep_meta_frozen;
- };
- if ($@) {
- chomp(my $err = $@);
- # remove extra noise from Storable
- $err =~ s{ at \S+?/Storable.pm \(autosplit into \S+?/Storable/thaw.al\) line \d+(, \S+ line \d+)?}{};
- my $msg = sprintf "Error thawing: %s (data=%s)", $err, DBI::neat($frozen_data,50);
- Carp::cluck("$msg, pid $$ stack trace follows:"); # XXX if $self->trace;
- die $msg;
- }
- $self->_dump("thawing $self->{trace} ".ref($data), $data)
- if !$skip_trace and $self->trace;
-
- return $data;
-}
-# public aliases used by subclasses
-*thaw_request = \&_thaw_data;
-*thaw_response = \&_thaw_data;
-
-
-# this should probably live in the request and response classes
-# and the tace level passed in
-sub _dump {
- my ($self, $label, $data) = @_;
-
- # don't dump the binary
- local $data->{meta}{frozen} if $data->{meta} && $data->{meta}{frozen};
-
- my $trace_level = $self->trace;
- my $summary;
- if ($trace_level >= 4) {
- require Data::Dumper;
- local $Data::Dumper::Indent = 1;
- local $Data::Dumper::Terse = 1;
- local $Data::Dumper::Useqq = 0;
- local $Data::Dumper::Sortkeys = 1;
- local $Data::Dumper::Quotekeys = 0;
- local $Data::Dumper::Deparse = 0;
- local $Data::Dumper::Purity = 0;
- $summary = Data::Dumper::Dumper($data);
- }
- elsif ($trace_level >= 2) {
- $summary = eval { $data->summary_as_text } || $@ || "no summary available\n";
- }
- else {
- $summary = eval { $data->outline_as_text."\n" } || $@ || "no summary available\n";
- }
- $self->trace_msg("$label: $summary");
-}
-
-
-sub trace_msg {
- my ($self, $msg, $min_level) = @_;
- $min_level = 1 unless defined $min_level;
- # transport trace level can override DBI's trace level
- $min_level = 0 if $self->trace >= $min_level;
- return DBI->trace_msg("gofer ".$msg, $min_level);
-}
-
-1;
-
-=head1 NAME
-
-DBI::Gofer::Transport::Base - Base class for Gofer transports
-
-=head1 DESCRIPTION
-
-This is the base class for server-side Gofer transports.
-
-It's also the base class for the client-side base class L<DBD::Gofer::Transport::Base>.
-
-This is an internal class.
-
-=head1 AUTHOR
-
-Tim Bunce, L<http://www.tim.bunce.name>
-
-=head1 LICENCE AND COPYRIGHT
-
-Copyright (c) 2007, Tim Bunce, Ireland. All rights reserved.
-
-This module is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself. See L<perlartistic>.
-
-=cut
-
+++ /dev/null
-package DBI::Gofer::Transport::pipeone;
-
-# $Id: pipeone.pm 12536 2009-02-24 22:37:09Z Tim $
-#
-# Copyright (c) 2007, Tim Bunce, Ireland
-#
-# You may distribute under the terms of either the GNU General Public
-# License or the Artistic License, as specified in the Perl README file.
-
-use strict;
-use warnings;
-
-use DBI::Gofer::Execute;
-
-use base qw(DBI::Gofer::Transport::Base Exporter);
-
-our $VERSION = "0.012537";
-
-our @EXPORT = qw(run_one_stdio);
-
-my $executor = DBI::Gofer::Execute->new();
-
-sub run_one_stdio {
-
- binmode STDIN;
- binmode STDOUT;
-
- my $transport = DBI::Gofer::Transport::pipeone->new();
-
- my $frozen_request = do { local $/; <STDIN> };
-
- my $response = $executor->execute_request( $transport->thaw_request($frozen_request) );
-
- my $frozen_response = $transport->freeze_response($response);
-
- print $frozen_response;
-
- # no point calling $executor->update_stats(...) for pipeONE
-}
-
-1;
-__END__
-
-=head1 NAME
-
-DBI::Gofer::Transport::pipeone - DBD::Gofer server-side transport for pipeone
-
-=head1 SYNOPSIS
-
-See L<DBD::Gofer::Transport::pipeone>.
-
-=head1 AUTHOR
-
-Tim Bunce, L<http://www.tim.bunce.name>
-
-=head1 LICENCE AND COPYRIGHT
-
-Copyright (c) 2007, Tim Bunce, Ireland. All rights reserved.
-
-This module is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself. See L<perlartistic>.
-
-=cut
-
+++ /dev/null
-package DBI::Gofer::Transport::stream;
-
-# $Id: stream.pm 12536 2009-02-24 22:37:09Z Tim $
-#
-# Copyright (c) 2007, Tim Bunce, Ireland
-#
-# You may distribute under the terms of either the GNU General Public
-# License or the Artistic License, as specified in the Perl README file.
-
-use strict;
-use warnings;
-
-use DBI qw(dbi_time);
-use DBI::Gofer::Execute;
-
-use base qw(DBI::Gofer::Transport::pipeone Exporter);
-
-our $VERSION = "0.012537";
-
-our @EXPORT = qw(run_stdio_hex);
-
-my $executor = DBI::Gofer::Execute->new();
-
-sub run_stdio_hex {
-
- my $transport = DBI::Gofer::Transport::stream->new();
- local $| = 1;
-
- DBI->trace_msg("$0 started (pid $$)\n");
-
- local $\; # OUTPUT_RECORD_SEPARATOR
- local $/ = "\012"; # INPUT_RECORD_SEPARATOR
- while ( defined( my $encoded_request = <STDIN> ) ) {
- my $time_received = dbi_time();
- $encoded_request =~ s/\015?\012$//;
-
- my $frozen_request = pack "H*", $encoded_request;
- my $request = $transport->thaw_request( $frozen_request );
-
- my $response = $executor->execute_request( $request );
-
- my $frozen_response = $transport->freeze_response($response);
- my $encoded_response = unpack "H*", $frozen_response;
-
- print $encoded_response, "\015\012"; # autoflushed due to $|=1
-
- # there's no way to access the stats currently
- # so this just serves as a basic test and illustration of update_stats()
- $executor->update_stats($request, $response, $frozen_request, $frozen_response, $time_received, 1);
- }
- DBI->trace_msg("$0 ending (pid $$)\n");
-}
-
-1;
-__END__
-
-=head1 NAME
-
-DBI::Gofer::Transport::stream - DBD::Gofer server-side transport for stream
-
-=head1 SYNOPSIS
-
-See L<DBD::Gofer::Transport::stream>.
-
-=head1 AUTHOR
-
-Tim Bunce, L<http://www.tim.bunce.name>
-
-=head1 LICENCE AND COPYRIGHT
-
-Copyright (c) 2007, Tim Bunce, Ireland. All rights reserved.
-
-This module is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself. See L<perlartistic>.
-
-=cut
+++ /dev/null
-package DBI::Profile;
-
-=head1 NAME
-
-DBI::Profile - Performance profiling and benchmarking for the DBI
-
-=head1 SYNOPSIS
-
-The easiest way to enable DBI profiling is to set the DBI_PROFILE
-environment variable to 2 and then run your code as usual:
-
- DBI_PROFILE=2 prog.pl
-
-This will profile your program and then output a textual summary
-grouped by query when the program exits. You can also enable profiling by
-setting the Profile attribute of any DBI handle:
-
- $dbh->{Profile} = 2;
-
-Then the summary will be printed when the handle is destroyed.
-
-Many other values apart from are possible - see L<"ENABLING A PROFILE"> below.
-
-=head1 DESCRIPTION
-
-The DBI::Profile module provides a simple interface to collect and
-report performance and benchmarking data from the DBI.
-
-For a more elaborate interface, suitable for larger programs, see
-L<DBI::ProfileDumper|DBI::ProfileDumper> and L<dbiprof|dbiprof>.
-For Apache/mod_perl applications see
-L<DBI::ProfileDumper::Apache|DBI::ProfileDumper::Apache>.
-
-=head1 OVERVIEW
-
-Performance data collection for the DBI is built around several
-concepts which are important to understand clearly.
-
-=over 4
-
-=item Method Dispatch
-
-Every method call on a DBI handle passes through a single 'dispatch'
-function which manages all the common aspects of DBI method calls,
-such as handling the RaiseError attribute.
-
-=item Data Collection
-
-If profiling is enabled for a handle then the dispatch code takes
-a high-resolution timestamp soon after it is entered. Then, after
-calling the appropriate method and just before returning, it takes
-another high-resolution timestamp and calls a function to record
-the information. That function is passed the two timestamps
-plus the DBI handle and the name of the method that was called.
-That data about a single DBI method call is called a I<profile sample>.
-
-=item Data Filtering
-
-If the method call was invoked by the DBI or by a driver then the call is
-ignored for profiling because the time spent will be accounted for by the
-original 'outermost' call for your code.
-
-For example, the calls that the selectrow_arrayref() method makes
-to prepare() and execute() etc. are not counted individually
-because the time spent in those methods is going to be allocated
-to the selectrow_arrayref() method when it returns. If this was not
-done then it would be very easy to double count time spent inside
-the DBI.
-
-=item Data Storage Tree
-
-The profile data is accumulated as 'leaves on a tree'. The 'path' through the
-branches of the tree to a particular leaf is determined dynamically for each sample.
-This is a key feature of DBI profiling.
-
-For each profiled method call the DBI walks along the Path and uses each value
-in the Path to step into and grow the Data tree.
-
-For example, if the Path is
-
- [ 'foo', 'bar', 'baz' ]
-
-then the new profile sample data will be I<merged> into the tree at
-
- $h->{Profile}->{Data}->{foo}->{bar}->{baz}
-
-But it's not very useful to merge all the call data into one leaf node (except
-to get an overall 'time spent inside the DBI' total). It's more common to want
-the Path to include dynamic values such as the current statement text and/or
-the name of the method called to show what the time spent inside the DBI was for.
-
-The Path can contain some 'magic cookie' values that are automatically replaced
-by corresponding dynamic values when they're used. These magic cookies always
-start with a punctuation character.
-
-For example a value of 'C<!MethodName>' in the Path causes the corresponding
-entry in the Data to be the name of the method that was called.
-For example, if the Path was:
-
- [ 'foo', '!MethodName', 'bar' ]
-
-and the selectall_arrayref() method was called, then the profile sample data
-for that call will be merged into the tree at:
-
- $h->{Profile}->{Data}->{foo}->{selectall_arrayref}->{bar}
-
-=item Profile Data
-
-Profile data is stored at the 'leaves' of the tree as references
-to an array of numeric values. For example:
-
- [
- 106, # 0: count of samples at this node
- 0.0312958955764771, # 1: total duration
- 0.000490069389343262, # 2: first duration
- 0.000176072120666504, # 3: shortest duration
- 0.00140702724456787, # 4: longest duration
- 1023115819.83019, # 5: time of first sample
- 1023115819.86576, # 6: time of last sample
- ]
-
-After the first sample, later samples always update elements 0, 1, and 6, and
-may update 3 or 4 depending on the duration of the sampled call.
-
-=back
-
-=head1 ENABLING A PROFILE
-
-Profiling is enabled for a handle by assigning to the Profile
-attribute. For example:
-
- $h->{Profile} = DBI::Profile->new();
-
-The Profile attribute holds a blessed reference to a hash object
-that contains the profile data and attributes relating to it.
-
-The class the Profile object is blessed into is expected to
-provide at least a DESTROY method which will dump the profile data
-to the DBI trace file handle (STDERR by default).
-
-All these examples have the same effect as each other:
-
- $h->{Profile} = 0;
- $h->{Profile} = "/DBI::Profile";
- $h->{Profile} = DBI::Profile->new();
- $h->{Profile} = {};
- $h->{Profile} = { Path => [] };
-
-Similarly, these examples have the same effect as each other:
-
- $h->{Profile} = 6;
- $h->{Profile} = "6/DBI::Profile";
- $h->{Profile} = "!Statement:!MethodName/DBI::Profile";
- $h->{Profile} = { Path => [ '!Statement', '!MethodName' ] };
-
-If a non-blessed hash reference is given then the DBI::Profile
-module is automatically C<require>'d and the reference is blessed
-into that class.
-
-If a string is given then it is processed like this:
-
- ($path, $module, $args) = split /\//, $string, 3
-
- @path = split /:/, $path
- @args = split /:/, $args
-
- eval "require $module" if $module
- $module ||= "DBI::Profile"
-
- $module->new( Path => \@Path, @args )
-
-So the first value is used to select the Path to be used (see below).
-The second value, if present, is used as the name of a module which
-will be loaded and it's C<new> method called. If not present it
-defaults to DBI::Profile. Any other values are passed as arguments
-to the C<new> method. For example: "C<2/DBIx::OtherProfile/Foo:42>".
-
-Numbers can be used as a shorthand way to enable common Path values.
-The simplest way to explain how the values are interpreted is to show the code:
-
- push @Path, "DBI" if $path_elem & 0x01;
- push @Path, "!Statement" if $path_elem & 0x02;
- push @Path, "!MethodName" if $path_elem & 0x04;
- push @Path, "!MethodClass" if $path_elem & 0x08;
- push @Path, "!Caller2" if $path_elem & 0x10;
-
-So "2" is the same as "!Statement" and "6" (2+4) is the same as
-"!Statement:!Method". Those are the two most commonly used values. Using a
-negative number will reverse the path. Thus "-6" will group by method name then
-statement.
-
-The splitting and parsing of string values assigned to the Profile
-attribute may seem a little odd, but there's a good reason for it.
-Remember that attributes can be embedded in the Data Source Name
-string which can be passed in to a script as a parameter. For
-example:
-
- dbi:DriverName(Profile=>2):dbname
- dbi:DriverName(Profile=>{Username}:!Statement/MyProfiler/Foo:42):dbname
-
-And also, if the C<DBI_PROFILE> environment variable is set then
-The DBI arranges for every driver handle to share the same profile
-object. When perl exits a single profile summary will be generated
-that reflects (as nearly as practical) the total use of the DBI by
-the application.
-
-
-=head1 THE PROFILE OBJECT
-
-The DBI core expects the Profile attribute value to be a hash
-reference and if the following values don't exist it will create
-them as needed:
-
-=head2 Data
-
-A reference to a hash containing the collected profile data.
-
-=head2 Path
-
-The Path value is a reference to an array. Each element controls the
-value to use at the corresponding level of the profile Data tree.
-
-If the value of Path is anything other than an array reference,
-it is treated as if it was:
-
- [ '!Statement' ]
-
-The elements of Path array can be one of the following types:
-
-=head3 Special Constant
-
-B<!Statement>
-
-Use the current Statement text. Typically that's the value of the Statement
-attribute for the handle the method was called with. Some methods, like
-commit() and rollback(), are unrelated to a particular statement. For those
-methods !Statement records an empty string.
-
-For statement handles this is always simply the string that was
-given to prepare() when the handle was created. For database handles
-this is the statement that was last prepared or executed on that
-database handle. That can lead to a little 'fuzzyness' because, for
-example, calls to the quote() method to build a new statement will
-typically be associated with the previous statement. In practice
-this isn't a significant issue and the dynamic Path mechanism can
-be used to setup your own rules.
-
-B<!MethodName>
-
-Use the name of the DBI method that the profile sample relates to.
-
-B<!MethodClass>
-
-Use the fully qualified name of the DBI method, including
-the package, that the profile sample relates to. This shows you
-where the method was implemented. For example:
-
- 'DBD::_::db::selectrow_arrayref' =>
- 0.022902s
- 'DBD::mysql::db::selectrow_arrayref' =>
- 2.244521s / 99 = 0.022445s avg (first 0.022813s, min 0.022051s, max 0.028932s)
-
-The "DBD::_::db::selectrow_arrayref" shows that the driver has
-inherited the selectrow_arrayref method provided by the DBI.
-
-But you'll note that there is only one call to
-DBD::_::db::selectrow_arrayref but another 99 to
-DBD::mysql::db::selectrow_arrayref. Currently the first
-call doesn't record the true location. That may change.
-
-B<!Caller>
-
-Use a string showing the filename and line number of the code calling the method.
-
-B<!Caller2>
-
-Use a string showing the filename and line number of the code calling the
-method, as for !Caller, but also include filename and line number of the code
-that called that. Calls from DBI:: and DBD:: packages are skipped.
-
-B<!File>
-
-Same as !Caller above except that only the filename is included, not the line number.
-
-B<!File2>
-
-Same as !Caller2 above except that only the filenames are included, not the line number.
-
-B<!Time>
-
-Use the current value of time(). Rarely used. See the more useful C<!Time~N> below.
-
-B<!Time~N>
-
-Where C<N> is an integer. Use the current value of time() but with reduced precision.
-The value used is determined in this way:
-
- int( time() / N ) * N
-
-This is a useful way to segregate a profile into time slots. For example:
-
- [ '!Time~60', '!Statement' ]
-
-=head3 Code Reference
-
-The subroutine is passed the handle it was called on and the DBI method name.
-The current Statement is in $_. The statement string should not be modified,
-so most subs start with C<local $_ = $_;>.
-
-The list of values it returns is used at that point in the Profile Path.
-Any undefined values are treated as the string "C<undef>".
-
-The sub can 'veto' (reject) a profile sample by including a reference to undef
-(C<\undef>) in the returned list. That can be useful when you want to only profile
-statements that match a certain pattern, or only profile certain methods.
-
-=head3 Subroutine Specifier
-
-A Path element that begins with 'C<&>' is treated as the name of a subroutine
-in the DBI::ProfileSubs namespace and replaced with the corresponding code reference.
-
-Currently this only works when the Path is specified by the C<DBI_PROFILE>
-environment variable.
-
-Also, currently, the only subroutine in the DBI::ProfileSubs namespace is
-C<'&norm_std_n3'>. That's a very handy subroutine when profiling code that
-doesn't use placeholders. See L<DBI::ProfileSubs> for more information.
-
-=head3 Attribute Specifier
-
-A string enclosed in braces, such as 'C<{Username}>', specifies that the current
-value of the corresponding database handle attribute should be used at that
-point in the Path.
-
-=head3 Reference to a Scalar
-
-Specifies that the current value of the referenced scalar be used at that point
-in the Path. This provides an efficient way to get 'contextual' values into
-your profile.
-
-=head3 Other Values
-
-Any other values are stringified and used literally.
-
-(References, and values that begin with punctuation characters are reserved.)
-
-
-=head1 REPORTING
-
-=head2 Report Format
-
-The current accumulated profile data can be formatted and output using
-
- print $h->{Profile}->format;
-
-To discard the profile data and start collecting fresh data
-you can do:
-
- $h->{Profile}->{Data} = undef;
-
-
-The default results format looks like this:
-
- DBI::Profile: 0.001015s 42.7% (5 calls) programname @ YYYY-MM-DD HH:MM:SS
- '' =>
- 0.000024s / 2 = 0.000012s avg (first 0.000015s, min 0.000009s, max 0.000015s)
- 'SELECT mode,size,name FROM table' =>
- 0.000991s / 3 = 0.000330s avg (first 0.000678s, min 0.000009s, max 0.000678s)
-
-Which shows the total time spent inside the DBI, with a count of
-the total number of method calls and the name of the script being
-run, then a formatted version of the profile data tree.
-
-If the results are being formatted when the perl process is exiting
-(which is usually the case when the DBI_PROFILE environment variable
-is used) then the percentage of time the process spent inside the
-DBI is also shown. If the process is not exiting then the percentage is
-calculated using the time between the first and last call to the DBI.
-
-In the example above the paths in the tree are only one level deep and
-use the Statement text as the value (that's the default behaviour).
-
-The merged profile data at the 'leaves' of the tree are presented
-as total time spent, count, average time spent (which is simply total
-time divided by the count), then the time spent on the first call,
-the time spent on the fastest call, and finally the time spent on
-the slowest call.
-
-The 'avg', 'first', 'min' and 'max' times are not particularly
-useful when the profile data path only contains the statement text.
-Here's an extract of a more detailed example using both statement
-text and method name in the path:
-
- 'SELECT mode,size,name FROM table' =>
- 'FETCH' =>
- 0.000076s
- 'fetchrow_hashref' =>
- 0.036203s / 108 = 0.000335s avg (first 0.000490s, min 0.000152s, max 0.002786s)
-
-Here you can see the 'avg', 'first', 'min' and 'max' for the
-108 calls to fetchrow_hashref() become rather more interesting.
-Also the data for FETCH just shows a time value because it was only
-called once.
-
-Currently the profile data is output sorted by branch names. That
-may change in a later version so the leaf nodes are sorted by total
-time per leaf node.
-
-
-=head2 Report Destination
-
-The default method of reporting is for the DESTROY method of the
-Profile object to format the results and write them using:
-
- DBI->trace_msg($results, 0); # see $ON_DESTROY_DUMP below
-
-to write them to the DBI trace() filehandle (which defaults to
-STDERR). To direct the DBI trace filehandle to write to a file
-without enabling tracing the trace() method can be called with a
-trace level of 0. For example:
-
- DBI->trace(0, $filename);
-
-The same effect can be achieved without changing the code by
-setting the C<DBI_TRACE> environment variable to C<0=filename>.
-
-The $DBI::Profile::ON_DESTROY_DUMP variable holds a code ref
-that's called to perform the output of the formatted results.
-The default value is:
-
- $ON_DESTROY_DUMP = sub { DBI->trace_msg($results, 0) };
-
-Apart from making it easy to send the dump elsewhere, it can also
-be useful as a simple way to disable dumping results.
-
-=head1 CHILD HANDLES
-
-Child handles inherit a reference to the Profile attribute value
-of their parent. So if profiling is enabled for a database handle
-then by default the statement handles created from it all contribute
-to the same merged profile data tree.
-
-
-=head1 PROFILE OBJECT METHODS
-
-=head2 format
-
-See L</REPORTING>.
-
-=head2 as_node_path_list
-
- @ary = $dbh->{Profile}->as_node_path_list();
- @ary = $dbh->{Profile}->as_node_path_list($node, $path);
-
-Returns the collected data ($dbh->{Profile}{Data}) restructured into a list of
-array refs, one for each leaf node in the Data tree. This 'flat' structure is
-often much simpler for applications to work with.
-
-The first element of each array ref is a reference to the leaf node.
-The remaining elements are the 'path' through the data tree to that node.
-
-For example, given a data tree like this:
-
- {key1a}{key2a}[node1]
- {key1a}{key2b}[node2]
- {key1b}{key2a}{key3a}[node3]
-
-The as_node_path_list() method will return this list:
-
- [ [node1], 'key1a', 'key2a' ]
- [ [node2], 'key1a', 'key2b' ]
- [ [node3], 'key1b', 'key2a', 'key3a' ]
-
-The nodes are ordered by key, depth-first.
-
-The $node argument can be used to focus on a sub-tree.
-If not specified it defaults to $dbh->{Profile}{Data}.
-
-The $path argument can be used to specify a list of path elements that will be
-added to each element of the returned list. If not specified it defaults to a
-ref to an empty array.
-
-=head2 as_text
-
- @txt = $dbh->{Profile}->as_text();
- $txt = $dbh->{Profile}->as_text({
- node => undef,
- path => [],
- separator => " > ",
- format => '%1$s: %11$fs / %10$d = %2$fs avg (first %12$fs, min %13$fs, max %14$fs)'."\n";
- sortsub => sub { ... },
- );
-
-Returns the collected data ($dbh->{Profile}{Data}) reformatted into a list of formatted strings.
-In scalar context the list is returned as a single concatenated string.
-
-A hashref can be used to pass in arguments, the default values are shown in the example above.
-
-The C<node> and <path> arguments are passed to as_node_path_list().
-
-The C<separator> argument is used to join the elements of the path for each leaf node.
-
-The C<sortsub> argument is used to pass in a ref to a sub that will order the list.
-The subroutine will be passed a reference to the array returned by
-as_node_path_list() and should sort the contents of the array in place.
-The return value from the sub is ignored. For example, to sort the nodes by the
-second level key you could use:
-
- sortsub => sub { my $ary=shift; @$ary = sort { $a->[2] cmp $b->[2] } @$ary }
-
-The C<format> argument is a C<sprintf> format string that specifies the format
-to use for each leaf node. It uses the explicit format parameter index
-mechanism to specify which of the arguments should appear where in the string.
-The arguments to sprintf are:
-
- 1: path to node, joined with the separator
- 2: average duration (total duration/count)
- (3 thru 9 are currently unused)
- 10: count
- 11: total duration
- 12: first duration
- 13: smallest duration
- 14: largest duration
- 15: time of first call
- 16: time of first call
-
-=head1 CUSTOM DATA MANIPULATION
-
-Recall that C<< $h->{Profile}->{Data} >> is a reference to the collected data.
-Either to a 'leaf' array (when the Path is empty, i.e., DBI_PROFILE env var is 1),
-or a reference to hash containing values that are either further hash
-references or leaf array references.
-
-Sometimes it's useful to be able to summarise some or all of the collected data.
-The dbi_profile_merge_nodes() function can be used to merge leaf node values.
-
-=head2 dbi_profile_merge_nodes
-
- use DBI qw(dbi_profile_merge_nodes);
-
- $time_in_dbi = dbi_profile_merge_nodes(my $totals=[], @$leaves);
-
-Merges profile data node. Given a reference to a destination array, and zero or
-more references to profile data, merges the profile data into the destination array.
-For example:
-
- $time_in_dbi = dbi_profile_merge_nodes(
- my $totals=[],
- [ 10, 0.51, 0.11, 0.01, 0.22, 1023110000, 1023110010 ],
- [ 15, 0.42, 0.12, 0.02, 0.23, 1023110005, 1023110009 ],
- );
-
-$totals will then contain
-
- [ 25, 0.93, 0.11, 0.01, 0.23, 1023110000, 1023110010 ]
-
-and $time_in_dbi will be 0.93;
-
-The second argument need not be just leaf nodes. If given a reference to a hash
-then the hash is recursively searched for leaf nodes and all those found
-are merged.
-
-For example, to get the time spent 'inside' the DBI during an http request,
-your logging code run at the end of the request (i.e. mod_perl LogHandler)
-could use:
-
- my $time_in_dbi = 0;
- if (my $Profile = $dbh->{Profile}) { # if DBI profiling is enabled
- $time_in_dbi = dbi_profile_merge_nodes(my $total=[], $Profile->{Data});
- $Profile->{Data} = {}; # reset the profile data
- }
-
-If profiling has been enabled then $time_in_dbi will hold the time spent inside
-the DBI for that handle (and any other handles that share the same profile data)
-since the last request.
-
-Prior to DBI 1.56 the dbi_profile_merge_nodes() function was called dbi_profile_merge().
-That name still exists as an alias.
-
-=head1 CUSTOM DATA COLLECTION
-
-=head2 Using The Path Attribute
-
- XXX example to be added later using a selectall_arrayref call
- XXX nested inside a fetch loop where the first column of the
- XXX outer loop is bound to the profile Path using
- XXX bind_column(1, \${ $dbh->{Profile}->{Path}->[0] })
- XXX so you end up with separate profiles for each loop
- XXX (patches welcome to add this to the docs :)
-
-=head2 Adding Your Own Samples
-
-The dbi_profile() function can be used to add extra sample data
-into the profile data tree. For example:
-
- use DBI;
- use DBI::Profile (dbi_profile dbi_time);
-
- my $t1 = dbi_time(); # floating point high-resolution time
-
- ... execute code you want to profile here ...
-
- my $t2 = dbi_time();
- dbi_profile($h, $statement, $method, $t1, $t2);
-
-The $h parameter is the handle the extra profile sample should be
-associated with. The $statement parameter is the string to use where
-the Path specifies !Statement. If $statement is undef
-then $h->{Statement} will be used. Similarly $method is the string
-to use if the Path specifies !MethodName. There is no
-default value for $method.
-
-The $h->{Profile}{Path} attribute is processed by dbi_profile() in
-the usual way.
-
-The $h parameter is usually a DBI handle but it can also be a reference to a
-hash, in which case the dbi_profile() acts on each defined value in the hash.
-This is an efficient way to update multiple profiles with a single sample,
-and is used by the L<DashProfiler> module.
-
-=head1 SUBCLASSING
-
-Alternate profile modules must subclass DBI::Profile to help ensure
-they work with future versions of the DBI.
-
-
-=head1 CAVEATS
-
-Applications which generate many different statement strings
-(typically because they don't use placeholders) and profile with
-!Statement in the Path (the default) will consume memory
-in the Profile Data structure for each statement. Use a code ref
-in the Path to return an edited (simplified) form of the statement.
-
-If a method throws an exception itself (not via RaiseError) then
-it won't be counted in the profile.
-
-If a HandleError subroutine throws an exception (rather than returning
-0 and letting RaiseError do it) then the method call won't be counted
-in the profile.
-
-Time spent in DESTROY is added to the profile of the parent handle.
-
-Time spent in DBI->*() methods is not counted. The time spent in
-the driver connect method, $drh->connect(), when it's called by
-DBI->connect is counted if the DBI_PROFILE environment variable is set.
-
-Time spent fetching tied variables, $DBI::errstr, is counted.
-
-Time spent in FETCH for $h->{Profile} is not counted, so getting the profile
-data doesn't alter it.
-
-DBI::PurePerl does not support profiling (though it could in theory).
-
-For asynchronous queries, time spent while the query is running on the
-backend is not counted.
-
-A few platforms don't support the gettimeofday() high resolution
-time function used by the DBI (and available via the dbi_time() function).
-In which case you'll get integer resolution time which is mostly useless.
-
-On Windows platforms the dbi_time() function is limited to millisecond
-resolution. Which isn't sufficiently fine for our needs, but still
-much better than integer resolution. This limited resolution means
-that fast method calls will often register as taking 0 time. And
-timings in general will have much more 'jitter' depending on where
-within the 'current millisecond' the start and end timing was taken.
-
-This documentation could be more clear. Probably needs to be reordered
-to start with several examples and build from there. Trying to
-explain the concepts first seems painful and to lead to just as
-many forward references. (Patches welcome!)
-
-=cut
-
-
-use strict;
-use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION);
-use Exporter ();
-use UNIVERSAL ();
-use Carp;
-
-use DBI qw(dbi_time dbi_profile dbi_profile_merge_nodes dbi_profile_merge);
-
-$VERSION = "2.015065";
-
-@ISA = qw(Exporter);
-@EXPORT = qw(
- DBIprofile_Statement
- DBIprofile_MethodName
- DBIprofile_MethodClass
- dbi_profile
- dbi_profile_merge_nodes
- dbi_profile_merge
- dbi_time
-);
-@EXPORT_OK = qw(
- format_profile_thingy
-);
-
-use constant DBIprofile_Statement => '!Statement';
-use constant DBIprofile_MethodName => '!MethodName';
-use constant DBIprofile_MethodClass => '!MethodClass';
-
-our $ON_DESTROY_DUMP = sub { DBI->trace_msg(shift, 0) };
-our $ON_FLUSH_DUMP = sub { DBI->trace_msg(shift, 0) };
-
-sub new {
- my $class = shift;
- my $profile = { @_ };
- return bless $profile => $class;
-}
-
-
-sub _auto_new {
- my $class = shift;
- my ($arg) = @_;
-
- # This sub is called by DBI internals when a non-hash-ref is
- # assigned to the Profile attribute. For example
- # dbi:mysql(RaiseError=>1,Profile=>!Statement:!MethodName/DBIx::MyProfile/arg1:arg2):dbname
- # This sub works out what to do and returns a suitable hash ref.
-
- $arg =~ s/^DBI::/2\/DBI::/
- and carp "Automatically changed old-style DBI::Profile specification to $arg";
-
- # it's a path/module/k1:v1:k2:v2:... list
- my ($path, $package, $args) = split /\//, $arg, 3;
- my @args = (defined $args) ? split(/:/, $args, -1) : ();
- my @Path;
-
- for my $element (split /:/, $path) {
- if (DBI::looks_like_number($element)) {
- my $reverse = ($element < 0) ? ($element=-$element, 1) : 0;
- my @p;
- # a single "DBI" is special-cased in format()
- push @p, "DBI" if $element & 0x01;
- push @p, DBIprofile_Statement if $element & 0x02;
- push @p, DBIprofile_MethodName if $element & 0x04;
- push @p, DBIprofile_MethodClass if $element & 0x08;
- push @p, '!Caller2' if $element & 0x10;
- push @Path, ($reverse ? reverse @p : @p);
- }
- elsif ($element =~ m/^&(\w.*)/) {
- my $name = "DBI::ProfileSubs::$1"; # capture $1 early
- require DBI::ProfileSubs;
- my $code = do { no strict; *{$name}{CODE} };
- if (defined $code) {
- push @Path, $code;
- }
- else {
- warn "$name: subroutine not found\n";
- push @Path, $element;
- }
- }
- else {
- push @Path, $element;
- }
- }
-
- eval "require $package" if $package; # silently ignores errors
- $package ||= $class;
-
- return $package->new(Path => \@Path, @args);
-}
-
-
-sub empty { # empty out profile data
- my $self = shift;
- DBI->trace_msg("profile data discarded\n",0) if $self->{Trace};
- $self->{Data} = undef;
-}
-
-sub filename { # baseclass method, see DBI::ProfileDumper
- return undef;
-}
-
-sub flush_to_disk { # baseclass method, see DBI::ProfileDumper & DashProfiler::Core
- my $self = shift;
- return unless $ON_FLUSH_DUMP;
- return unless $self->{Data};
- my $detail = $self->format();
- $ON_FLUSH_DUMP->($detail) if $detail;
-}
-
-
-sub as_node_path_list {
- my ($self, $node, $path) = @_;
- # convert the tree into an array of arrays
- # from
- # {key1a}{key2a}[node1]
- # {key1a}{key2b}[node2]
- # {key1b}{key2a}{key3a}[node3]
- # to
- # [ [node1], 'key1a', 'key2a' ]
- # [ [node2], 'key1a', 'key2b' ]
- # [ [node3], 'key1b', 'key2a', 'key3a' ]
-
- $node ||= $self->{Data} or return;
- $path ||= [];
- if (ref $node eq 'HASH') { # recurse
- $path = [ @$path, undef ];
- return map {
- $path->[-1] = $_;
- ($node->{$_}) ? $self->as_node_path_list($node->{$_}, $path) : ()
- } sort keys %$node;
- }
- return [ $node, @$path ];
-}
-
-
-sub as_text {
- my ($self, $args_ref) = @_;
- my $separator = $args_ref->{separator} || " > ";
- my $format_path_element = $args_ref->{format_path_element}
- || "%s"; # or e.g., " key%2$d='%s'"
- my $format = $args_ref->{format}
- || '%1$s: %11$fs / %10$d = %2$fs avg (first %12$fs, min %13$fs, max %14$fs)'."\n";
-
- my @node_path_list = $self->as_node_path_list(undef, $args_ref->{path});
-
- $args_ref->{sortsub}->(\@node_path_list) if $args_ref->{sortsub};
-
- my $eval = "qr/".quotemeta($separator)."/";
- my $separator_re = eval($eval) || quotemeta($separator);
- #warn "[$eval] = [$separator_re]";
- my @text;
- my @spare_slots = (undef) x 7;
- for my $node_path (@node_path_list) {
- my ($node, @path) = @$node_path;
- my $idx = 0;
- for (@path) {
- s/[\r\n]+/ /g;
- s/$separator_re/ /g;
- ++$idx;
- if ($format_path_element eq "%s") {
- $_ = sprintf $format_path_element, $_;
- } else {
- $_ = sprintf $format_path_element, $_, $idx;
- }
- }
- push @text, sprintf $format,
- join($separator, @path), # 1=path
- ($node->[0] ? $node->[1]/$node->[0] : 0), # 2=avg
- @spare_slots,
- @$node; # 10=count, 11=dur, 12=first_dur, 13=min, 14=max, 15=first_called, 16=last_called
- }
- return @text if wantarray;
- return join "", @text;
-}
-
-
-sub format {
- my $self = shift;
- my $class = ref($self) || $self;
-
- my $prologue = "$class: ";
- my $detail = $self->format_profile_thingy(
- $self->{Data}, 0, " ",
- my $path = [],
- my $leaves = [],
- )."\n";
-
- if (@$leaves) {
- dbi_profile_merge_nodes(my $totals=[], @$leaves);
- my ($count, $time_in_dbi, undef, undef, undef, $t1, $t2) = @$totals;
- (my $progname = $0) =~ s:.*/::;
- if ($count) {
- $prologue .= sprintf "%fs ", $time_in_dbi;
- my $perl_time = ($DBI::PERL_ENDING) ? time() - $^T : $t2-$t1;
- $prologue .= sprintf "%.2f%% ", $time_in_dbi/$perl_time*100 if $perl_time;
- my @lt = localtime(time);
- my $ts = sprintf "%d-%02d-%02d %02d:%02d:%02d",
- 1900+$lt[5], $lt[4]+1, @lt[3,2,1,0];
- $prologue .= sprintf "(%d calls) $progname \@ $ts\n", $count;
- }
- if (@$leaves == 1 && ref($self->{Data}) eq 'HASH' && $self->{Data}->{DBI}) {
- $detail = ""; # hide the "DBI" from DBI_PROFILE=1
- }
- }
- return ($prologue, $detail) if wantarray;
- return $prologue.$detail;
-}
-
-
-sub format_profile_leaf {
- my ($self, $thingy, $depth, $pad, $path, $leaves) = @_;
- croak "format_profile_leaf called on non-leaf ($thingy)"
- unless UNIVERSAL::isa($thingy,'ARRAY');
-
- push @$leaves, $thingy if $leaves;
- my ($count, $total_time, $first_time, $min, $max, $first_called, $last_called) = @$thingy;
- return sprintf "%s%fs\n", ($pad x $depth), $total_time
- if $count <= 1;
- return sprintf "%s%fs / %d = %fs avg (first %fs, min %fs, max %fs)\n",
- ($pad x $depth), $total_time, $count, $count ? $total_time/$count : 0,
- $first_time, $min, $max;
-}
-
-
-sub format_profile_branch {
- my ($self, $thingy, $depth, $pad, $path, $leaves) = @_;
- croak "format_profile_branch called on non-branch ($thingy)"
- unless UNIVERSAL::isa($thingy,'HASH');
- my @chunk;
- my @keys = sort keys %$thingy;
- while ( @keys ) {
- my $k = shift @keys;
- my $v = $thingy->{$k};
- push @$path, $k;
- push @chunk, sprintf "%s'%s' =>\n%s",
- ($pad x $depth), $k,
- $self->format_profile_thingy($v, $depth+1, $pad, $path, $leaves);
- pop @$path;
- }
- return join "", @chunk;
-}
-
-
-sub format_profile_thingy {
- my ($self, $thingy, $depth, $pad, $path, $leaves) = @_;
- return "undef" if not defined $thingy;
- return $self->format_profile_leaf( $thingy, $depth, $pad, $path, $leaves)
- if UNIVERSAL::isa($thingy,'ARRAY');
- return $self->format_profile_branch($thingy, $depth, $pad, $path, $leaves)
- if UNIVERSAL::isa($thingy,'HASH');
- return "$thingy\n";
-}
-
-
-sub on_destroy {
- my $self = shift;
- return unless $ON_DESTROY_DUMP;
- return unless $self->{Data};
- my $detail = $self->format();
- $ON_DESTROY_DUMP->($detail) if $detail;
- $self->{Data} = undef;
-}
-
-sub DESTROY {
- my $self = shift;
- local $@;
- DBI->trace_msg("profile data DESTROY\n",0)
- if (($self->{Trace}||0) >= 2);
- eval { $self->on_destroy };
- if ($@) {
- chomp $@;
- my $class = ref($self) || $self;
- DBI->trace_msg("$class on_destroy failed: $@", 0);
- }
-}
-
-1;
-
+++ /dev/null
-package DBI::ProfileData;
-use strict;
-
-=head1 NAME
-
-DBI::ProfileData - manipulate DBI::ProfileDumper data dumps
-
-=head1 SYNOPSIS
-
-The easiest way to use this module is through the dbiprof frontend
-(see L<dbiprof> for details):
-
- dbiprof --number 15 --sort count
-
-This module can also be used to roll your own profile analysis:
-
- # load data from dbi.prof
- $prof = DBI::ProfileData->new(File => "dbi.prof");
-
- # get a count of the records (unique paths) in the data set
- $count = $prof->count();
-
- # sort by longest overall time
- $prof->sort(field => "longest");
-
- # sort by longest overall time, least to greatest
- $prof->sort(field => "longest", reverse => 1);
-
- # exclude records with key2 eq 'disconnect'
- $prof->exclude(key2 => 'disconnect');
-
- # exclude records with key1 matching /^UPDATE/i
- $prof->exclude(key1 => qr/^UPDATE/i);
-
- # remove all records except those where key1 matches /^SELECT/i
- $prof->match(key1 => qr/^SELECT/i);
-
- # produce a formatted report with the given number of items
- $report = $prof->report(number => 10);
-
- # clone the profile data set
- $clone = $prof->clone();
-
- # get access to hash of header values
- $header = $prof->header();
-
- # get access to sorted array of nodes
- $nodes = $prof->nodes();
-
- # format a single node in the same style as report()
- $text = $prof->format($nodes->[0]);
-
- # get access to Data hash in DBI::Profile format
- $Data = $prof->Data();
-
-=head1 DESCRIPTION
-
-This module offers the ability to read, manipulate and format
-L<DBI::ProfileDumper> profile data.
-
-Conceptually, a profile consists of a series of records, or nodes,
-each of each has a set of statistics and set of keys. Each record
-must have a unique set of keys, but there is no requirement that every
-record have the same number of keys.
-
-=head1 METHODS
-
-The following methods are supported by DBI::ProfileData objects.
-
-=cut
-
-our $VERSION = "2.010008";
-
-use Carp qw(croak);
-use Symbol;
-use Fcntl qw(:flock);
-
-use DBI::Profile qw(dbi_profile_merge);
-
-# some constants for use with node data arrays
-sub COUNT () { 0 };
-sub TOTAL () { 1 };
-sub FIRST () { 2 };
-sub SHORTEST () { 3 };
-sub LONGEST () { 4 };
-sub FIRST_AT () { 5 };
-sub LAST_AT () { 6 };
-sub PATH () { 7 };
-
-
-my $HAS_FLOCK = (defined $ENV{DBI_PROFILE_FLOCK})
- ? $ENV{DBI_PROFILE_FLOCK}
- : do { local $@; eval { flock STDOUT, 0; 1 } };
-
-
-=head2 $prof = DBI::ProfileData->new(File => "dbi.prof")
-
-=head2 $prof = DBI::ProfileData->new(File => "dbi.prof", Filter => sub { ... })
-
-=head2 $prof = DBI::ProfileData->new(Files => [ "dbi.prof.1", "dbi.prof.2" ])
-
-Creates a new DBI::ProfileData object. Takes either a single file
-through the File option or a list of Files in an array ref. If
-multiple files are specified then the header data from the first file
-is used.
-
-=head3 Files
-
-Reference to an array of file names to read.
-
-=head3 File
-
-Name of file to read. Takes precedence over C<Files>.
-
-=head3 DeleteFiles
-
-If true, the files are deleted after being read.
-
-Actually the files are renamed with a C<deleteme> suffix before being read,
-and then, after reading all the files, they're all deleted together.
-
-The files are locked while being read which, combined with the rename, makes it
-safe to 'consume' files that are still being generated by L<DBI::ProfileDumper>.
-
-=head3 Filter
-
-The C<Filter> parameter can be used to supply a code reference that can
-manipulate the profile data as it is being read. This is most useful for
-editing SQL statements so that slightly different statements in the raw data
-will be merged and aggregated in the loaded data. For example:
-
- Filter => sub {
- my ($path_ref, $data_ref) = @_;
- s/foo = '.*?'/foo = '...'/ for @$path_ref;
- }
-
-Here's an example that performs some normalization on the SQL. It converts all
-numbers to C<N> and all quoted strings to C<S>. It can also convert digits to
-N within names. Finally, it summarizes long "IN (...)" clauses.
-
-It's aggressive and simplistic, but it's often sufficient, and serves as an
-example that you can tailor to suit your own needs:
-
- Filter => sub {
- my ($path_ref, $data_ref) = @_;
- local $_ = $path_ref->[0]; # whichever element contains the SQL Statement
- s/\b\d+\b/N/g; # 42 -> N
- s/\b0x[0-9A-Fa-f]+\b/N/g; # 0xFE -> N
- s/'.*?'/'S'/g; # single quoted strings (doesn't handle escapes)
- s/".*?"/"S"/g; # double quoted strings (doesn't handle escapes)
- # convert names like log_20001231 into log_NNNNNNNN, controlled by $opt{n}
- s/([a-z_]+)(\d{$opt{n},})/$1.('N' x length($2))/ieg if $opt{n};
- # abbreviate massive "in (...)" statements and similar
- s!(([NS],){100,})!sprintf("$2,{repeated %d times}",length($1)/2)!eg;
- }
-
-It's often better to perform this kinds of normalization in the DBI while the
-data is being collected, to avoid too much memory being used by storing profile
-data for many different SQL statement. See L<DBI::Profile>.
-
-=cut
-
-sub new {
- my $pkg = shift;
- my $self = {
- Files => [ "dbi.prof" ],
- Filter => undef,
- DeleteFiles => 0,
- LockFile => $HAS_FLOCK,
- _header => {},
- _nodes => [],
- _node_lookup => {},
- _sort => 'none',
- @_
- };
- bless $self, $pkg;
-
- # File (singular) overrides Files (plural)
- $self->{Files} = [ $self->{File} ] if exists $self->{File};
-
- $self->_read_files();
- return $self;
-}
-
-# read files into _header and _nodes
-sub _read_files {
- my $self = shift;
- my $files = $self->{Files};
- my $read_header = 0;
- my @files_to_delete;
-
- my $fh = gensym;
- foreach (@$files) {
- my $filename = $_;
-
- if ($self->{DeleteFiles}) {
- my $newfilename = $filename . ".deleteme";
- if ($^O eq 'VMS') {
- # VMS default filesystem can only have one period
- $newfilename = $filename . 'deleteme';
- }
- # will clobber an existing $newfilename
- rename($filename, $newfilename)
- or croak "Can't rename($filename, $newfilename): $!";
- # On a versioned filesystem we want old versions to be removed
- 1 while (unlink $filename);
- $filename = $newfilename;
- }
-
- open($fh, "<", $filename)
- or croak("Unable to read profile file '$filename': $!");
-
- # lock the file in case it's still being written to
- # (we'll be forced to wait till the write is complete)
- flock($fh, LOCK_SH) if $self->{LockFile};
-
- if (-s $fh) { # not empty
- $self->_read_header($fh, $filename, $read_header ? 0 : 1);
- $read_header = 1;
- $self->_read_body($fh, $filename);
- }
- close($fh); # and release lock
-
- push @files_to_delete, $filename
- if $self->{DeleteFiles};
- }
- for (@files_to_delete){
- # for versioned file systems
- 1 while (unlink $_);
- if(-e $_){
- warn "Can't delete '$_': $!";
- }
- }
-
- # discard node_lookup now that all files are read
- delete $self->{_node_lookup};
-}
-
-# read the header from the given $fh named $filename. Discards the
-# data unless $keep.
-sub _read_header {
- my ($self, $fh, $filename, $keep) = @_;
-
- # get profiler module id
- my $first = <$fh>;
- chomp $first;
- $self->{_profiler} = $first if $keep;
-
- # collect variables from the header
- local $_;
- while (<$fh>) {
- chomp;
- last unless length $_;
- /^(\S+)\s*=\s*(.*)/
- or croak("Syntax error in header in $filename line $.: $_");
- # XXX should compare new with existing (from previous file)
- # and warn if they differ (different program or path)
- $self->{_header}{$1} = unescape_key($2) if $keep;
- }
-}
-
-
-sub unescape_key { # inverse of escape_key() in DBI::ProfileDumper
- local $_ = shift;
- s/(?<!\\)\\n/\n/g; # expand \n, unless it's a \\n
- s/(?<!\\)\\r/\r/g; # expand \r, unless it's a \\r
- s/\\\\/\\/g; # \\ to \
- return $_;
-}
-
-
-# reads the body of the profile data
-sub _read_body {
- my ($self, $fh, $filename) = @_;
- my $nodes = $self->{_nodes};
- my $lookup = $self->{_node_lookup};
- my $filter = $self->{Filter};
-
- # build up node array
- my @path = ("");
- my (@data, $path_key);
- local $_;
- while (<$fh>) {
- chomp;
- if (/^\+\s+(\d+)\s?(.*)/) {
- # it's a key
- my ($key, $index) = ($2, $1 - 1);
-
- $#path = $index; # truncate path to new length
- $path[$index] = unescape_key($key); # place new key at end
-
- }
- elsif (s/^=\s+//) {
- # it's data - file in the node array with the path in index 0
- # (the optional minus is to make it more robust against systems
- # with unstable high-res clocks - typically due to poor NTP config
- # of kernel SMP behaviour, i.e. min time may be -0.000008))
-
- @data = split / /, $_;
-
- # corrupt data?
- croak("Invalid number of fields in $filename line $.: $_")
- unless @data == 7;
- croak("Invalid leaf node characters $filename line $.: $_")
- unless m/^[-+ 0-9eE\.]+$/;
-
- # hook to enable pre-processing of the data - such as mangling SQL
- # so that slightly different statements get treated as the same
- # and so merged in the results
- $filter->(\@path, \@data) if $filter;
-
- # elements of @path can't have NULLs in them, so this
- # forms a unique string per @path. If there's some way I
- # can get this without arbitrarily stripping out a
- # character I'd be happy to hear it!
- $path_key = join("\0",@path);
-
- # look for previous entry
- if (exists $lookup->{$path_key}) {
- # merge in the new data
- dbi_profile_merge($nodes->[$lookup->{$path_key}], \@data);
- } else {
- # insert a new node - nodes are arrays with data in 0-6
- # and path data after that
- push(@$nodes, [ @data, @path ]);
-
- # record node in %seen
- $lookup->{$path_key} = $#$nodes;
- }
- }
- else {
- croak("Invalid line type syntax error in $filename line $.: $_");
- }
- }
-}
-
-
-
-=head2 $copy = $prof->clone();
-
-Clone a profile data set creating a new object.
-
-=cut
-
-sub clone {
- my $self = shift;
-
- # start with a simple copy
- my $clone = bless { %$self }, ref($self);
-
- # deep copy nodes
- $clone->{_nodes} = [ map { [ @$_ ] } @{$self->{_nodes}} ];
-
- # deep copy header
- $clone->{_header} = { %{$self->{_header}} };
-
- return $clone;
-}
-
-=head2 $header = $prof->header();
-
-Returns a reference to a hash of header values. These are the key
-value pairs included in the header section of the L<DBI::ProfileDumper>
-data format. For example:
-
- $header = {
- Path => [ '!Statement', '!MethodName' ],
- Program => 't/42profile_data.t',
- };
-
-Note that modifying this hash will modify the header data stored
-inside the profile object.
-
-=cut
-
-sub header { shift->{_header} }
-
-
-=head2 $nodes = $prof->nodes()
-
-Returns a reference the sorted nodes array. Each element in the array
-is a single record in the data set. The first seven elements are the
-same as the elements provided by L<DBI::Profile>. After that each key is
-in a separate element. For example:
-
- $nodes = [
- [
- 2, # 0, count
- 0.0312958955764771, # 1, total duration
- 0.000490069389343262, # 2, first duration
- 0.000176072120666504, # 3, shortest duration
- 0.00140702724456787, # 4, longest duration
- 1023115819.83019, # 5, time of first event
- 1023115819.86576, # 6, time of last event
- 'SELECT foo FROM bar' # 7, key1
- 'execute' # 8, key2
- # 6+N, keyN
- ],
- # ...
- ];
-
-Note that modifying this array will modify the node data stored inside
-the profile object.
-
-=cut
-
-sub nodes { shift->{_nodes} }
-
-
-=head2 $count = $prof->count()
-
-Returns the number of items in the profile data set.
-
-=cut
-
-sub count { scalar @{shift->{_nodes}} }
-
-
-=head2 $prof->sort(field => "field")
-
-=head2 $prof->sort(field => "field", reverse => 1)
-
-Sorts data by the given field. Available fields are:
-
- longest
- total
- count
- shortest
-
-The default sort is greatest to smallest, which is the opposite of the
-normal Perl meaning. This, however, matches the expected behavior of
-the dbiprof frontend.
-
-=cut
-
-
-# sorts data by one of the available fields
-{
- my %FIELDS = (
- longest => LONGEST,
- total => TOTAL,
- count => COUNT,
- shortest => SHORTEST,
- key1 => PATH+0,
- key2 => PATH+1,
- key3 => PATH+2,
- );
- sub sort {
- my $self = shift;
- my $nodes = $self->{_nodes};
- my %opt = @_;
-
- croak("Missing required field option.") unless $opt{field};
-
- my $index = $FIELDS{$opt{field}};
-
- croak("Unrecognized sort field '$opt{field}'.")
- unless defined $index;
-
- # sort over index
- if ($opt{reverse}) {
- @$nodes = sort {
- $a->[$index] <=> $b->[$index]
- } @$nodes;
- } else {
- @$nodes = sort {
- $b->[$index] <=> $a->[$index]
- } @$nodes;
- }
-
- # remember how we're sorted
- $self->{_sort} = $opt{field};
-
- return $self;
- }
-}
-
-
-=head2 $count = $prof->exclude(key2 => "disconnect")
-
-=head2 $count = $prof->exclude(key2 => "disconnect", case_sensitive => 1)
-
-=head2 $count = $prof->exclude(key1 => qr/^SELECT/i)
-
-Removes records from the data set that match the given string or
-regular expression. This method modifies the data in a permanent
-fashion - use clone() first to maintain the original data after
-exclude(). Returns the number of nodes left in the profile data set.
-
-=cut
-
-sub exclude {
- my $self = shift;
- my $nodes = $self->{_nodes};
- my %opt = @_;
-
- # find key index number
- my ($index, $val);
- foreach (keys %opt) {
- if (/^key(\d+)$/) {
- $index = PATH + $1 - 1;
- $val = $opt{$_};
- last;
- }
- }
- croak("Missing required keyN option.") unless $index;
-
- if (UNIVERSAL::isa($val,"Regexp")) {
- # regex match
- @$nodes = grep {
- $#$_ < $index or $_->[$index] !~ /$val/
- } @$nodes;
- } else {
- if ($opt{case_sensitive}) {
- @$nodes = grep {
- $#$_ < $index or $_->[$index] ne $val;
- } @$nodes;
- } else {
- $val = lc $val;
- @$nodes = grep {
- $#$_ < $index or lc($_->[$index]) ne $val;
- } @$nodes;
- }
- }
-
- return scalar @$nodes;
-}
-
-
-=head2 $count = $prof->match(key2 => "disconnect")
-
-=head2 $count = $prof->match(key2 => "disconnect", case_sensitive => 1)
-
-=head2 $count = $prof->match(key1 => qr/^SELECT/i)
-
-Removes records from the data set that do not match the given string
-or regular expression. This method modifies the data in a permanent
-fashion - use clone() first to maintain the original data after
-match(). Returns the number of nodes left in the profile data set.
-
-=cut
-
-sub match {
- my $self = shift;
- my $nodes = $self->{_nodes};
- my %opt = @_;
-
- # find key index number
- my ($index, $val);
- foreach (keys %opt) {
- if (/^key(\d+)$/) {
- $index = PATH + $1 - 1;
- $val = $opt{$_};
- last;
- }
- }
- croak("Missing required keyN option.") unless $index;
-
- if (UNIVERSAL::isa($val,"Regexp")) {
- # regex match
- @$nodes = grep {
- $#$_ >= $index and $_->[$index] =~ /$val/
- } @$nodes;
- } else {
- if ($opt{case_sensitive}) {
- @$nodes = grep {
- $#$_ >= $index and $_->[$index] eq $val;
- } @$nodes;
- } else {
- $val = lc $val;
- @$nodes = grep {
- $#$_ >= $index and lc($_->[$index]) eq $val;
- } @$nodes;
- }
- }
-
- return scalar @$nodes;
-}
-
-
-=head2 $Data = $prof->Data()
-
-Returns the same Data hash structure as seen in L<DBI::Profile>. This
-structure is not sorted. The nodes() structure probably makes more
-sense for most analysis.
-
-=cut
-
-sub Data {
- my $self = shift;
- my (%Data, @data, $ptr);
-
- foreach my $node (@{$self->{_nodes}}) {
- # traverse to key location
- $ptr = \%Data;
- foreach my $key (@{$node}[PATH .. $#$node - 1]) {
- $ptr->{$key} = {} unless exists $ptr->{$key};
- $ptr = $ptr->{$key};
- }
-
- # slice out node data
- $ptr->{$node->[-1]} = [ @{$node}[0 .. 6] ];
- }
-
- return \%Data;
-}
-
-
-=head2 $text = $prof->format($nodes->[0])
-
-Formats a single node into a human-readable block of text.
-
-=cut
-
-sub format {
- my ($self, $node) = @_;
- my $format;
-
- # setup keys
- my $keys = "";
- for (my $i = PATH; $i <= $#$node; $i++) {
- my $key = $node->[$i];
-
- # remove leading and trailing space
- $key =~ s/^\s+//;
- $key =~ s/\s+$//;
-
- # if key has newlines or is long take special precautions
- if (length($key) > 72 or $key =~ /\n/) {
- $keys .= " Key " . ($i - PATH + 1) . " :\n\n$key\n\n";
- } else {
- $keys .= " Key " . ($i - PATH + 1) . " : $key\n";
- }
- }
-
- # nodes with multiple runs get the long entry format, nodes with
- # just one run get a single count.
- if ($node->[COUNT] > 1) {
- $format = <<END;
- Count : %d
- Total Time : %3.6f seconds
- Longest Time : %3.6f seconds
- Shortest Time : %3.6f seconds
- Average Time : %3.6f seconds
-END
- return sprintf($format, @{$node}[COUNT,TOTAL,LONGEST,SHORTEST],
- $node->[TOTAL] / $node->[COUNT]) . $keys;
- } else {
- $format = <<END;
- Count : %d
- Time : %3.6f seconds
-END
-
- return sprintf($format, @{$node}[COUNT,TOTAL]) . $keys;
-
- }
-}
-
-
-=head2 $text = $prof->report(number => 10)
-
-Produces a report with the given number of items.
-
-=cut
-
-sub report {
- my $self = shift;
- my $nodes = $self->{_nodes};
- my %opt = @_;
-
- croak("Missing required number option") unless exists $opt{number};
-
- $opt{number} = @$nodes if @$nodes < $opt{number};
-
- my $report = $self->_report_header($opt{number});
- for (0 .. $opt{number} - 1) {
- $report .= sprintf("#" x 5 . "[ %d ]". "#" x 59 . "\n",
- $_ + 1);
- $report .= $self->format($nodes->[$_]);
- $report .= "\n";
- }
- return $report;
-}
-
-# format the header for report()
-sub _report_header {
- my ($self, $number) = @_;
- my $nodes = $self->{_nodes};
- my $node_count = @$nodes;
-
- # find total runtime and method count
- my ($time, $count) = (0,0);
- foreach my $node (@$nodes) {
- $time += $node->[TOTAL];
- $count += $node->[COUNT];
- }
-
- my $header = <<END;
-
-DBI Profile Data ($self->{_profiler})
-
-END
-
- # output header fields
- while (my ($key, $value) = each %{$self->{_header}}) {
- $header .= sprintf(" %-13s : %s\n", $key, $value);
- }
-
- # output summary data fields
- $header .= sprintf(<<END, $node_count, $number, $self->{_sort}, $count, $time);
- Total Records : %d (showing %d, sorted by %s)
- Total Count : %d
- Total Runtime : %3.6f seconds
-
-END
-
- return $header;
-}
-
-
-1;
-
-__END__
-
-=head1 AUTHOR
-
-Sam Tregar <sam@tregar.com>
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright (C) 2002 Sam Tregar
-
-This program is free software; you can redistribute it and/or modify
-it under the same terms as Perl 5 itself.
-
-=cut
+++ /dev/null
-package DBI::ProfileDumper;
-use strict;
-
-=head1 NAME
-
-DBI::ProfileDumper - profile DBI usage and output data to a file
-
-=head1 SYNOPSIS
-
-To profile an existing program using DBI::ProfileDumper, set the
-DBI_PROFILE environment variable and run your program as usual. For
-example, using bash:
-
- DBI_PROFILE=2/DBI::ProfileDumper program.pl
-
-Then analyze the generated file (F<dbi.prof>) with L<dbiprof|dbiprof>:
-
- dbiprof
-
-You can also activate DBI::ProfileDumper from within your code:
-
- use DBI;
-
- # profile with default path (2) and output file (dbi.prof)
- $dbh->{Profile} = "!Statement/DBI::ProfileDumper";
-
- # same thing, spelled out
- $dbh->{Profile} = "!Statement/DBI::ProfileDumper/File:dbi.prof";
-
- # another way to say it
- use DBI::ProfileDumper;
- $dbh->{Profile} = DBI::ProfileDumper->new(
- Path => [ '!Statement' ],
- File => 'dbi.prof' );
-
- # using a custom path
- $dbh->{Profile} = DBI::ProfileDumper->new(
- Path => [ "foo", "bar" ],
- File => 'dbi.prof',
- );
-
-
-=head1 DESCRIPTION
-
-DBI::ProfileDumper is a subclass of L<DBI::Profile|DBI::Profile> which
-dumps profile data to disk instead of printing a summary to your
-screen. You can then use L<dbiprof|dbiprof> to analyze the data in
-a number of interesting ways, or you can roll your own analysis using
-L<DBI::ProfileData|DBI::ProfileData>.
-
-B<NOTE:> For Apache/mod_perl applications, use
-L<DBI::ProfileDumper::Apache|DBI::ProfileDumper::Apache>.
-
-=head1 USAGE
-
-One way to use this module is just to enable it in your C<$dbh>:
-
- $dbh->{Profile} = "1/DBI::ProfileDumper";
-
-This will write out profile data by statement into a file called
-F<dbi.prof>. If you want to modify either of these properties, you
-can construct the DBI::ProfileDumper object yourself:
-
- use DBI::ProfileDumper;
- $dbh->{Profile} = DBI::ProfileDumper->new(
- Path => [ '!Statement' ],
- File => 'dbi.prof'
- );
-
-The C<Path> option takes the same values as in
-L<DBI::Profile>. The C<File> option gives the name of the
-file where results will be collected. If it already exists it will be
-overwritten.
-
-You can also activate this module by setting the DBI_PROFILE
-environment variable:
-
- $ENV{DBI_PROFILE} = "!Statement/DBI::ProfileDumper";
-
-This will cause all DBI handles to share the same profiling object.
-
-=head1 METHODS
-
-The following methods are available to be called using the profile
-object. You can get access to the profile object from the Profile key
-in any DBI handle:
-
- my $profile = $dbh->{Profile};
-
-=head2 flush_to_disk
-
- $profile->flush_to_disk()
-
-Flushes all collected profile data to disk and empties the Data hash. Returns
-the filename written to. If no profile data has been collected then the file is
-not written and flush_to_disk() returns undef.
-
-The file is locked while it's being written. A process 'consuming' the files
-while they're being written to, should rename the file first, then lock it,
-then read it, then close and delete it. The C<DeleteFiles> option to
-L<DBI::ProfileData> does the right thing.
-
-This method may be called multiple times during a program run.
-
-=head2 empty
-
- $profile->empty()
-
-Clears the Data hash without writing to disk.
-
-=head2 filename
-
- $filename = $profile->filename();
-
-Get or set the filename.
-
-The filename can be specified as a CODE reference, in which case the referenced
-code should return the filename to be used. The code will be called with the
-profile object as its first argument.
-
-=head1 DATA FORMAT
-
-The data format written by DBI::ProfileDumper starts with a header
-containing the version number of the module used to generate it. Then
-a block of variable declarations describes the profile. After two
-newlines, the profile data forms the body of the file. For example:
-
- DBI::ProfileDumper 2.003762
- Path = [ '!Statement', '!MethodName' ]
- Program = t/42profile_data.t
-
- + 1 SELECT name FROM users WHERE id = ?
- + 2 prepare
- = 1 0.0312958955764771 0.000490069389343262 0.000176072120666504 0.00140702724456787 1023115819.83019 1023115819.86576
- + 2 execute
- 1 0.0312958955764771 0.000490069389343262 0.000176072120666504 0.00140702724456787 1023115819.83019 1023115819.86576
- + 2 fetchrow_hashref
- = 1 0.0312958955764771 0.000490069389343262 0.000176072120666504 0.00140702724456787 1023115819.83019 1023115819.86576
- + 1 UPDATE users SET name = ? WHERE id = ?
- + 2 prepare
- = 1 0.0312958955764771 0.000490069389343262 0.000176072120666504 0.00140702724456787 1023115819.83019 1023115819.86576
- + 2 execute
- = 1 0.0312958955764771 0.000490069389343262 0.000176072120666504 0.00140702724456787 1023115819.83019 1023115819.86576
-
-The lines beginning with C<+> signs signify keys. The number after
-the C<+> sign shows the nesting level of the key. Lines beginning
-with C<=> are the actual profile data, in the same order as
-in DBI::Profile.
-
-Note that the same path may be present multiple times in the data file
-since C<format()> may be called more than once. When read by
-DBI::ProfileData the data points will be merged to produce a single
-data set for each distinct path.
-
-The key strings are transformed in three ways. First, all backslashes
-are doubled. Then all newlines and carriage-returns are transformed
-into C<\n> and C<\r> respectively. Finally, any NULL bytes (C<\0>)
-are entirely removed. When DBI::ProfileData reads the file the first
-two transformations will be reversed, but NULL bytes will not be
-restored.
-
-=head1 AUTHOR
-
-Sam Tregar <sam@tregar.com>
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright (C) 2002 Sam Tregar
-
-This program is free software; you can redistribute it and/or modify
-it under the same terms as Perl 5 itself.
-
-=cut
-
-# inherit from DBI::Profile
-use DBI::Profile;
-
-our @ISA = ("DBI::Profile");
-
-our $VERSION = "2.015325";
-
-use Carp qw(croak);
-use Fcntl qw(:flock);
-use Symbol;
-
-my $HAS_FLOCK = (defined $ENV{DBI_PROFILE_FLOCK})
- ? $ENV{DBI_PROFILE_FLOCK}
- : do { local $@; eval { flock STDOUT, 0; 1 } };
-
-my $program_header;
-
-
-# validate params and setup default
-sub new {
- my $pkg = shift;
- my $self = $pkg->SUPER::new(
- LockFile => $HAS_FLOCK,
- @_,
- );
-
- # provide a default filename
- $self->filename("dbi.prof") unless $self->filename;
-
- DBI->trace_msg("$self: @{[ %$self ]}\n",0)
- if $self->{Trace} && $self->{Trace} >= 2;
-
- return $self;
-}
-
-
-# get/set filename to use
-sub filename {
- my $self = shift;
- $self->{File} = shift if @_;
- my $filename = $self->{File};
- $filename = $filename->($self) if ref($filename) eq 'CODE';
- return $filename;
-}
-
-
-# flush available data to disk
-sub flush_to_disk {
- my $self = shift;
- my $class = ref $self;
- my $filename = $self->filename;
- my $data = $self->{Data};
-
- if (1) { # make an option
- if (not $data or ref $data eq 'HASH' && !%$data) {
- DBI->trace_msg("flush_to_disk skipped for empty profile\n",0) if $self->{Trace};
- return undef;
- }
- }
-
- my $fh = gensym;
- if (($self->{_wrote_header}||'') eq $filename) {
- # append more data to the file
- # XXX assumes that Path hasn't changed
- open($fh, ">>", $filename)
- or croak("Unable to open '$filename' for $class output: $!");
- } else {
- # create new file (or overwrite existing)
- if (-f $filename) {
- my $bak = $filename.'.prev';
- unlink($bak);
- rename($filename, $bak)
- or warn "Error renaming $filename to $bak: $!\n";
- }
- open($fh, ">", $filename)
- or croak("Unable to open '$filename' for $class output: $!");
- }
- # lock the file (before checking size and writing the header)
- flock($fh, LOCK_EX) if $self->{LockFile};
- # write header if file is empty - typically because we just opened it
- # in '>' mode, or perhaps we used '>>' but the file had been truncated externally.
- if (-s $fh == 0) {
- DBI->trace_msg("flush_to_disk wrote header to $filename\n",0) if $self->{Trace};
- $self->write_header($fh);
- $self->{_wrote_header} = $filename;
- }
-
- my $lines = $self->write_data($fh, $self->{Data}, 1);
- DBI->trace_msg("flush_to_disk wrote $lines lines to $filename\n",0) if $self->{Trace};
-
- close($fh) # unlocks the file
- or croak("Error closing '$filename': $!");
-
- $self->empty();
-
-
- return $filename;
-}
-
-
-# write header to a filehandle
-sub write_header {
- my ($self, $fh) = @_;
-
- # isolate us against globals which effect print
- local($\, $,);
-
- # $self->VERSION can return undef during global destruction
- my $version = $self->VERSION || $VERSION;
-
- # module name and version number
- print $fh ref($self)." $version\n";
-
- # print out Path (may contain CODE refs etc)
- my @path_words = map { escape_key($_) } @{ $self->{Path} || [] };
- print $fh "Path = [ ", join(', ', @path_words), " ]\n";
-
- # print out $0 and @ARGV
- if (!$program_header) {
- # XXX should really quote as well as escape
- $program_header = "Program = "
- . join(" ", map { escape_key($_) } $0, @ARGV)
- . "\n";
- }
- print $fh $program_header;
-
- # all done
- print $fh "\n";
-}
-
-
-# write data in the proscribed format
-sub write_data {
- my ($self, $fh, $data, $level) = @_;
-
- # XXX it's valid for $data to be an ARRAY ref, i.e., Path is empty.
- # produce an empty profile for invalid $data
- return 0 unless $data and UNIVERSAL::isa($data,'HASH');
-
- # isolate us against globals which affect print
- local ($\, $,);
-
- my $lines = 0;
- while (my ($key, $value) = each(%$data)) {
- # output a key
- print $fh "+ $level ". escape_key($key). "\n";
- if (UNIVERSAL::isa($value,'ARRAY')) {
- # output a data set for a leaf node
- print $fh "= ".join(' ', @$value)."\n";
- $lines += 1;
- } else {
- # recurse through keys - this could be rewritten to use a
- # stack for some small performance gain
- $lines += $self->write_data($fh, $value, $level + 1);
- }
- }
- return $lines;
-}
-
-
-# escape a key for output
-sub escape_key {
- my $key = shift;
- $key =~ s!\\!\\\\!g;
- $key =~ s!\n!\\n!g;
- $key =~ s!\r!\\r!g;
- $key =~ s!\0!!g;
- return $key;
-}
-
-
-# flush data to disk when profile object goes out of scope
-sub on_destroy {
- shift->flush_to_disk();
-}
-
-1;
+++ /dev/null
-package DBI::ProfileDumper::Apache;
-
-use strict;
-
-=head1 NAME
-
-DBI::ProfileDumper::Apache - capture DBI profiling data from Apache/mod_perl
-
-=head1 SYNOPSIS
-
-Add this line to your F<httpd.conf>:
-
- PerlSetEnv DBI_PROFILE 2/DBI::ProfileDumper::Apache
-
-(If you're using mod_perl2, see L</When using mod_perl2> for some additional notes.)
-
-Then restart your server. Access the code you wish to test using a
-web browser, then shutdown your server. This will create a set of
-F<dbi.prof.*> files in your Apache log directory.
-
-Get a profiling report with L<dbiprof|dbiprof>:
-
- dbiprof /path/to/your/apache/logs/dbi.prof.*
-
-When you're ready to perform another profiling run, delete the old files and start again.
-
-=head1 DESCRIPTION
-
-This module interfaces DBI::ProfileDumper to Apache/mod_perl. Using
-this module you can collect profiling data from mod_perl applications.
-It works by creating a DBI::ProfileDumper data file for each Apache
-process. These files are created in your Apache log directory. You
-can then use the dbiprof utility to analyze the profile files.
-
-=head1 USAGE
-
-=head2 LOADING THE MODULE
-
-The easiest way to use this module is just to set the DBI_PROFILE
-environment variable in your F<httpd.conf>:
-
- PerlSetEnv DBI_PROFILE 2/DBI::ProfileDumper::Apache
-
-The DBI will look after loading and using the module when the first DBI handle
-is created.
-
-It's also possible to use this module by setting the Profile attribute
-of any DBI handle:
-
- $dbh->{Profile} = "2/DBI::ProfileDumper::Apache";
-
-See L<DBI::ProfileDumper> for more possibilities, and L<DBI::Profile> for full
-details of the DBI's profiling mechanism.
-
-=head2 WRITING PROFILE DATA
-
-The profile data files will be written to your Apache log directory by default.
-
-The user that the httpd processes run as will need write access to the
-directory. So, for example, if you're running the child httpds as user 'nobody'
-and using chronolog to write to the logs directory, then you'll need to change
-the default.
-
-You can change the destination directory either by specifying a C<Dir> value
-when creating the profile (like C<File> in the L<DBI::ProfileDumper> docs),
-or you can use the C<DBI_PROFILE_APACHE_LOG_DIR> env var to change that. For example:
-
- PerlSetEnv DBI_PROFILE_APACHE_LOG_DIR /server_root/logs
-
-=head3 When using mod_perl2
-
-Under mod_perl2 you'll need to either set the C<DBI_PROFILE_APACHE_LOG_DIR> env var,
-or enable the mod_perl2 C<GlobalRequest> option, like this:
-
- PerlOptions +GlobalRequest
-
-to the global config section you're about test with DBI::ProfileDumper::Apache.
-If you don't do one of those then you'll see messages in your error_log similar to:
-
- DBI::ProfileDumper::Apache on_destroy failed: Global $r object is not available. Set:
- PerlOptions +GlobalRequest in httpd.conf at ..../DBI/ProfileDumper/Apache.pm line 144
-
-=head3 Naming the files
-
-The default file name is inherited from L<DBI::ProfileDumper> via the
-filename() method, but DBI::ProfileDumper::Apache appends the parent pid and
-the current pid, separated by dots, to that name.
-
-=head3 Silencing the log
-
-By default a message is written to STDERR (i.e., the apache error_log file)
-when flush_to_disk() is called (either explicitly, or implicitly via DESTROY).
-
-That's usually very useful. If you don't want the log message you can silence
-it by setting the C<Quiet> attribute true.
-
- PerlSetEnv DBI_PROFILE 2/DBI::ProfileDumper::Apache/Quiet:1
-
- $dbh->{Profile} = "!Statement/DBI::ProfileDumper/Quiet:1";
-
- $dbh->{Profile} = DBI::ProfileDumper->new(
- Path => [ '!Statement' ]
- Quiet => 1
- );
-
-
-=head2 GATHERING PROFILE DATA
-
-Once you have the module loaded, use your application as you normally
-would. Stop the webserver when your tests are complete. Profile data
-files will be produced when Apache exits and you'll see something like
-this in your error_log:
-
- DBI::ProfileDumper::Apache writing to /usr/local/apache/logs/dbi.prof.2604.2619
-
-Now you can use dbiprof to examine the data:
-
- dbiprof /usr/local/apache/logs/dbi.prof.2604.*
-
-By passing dbiprof a list of all generated files, dbiprof will
-automatically merge them into one result set. You can also pass
-dbiprof sorting and querying options, see L<dbiprof> for details.
-
-=head2 CLEANING UP
-
-Once you've made some code changes, you're ready to start again.
-First, delete the old profile data files:
-
- rm /usr/local/apache/logs/dbi.prof.*
-
-Then restart your server and get back to work.
-
-=head1 OTHER ISSUES
-
-=head2 Memory usage
-
-DBI::Profile can use a lot of memory for very active applications because it
-collects profiling data in memory for each distinct query run.
-Calling C<flush_to_disk()> will write the current data to disk and free the
-memory it's using. For example:
-
- $dbh->{Profile}->flush_to_disk() if $dbh->{Profile};
-
-or, rather than flush every time, you could flush less often:
-
- $dbh->{Profile}->flush_to_disk()
- if $dbh->{Profile} and ++$i % 100;
-
-=head1 AUTHOR
-
-Sam Tregar <sam@tregar.com>
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright (C) 2002 Sam Tregar
-
-This program is free software; you can redistribute it and/or modify
-it under the same terms as Perl 5 itself.
-
-=cut
-
-our $VERSION = "2.014121";
-
-our @ISA = qw(DBI::ProfileDumper);
-
-use DBI::ProfileDumper;
-use File::Spec;
-
-my $initial_pid = $$;
-
-use constant MP2 => ($ENV{MOD_PERL_API_VERSION} and $ENV{MOD_PERL_API_VERSION} == 2) ? 1 : 0;
-
-my $server_root_dir;
-
-if (MP2) {
- require Apache2::ServerUtil;
- $server_root_dir = Apache2::ServerUtil::server_root();
-}
-else {
- require Apache;
- $server_root_dir = eval { Apache->server_root_relative('') } || "/tmp";
-}
-
-
-sub _dirname {
- my $self = shift;
- return $self->{Dir} ||= $ENV{DBI_PROFILE_APACHE_LOG_DIR}
- || File::Spec->catdir($server_root_dir, "logs");
-}
-
-
-sub filename {
- my $self = shift;
- my $filename = $self->SUPER::filename(@_);
- return $filename if not $filename; # not set yet
-
- # to be able to identify groups of profile files from the same set of
- # apache processes, we include the parent pid in the file name
- # as well as the pid.
- my $group_pid = ($$ eq $initial_pid) ? $$ : getppid();
- $filename .= ".$group_pid.$$";
-
- return $filename if File::Spec->file_name_is_absolute($filename);
- return File::Spec->catfile($self->_dirname, $filename);
-}
-
-
-sub flush_to_disk {
- my $self = shift;
-
- my $filename = $self->SUPER::flush_to_disk(@_);
-
- print STDERR ref($self)." pid$$ written to $filename\n"
- if $filename && not $self->{Quiet};
-
- return $filename;
-}
-
-1;
+++ /dev/null
-package DBI::ProfileSubs;
-
-our $VERSION = "0.009396";
-
-=head1 NAME
-
-DBI::ProfileSubs - Subroutines for dynamic profile Path
-
-=head1 SYNOPSIS
-
- DBI_PROFILE='&norm_std_n3' prog.pl
-
-This is new and still experimental.
-
-=head1 TO DO
-
-Define come kind of naming convention for the subs.
-
-=cut
-
-use strict;
-use warnings;
-
-
-# would be good to refactor these regex into separate subs and find some
-# way to compose them in various combinations into multiple subs.
-# Perhaps via AUTOLOAD where \&auto_X_Y_Z creates a sub that does X, Y, and Z.
-# The final subs always need to be very fast.
-#
-
-sub norm_std_n3 {
- # my ($h, $method_name) = @_;
- local $_ = $_;
-
- s/\b\d+\b/<N>/g; # 42 -> <N>
- s/\b0x[0-9A-Fa-f]+\b/<N>/g; # 0xFE -> <N>
-
- s/'.*?'/'<S>'/g; # single quoted strings (doesn't handle escapes)
- s/".*?"/"<S>"/g; # double quoted strings (doesn't handle escapes)
-
- # convert names like log20001231 into log<N>
- s/([a-z_]+)(\d{3,})\b/${1}<N>/ig;
-
- # abbreviate massive "in (...)" statements and similar
- s!((\s*<[NS]>\s*,\s*){100,})!sprintf("$2,<repeated %d times>",length($1)/2)!eg;
-
- return $_;
-}
-
-1;
+++ /dev/null
-# $Header: /home/timbo/dbi/lib/DBI/RCS/ProxyServer.pm,v 11.9 2003/05/14 11:08:17 timbo Exp $
-# -*- perl -*-
-#
-# DBI::ProxyServer - a proxy server for DBI drivers
-#
-# Copyright (c) 1997 Jochen Wiedmann
-#
-# The DBD::Proxy module is free software; you can redistribute it and/or
-# modify it under the same terms as Perl itself. In particular permission
-# is granted to Tim Bunce for distributing this as a part of the DBI.
-#
-#
-# Author: Jochen Wiedmann
-# Am Eisteich 9
-# 72555 Metzingen
-# Germany
-#
-# Email: joe@ispsoft.de
-# Phone: +49 7123 14881
-#
-#
-##############################################################################
-
-
-require 5.004;
-use strict;
-
-use RPC::PlServer 0.2001;
-require DBI;
-require Config;
-
-
-package DBI::ProxyServer;
-
-
-
-############################################################################
-#
-# Constants
-#
-############################################################################
-
-use vars qw($VERSION @ISA);
-
-$VERSION = "0.3005";
-@ISA = qw(RPC::PlServer DBI);
-
-
-# Most of the options below are set to default values, we note them here
-# just for the sake of documentation.
-my %DEFAULT_SERVER_OPTIONS;
-{
- my $o = \%DEFAULT_SERVER_OPTIONS;
- $o->{'chroot'} = undef, # To be used in the initfile,
- # after loading the required
- # DBI drivers.
- $o->{'clients'} =
- [ { 'mask' => '.*',
- 'accept' => 1,
- 'cipher' => undef
- }
- ];
- $o->{'configfile'} = '/etc/dbiproxy.conf' if -f '/etc/dbiproxy.conf';
- $o->{'debug'} = 0;
- $o->{'facility'} = 'daemon';
- $o->{'group'} = undef;
- $o->{'localaddr'} = undef; # Bind to any local IP number
- $o->{'localport'} = undef; # Must set port number on the
- # command line.
- $o->{'logfile'} = undef; # Use syslog or EventLog.
-
- # XXX don't restrict methods that can be called (trust users once connected)
- $o->{'XXX_methods'} = {
- 'DBI::ProxyServer' => {
- 'Version' => 1,
- 'NewHandle' => 1,
- 'CallMethod' => 1,
- 'DestroyHandle' => 1
- },
- 'DBI::ProxyServer::db' => {
- 'prepare' => 1,
- 'commit' => 1,
- 'rollback' => 1,
- 'STORE' => 1,
- 'FETCH' => 1,
- 'func' => 1,
- 'quote' => 1,
- 'type_info_all' => 1,
- 'table_info' => 1,
- 'disconnect' => 1,
- },
- 'DBI::ProxyServer::st' => {
- 'execute' => 1,
- 'STORE' => 1,
- 'FETCH' => 1,
- 'func' => 1,
- 'fetch' => 1,
- 'finish' => 1
- }
- };
- if ($Config::Config{'usethreads'} eq 'define') {
- $o->{'mode'} = 'threads';
- } elsif ($Config::Config{'d_fork'} eq 'define') {
- $o->{'mode'} = 'fork';
- } else {
- $o->{'mode'} = 'single';
- }
- # No pidfile by default, configuration must provide one if needed
- $o->{'pidfile'} = 'none';
- $o->{'user'} = undef;
-};
-
-
-############################################################################
-#
-# Name: Version
-#
-# Purpose: Return version string
-#
-# Inputs: $class - This class
-#
-# Result: Version string; suitable for printing by "--version"
-#
-############################################################################
-
-sub Version {
- my $version = $DBI::ProxyServer::VERSION;
- "DBI::ProxyServer $version, Copyright (C) 1998, Jochen Wiedmann";
-}
-
-
-############################################################################
-#
-# Name: AcceptApplication
-#
-# Purpose: Verify DBI DSN
-#
-# Inputs: $self - This instance
-# $dsn - DBI dsn
-#
-# Returns: TRUE for a valid DSN, FALSE otherwise
-#
-############################################################################
-
-sub AcceptApplication {
- my $self = shift; my $dsn = shift;
- $dsn =~ /^dbi:\w+:/i;
-}
-
-
-############################################################################
-#
-# Name: AcceptVersion
-#
-# Purpose: Verify requested DBI version
-#
-# Inputs: $self - Instance
-# $version - DBI version being requested
-#
-# Returns: TRUE for ok, FALSE otherwise
-#
-############################################################################
-
-sub AcceptVersion {
- my $self = shift; my $version = shift;
- require DBI;
- DBI::ProxyServer->init_rootclass();
- $DBI::VERSION >= $version;
-}
-
-
-############################################################################
-#
-# Name: AcceptUser
-#
-# Purpose: Verify user and password by connecting to the client and
-# creating a database connection
-#
-# Inputs: $self - Instance
-# $user - User name
-# $password - Password
-#
-############################################################################
-
-sub AcceptUser {
- my $self = shift; my $user = shift; my $password = shift;
- return 0 if (!$self->SUPER::AcceptUser($user, $password));
- my $dsn = $self->{'application'};
- $self->Debug("Connecting to $dsn as $user");
- local $ENV{DBI_AUTOPROXY} = ''; # :-)
- $self->{'dbh'} = eval {
- DBI::ProxyServer->connect($dsn, $user, $password,
- { 'PrintError' => 0,
- 'Warn' => 0,
- 'RaiseError' => 1,
- 'HandleError' => sub {
- my $err = $_[1]->err;
- my $state = $_[1]->state || '';
- $_[0] .= " [err=$err,state=$state]";
- return 0;
- } })
- };
- if ($@) {
- $self->Error("Error while connecting to $dsn as $user: $@");
- return 0;
- }
- [1, $self->StoreHandle($self->{'dbh'}) ];
-}
-
-
-sub CallMethod {
- my $server = shift;
- my $dbh = $server->{'dbh'};
- # We could store the private_server attribute permanently in
- # $dbh. However, we'd have a reference loop in that case and
- # I would be concerned about garbage collection. :-(
- $dbh->{'private_server'} = $server;
- $server->Debug("CallMethod: => " . do { local $^W; join(",", @_)});
- my @result = eval { $server->SUPER::CallMethod(@_) };
- my $msg = $@;
- undef $dbh->{'private_server'};
- if ($msg) {
- $server->Debug("CallMethod died with: $@");
- die $msg;
- } else {
- $server->Debug("CallMethod: <= " . do { local $^W; join(",", @result) });
- }
- @result;
-}
-
-
-sub main {
- my $server = DBI::ProxyServer->new(\%DEFAULT_SERVER_OPTIONS, \@_);
- $server->Bind();
-}
-
-
-############################################################################
-#
-# The DBI part of the proxyserver is implemented as a DBI subclass.
-# Thus we can reuse some of the DBI methods and overwrite only
-# those that need additional handling.
-#
-############################################################################
-
-package DBI::ProxyServer::dr;
-
-@DBI::ProxyServer::dr::ISA = qw(DBI::dr);
-
-
-package DBI::ProxyServer::db;
-
-@DBI::ProxyServer::db::ISA = qw(DBI::db);
-
-sub prepare {
- my($dbh, $statement, $attr, $params, $proto_ver) = @_;
- my $server = $dbh->{'private_server'};
- if (my $client = $server->{'client'}) {
- if ($client->{'sql'}) {
- if ($statement =~ /^\s*(\S+)/) {
- my $st = $1;
- if (!($statement = $client->{'sql'}->{$st})) {
- die "Unknown SQL query: $st";
- }
- } else {
- die "Cannot parse restricted SQL statement: $statement";
- }
- }
- }
- my $sth = $dbh->SUPER::prepare($statement, $attr);
- my $handle = $server->StoreHandle($sth);
-
- if ( $proto_ver and $proto_ver > 1 ) {
- $sth->{private_proxyserver_described} = 0;
- return $handle;
-
- } else {
- # The difference between the usual prepare and ours is that we implement
- # a combined prepare/execute. The DBD::Proxy driver doesn't call us for
- # prepare. Only if an execute happens, then we are called with method
- # "prepare". Further execute's are called as "execute".
- my @result = $sth->execute($params);
- my ($NAME, $TYPE);
- my $NUM_OF_FIELDS = $sth->{NUM_OF_FIELDS};
- if ($NUM_OF_FIELDS) { # is a SELECT
- $NAME = $sth->{NAME};
- $TYPE = $sth->{TYPE};
- }
- ($handle, $NUM_OF_FIELDS, $sth->{'NUM_OF_PARAMS'},
- $NAME, $TYPE, @result);
- }
-}
-
-sub table_info {
- my $dbh = shift;
- my $sth = $dbh->SUPER::table_info();
- my $numFields = $sth->{'NUM_OF_FIELDS'};
- my $names = $sth->{'NAME'};
- my $types = $sth->{'TYPE'};
-
- # We wouldn't need to send all the rows at this point, instead we could
- # make use of $rsth->fetch() on the client as usual.
- # The problem is that some drivers (namely DBD::ExampleP, DBD::mysql and
- # DBD::mSQL) are returning foreign sth's here, thus an instance of
- # DBI::st and not DBI::ProxyServer::st. We could fix this by permitting
- # the client to execute method DBI::st, but I don't like this.
- my @rows;
- while (my ($row) = $sth->fetch()) {
- last unless defined $row;
- push(@rows, [@$row]);
- }
- ($numFields, $names, $types, @rows);
-}
-
-
-package DBI::ProxyServer::st;
-
-@DBI::ProxyServer::st::ISA = qw(DBI::st);
-
-sub execute {
- my $sth = shift; my $params = shift; my $proto_ver = shift;
- my @outParams;
- if ($params) {
- for (my $i = 0; $i < @$params;) {
- my $param = $params->[$i++];
- if (!ref($param)) {
- $sth->bind_param($i, $param);
- }
- else {
- if (!ref(@$param[0])) {#It's not a reference
- $sth->bind_param($i, @$param);
- }
- else {
- $sth->bind_param_inout($i, @$param);
- my $ref = shift @$param;
- push(@outParams, $ref);
- }
- }
- }
- }
- my $rows = $sth->SUPER::execute();
- if ( $proto_ver and $proto_ver > 1 and not $sth->{private_proxyserver_described} ) {
- my ($NAME, $TYPE);
- my $NUM_OF_FIELDS = $sth->{NUM_OF_FIELDS};
- if ($NUM_OF_FIELDS) { # is a SELECT
- $NAME = $sth->{NAME};
- $TYPE = $sth->{TYPE};
- }
- $sth->{private_proxyserver_described} = 1;
- # First execution, we ship back description.
- return ($rows, $NUM_OF_FIELDS, $sth->{'NUM_OF_PARAMS'}, $NAME, $TYPE, @outParams);
- }
- ($rows, @outParams);
-}
-
-sub fetch {
- my $sth = shift; my $numRows = shift || 1;
- my($ref, @rows);
- while ($numRows-- && ($ref = $sth->SUPER::fetch())) {
- push(@rows, [@$ref]);
- }
- @rows;
-}
-
-
-1;
-
-
-__END__
-
-=head1 NAME
-
-DBI::ProxyServer - a server for the DBD::Proxy driver
-
-=head1 SYNOPSIS
-
- use DBI::ProxyServer;
- DBI::ProxyServer::main(@ARGV);
-
-=head1 DESCRIPTION
-
-DBI::Proxy Server is a module for implementing a proxy for the DBI proxy
-driver, DBD::Proxy. It allows access to databases over the network if the
-DBMS does not offer networked operations. But the proxy server might be
-useful for you, even if you have a DBMS with integrated network
-functionality: It can be used as a DBI proxy in a firewalled environment.
-
-DBI::ProxyServer runs as a daemon on the machine with the DBMS or on the
-firewall. The client connects to the agent using the DBI driver DBD::Proxy,
-thus in the exactly same way than using DBD::mysql, DBD::mSQL or any other
-DBI driver.
-
-The agent is implemented as a RPC::PlServer application. Thus you have
-access to all the possibilities of this module, in particular encryption
-and a similar configuration file. DBI::ProxyServer adds the possibility of
-query restrictions: You can define a set of queries that a client may
-execute and restrict access to those. (Requires a DBI driver that supports
-parameter binding.) See L</CONFIGURATION FILE>.
-
-The provided driver script, L<dbiproxy>, may either be used as it is or
-used as the basis for a local version modified to meet your needs.
-
-=head1 OPTIONS
-
-When calling the DBI::ProxyServer::main() function, you supply an
-array of options. These options are parsed by the Getopt::Long module.
-The ProxyServer inherits all of RPC::PlServer's and hence Net::Daemon's
-options and option handling, in particular the ability to read
-options from either the command line or a config file. See
-L<RPC::PlServer>. See L<Net::Daemon>. Available options include
-
-=over 4
-
-=item I<chroot> (B<--chroot=dir>)
-
-(UNIX only) After doing a bind(), change root directory to the given
-directory by doing a chroot(). This is useful for security, but it
-restricts the environment a lot. For example, you need to load DBI
-drivers in the config file or you have to create hard links to Unix
-sockets, if your drivers are using them. For example, with MySQL, a
-config file might contain the following lines:
-
- my $rootdir = '/var/dbiproxy';
- my $unixsockdir = '/tmp';
- my $unixsockfile = 'mysql.sock';
- foreach $dir ($rootdir, "$rootdir$unixsockdir") {
- mkdir 0755, $dir;
- }
- link("$unixsockdir/$unixsockfile",
- "$rootdir$unixsockdir/$unixsockfile");
- require DBD::mysql;
-
- {
- 'chroot' => $rootdir,
- ...
- }
-
-If you don't know chroot(), think of an FTP server where you can see a
-certain directory tree only after logging in. See also the --group and
---user options.
-
-=item I<clients>
-
-An array ref with a list of clients. Clients are hash refs, the attributes
-I<accept> (0 for denying access and 1 for permitting) and I<mask>, a Perl
-regular expression for the clients IP number or its host name.
-
-=item I<configfile> (B<--configfile=file>)
-
-Config files are assumed to return a single hash ref that overrides the
-arguments of the new method. However, command line arguments in turn take
-precedence over the config file. See the L<"CONFIGURATION FILE"> section
-below for details on the config file.
-
-=item I<debug> (B<--debug>)
-
-Turn debugging mode on. Mainly this asserts that logging messages of
-level "debug" are created.
-
-=item I<facility> (B<--facility=mode>)
-
-(UNIX only) Facility to use for L<Sys::Syslog>. The default is
-B<daemon>.
-
-=item I<group> (B<--group=gid>)
-
-After doing a bind(), change the real and effective GID to the given.
-This is useful, if you want your server to bind to a privileged port
-(<1024), but don't want the server to execute as root. See also
-the --user option.
-
-GID's can be passed as group names or numeric values.
-
-=item I<localaddr> (B<--localaddr=ip>)
-
-By default a daemon is listening to any IP number that a machine
-has. This attribute allows one to restrict the server to the given
-IP number.
-
-=item I<localport> (B<--localport=port>)
-
-This attribute sets the port on which the daemon is listening. It
-must be given somehow, as there's no default.
-
-=item I<logfile> (B<--logfile=file>)
-
-Be default logging messages will be written to the syslog (Unix) or
-to the event log (Windows NT). On other operating systems you need to
-specify a log file. The special value "STDERR" forces logging to
-stderr. See L<Net::Daemon::Log> for details.
-
-=item I<mode> (B<--mode=modename>)
-
-The server can run in three different modes, depending on the environment.
-
-If you are running Perl 5.005 and did compile it for threads, then the
-server will create a new thread for each connection. The thread will
-execute the server's Run() method and then terminate. This mode is the
-default, you can force it with "--mode=threads".
-
-If threads are not available, but you have a working fork(), then the
-server will behave similar by creating a new process for each connection.
-This mode will be used automatically in the absence of threads or if
-you use the "--mode=fork" option.
-
-Finally there's a single-connection mode: If the server has accepted a
-connection, he will enter the Run() method. No other connections are
-accepted until the Run() method returns (if the client disconnects).
-This operation mode is useful if you have neither threads nor fork(),
-for example on the Macintosh. For debugging purposes you can force this
-mode with "--mode=single".
-
-=item I<pidfile> (B<--pidfile=file>)
-
-(UNIX only) If this option is present, a PID file will be created at the
-given location. Default is to not create a pidfile.
-
-=item I<user> (B<--user=uid>)
-
-After doing a bind(), change the real and effective UID to the given.
-This is useful, if you want your server to bind to a privileged port
-(<1024), but don't want the server to execute as root. See also
-the --group and the --chroot options.
-
-UID's can be passed as group names or numeric values.
-
-=item I<version> (B<--version>)
-
-Suppresses startup of the server; instead the version string will
-be printed and the program exits immediately.
-
-=back
-
-=head1 SHUTDOWN
-
-DBI::ProxyServer is built on L<RPC::PlServer> which is, in turn, built on L<Net::Daemon>.
-
-You should refer to L<Net::Daemon> for how to shutdown the server, except that
-you can't because it's not currently documented there (as of v0.43).
-The bottom-line is that it seems that there's no support for graceful shutdown.
-
-=head1 CONFIGURATION FILE
-
-The configuration file is just that of I<RPC::PlServer> or I<Net::Daemon>
-with some additional attributes in the client list.
-
-The config file is a Perl script. At the top of the file you may include
-arbitrary Perl source, for example load drivers at the start (useful
-to enhance performance), prepare a chroot environment and so on.
-
-The important thing is that you finally return a hash ref of option
-name/value pairs. The possible options are listed above.
-
-All possibilities of Net::Daemon and RPC::PlServer apply, in particular
-
-=over 4
-
-=item Host and/or User dependent access control
-
-=item Host and/or User dependent encryption
-
-=item Changing UID and/or GID after binding to the port
-
-=item Running in a chroot() environment
-
-=back
-
-Additionally the server offers you query restrictions. Suggest the
-following client list:
-
- 'clients' => [
- { 'mask' => '^admin\.company\.com$',
- 'accept' => 1,
- 'users' => [ 'root', 'wwwrun' ],
- },
- {
- 'mask' => '^admin\.company\.com$',
- 'accept' => 1,
- 'users' => [ 'root', 'wwwrun' ],
- 'sql' => {
- 'select' => 'SELECT * FROM foo',
- 'insert' => 'INSERT INTO foo VALUES (?, ?, ?)'
- }
- }
-
-then only the users root and wwwrun may connect from admin.company.com,
-executing arbitrary queries, but only wwwrun may connect from other
-hosts and is restricted to
-
- $sth->prepare("select");
-
-or
-
- $sth->prepare("insert");
-
-which in fact are "SELECT * FROM foo" or "INSERT INTO foo VALUES (?, ?, ?)".
-
-
-=head1 Proxyserver Configuration file (bigger example)
-
-This section tells you how to restrict a DBI-Proxy: Not every user from
-every workstation shall be able to execute every query.
-
-There is a perl program "dbiproxy" which runs on a machine which is able
-to connect to all the databases we wish to reach. All Perl-DBD-drivers must
-be installed on this machine. You can also reach databases for which drivers
-are not available on the machine where you run the program querying the
-database, e.g. ask MS-Access-database from Linux.
-
-Create a configuration file "proxy_oracle.cfg" at the dbproxy-server:
-
- {
- # This shall run in a shell or a DOS-window
- # facility => 'daemon',
- pidfile => 'your_dbiproxy.pid',
- logfile => 1,
- debug => 0,
- mode => 'single',
- localport => '12400',
-
- # Access control, the first match in this list wins!
- # So the order is important
- clients => [
- # hint to organize:
- # the most specialized rules for single machines/users are 1st
- # then the denying rules
- # then the rules about whole networks
-
- # rule: internal_webserver
- # desc: to get statistical information
- {
- # this IP-address only is meant
- mask => '^10\.95\.81\.243$',
- # accept (not defer) connections like this
- accept => 1,
- # only users from this list
- # are allowed to log on
- users => [ 'informationdesk' ],
- # only this statistical query is allowed
- # to get results for a web-query
- sql => {
- alive => 'select count(*) from dual',
- statistic_area => 'select count(*) from e01admin.e01e203 where geb_bezei like ?',
- }
- },
-
- # rule: internal_bad_guy_1
- {
- mask => '^10\.95\.81\.1$',
- accept => 0,
- },
-
- # rule: employee_workplace
- # desc: get detailed information
- {
- # any IP-address is meant here
- mask => '^10\.95\.81\.(\d+)$',
- # accept (not defer) connections like this
- accept => 1,
- # only users from this list
- # are allowed to log on
- users => [ 'informationdesk', 'lippmann' ],
- # all these queries are allowed:
- sql => {
- search_city => 'select ort_nr, plz, ort from e01admin.e01e200 where plz like ?',
- search_area => 'select gebiettyp, geb_bezei from e01admin.e01e203 where geb_bezei like ? or geb_bezei like ?',
- }
- },
-
- # rule: internal_bad_guy_2
- # This does NOT work, because rule "employee_workplace" hits
- # with its ip-address-mask of the whole network
- {
- # don't accept connection from this ip-address
- mask => '^10\.95\.81\.5$',
- accept => 0,
- }
- ]
- }
-
-Start the proxyserver like this:
-
- rem well-set Oracle_home needed for Oracle
- set ORACLE_HOME=d:\oracle\ora81
- dbiproxy --configfile proxy_oracle.cfg
-
-
-=head2 Testing the connection from a remote machine
-
-Call a program "dbish" from your commandline. I take the machine from rule "internal_webserver"
-
- dbish "dbi:Proxy:hostname=oracle.zdf;port=12400;dsn=dbi:Oracle:e01" informationdesk xxx
-
-There will be a shell-prompt:
-
- informationdesk@dbi...> alive
-
- Current statement buffer (enter '/'...):
- alive
-
- informationdesk@dbi...> /
- COUNT(*)
- '1'
- [1 rows of 1 fields returned]
-
-
-=head2 Testing the connection with a perl-script
-
-Create a perl-script like this:
-
- # file: oratest.pl
- # call me like this: perl oratest.pl user password
-
- use strict;
- use DBI;
-
- my $user = shift || die "Usage: $0 user password";
- my $pass = shift || die "Usage: $0 user password";
- my $config = {
- dsn_at_proxy => "dbi:Oracle:e01",
- proxy => "hostname=oechsle.zdf;port=12400",
- };
- my $dsn = sprintf "dbi:Proxy:%s;dsn=%s",
- $config->{proxy},
- $config->{dsn_at_proxy};
-
- my $dbh = DBI->connect( $dsn, $user, $pass )
- || die "connect did not work: $DBI::errstr";
-
- my $sql = "search_city";
- printf "%s\n%s\n%s\n", "="x40, $sql, "="x40;
- my $cur = $dbh->prepare($sql);
- $cur->bind_param(1,'905%');
- &show_result ($cur);
-
- my $sql = "search_area";
- printf "%s\n%s\n%s\n", "="x40, $sql, "="x40;
- my $cur = $dbh->prepare($sql);
- $cur->bind_param(1,'Pfarr%');
- $cur->bind_param(2,'Bronnamberg%');
- &show_result ($cur);
-
- my $sql = "statistic_area";
- printf "%s\n%s\n%s\n", "="x40, $sql, "="x40;
- my $cur = $dbh->prepare($sql);
- $cur->bind_param(1,'Pfarr%');
- &show_result ($cur);
-
- $dbh->disconnect;
- exit;
-
-
- sub show_result {
- my $cur = shift;
- unless ($cur->execute()) {
- print "Could not execute\n";
- return;
- }
-
- my $rownum = 0;
- while (my @row = $cur->fetchrow_array()) {
- printf "Row is: %s\n", join(", ",@row);
- if ($rownum++ > 5) {
- print "... and so on\n";
- last;
- }
- }
- $cur->finish;
- }
-
-The result
-
- C:\>perl oratest.pl informationdesk xxx
- ========================================
- search_city
- ========================================
- Row is: 3322, 9050, Chemnitz
- Row is: 3678, 9051, Chemnitz
- Row is: 10447, 9051, Chemnitz
- Row is: 12128, 9051, Chemnitz
- Row is: 10954, 90513, Zirndorf
- Row is: 5808, 90513, Zirndorf
- Row is: 5715, 90513, Zirndorf
- ... and so on
- ========================================
- search_area
- ========================================
- Row is: 101, Bronnamberg
- Row is: 400, Pfarramt Zirndorf
- Row is: 400, Pfarramt Rosstal
- Row is: 400, Pfarramt Oberasbach
- Row is: 401, Pfarramt Zirndorf
- Row is: 401, Pfarramt Rosstal
- ========================================
- statistic_area
- ========================================
- DBD::Proxy::st execute failed: Server returned error: Failed to execute method CallMethod: Unknown SQL query: statistic_area at E:/Perl/site/lib/DBI/ProxyServer.pm line 258.
- Could not execute
-
-
-=head2 How the configuration works
-
-The most important section to control access to your dbi-proxy is "client=>"
-in the file "proxy_oracle.cfg":
-
-Controlling which person at which machine is allowed to access
-
-=over 4
-
-=item * "mask" is a perl regular expression against the plain ip-address of the machine which wishes to connect _or_ the reverse-lookup from a nameserver.
-
-=item * "accept" tells the dbiproxy-server whether ip-adresse like in "mask" are allowed to connect or not (0/1)
-
-=item * "users" is a reference to a list of usernames which must be matched, this is NOT a regular expression.
-
-=back
-
-Controlling which SQL-statements are allowed
-
-You can put every SQL-statement you like in simply omitting "sql => ...", but the more important thing is to restrict the connection so that only allowed queries are possible.
-
-If you include an sql-section in your config-file like this:
-
- sql => {
- alive => 'select count(*) from dual',
- statistic_area => 'select count(*) from e01admin.e01e203 where geb_bezei like ?',
- }
-
-The user is allowed to put two queries against the dbi-proxy. The queries are _not_ "select count(*)...", the queries are "alive" and "statistic_area"! These keywords are replaced by the real query. So you can run a query for "alive":
-
- my $sql = "alive";
- my $cur = $dbh->prepare($sql);
- ...
-
-The flexibility is that you can put parameters in the where-part of the query so the query are not static. Simply replace a value in the where-part of the query through a question mark and bind it as a parameter to the query.
-
- my $sql = "statistic_area";
- my $cur = $dbh->prepare($sql);
- $cur->bind_param(1,'905%');
- # A second parameter would be called like this:
- # $cur->bind_param(2,'98%');
-
-The result is this query:
-
- select count(*) from e01admin.e01e203
- where geb_bezei like '905%'
-
-Don't try to put parameters into the sql-query like this:
-
- # Does not work like you think.
- # Only the first word of the query is parsed,
- # so it's changed to "statistic_area", the rest is omitted.
- # You _have_ to work with $cur->bind_param.
- my $sql = "statistic_area 905%";
- my $cur = $dbh->prepare($sql);
- ...
-
-
-=head2 Problems
-
-=over 4
-
-=item * I don't know how to restrict users to special databases.
-
-=item * I don't know how to pass query-parameters via dbish
-
-=back
-
-
-=head1 SECURITY WARNING
-
-L<RPC::PlServer> used underneath is not secure due to serializing and
-deserializing data with L<Storable> module. Use the proxy driver only in
-trusted environment.
-
-
-=head1 AUTHOR
-
- Copyright (c) 1997 Jochen Wiedmann
- Am Eisteich 9
- 72555 Metzingen
- Germany
-
- Email: joe@ispsoft.de
- Phone: +49 7123 14881
-
-The DBI::ProxyServer module is free software; you can redistribute it
-and/or modify it under the same terms as Perl itself. In particular
-permission is granted to Tim Bunce for distributing this as a part of
-the DBI.
-
-
-=head1 SEE ALSO
-
-L<dbiproxy>, L<DBD::Proxy>, L<DBI>, L<RPC::PlServer>,
-L<RPC::PlClient>, L<Net::Daemon>, L<Net::Daemon::Log>,
-L<Sys::Syslog>, L<Win32::EventLog>, L<syslog>
+++ /dev/null
-########################################################################
-package # hide from PAUSE
- DBI;
-# vim: ts=8:sw=4
-########################################################################
-#
-# Copyright (c) 2002,2003 Tim Bunce Ireland.
-#
-# See COPYRIGHT section in DBI.pm for usage and distribution rights.
-#
-########################################################################
-#
-# Please send patches and bug reports to
-#
-# Jeff Zucker <jeff@vpservices.com> with cc to <dbi-dev@perl.org>
-#
-########################################################################
-
-use strict;
-use Carp;
-require Symbol;
-
-require utf8;
-*utf8::is_utf8 = sub { # hack for perl 5.6
- require bytes;
- return unless defined $_[0];
- return !(length($_[0]) == bytes::length($_[0]))
-} unless defined &utf8::is_utf8;
-
-$DBI::PurePerl = $ENV{DBI_PUREPERL} || 1;
-$DBI::PurePerl::VERSION = "2.014286";
-
-$DBI::neat_maxlen ||= 400;
-
-$DBI::tfh = Symbol::gensym();
-open $DBI::tfh, ">&STDERR" or warn "Can't dup STDERR: $!";
-select( (select($DBI::tfh), $| = 1)[0] ); # autoflush
-
-# check for weaken support, used by ChildHandles
-my $HAS_WEAKEN = eval {
- require Scalar::Util;
- # this will croak() if this Scalar::Util doesn't have a working weaken().
- Scalar::Util::weaken( my $test = [] );
- 1;
-};
-
-%DBI::last_method_except = map { $_=>1 } qw(DESTROY _set_fbav set_err);
-
-use constant SQL_ALL_TYPES => 0;
-use constant SQL_ARRAY => 50;
-use constant SQL_ARRAY_LOCATOR => 51;
-use constant SQL_BIGINT => (-5);
-use constant SQL_BINARY => (-2);
-use constant SQL_BIT => (-7);
-use constant SQL_BLOB => 30;
-use constant SQL_BLOB_LOCATOR => 31;
-use constant SQL_BOOLEAN => 16;
-use constant SQL_CHAR => 1;
-use constant SQL_CLOB => 40;
-use constant SQL_CLOB_LOCATOR => 41;
-use constant SQL_DATE => 9;
-use constant SQL_DATETIME => 9;
-use constant SQL_DECIMAL => 3;
-use constant SQL_DOUBLE => 8;
-use constant SQL_FLOAT => 6;
-use constant SQL_GUID => (-11);
-use constant SQL_INTEGER => 4;
-use constant SQL_INTERVAL => 10;
-use constant SQL_INTERVAL_DAY => 103;
-use constant SQL_INTERVAL_DAY_TO_HOUR => 108;
-use constant SQL_INTERVAL_DAY_TO_MINUTE => 109;
-use constant SQL_INTERVAL_DAY_TO_SECOND => 110;
-use constant SQL_INTERVAL_HOUR => 104;
-use constant SQL_INTERVAL_HOUR_TO_MINUTE => 111;
-use constant SQL_INTERVAL_HOUR_TO_SECOND => 112;
-use constant SQL_INTERVAL_MINUTE => 105;
-use constant SQL_INTERVAL_MINUTE_TO_SECOND => 113;
-use constant SQL_INTERVAL_MONTH => 102;
-use constant SQL_INTERVAL_SECOND => 106;
-use constant SQL_INTERVAL_YEAR => 101;
-use constant SQL_INTERVAL_YEAR_TO_MONTH => 107;
-use constant SQL_LONGVARBINARY => (-4);
-use constant SQL_LONGVARCHAR => (-1);
-use constant SQL_MULTISET => 55;
-use constant SQL_MULTISET_LOCATOR => 56;
-use constant SQL_NUMERIC => 2;
-use constant SQL_REAL => 7;
-use constant SQL_REF => 20;
-use constant SQL_ROW => 19;
-use constant SQL_SMALLINT => 5;
-use constant SQL_TIME => 10;
-use constant SQL_TIMESTAMP => 11;
-use constant SQL_TINYINT => (-6);
-use constant SQL_TYPE_DATE => 91;
-use constant SQL_TYPE_TIME => 92;
-use constant SQL_TYPE_TIMESTAMP => 93;
-use constant SQL_TYPE_TIMESTAMP_WITH_TIMEZONE => 95;
-use constant SQL_TYPE_TIME_WITH_TIMEZONE => 94;
-use constant SQL_UDT => 17;
-use constant SQL_UDT_LOCATOR => 18;
-use constant SQL_UNKNOWN_TYPE => 0;
-use constant SQL_VARBINARY => (-3);
-use constant SQL_VARCHAR => 12;
-use constant SQL_WCHAR => (-8);
-use constant SQL_WLONGVARCHAR => (-10);
-use constant SQL_WVARCHAR => (-9);
-
-# for Cursor types
-use constant SQL_CURSOR_FORWARD_ONLY => 0;
-use constant SQL_CURSOR_KEYSET_DRIVEN => 1;
-use constant SQL_CURSOR_DYNAMIC => 2;
-use constant SQL_CURSOR_STATIC => 3;
-use constant SQL_CURSOR_TYPE_DEFAULT => SQL_CURSOR_FORWARD_ONLY;
-
-use constant IMA_HAS_USAGE => 0x0001; #/* check parameter usage */
-use constant IMA_FUNC_REDIRECT => 0x0002; #/* is $h->func(..., "method")*/
-use constant IMA_KEEP_ERR => 0x0004; #/* don't reset err & errstr */
-use constant IMA_KEEP_ERR_SUB => 0x0008; #/* '' if in nested call */
-use constant IMA_NO_TAINT_IN => 0x0010; #/* don't check for tainted args*/
-use constant IMA_NO_TAINT_OUT => 0x0020; #/* don't taint results */
-use constant IMA_COPY_UP_STMT => 0x0040; #/* copy sth Statement to dbh */
-use constant IMA_END_WORK => 0x0080; #/* set on commit & rollback */
-use constant IMA_STUB => 0x0100; #/* do nothing eg $dbh->connected */
-use constant IMA_CLEAR_STMT => 0x0200; #/* clear Statement before call */
-use constant IMA_UNRELATED_TO_STMT=> 0x0400; #/* profile as empty Statement */
-use constant IMA_NOT_FOUND_OKAY => 0x0800; #/* not error if not found */
-use constant IMA_EXECUTE => 0x1000; #/* do/execute: DBIcf_Executed */
-use constant IMA_SHOW_ERR_STMT => 0x2000; #/* dbh meth relates to Statement*/
-use constant IMA_HIDE_ERR_PARAMVALUES => 0x4000; #/* ParamValues are not relevant */
-use constant IMA_IS_FACTORY => 0x8000; #/* new h ie connect & prepare */
-use constant IMA_CLEAR_CACHED_KIDS => 0x10000; #/* clear CachedKids before call */
-
-use constant DBIstcf_STRICT => 0x0001;
-use constant DBIstcf_DISCARD_STRING => 0x0002;
-
-my %is_flag_attribute = map {$_ =>1 } qw(
- Active
- AutoCommit
- ChopBlanks
- CompatMode
- Executed
- Taint
- TaintIn
- TaintOut
- InactiveDestroy
- AutoInactiveDestroy
- LongTruncOk
- MultiThread
- PrintError
- PrintWarn
- RaiseError
- ShowErrorStatement
- Warn
-);
-my %is_valid_attribute = map {$_ =>1 } (keys %is_flag_attribute, qw(
- ActiveKids
- Attribution
- BegunWork
- CachedKids
- Callbacks
- ChildHandles
- CursorName
- Database
- DebugDispatch
- Driver
- Err
- Errstr
- ErrCount
- FetchHashKeyName
- HandleError
- HandleSetErr
- ImplementorClass
- Kids
- LongReadLen
- NAME NAME_uc NAME_lc NAME_uc_hash NAME_lc_hash
- NULLABLE
- NUM_OF_FIELDS
- NUM_OF_PARAMS
- Name
- PRECISION
- ParamValues
- Profile
- Provider
- ReadOnly
- RootClass
- RowCacheSize
- RowsInCache
- SCALE
- State
- Statement
- TYPE
- Type
- TraceLevel
- Username
- Version
-));
-
-sub valid_attribute {
- my $attr = shift;
- return 1 if $is_valid_attribute{$attr};
- return 1 if $attr =~ m/^[a-z]/; # starts with lowercase letter
- return 0
-}
-
-my $initial_setup;
-sub initial_setup {
- $initial_setup = 1;
- print $DBI::tfh __FILE__ . " version " . $DBI::PurePerl::VERSION . "\n"
- if $DBI::dbi_debug & 0xF;
- untie $DBI::err;
- untie $DBI::errstr;
- untie $DBI::state;
- untie $DBI::rows;
- #tie $DBI::lasth, 'DBI::var', '!lasth'; # special case: return boolean
-}
-
-sub _install_method {
- my ( $caller, $method, $from, $param_hash ) = @_;
- initial_setup() unless $initial_setup;
-
- my ($class, $method_name) = $method =~ /^[^:]+::(.+)::(.+)$/;
- my $bitmask = $param_hash->{'O'} || 0;
- my @pre_call_frag;
-
- return if $method_name eq 'can';
-
- push @pre_call_frag, q{
- delete $h->{CachedKids};
- # ignore DESTROY for outer handle (DESTROY for inner likely to follow soon)
- return if $h_inner;
- # handle AutoInactiveDestroy and InactiveDestroy
- $h->{InactiveDestroy} = 1
- if $h->{AutoInactiveDestroy} and $$ != $h->{dbi_pp_pid};
- $h->{Active} = 0
- if $h->{InactiveDestroy};
- # copy err/errstr/state up to driver so $DBI::err etc still work
- if ($h->{err} and my $drh = $h->{Driver}) {
- $drh->{$_} = $h->{$_} for ('err','errstr','state');
- }
- } if $method_name eq 'DESTROY';
-
- push @pre_call_frag, q{
- return $h->{$_[0]} if exists $h->{$_[0]};
- } if $method_name eq 'FETCH' && !exists $ENV{DBI_TRACE}; # XXX ?
-
- push @pre_call_frag, "return;"
- if IMA_STUB & $bitmask;
-
- push @pre_call_frag, q{
- $method_name = pop @_;
- } if IMA_FUNC_REDIRECT & $bitmask;
-
- push @pre_call_frag, q{
- my $parent_dbh = $h->{Database};
- } if (IMA_COPY_UP_STMT|IMA_EXECUTE) & $bitmask;
-
- push @pre_call_frag, q{
- warn "No Database set for $h on $method_name!" unless $parent_dbh; # eg proxy problems
- $parent_dbh->{Statement} = $h->{Statement} if $parent_dbh;
- } if IMA_COPY_UP_STMT & $bitmask;
-
- push @pre_call_frag, q{
- $h->{Executed} = 1;
- $parent_dbh->{Executed} = 1 if $parent_dbh;
- } if IMA_EXECUTE & $bitmask;
-
- push @pre_call_frag, q{
- %{ $h->{CachedKids} } = () if $h->{CachedKids};
- } if IMA_CLEAR_CACHED_KIDS & $bitmask;
-
- if (IMA_KEEP_ERR & $bitmask) {
- push @pre_call_frag, q{
- my $keep_error = DBI::_err_hash($h);
- };
- }
- else {
- my $ke_init = (IMA_KEEP_ERR_SUB & $bitmask)
- ? q{= ($h->{dbi_pp_parent}->{dbi_pp_call_depth} && DBI::_err_hash($h)) }
- : "";
- push @pre_call_frag, qq{
- my \$keep_error $ke_init;
- };
- my $clear_error_code = q{
- #warn "$method_name cleared err";
- $h->{err} = $DBI::err = undef;
- $h->{errstr} = $DBI::errstr = undef;
- $h->{state} = $DBI::state = '';
- };
- $clear_error_code = q{
- printf $DBI::tfh " !! %s: %s CLEARED by call to }.$method_name.q{ method\n".
- $h->{err}, $h->{err}
- if defined $h->{err} && $DBI::dbi_debug & 0xF;
- }. $clear_error_code
- if exists $ENV{DBI_TRACE};
- push @pre_call_frag, ($ke_init)
- ? qq{ unless (\$keep_error) { $clear_error_code }}
- : $clear_error_code
- unless $method_name eq 'set_err';
- }
-
- push @pre_call_frag, q{
- my $ErrCount = $h->{ErrCount};
- };
-
- push @pre_call_frag, q{
- if (($DBI::dbi_debug & 0xF) >= 2) {
- local $^W;
- my $args = join " ", map { DBI::neat($_) } ($h, @_);
- printf $DBI::tfh " > $method_name in $imp ($args) [$@]\n";
- }
- } if exists $ENV{DBI_TRACE}; # note use of 'exists'
-
- push @pre_call_frag, q{
- $h->{'dbi_pp_last_method'} = $method_name;
- } unless exists $DBI::last_method_except{$method_name};
-
- # --- post method call code fragments ---
- my @post_call_frag;
-
- push @post_call_frag, q{
- if (my $trace_level = ($DBI::dbi_debug & 0xF)) {
- if ($h->{err}) {
- printf $DBI::tfh " !! ERROR: %s %s\n", $h->{err}, $h->{errstr};
- }
- my $ret = join " ", map { DBI::neat($_) } @ret;
- my $msg = " < $method_name= $ret";
- $msg = ($trace_level >= 2) ? Carp::shortmess($msg) : "$msg\n";
- print $DBI::tfh $msg;
- }
- } if exists $ENV{DBI_TRACE}; # note use of exists
-
- push @post_call_frag, q{
- $h->{Executed} = 0;
- if ($h->{BegunWork}) {
- $h->{BegunWork} = 0;
- $h->{AutoCommit} = 1;
- }
- } if IMA_END_WORK & $bitmask;
-
- push @post_call_frag, q{
- if ( ref $ret[0] and
- UNIVERSAL::isa($ret[0], 'DBI::_::common') and
- defined( (my $h_new = tied(%{$ret[0]})||$ret[0])->{err} )
- ) {
- # copy up info/warn to drh so PrintWarn on connect is triggered
- $h->set_err($h_new->{err}, $h_new->{errstr}, $h_new->{state})
- }
- } if IMA_IS_FACTORY & $bitmask;
-
- push @post_call_frag, q{
- if ($keep_error) {
- $keep_error = 0
- if $h->{ErrCount} > $ErrCount
- or DBI::_err_hash($h) ne $keep_error;
- }
-
- $DBI::err = $h->{err};
- $DBI::errstr = $h->{errstr};
- $DBI::state = $h->{state};
-
- if ( !$keep_error
- && defined(my $err = $h->{err})
- && ($call_depth <= 1 && !$h->{dbi_pp_parent}{dbi_pp_call_depth})
- ) {
-
- my($pe,$pw,$re,$he) = @{$h}{qw(PrintError PrintWarn RaiseError HandleError)};
- my $msg;
-
- if ($err && ($pe || $re || $he) # error
- or (!$err && length($err) && $pw) # warning
- ) {
- my $last = ($DBI::last_method_except{$method_name})
- ? ($h->{'dbi_pp_last_method'}||$method_name) : $method_name;
- my $errstr = $h->{errstr} || $DBI::errstr || $err || '';
- my $msg = sprintf "%s %s %s: %s", $imp, $last,
- ($err eq "0") ? "warning" : "failed", $errstr;
-
- if ($h->{'ShowErrorStatement'} and my $Statement = $h->{Statement}) {
- $msg .= ' [for Statement "' . $Statement;
- if (my $ParamValues = $h->FETCH('ParamValues')) {
- $msg .= '" with ParamValues: ';
- $msg .= DBI::_concat_hash_sorted($ParamValues, "=", ", ", 1, undef);
- $msg .= "]";
- }
- else {
- $msg .= '"]';
- }
- }
- if ($err eq "0") { # is 'warning' (not info)
- carp $msg if $pw;
- }
- else {
- my $do_croak = 1;
- if (my $subsub = $h->{'HandleError'}) {
- $do_croak = 0 if &$subsub($msg,$h,$ret[0]);
- }
- if ($do_croak) {
- printf $DBI::tfh " $method_name has failed ($h->{PrintError},$h->{RaiseError})\n"
- if ($DBI::dbi_debug & 0xF) >= 4;
- carp $msg if $pe;
- die $msg if $h->{RaiseError};
- }
- }
- }
- }
- };
-
-
- my $method_code = q[
- sub {
- my $h = shift;
- my $h_inner = tied(%$h);
- $h = $h_inner if $h_inner;
-
- my $imp;
- if ($method_name eq 'DESTROY') {
- # during global destruction, $h->{...} can trigger "Can't call FETCH on an undef value"
- # implying that tied() above lied to us, so we need to use eval
- local $@; # protect $@
- $imp = eval { $h->{"ImplementorClass"} } or return; # probably global destruction
- }
- else {
- $imp = $h->{"ImplementorClass"} or do {
- warn "Can't call $method_name method on handle $h after take_imp_data()\n"
- if not exists $h->{Active};
- return; # or, more likely, global destruction
- };
- }
-
- ] . join("\n", '', @pre_call_frag, '') . q[
-
- my $call_depth = $h->{'dbi_pp_call_depth'} + 1;
- local ($h->{'dbi_pp_call_depth'}) = $call_depth;
-
- my @ret;
- my $sub = $imp->can($method_name);
- if (!$sub and IMA_FUNC_REDIRECT & $bitmask and $sub = $imp->can('func')) {
- push @_, $method_name;
- }
- if ($sub) {
- (wantarray) ? (@ret = &$sub($h,@_)) : (@ret = scalar &$sub($h,@_));
- }
- else {
- # XXX could try explicit fallback to $imp->can('AUTOLOAD') etc
- # which would then let Multiplex pass PurePerl tests, but some
- # hook into install_method may be better.
- croak "Can't locate DBI object method \"$method_name\" via package \"$imp\""
- if ] . ((IMA_NOT_FOUND_OKAY & $bitmask) ? 0 : 1) . q[;
- }
-
- ] . join("\n", '', @post_call_frag, '') . q[
-
- return (wantarray) ? @ret : $ret[0];
- }
- ];
- no strict qw(refs);
- my $code_ref = eval qq{#line 1 "DBI::PurePerl $method"\n$method_code};
- warn "$@\n$method_code\n" if $@;
- die "$@\n$method_code\n" if $@;
- *$method = $code_ref;
- if (0 && $method =~ /\b(connect|FETCH)\b/) { # debuging tool
- my $l=0; # show line-numbered code for method
- warn "*$method code:\n".join("\n", map { ++$l.": $_" } split/\n/,$method_code);
- }
-}
-
-
-sub _new_handle {
- my ($class, $parent, $attr, $imp_data, $imp_class) = @_;
-
- DBI->trace_msg(" New $class (for $imp_class, parent=$parent, id=".($imp_data||'').")\n")
- if $DBI::dbi_debug >= 3;
-
- $attr->{ImplementorClass} = $imp_class
- or Carp::croak("_new_handle($class): 'ImplementorClass' attribute not given");
-
- # This is how we create a DBI style Object:
- # %outer gets tied to %$attr (which becomes the 'inner' handle)
- my (%outer, $i, $h);
- $i = tie %outer, $class, $attr; # ref to inner hash (for driver)
- $h = bless \%outer, $class; # ref to outer hash (for application)
- # The above tie and bless may migrate down into _setup_handle()...
- # Now add magic so DBI method dispatch works
- DBI::_setup_handle($h, $imp_class, $parent, $imp_data);
- return $h unless wantarray;
- return ($h, $i);
-}
-
-sub _setup_handle {
- my($h, $imp_class, $parent, $imp_data) = @_;
- my $h_inner = tied(%$h) || $h;
- if (($DBI::dbi_debug & 0xF) >= 4) {
- local $^W;
- print $DBI::tfh " _setup_handle(@_)\n";
- }
- $h_inner->{"imp_data"} = $imp_data;
- $h_inner->{"ImplementorClass"} = $imp_class;
- $h_inner->{"Kids"} = $h_inner->{"ActiveKids"} = 0; # XXX not maintained
- if ($parent) {
- foreach (qw(
- RaiseError PrintError PrintWarn HandleError HandleSetErr
- Warn LongTruncOk ChopBlanks AutoCommit ReadOnly
- ShowErrorStatement FetchHashKeyName LongReadLen CompatMode
- )) {
- $h_inner->{$_} = $parent->{$_}
- if exists $parent->{$_} && !exists $h_inner->{$_};
- }
- if (ref($parent) =~ /::db$/) { # is sth
- $h_inner->{Database} = $parent;
- $parent->{Statement} = $h_inner->{Statement};
- $h_inner->{NUM_OF_PARAMS} = 0;
- $h_inner->{Active} = 0; # driver sets true when there's data to fetch
- }
- elsif (ref($parent) =~ /::dr$/){ # is dbh
- $h_inner->{Driver} = $parent;
- $h_inner->{Active} = 0;
- }
- else {
- warn "panic: ".ref($parent); # should never happen
- }
- $h_inner->{dbi_pp_parent} = $parent;
-
- # add to the parent's ChildHandles
- if ($HAS_WEAKEN) {
- my $handles = $parent->{ChildHandles} ||= [];
- push @$handles, $h;
- Scalar::Util::weaken($handles->[-1]);
- # purge destroyed handles occasionally
- if (@$handles % 120 == 0) {
- @$handles = grep { defined } @$handles;
- Scalar::Util::weaken($_) for @$handles; # re-weaken after grep
- }
- }
- }
- else { # setting up a driver handle
- $h_inner->{Warn} = 1;
- $h_inner->{PrintWarn} = 1;
- $h_inner->{AutoCommit} = 1;
- $h_inner->{TraceLevel} = 0;
- $h_inner->{CompatMode} = (1==0);
- $h_inner->{FetchHashKeyName} ||= 'NAME';
- $h_inner->{LongReadLen} ||= 80;
- $h_inner->{ChildHandles} ||= [] if $HAS_WEAKEN;
- $h_inner->{Type} ||= 'dr';
- $h_inner->{Active} = 1;
- }
- $h_inner->{"dbi_pp_call_depth"} = 0;
- $h_inner->{"dbi_pp_pid"} = $$;
- $h_inner->{ErrCount} = 0;
-}
-
-sub constant {
- warn "constant(@_) called unexpectedly"; return undef;
-}
-
-sub trace {
- my ($h, $level, $file) = @_;
- $level = $h->parse_trace_flags($level)
- if defined $level and !DBI::looks_like_number($level);
- my $old_level = $DBI::dbi_debug;
- _set_trace_file($file) if $level;
- if (defined $level) {
- $DBI::dbi_debug = $level;
- print $DBI::tfh " DBI $DBI::VERSION (PurePerl) "
- . "dispatch trace level set to $DBI::dbi_debug\n"
- if $DBI::dbi_debug & 0xF;
- }
- _set_trace_file($file) if !$level;
- return $old_level;
-}
-
-sub _set_trace_file {
- my ($file) = @_;
- #
- # DAA add support for filehandle inputs
- #
- # DAA required to avoid closing a prior fh trace()
- $DBI::tfh = undef unless $DBI::tfh_needs_close;
-
- if (ref $file eq 'GLOB') {
- $DBI::tfh = $file;
- select((select($DBI::tfh), $| = 1)[0]);
- $DBI::tfh_needs_close = 0;
- return 1;
- }
- if ($file && ref \$file eq 'GLOB') {
- $DBI::tfh = *{$file}{IO};
- select((select($DBI::tfh), $| = 1)[0]);
- $DBI::tfh_needs_close = 0;
- return 1;
- }
- $DBI::tfh_needs_close = 1;
- if (!$file || $file eq 'STDERR') {
- open $DBI::tfh, ">&STDERR" or carp "Can't dup STDERR: $!";
- }
- elsif ($file eq 'STDOUT') {
- open $DBI::tfh, ">&STDOUT" or carp "Can't dup STDOUT: $!";
- }
- else {
- open $DBI::tfh, ">>$file" or carp "Can't open $file: $!";
- }
- select((select($DBI::tfh), $| = 1)[0]);
- return 1;
-}
-sub _get_imp_data { shift->{"imp_data"}; }
-sub _svdump { }
-sub dump_handle {
- my ($h,$msg,$level) = @_;
- $msg||="dump_handle $h";
- print $DBI::tfh "$msg:\n";
- for my $attrib (sort keys %$h) {
- print $DBI::tfh "\t$attrib => ".DBI::neat($h->{$attrib})."\n";
- }
-}
-
-sub _handles {
- my $h = shift;
- my $h_inner = tied %$h;
- if ($h_inner) { # this is okay
- return $h unless wantarray;
- return ($h, $h_inner);
- }
- # XXX this isn't okay... we have an inner handle but
- # currently have no way to get at its outer handle,
- # so we just warn and return the inner one for both...
- Carp::carp("Can't return outer handle from inner handle using DBI::PurePerl");
- return $h unless wantarray;
- return ($h,$h);
-}
-
-sub hash {
- my ($key, $type) = @_;
- my ($hash);
- if (!$type) {
- $hash = 0;
- # XXX The C version uses the "char" type, which could be either
- # signed or unsigned. I use signed because so do the two
- # compilers on my system.
- for my $char (unpack ("c*", $key)) {
- $hash = $hash * 33 + $char;
- }
- $hash &= 0x7FFFFFFF; # limit to 31 bits
- $hash |= 0x40000000; # set bit 31
- return -$hash; # return negative int
- }
- elsif ($type == 1) { # Fowler/Noll/Vo hash
- # see http://www.isthe.com/chongo/tech/comp/fnv/
- require Math::BigInt; # feel free to reimplement w/o BigInt!
- (my $version = $Math::BigInt::VERSION || 0) =~ s/_.*//; # eg "1.70_01"
- if ($version >= 1.56) {
- $hash = Math::BigInt->new(0x811c9dc5);
- for my $uchar (unpack ("C*", $key)) {
- # multiply by the 32 bit FNV magic prime mod 2^64
- $hash = ($hash * 0x01000193) & 0xffffffff;
- # xor the bottom with the current octet
- $hash ^= $uchar;
- }
- # cast to int
- return unpack "i", pack "i", $hash;
- }
- croak("DBI::PurePerl doesn't support hash type 1 without Math::BigInt >= 1.56 (available on CPAN)");
- }
- else {
- croak("bad hash type $type");
- }
-}
-
-sub looks_like_number {
- my @new = ();
- for my $thing(@_) {
- if (!defined $thing or $thing eq '') {
- push @new, undef;
- }
- else {
- push @new, ($thing =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/) ? 1 : 0;
- }
- }
- return (@_ >1) ? @new : $new[0];
-}
-
-sub neat {
- my $v = shift;
- return "undef" unless defined $v;
- my $quote = q{"};
- if (not utf8::is_utf8($v)) {
- return $v if (($v & ~ $v) eq "0"); # is SvNIOK
- $quote = q{'};
- }
- my $maxlen = shift || $DBI::neat_maxlen;
- if ($maxlen && $maxlen < length($v) + 2) {
- $v = substr($v,0,$maxlen-5);
- $v .= '...';
- }
- $v =~ s/[^[:print:]]/./g;
- return "$quote$v$quote";
-}
-
-sub sql_type_cast {
- my (undef, $sql_type, $flags) = @_;
-
- return -1 unless defined $_[0];
-
- my $cast_ok = 1;
-
- my $evalret = eval {
- use warnings FATAL => qw(numeric);
- if ($sql_type == SQL_INTEGER) {
- my $dummy = $_[0] + 0;
- return 1;
- }
- elsif ($sql_type == SQL_DOUBLE) {
- my $dummy = $_[0] + 0.0;
- return 1;
- }
- elsif ($sql_type == SQL_NUMERIC) {
- my $dummy = $_[0] + 0.0;
- return 1;
- }
- else {
- return -2;
- }
- } or $^W && warn $@; # XXX warnings::warnif("numeric", $@) ?
-
- return $evalret if defined($evalret) && ($evalret == -2);
- $cast_ok = 0 unless $evalret;
-
- # DBIstcf_DISCARD_STRING not supported for PurePerl currently
-
- return 2 if $cast_ok;
- return 0 if $flags & DBIstcf_STRICT;
- return 1;
-}
-
-sub dbi_time {
- return time();
-}
-
-sub DBI::st::TIEHASH { bless $_[1] => $_[0] };
-
-sub _concat_hash_sorted {
- my ( $hash_ref, $kv_separator, $pair_separator, $use_neat, $num_sort ) = @_;
- # $num_sort: 0=lexical, 1=numeric, undef=try to guess
-
- return undef unless defined $hash_ref;
- die "hash is not a hash reference" unless ref $hash_ref eq 'HASH';
- my $keys = _get_sorted_hash_keys($hash_ref, $num_sort);
- my $string = '';
- for my $key (@$keys) {
- $string .= $pair_separator if length $string > 0;
- my $value = $hash_ref->{$key};
- if ($use_neat) {
- $value = DBI::neat($value, 0);
- }
- else {
- $value = (defined $value) ? "'$value'" : 'undef';
- }
- $string .= $key . $kv_separator . $value;
- }
- return $string;
-}
-
-sub _get_sorted_hash_keys {
- my ($hash_ref, $num_sort) = @_;
- if (not defined $num_sort) {
- my $sort_guess = 1;
- $sort_guess = (not looks_like_number($_)) ? 0 : $sort_guess
- for keys %$hash_ref;
- $num_sort = $sort_guess;
- }
-
- my @keys = keys %$hash_ref;
- no warnings 'numeric';
- my @sorted = ($num_sort)
- ? sort { $a <=> $b or $a cmp $b } @keys
- : sort @keys;
- return \@sorted;
-}
-
-sub _err_hash {
- return 1 unless defined $_[0]->{err};
- return "$_[0]->{err} $_[0]->{errstr}"
-}
-
-
-package
- DBI::var;
-
-sub FETCH {
- my($key)=shift;
- return $DBI::err if $$key eq '*err';
- return $DBI::errstr if $$key eq '&errstr';
- Carp::confess("FETCH $key not supported when using DBI::PurePerl");
-}
-
-package
- DBD::_::common;
-
-sub swap_inner_handle {
- my ($h1, $h2) = @_;
- # can't make this work till we can get the outer handle from the inner one
- # probably via a WeakRef
- return $h1->set_err($DBI::stderr, "swap_inner_handle not currently supported by DBI::PurePerl");
-}
-
-sub trace { # XXX should set per-handle level, not global
- my ($h, $level, $file) = @_;
- $level = $h->parse_trace_flags($level)
- if defined $level and !DBI::looks_like_number($level);
- my $old_level = $DBI::dbi_debug;
- DBI::_set_trace_file($file) if defined $file;
- if (defined $level) {
- $DBI::dbi_debug = $level;
- if ($DBI::dbi_debug) {
- printf $DBI::tfh
- " %s trace level set to %d in DBI $DBI::VERSION (PurePerl)\n",
- $h, $DBI::dbi_debug;
- print $DBI::tfh " Full trace not available because DBI_TRACE is not in environment\n"
- unless exists $ENV{DBI_TRACE};
- }
- }
- return $old_level;
-}
-*debug = \&trace; *debug = \&trace; # twice to avoid typo warning
-
-sub FETCH {
- my($h,$key)= @_;
- my $v = $h->{$key};
- #warn ((exists $h->{$key}) ? "$key=$v\n" : "$key NONEXISTANT\n");
- return $v if defined $v;
- if ($key =~ /^NAME_.c$/) {
- my $cols = $h->FETCH('NAME');
- return undef unless $cols;
- my @lcols = map { lc $_ } @$cols;
- $h->{NAME_lc} = \@lcols;
- my @ucols = map { uc $_ } @$cols;
- $h->{NAME_uc} = \@ucols;
- return $h->FETCH($key);
- }
- if ($key =~ /^NAME.*_hash$/) {
- my $i=0;
- for my $c(@{$h->FETCH('NAME')||[]}) {
- $h->{'NAME_hash'}->{$c} = $i;
- $h->{'NAME_lc_hash'}->{"\L$c"} = $i;
- $h->{'NAME_uc_hash'}->{"\U$c"} = $i;
- $i++;
- }
- return $h->{$key};
- }
- if (!defined $v && !exists $h->{$key}) {
- return ($h->FETCH('TaintIn') && $h->FETCH('TaintOut')) if $key eq'Taint';
- return (1==0) if $is_flag_attribute{$key}; # return perl-style sv_no, not undef
- return $DBI::dbi_debug if $key eq 'TraceLevel';
- return [] if $key eq 'ChildHandles' && $HAS_WEAKEN;
- if ($key eq 'Type') {
- return "dr" if $h->isa('DBI::dr');
- return "db" if $h->isa('DBI::db');
- return "st" if $h->isa('DBI::st');
- Carp::carp( sprintf "Can't determine Type for %s",$h );
- }
- if (!$is_valid_attribute{$key} and $key =~ m/^[A-Z]/) {
- local $^W; # hide undef warnings
- Carp::carp( sprintf "Can't get %s->{%s}: unrecognised attribute (@{[ %$h ]})",$h,$key )
- }
- }
- return $v;
-}
-sub STORE {
- my ($h,$key,$value) = @_;
- if ($key eq 'AutoCommit') {
- Carp::croak("DBD driver has not implemented the AutoCommit attribute")
- unless $value == -900 || $value == -901;
- $value = ($value == -901);
- }
- elsif ($key =~ /^Taint/ ) {
- Carp::croak(sprintf "Can't set %s->{%s}: Taint mode not supported by DBI::PurePerl",$h,$key)
- if $value;
- }
- elsif ($key eq 'TraceLevel') {
- $h->trace($value);
- return 1;
- }
- elsif ($key eq 'NUM_OF_FIELDS') {
- $h->{$key} = $value;
- if ($value) {
- my $fbav = DBD::_::st::dbih_setup_fbav($h);
- @$fbav = (undef) x $value if @$fbav != $value;
- }
- return 1;
- }
- elsif (!$is_valid_attribute{$key} && $key =~ /^[A-Z]/ && !exists $h->{$key}) {
- Carp::carp(sprintf "Can't set %s->{%s}: unrecognised attribute or invalid value %s",
- $h,$key,$value);
- }
- $h->{$key} = $is_flag_attribute{$key} ? !!$value : $value;
- Scalar::Util::weaken($h->{$key}) if $key eq 'CachedKids';
- return 1;
-}
-sub DELETE {
- my ($h, $key) = @_;
- return $h->FETCH($key) unless $key =~ /^private_/;
- return delete $h->{$key};
-}
-sub err { return shift->{err} }
-sub errstr { return shift->{errstr} }
-sub state { return shift->{state} }
-sub set_err {
- my ($h, $errnum,$msg,$state, $method, $rv) = @_;
- $h = tied(%$h) || $h;
-
- if (my $hss = $h->{HandleSetErr}) {
- return if $hss->($h, $errnum, $msg, $state, $method);
- }
-
- if (!defined $errnum) {
- $h->{err} = $DBI::err = undef;
- $h->{errstr} = $DBI::errstr = undef;
- $h->{state} = $DBI::state = '';
- return;
- }
-
- if ($h->{errstr}) {
- $h->{errstr} .= sprintf " [err was %s now %s]", $h->{err}, $errnum
- if $h->{err} && $errnum && $h->{err} ne $errnum;
- $h->{errstr} .= sprintf " [state was %s now %s]", $h->{state}, $state
- if $h->{state} and $h->{state} ne "S1000" && $state && $h->{state} ne $state;
- $h->{errstr} .= "\n$msg" if $h->{errstr} ne $msg;
- $DBI::errstr = $h->{errstr};
- }
- else {
- $h->{errstr} = $DBI::errstr = $msg;
- }
-
- # assign if higher priority: err > "0" > "" > undef
- my $err_changed;
- if ($errnum # new error: so assign
- or !defined $h->{err} # no existing warn/info: so assign
- # new warn ("0" len 1) > info ("" len 0): so assign
- or defined $errnum && length($errnum) > length($h->{err})
- ) {
- $h->{err} = $DBI::err = $errnum;
- ++$h->{ErrCount} if $errnum;
- ++$err_changed;
- }
-
- if ($err_changed) {
- $state ||= "S1000" if $DBI::err;
- $h->{state} = $DBI::state = ($state eq "00000") ? "" : $state
- if $state;
- }
-
- if (my $p = $h->{Database}) { # just sth->dbh, not dbh->drh (see ::db::DESTROY)
- $p->{err} = $DBI::err;
- $p->{errstr} = $DBI::errstr;
- $p->{state} = $DBI::state;
- }
-
- $h->{'dbi_pp_last_method'} = $method;
- return $rv; # usually undef
-}
-sub trace_msg {
- my ($h, $msg, $minlevel)=@_;
- $minlevel = 1 unless defined $minlevel;
- return unless $minlevel <= ($DBI::dbi_debug & 0xF);
- print $DBI::tfh $msg;
- return 1;
-}
-sub private_data {
- warn "private_data @_";
-}
-sub take_imp_data {
- my $dbh = shift;
- # A reasonable default implementation based on the one in DBI.xs.
- # Typically a pure-perl driver would have their own take_imp_data method
- # that would delete all but the essential items in the hash before ending with:
- # return $dbh->SUPER::take_imp_data();
- # Of course it's useless if the driver doesn't also implement support for
- # the dbi_imp_data attribute to the connect() method.
- require Storable;
- croak("Can't take_imp_data from handle that's not Active")
- unless $dbh->{Active};
- for my $sth (@{ $dbh->{ChildHandles} || [] }) {
- next unless $sth;
- $sth->finish if $sth->{Active};
- bless $sth, 'DBI::zombie';
- }
- delete $dbh->{$_} for (keys %is_valid_attribute);
- delete $dbh->{$_} for grep { m/^dbi_/ } keys %$dbh;
- # warn "@{[ %$dbh ]}";
- local $Storable::forgive_me = 1; # in case there are some CODE refs
- my $imp_data = Storable::freeze($dbh);
- # XXX um, should probably untie here - need to check dispatch behaviour
- return $imp_data;
-}
-sub rows {
- return -1; # always returns -1 here, see DBD::_::st::rows below
-}
-sub DESTROY {
-}
-
-package
- DBD::_::dr;
-
-sub dbixs_revision {
- return 0;
-}
-
-package
- DBD::_::db;
-
-sub connected {
-}
-
-
-package
- DBD::_::st;
-
-sub fetchrow_arrayref {
- my $h = shift;
- # if we're here then driver hasn't implemented fetch/fetchrow_arrayref
- # so we assume they've implemented fetchrow_array and call that instead
- my @row = $h->fetchrow_array or return;
- return $h->_set_fbav(\@row);
-}
-# twice to avoid typo warning
-*fetch = \&fetchrow_arrayref; *fetch = \&fetchrow_arrayref;
-
-sub fetchrow_array {
- my $h = shift;
- # if we're here then driver hasn't implemented fetchrow_array
- # so we assume they've implemented fetch/fetchrow_arrayref
- my $row = $h->fetch or return;
- return @$row;
-}
-*fetchrow = \&fetchrow_array; *fetchrow = \&fetchrow_array;
-
-sub fetchrow_hashref {
- my $h = shift;
- my $row = $h->fetch or return;
- my $FetchCase = shift;
- my $FetchHashKeyName = $FetchCase || $h->{'FetchHashKeyName'} || 'NAME';
- my $FetchHashKeys = $h->FETCH($FetchHashKeyName);
- my %rowhash;
- @rowhash{ @$FetchHashKeys } = @$row;
- return \%rowhash;
-}
-sub dbih_setup_fbav {
- my $h = shift;
- return $h->{'_fbav'} || do {
- $DBI::rows = $h->{'_rows'} = 0;
- my $fields = $h->{'NUM_OF_FIELDS'}
- or DBI::croak("NUM_OF_FIELDS not set");
- my @row = (undef) x $fields;
- \@row;
- };
-}
-sub _get_fbav {
- my $h = shift;
- my $av = $h->{'_fbav'} ||= dbih_setup_fbav($h);
- $DBI::rows = ++$h->{'_rows'};
- return $av;
-}
-sub _set_fbav {
- my $h = shift;
- my $fbav = $h->{'_fbav'};
- if ($fbav) {
- $DBI::rows = ++$h->{'_rows'};
- }
- else {
- $fbav = $h->_get_fbav;
- }
- my $row = shift;
- if (my $bc = $h->{'_bound_cols'}) {
- for my $i (0..@$row-1) {
- my $bound = $bc->[$i];
- $fbav->[$i] = ($bound) ? ($$bound = $row->[$i]) : $row->[$i];
- }
- }
- else {
- @$fbav = @$row;
- }
- return $fbav;
-}
-sub bind_col {
- my ($h, $col, $value_ref,$from_bind_columns) = @_;
- my $fbav = $h->{'_fbav'} ||= dbih_setup_fbav($h); # from _get_fbav()
- my $num_of_fields = @$fbav;
- DBI::croak("bind_col: column $col is not a valid column (1..$num_of_fields)")
- if $col < 1 or $col > $num_of_fields;
- return 1 if not defined $value_ref; # ie caller is just trying to set TYPE
- DBI::croak("bind_col($col,$value_ref) needs a reference to a scalar")
- unless ref $value_ref eq 'SCALAR';
- $h->{'_bound_cols'}->[$col-1] = $value_ref;
- return 1;
-}
-sub finish {
- my $h = shift;
- $h->{'_fbav'} = undef;
- $h->{'Active'} = 0;
- return 1;
-}
-sub rows {
- my $h = shift;
- my $rows = $h->{'_rows'};
- return -1 unless defined $rows;
- return $rows;
-}
-
-1;
-__END__
-
-=pod
-
-=head1 NAME
-
-DBI::PurePerl -- a DBI emulation using pure perl (no C/XS compilation required)
-
-=head1 SYNOPSIS
-
- BEGIN { $ENV{DBI_PUREPERL} = 2 }
- use DBI;
-
-=head1 DESCRIPTION
-
-This is a pure perl emulation of the DBI internals. In almost all
-cases you will be better off using standard DBI since the portions
-of the standard version written in C make it *much* faster.
-
-However, if you are in a situation where it isn't possible to install
-a compiled version of standard DBI, and you're using pure-perl DBD
-drivers, then this module allows you to use most common features
-of DBI without needing any changes in your scripts.
-
-=head1 EXPERIMENTAL STATUS
-
-DBI::PurePerl is new so please treat it as experimental pending
-more extensive testing. So far it has passed all tests with DBD::CSV,
-DBD::AnyData, DBD::XBase, DBD::Sprite, DBD::mysqlPP. Please send
-bug reports to Jeff Zucker at <jeff@vpservices.com> with a cc to
-<dbi-dev@perl.org>.
-
-=head1 USAGE
-
-The usage is the same as for standard DBI with the exception
-that you need to set the environment variable DBI_PUREPERL if
-you want to use the PurePerl version.
-
- DBI_PUREPERL == 0 (the default) Always use compiled DBI, die
- if it isn't properly compiled & installed
-
- DBI_PUREPERL == 1 Use compiled DBI if it is properly compiled
- & installed, otherwise use PurePerl
-
- DBI_PUREPERL == 2 Always use PurePerl
-
-You may set the environment variable in your shell (e.g. with
-set or setenv or export, etc) or else set it in your script like
-this:
-
- BEGIN { $ENV{DBI_PUREPERL}=2 }
-
-before you C<use DBI;>.
-
-=head1 INSTALLATION
-
-In most situations simply install DBI (see the DBI pod for details).
-
-In the situation in which you can not install DBI itself, you
-may manually copy DBI.pm and PurePerl.pm into the appropriate
-directories.
-
-For example:
-
- cp DBI.pm /usr/jdoe/mylibs/.
- cp PurePerl.pm /usr/jdoe/mylibs/DBI/.
-
-Then add this to the top of scripts:
-
- BEGIN {
- $ENV{DBI_PUREPERL} = 1; # or =2
- unshift @INC, '/usr/jdoe/mylibs';
- }
-
-(Or should we perhaps patch Makefile.PL so that if DBI_PUREPERL
-is set to 2 prior to make, the normal compile process is skipped
-and the files are installed automatically?)
-
-=head1 DIFFERENCES BETWEEN DBI AND DBI::PurePerl
-
-=head2 Attributes
-
-Boolean attributes still return boolean values but the actual values
-used may be different, i.e., 0 or undef instead of an empty string.
-
-Some handle attributes are either not supported or have very limited
-functionality:
-
- ActiveKids
- InactiveDestroy
- AutoInactiveDestroy
- Kids
- Taint
- TaintIn
- TaintOut
-
-(and probably others)
-
-=head2 Tracing
-
-Trace functionality is more limited and the code to handle tracing is
-only embedded into DBI:PurePerl if the DBI_TRACE environment variable
-is defined. To enable total tracing you can set the DBI_TRACE
-environment variable as usual. But to enable individual handle
-tracing using the trace() method you also need to set the DBI_TRACE
-environment variable, but set it to 0.
-
-=head2 Parameter Usage Checking
-
-The DBI does some basic parameter count checking on method calls.
-DBI::PurePerl doesn't.
-
-=head2 Speed
-
-DBI::PurePerl is slower. Although, with some drivers in some
-contexts this may not be very significant for you.
-
-By way of example... the test.pl script in the DBI source
-distribution has a simple benchmark that just does:
-
- my $null_dbh = DBI->connect('dbi:NullP:','','');
- my $i = 10_000;
- $null_dbh->prepare('') while $i--;
-
-In other words just prepares a statement, creating and destroying
-a statement handle, over and over again. Using the real DBI this
-runs at ~4550 handles per second whereas DBI::PurePerl manages
-~2800 per second on the same machine (not too bad really).
-
-=head2 May not fully support hash()
-
-If you want to use type 1 hash, i.e., C<hash($string,1)> with
-DBI::PurePerl, you'll need version 1.56 or higher of Math::BigInt
-(available on CPAN).
-
-=head2 Doesn't support preparse()
-
-The DBI->preparse() method isn't supported in DBI::PurePerl.
-
-=head2 Doesn't support DBD::Proxy
-
-There's a subtle problem somewhere I've not been able to identify.
-DBI::ProxyServer seem to work fine with DBI::PurePerl but DBD::Proxy
-does not work 100% (which is sad because that would be far more useful :)
-Try re-enabling t/80proxy.t for DBI::PurePerl to see if the problem
-that remains will affect you're usage.
-
-=head2 Others
-
- can() - doesn't have any special behaviour
-
-Please let us know if you find any other differences between DBI
-and DBI::PurePerl.
-
-=head1 AUTHORS
-
-Tim Bunce and Jeff Zucker.
-
-Tim provided the direction and basis for the code. The original
-idea for the module and most of the brute force porting from C to
-Perl was by Jeff. Tim then reworked some core parts to boost the
-performance and accuracy of the emulation. Thanks also to Randal
-Schwartz and John Tobey for patches.
-
-=head1 COPYRIGHT
-
-Copyright (c) 2002 Tim Bunce Ireland.
-
-See COPYRIGHT section in DBI.pm for usage and distribution rights.
-
-=cut
+++ /dev/null
-#######################################################################
-#
-# DBI::SQL::Nano - a very tiny SQL engine
-#
-# Copyright (c) 2010 by Jens Rehsack < rehsack AT cpan.org >
-# Copyright (c) 2004 by Jeff Zucker < jzucker AT cpan.org >
-#
-# All rights reserved.
-#
-# You may freely distribute and/or modify this module under the terms
-# of either the GNU General Public License (GPL) or the Artistic License,
-# as specified in the Perl README file.
-#
-# See the pod at the bottom of this file for help information
-#
-#######################################################################
-
-#######################
-package DBI::SQL::Nano;
-#######################
-use strict;
-use warnings;
-use vars qw( $VERSION $versions );
-
-use Carp qw(croak);
-
-require DBI; # for looks_like_number()
-
-BEGIN
-{
- $VERSION = "1.015544";
-
- $versions->{nano_version} = $VERSION;
- if ( $ENV{DBI_SQL_NANO} || !eval { require SQL::Statement; $SQL::Statement::VERSION ge '1.400' } )
- {
- @DBI::SQL::Nano::Statement::ISA = qw(DBI::SQL::Nano::Statement_);
- @DBI::SQL::Nano::Table::ISA = qw(DBI::SQL::Nano::Table_);
- }
- else
- {
- @DBI::SQL::Nano::Statement::ISA = qw( SQL::Statement );
- @DBI::SQL::Nano::Table::ISA = qw( SQL::Eval::Table);
- $versions->{statement_version} = $SQL::Statement::VERSION;
- }
-}
-
-###################################
-package DBI::SQL::Nano::Statement_;
-###################################
-
-use Carp qw(croak);
-use Errno;
-
-if ( eval { require Clone; } )
-{
- Clone->import("clone");
-}
-else
-{
- require Storable; # in CORE since 5.7.3
- *clone = \&Storable::dclone;
-}
-
-sub new
-{
- my ( $class, $sql ) = @_;
- my $self = {};
- bless $self, $class;
- return $self->prepare($sql);
-}
-
-#####################################################################
-# PREPARE
-#####################################################################
-sub prepare
-{
- my ( $self, $sql ) = @_;
- $sql =~ s/\s+$//;
- $sql =~ s/\s*;$//;
- for ($sql)
- {
- /^\s*CREATE\s+TABLE\s+(.*?)\s*\((.+)\)\s*$/is
- && do
- {
- $self->{command} = 'CREATE';
- $self->{table_name} = $1;
- defined $2 and $2 ne "" and
- $self->{column_names} = parse_coldef_list($2);
- $self->{column_names} or croak "Can't find columns";
- };
- /^\s*DROP\s+TABLE\s+(IF\s+EXISTS\s+)?(.*?)\s*$/is
- && do
- {
- $self->{command} = 'DROP';
- $self->{table_name} = $2;
- defined $1 and $1 ne "" and
- $self->{ignore_missing_table} = 1;
- };
- /^\s*SELECT\s+(.*?)\s+FROM\s+(\S+)((.*))?/is
- && do
- {
- $self->{command} = 'SELECT';
- defined $1 and $1 ne "" and
- $self->{column_names} = parse_comma_list($1);
- $self->{column_names} or croak "Can't find columns";
- $self->{table_name} = $2;
- if ( my $clauses = $4 )
- {
- if ( $clauses =~ /^(.*)\s+ORDER\s+BY\s+(.*)$/is )
- {
- $clauses = $1;
- $self->{order_clause} = $self->parse_order_clause($2);
- }
- $self->{where_clause} = $self->parse_where_clause($clauses) if ($clauses);
- }
- };
- /^\s*INSERT\s+(?:INTO\s+)?(\S+)\s*(\((.*?)\))?\s*VALUES\s*\((.+)\)/is
- && do
- {
- $self->{command} = 'INSERT';
- $self->{table_name} = $1;
- defined $2 and $2 ne "" and
- $self->{column_names} = parse_comma_list($2);
- defined $4 and $4 ne "" and
- $self->{values} = $self->parse_values_list($4);
- $self->{values} or croak "Can't parse values";
- };
- /^\s*DELETE\s+FROM\s+(\S+)((.*))?/is
- && do
- {
- $self->{command} = 'DELETE';
- $self->{table_name} = $1;
- defined $3 and $3 ne "" and
- $self->{where_clause} = $self->parse_where_clause($3);
- };
- /^\s*UPDATE\s+(\S+)\s+SET\s+(.+)(\s+WHERE\s+.+)/is
- && do
- {
- $self->{command} = 'UPDATE';
- $self->{table_name} = $1;
- defined $2 and $2 ne "" and
- $self->parse_set_clause($2);
- defined $3 and $3 ne "" and
- $self->{where_clause} = $self->parse_where_clause($3);
- };
- }
- croak "Couldn't parse" unless ( $self->{command} and $self->{table_name} );
- return $self;
-}
-
-sub parse_order_clause
-{
- my ( $self, $str ) = @_;
- my @clause = split /\s+/, $str;
- return { $clause[0] => 'ASC' } if ( @clause == 1 );
- croak "Bad ORDER BY clause '$str'" if ( @clause > 2 );
- $clause[1] ||= '';
- return { $clause[0] => uc $clause[1] }
- if $clause[1] =~ /^ASC$/i
- or $clause[1] =~ /^DESC$/i;
- croak "Bad ORDER BY clause '$clause[1]'";
-}
-
-sub parse_coldef_list
-{ # check column definitions
- my @col_defs;
- for ( split ',', shift )
- {
- my $col = clean_parse_str($_);
- if ( $col =~ /^(\S+?)\s+.+/ )
- { # doesn't check what it is
- $col = $1; # just checks if it exists
- }
- else
- {
- croak "No column definition for '$_'";
- }
- push @col_defs, $col;
- }
- return \@col_defs;
-}
-
-sub parse_comma_list
-{
- [ map { clean_parse_str($_) } split( ',', shift ) ];
-}
-sub clean_parse_str { local $_ = shift; s/\(//; s/\)//; s/^\s+//; s/\s+$//; $_; }
-
-sub parse_values_list
-{
- my ( $self, $str ) = @_;
- [ map { $self->parse_value( clean_parse_str($_) ) } split( ',', $str ) ];
-}
-
-sub parse_set_clause
-{
- my $self = shift;
- my @cols = split /,/, shift;
- my $set_clause;
- for my $col (@cols)
- {
- my ( $col_name, $value ) = $col =~ /^\s*(.+?)\s*=\s*(.+?)\s*$/s;
- push @{ $self->{column_names} }, $col_name;
- push @{ $self->{values} }, $self->parse_value($value);
- }
- croak "Can't parse set clause" unless ( $self->{column_names} and $self->{values} );
-}
-
-sub parse_value
-{
- my ( $self, $str ) = @_;
- return unless ( defined $str );
- $str =~ s/\s+$//;
- $str =~ s/^\s+//;
- if ( $str =~ /^\?$/ )
- {
- push @{ $self->{params} }, '?';
- return {
- value => '?',
- type => 'placeholder'
- };
- }
- return {
- value => undef,
- type => 'NULL'
- } if ( $str =~ /^NULL$/i );
- return {
- value => $1,
- type => 'string'
- } if ( $str =~ /^'(.+)'$/s );
- return {
- value => $str,
- type => 'number'
- } if ( DBI::looks_like_number($str) );
- return {
- value => $str,
- type => 'column'
- };
-}
-
-sub parse_where_clause
-{
- my ( $self, $str ) = @_;
- $str =~ s/\s+$//;
- if ( $str =~ /^\s*WHERE\s+(.*)/i )
- {
- $str = $1;
- }
- else
- {
- croak "Couldn't find WHERE clause in '$str'";
- }
- my ($neg) = $str =~ s/^\s*(NOT)\s+//is;
- my $opexp = '=|<>|<=|>=|<|>|LIKE|CLIKE|IS';
- my ( $val1, $op, $val2 ) = $str =~ /^(.+?)\s*($opexp)\s*(.+)\s*$/iso;
- croak "Couldn't parse WHERE expression '$str'" unless ( defined $val1 and defined $op and defined $val2 );
- return {
- arg1 => $self->parse_value($val1),
- arg2 => $self->parse_value($val2),
- op => $op,
- neg => $neg,
- };
-}
-
-#####################################################################
-# EXECUTE
-#####################################################################
-sub execute
-{
- my ( $self, $data, $params ) = @_;
- my $num_placeholders = $self->params;
- my $num_params = scalar @$params || 0;
- croak "Number of params '$num_params' does not match number of placeholders '$num_placeholders'"
- unless ( $num_placeholders == $num_params );
- if ( scalar @$params )
- {
- for my $i ( 0 .. $#{ $self->{values} } )
- {
- if ( $self->{values}->[$i]->{type} eq 'placeholder' )
- {
- $self->{values}->[$i]->{value} = shift @$params;
- }
- }
- if ( $self->{where_clause} )
- {
- if ( $self->{where_clause}->{arg1}->{type} eq 'placeholder' )
- {
- $self->{where_clause}->{arg1}->{value} = shift @$params;
- }
- if ( $self->{where_clause}->{arg2}->{type} eq 'placeholder' )
- {
- $self->{where_clause}->{arg2}->{value} = shift @$params;
- }
- }
- }
- my $command = $self->{command};
- ( $self->{'NUM_OF_ROWS'}, $self->{'NUM_OF_FIELDS'}, $self->{'data'}, ) = $self->$command( $data, $params );
- $self->{NAME} ||= $self->{column_names};
- return $self->{'NUM_OF_ROWS'} || '0E0';
-}
-
-my $enoentstr = "Cannot open .*\(" . Errno::ENOENT . "\)";
-my $enoentrx = qr/$enoentstr/;
-
-sub DROP ($$$)
-{
- my ( $self, $data, $params ) = @_;
-
- my $table;
- my @err;
- eval {
- local $SIG{__WARN__} = sub { push @err, @_ };
- ($table) = $self->open_tables( $data, 0, 1 );
- };
- if ( $self->{ignore_missing_table} and ( $@ or @err ) and grep { $_ =~ $enoentrx } ( @err, $@ ) )
- {
- $@ = '';
- return ( -1, 0 );
- }
-
- croak( $@ || $err[0] ) if ( $@ || @err );
- return ( -1, 0 ) unless $table;
-
- $table->drop($data);
- ( -1, 0 );
-}
-
-sub CREATE ($$$)
-{
- my ( $self, $data, $params ) = @_;
- my $table = $self->open_tables( $data, 1, 1 );
- $table->push_names( $data, $self->{column_names} );
- ( 0, 0 );
-}
-
-sub INSERT ($$$)
-{
- my ( $self, $data, $params ) = @_;
- my $table = $self->open_tables( $data, 0, 1 );
- $self->verify_columns($table);
- my $all_columns = $table->{col_names};
- $table->seek( $data, 0, 2 ) unless ( $table->can('insert_one_row') );
- my ($array) = [];
- my ( $val, $col, $i );
- $self->{column_names} = $table->col_names() unless ( $self->{column_names} );
- my $cNum = scalar( @{ $self->{column_names} } ) if ( $self->{column_names} );
- my $param_num = 0;
-
- $cNum or
- croak "Bad col names in INSERT";
-
- my $maxCol = $#$all_columns;
-
- for ( $i = 0; $i < $cNum; $i++ )
- {
- $col = $self->{column_names}->[$i];
- $array->[ $self->column_nums( $table, $col ) ] = $self->row_values($i);
- }
-
- # Extend row to put values in ALL fields
- $#$array < $maxCol and $array->[$maxCol] = undef;
-
- $table->can('insert_new_row') ? $table->insert_new_row( $data, $array ) : $table->push_row( $data, $array );
-
- return ( 1, 0 );
-}
-
-sub DELETE ($$$)
-{
- my ( $self, $data, $params ) = @_;
- my $table = $self->open_tables( $data, 0, 1 );
- $self->verify_columns($table);
- my ($affected) = 0;
- my ( @rows, $array );
- my $can_dor = $table->can('delete_one_row');
- while ( $array = $table->fetch_row($data) )
- {
- if ( $self->eval_where( $table, $array ) )
- {
- ++$affected;
- if ( $self->{fetched_from_key} )
- {
- $array = $self->{fetched_value};
- $table->delete_one_row( $data, $array );
- return ( $affected, 0 );
- }
- push( @rows, $array ) if ($can_dor);
- }
- else
- {
- push( @rows, $array ) unless ($can_dor);
- }
- }
- if ($can_dor)
- {
- foreach $array (@rows)
- {
- $table->delete_one_row( $data, $array );
- }
- }
- else
- {
- $table->seek( $data, 0, 0 );
- foreach $array (@rows)
- {
- $table->push_row( $data, $array );
- }
- $table->truncate($data);
- }
- return ( $affected, 0 );
-}
-
-sub _anycmp($$;$)
-{
- my ( $a, $b, $case_fold ) = @_;
-
- if ( !defined($a) || !defined($b) )
- {
- return defined($a) - defined($b);
- }
- elsif ( DBI::looks_like_number($a) && DBI::looks_like_number($b) )
- {
- return $a <=> $b;
- }
- else
- {
- return $case_fold ? lc($a) cmp lc($b) || $a cmp $b : $a cmp $b;
- }
-}
-
-sub SELECT ($$$)
-{
- my ( $self, $data, $params ) = @_;
- my $table = $self->open_tables( $data, 0, 0 );
- $self->verify_columns($table);
- my $tname = $self->{table_name};
- my ($affected) = 0;
- my ( @rows, %cols, $array, $val, $col, $i );
- while ( $array = $table->fetch_row($data) )
- {
- if ( $self->eval_where( $table, $array ) )
- {
- $array = $self->{fetched_value} if ( $self->{fetched_from_key} );
- unless ( keys %cols )
- {
- my $col_nums = $self->column_nums($table);
- %cols = reverse %{$col_nums};
- }
-
- my $rowhash;
- for ( sort keys %cols )
- {
- $rowhash->{ $cols{$_} } = $array->[$_];
- }
- my @newarray;
- for ( $i = 0; $i < @{ $self->{column_names} }; $i++ )
- {
- $col = $self->{column_names}->[$i];
- push @newarray, $rowhash->{$col};
- }
- push( @rows, \@newarray );
- return ( scalar(@rows), scalar @{ $self->{column_names} }, \@rows )
- if ( $self->{fetched_from_key} );
- }
- }
- if ( $self->{order_clause} )
- {
- my ( $sort_col, $desc ) = each %{ $self->{order_clause} };
- my @sortCols = ( $self->column_nums( $table, $sort_col, 1 ) );
- $sortCols[1] = uc $desc eq 'DESC' ? 1 : 0;
-
- @rows = sort {
- my ( $result, $colNum, $desc );
- my $i = 0;
- do
- {
- $colNum = $sortCols[ $i++ ];
- $desc = $sortCols[ $i++ ];
- $result = _anycmp( $a->[$colNum], $b->[$colNum] );
- $result = -$result if ($desc);
- } while ( !$result && $i < @sortCols );
- $result;
- } @rows;
- }
- ( scalar(@rows), scalar @{ $self->{column_names} }, \@rows );
-}
-
-sub UPDATE ($$$)
-{
- my ( $self, $data, $params ) = @_;
- my $table = $self->open_tables( $data, 0, 1 );
- $self->verify_columns($table);
- return undef unless $table;
- my $affected = 0;
- my $can_usr = $table->can('update_specific_row');
- my $can_uor = $table->can('update_one_row');
- my $can_rwu = $can_usr || $can_uor;
- my ( @rows, $array, $f_array, $val, $col, $i );
-
- while ( $array = $table->fetch_row($data) )
- {
- if ( $self->eval_where( $table, $array ) )
- {
- $array = $self->{fetched_value} if ( $self->{fetched_from_key} and $can_rwu );
- my $orig_ary = clone($array) if ($can_usr);
- for ( $i = 0; $i < @{ $self->{column_names} }; $i++ )
- {
- $col = $self->{column_names}->[$i];
- $array->[ $self->column_nums( $table, $col ) ] = $self->row_values($i);
- }
- $affected++;
- if ( $self->{fetched_value} )
- {
- if ($can_usr)
- {
- $table->update_specific_row( $data, $array, $orig_ary );
- }
- elsif ($can_uor)
- {
- $table->update_one_row( $data, $array );
- }
- return ( $affected, 0 );
- }
- push( @rows, $can_usr ? [ $array, $orig_ary ] : $array );
- }
- else
- {
- push( @rows, $array ) unless ($can_rwu);
- }
- }
- if ($can_rwu)
- {
- foreach my $array (@rows)
- {
- if ($can_usr)
- {
- $table->update_specific_row( $data, @$array );
- }
- elsif ($can_uor)
- {
- $table->update_one_row( $data, $array );
- }
- }
- }
- else
- {
- $table->seek( $data, 0, 0 );
- foreach my $array (@rows)
- {
- $table->push_row( $data, $array );
- }
- $table->truncate($data);
- }
-
- return ( $affected, 0 );
-}
-
-sub verify_columns
-{
- my ( $self, $table ) = @_;
- my @cols = @{ $self->{column_names} };
- if ( $self->{where_clause} )
- {
- if ( my $col = $self->{where_clause}->{arg1} )
- {
- push @cols, $col->{value} if $col->{type} eq 'column';
- }
- if ( my $col = $self->{where_clause}->{arg2} )
- {
- push @cols, $col->{value} if $col->{type} eq 'column';
- }
- }
- for (@cols)
- {
- $self->column_nums( $table, $_ );
- }
-}
-
-sub column_nums
-{
- my ( $self, $table, $stmt_col_name, $find_in_stmt ) = @_;
- my %dbd_nums = %{ $table->col_nums() };
- my @dbd_cols = @{ $table->col_names() };
- my %stmt_nums;
- if ( $stmt_col_name and !$find_in_stmt )
- {
- while ( my ( $k, $v ) = each %dbd_nums )
- {
- return $v if uc $k eq uc $stmt_col_name;
- }
- croak "No such column '$stmt_col_name'";
- }
- if ( $stmt_col_name and $find_in_stmt )
- {
- for my $i ( 0 .. @{ $self->{column_names} } )
- {
- return $i if uc $stmt_col_name eq uc $self->{column_names}->[$i];
- }
- croak "No such column '$stmt_col_name'";
- }
- for my $i ( 0 .. $#dbd_cols )
- {
- for my $stmt_col ( @{ $self->{column_names} } )
- {
- $stmt_nums{$stmt_col} = $i if uc $dbd_cols[$i] eq uc $stmt_col;
- }
- }
- return \%stmt_nums;
-}
-
-sub eval_where
-{
- my ( $self, $table, $rowary ) = @_;
- my $where = $self->{"where_clause"} || return 1;
- my $col_nums = $table->col_nums();
- my %cols = reverse %{$col_nums};
- my $rowhash;
- for ( sort keys %cols )
- {
- $rowhash->{ uc $cols{$_} } = $rowary->[$_];
- }
- return $self->process_predicate( $where, $table, $rowhash );
-}
-
-sub process_predicate
-{
- my ( $self, $pred, $table, $rowhash ) = @_;
- my $val1 = $pred->{arg1};
- if ( $val1->{type} eq 'column' )
- {
- $val1 = $rowhash->{ uc $val1->{value} };
- }
- else
- {
- $val1 = $val1->{value};
- }
- my $val2 = $pred->{arg2};
- if ( $val2->{type} eq 'column' )
- {
- $val2 = $rowhash->{ uc $val2->{value} };
- }
- else
- {
- $val2 = $val2->{value};
- }
- my $op = $pred->{op};
- my $neg = $pred->{neg};
- if ( $op eq '=' and !$neg and $table->can('fetch_one_row') )
- {
- my $key_col = $table->fetch_one_row( 1, 1 );
- if ( $pred->{arg1}->{value} =~ /^$key_col$/i )
- {
- $self->{fetched_from_key} = 1;
- $self->{fetched_value} = $table->fetch_one_row( 0, $pred->{arg2}->{value} );
- return 1;
- }
- }
- my $match = $self->is_matched( $val1, $op, $val2 ) || 0;
- if ($neg) { $match = $match ? 0 : 1; }
- return $match;
-}
-
-sub is_matched
-{
- my ( $self, $val1, $op, $val2 ) = @_;
- if ( $op eq 'IS' )
- {
- return 1 if ( !defined $val1 or $val1 eq '' );
- return 0;
- }
- $val1 = '' unless ( defined $val1 );
- $val2 = '' unless ( defined $val2 );
- if ( $op =~ /LIKE|CLIKE/i )
- {
- $val2 = quotemeta($val2);
- $val2 =~ s/\\%/.*/g;
- $val2 =~ s/_/./g;
- }
- if ( $op eq 'LIKE' ) { return $val1 =~ /^$val2$/s; }
- if ( $op eq 'CLIKE' ) { return $val1 =~ /^$val2$/si; }
- if ( DBI::looks_like_number($val1) && DBI::looks_like_number($val2) )
- {
- if ( $op eq '<' ) { return $val1 < $val2; }
- if ( $op eq '>' ) { return $val1 > $val2; }
- if ( $op eq '=' ) { return $val1 == $val2; }
- if ( $op eq '<>' ) { return $val1 != $val2; }
- if ( $op eq '<=' ) { return $val1 <= $val2; }
- if ( $op eq '>=' ) { return $val1 >= $val2; }
- }
- else
- {
- if ( $op eq '<' ) { return $val1 lt $val2; }
- if ( $op eq '>' ) { return $val1 gt $val2; }
- if ( $op eq '=' ) { return $val1 eq $val2; }
- if ( $op eq '<>' ) { return $val1 ne $val2; }
- if ( $op eq '<=' ) { return $val1 ge $val2; }
- if ( $op eq '>=' ) { return $val1 le $val2; }
- }
-}
-
-sub params
-{
- my ( $self, $val_num ) = @_;
- if ( !$self->{"params"} ) { return 0; }
- if ( defined $val_num )
- {
- return $self->{"params"}->[$val_num];
- }
-
- return wantarray ? @{ $self->{"params"} } : scalar @{ $self->{"params"} };
-}
-
-sub open_tables
-{
- my ( $self, $data, $createMode, $lockMode ) = @_;
- my $table_name = $self->{table_name};
- my $table;
- eval { $table = $self->open_table( $data, $table_name, $createMode, $lockMode ) };
- if ($@)
- {
- chomp $@;
- croak $@;
- }
- croak "Couldn't open table '$table_name'" unless $table;
- if ( !$self->{column_names} or $self->{column_names}->[0] eq '*' )
- {
- $self->{column_names} = $table->col_names();
- }
- return $table;
-}
-
-sub row_values
-{
- my ( $self, $val_num ) = @_;
- if ( !$self->{"values"} ) { return 0; }
- if ( defined $val_num )
- {
- return $self->{"values"}->[$val_num]->{value};
- }
- if (wantarray)
- {
- return map { $_->{"value"} } @{ $self->{"values"} };
- }
- else
- {
- return scalar @{ $self->{"values"} };
- }
-}
-
-sub column_names
-{
- my ($self) = @_;
- my @col_names;
- if ( $self->{column_names} and $self->{column_names}->[0] ne '*' )
- {
- @col_names = @{ $self->{column_names} };
- }
- return @col_names;
-}
-
-###############################
-package DBI::SQL::Nano::Table_;
-###############################
-
-use Carp qw(croak);
-
-sub new ($$)
-{
- my ( $proto, $attr ) = @_;
- my ($self) = {%$attr};
-
- defined( $self->{col_names} ) and "ARRAY" eq ref( $self->{col_names} )
- or croak("attribute 'col_names' must be defined as an array");
- exists( $self->{col_nums} ) or $self->{col_nums} = _map_colnums( $self->{col_names} );
- defined( $self->{col_nums} ) and "HASH" eq ref( $self->{col_nums} )
- or croak("attribute 'col_nums' must be defined as a hash");
-
- bless( $self, ( ref($proto) || $proto ) );
- return $self;
-}
-
-sub _map_colnums
-{
- my $col_names = $_[0];
- my %col_nums;
- for my $i ( 0 .. $#$col_names )
- {
- next unless $col_names->[$i];
- $col_nums{ $col_names->[$i] } = $i;
- }
- return \%col_nums;
-}
-
-sub row() { return $_[0]->{row}; }
-sub column($) { return $_[0]->{row}->[ $_[0]->column_num( $_[1] ) ]; }
-sub column_num($) { $_[0]->{col_nums}->{ $_[1] }; }
-sub col_nums() { $_[0]->{col_nums} }
-sub col_names() { $_[0]->{col_names}; }
-
-sub drop ($$) { croak "Abstract method " . ref( $_[0] ) . "::drop called" }
-sub fetch_row ($$$) { croak "Abstract method " . ref( $_[0] ) . "::fetch_row called" }
-sub push_row ($$$) { croak "Abstract method " . ref( $_[0] ) . "::push_row called" }
-sub push_names ($$$) { croak "Abstract method " . ref( $_[0] ) . "::push_names called" }
-sub truncate ($$) { croak "Abstract method " . ref( $_[0] ) . "::truncate called" }
-sub seek ($$$$) { croak "Abstract method " . ref( $_[0] ) . "::seek called" }
-
-1;
-__END__
-
-=pod
-
-=head1 NAME
-
-DBI::SQL::Nano - a very tiny SQL engine
-
-=head1 SYNOPSIS
-
- BEGIN { $ENV{DBI_SQL_NANO}=1 } # forces use of Nano rather than SQL::Statement
- use DBI::SQL::Nano;
- use Data::Dumper;
- my $stmt = DBI::SQL::Nano::Statement->new(
- "SELECT bar,baz FROM foo WHERE qux = 1"
- ) or die "Couldn't parse";
- print Dumper $stmt;
-
-=head1 DESCRIPTION
-
-C<< DBI::SQL::Nano >> is meant as a I<very> minimal SQL engine for use in
-situations where SQL::Statement is not available. In most situations you are
-better off installing L<SQL::Statement> although DBI::SQL::Nano may be faster
-for some B<very> simple tasks.
-
-DBI::SQL::Nano, like SQL::Statement is primarily intended to provide a SQL
-engine for use with some pure perl DBDs including L<DBD::DBM>, L<DBD::CSV>,
-L<DBD::AnyData>, and L<DBD::Excel>. It is not of much use in and of itself.
-You can dump out the structure of a parsed SQL statement, but that is about
-it.
-
-=head1 USAGE
-
-=head2 Setting the DBI_SQL_NANO flag
-
-By default, when a C<< DBD >> uses C<< DBI::SQL::Nano >>, the module will
-look to see if C<< SQL::Statement >> is installed. If it is, SQL::Statement
-objects are used. If SQL::Statement is not available, DBI::SQL::Nano
-objects are used.
-
-In some cases, you may wish to use DBI::SQL::Nano objects even if
-SQL::Statement is available. To force usage of DBI::SQL::Nano objects
-regardless of the availability of SQL::Statement, set the environment
-variable DBI_SQL_NANO to 1.
-
-You can set the environment variable in your shell prior to running your
-script (with SET or EXPORT or whatever), or else you can set it in your
-script by putting this at the top of the script:
-
- BEGIN { $ENV{DBI_SQL_NANO} = 1 }
-
-=head2 Supported SQL syntax
-
- Here's a pseudo-BNF. Square brackets [] indicate optional items;
- Angle brackets <> indicate items defined elsewhere in the BNF.
-
- statement ::=
- DROP TABLE [IF EXISTS] <table_name>
- | CREATE TABLE <table_name> <col_def_list>
- | INSERT INTO <table_name> [<insert_col_list>] VALUES <val_list>
- | DELETE FROM <table_name> [<where_clause>]
- | UPDATE <table_name> SET <set_clause> <where_clause>
- | SELECT <select_col_list> FROM <table_name> [<where_clause>]
- [<order_clause>]
-
- the optional IF EXISTS clause ::=
- * similar to MySQL - prevents errors when trying to drop
- a table that doesn't exist
-
- identifiers ::=
- * table and column names should be valid SQL identifiers
- * especially avoid using spaces and commas in identifiers
- * note: there is no error checking for invalid names, some
- will be accepted, others will cause parse failures
-
- table_name ::=
- * only one table (no multiple table operations)
- * see identifier for valid table names
-
- col_def_list ::=
- * a parens delimited, comma-separated list of column names
- * see identifier for valid column names
- * column types and column constraints may be included but are ignored
- e.g. these are all the same:
- (id,phrase)
- (id INT, phrase VARCHAR(40))
- (id INT PRIMARY KEY, phrase VARCHAR(40) NOT NULL)
- * you are *strongly* advised to put in column types even though
- they are ignored ... it increases portability
-
- insert_col_list ::=
- * a parens delimited, comma-separated list of column names
- * as in standard SQL, this is optional
-
- select_col_list ::=
- * a comma-separated list of column names
- * or an asterisk denoting all columns
-
- val_list ::=
- * a parens delimited, comma-separated list of values which can be:
- * placeholders (an unquoted question mark)
- * numbers (unquoted numbers)
- * column names (unquoted strings)
- * nulls (unquoted word NULL)
- * strings (delimited with single quote marks);
- * note: leading and trailing percent mark (%) and underscore (_)
- can be used as wildcards in quoted strings for use with
- the LIKE and CLIKE operators
- * note: escaped single quotation marks within strings are not
- supported, neither are embedded commas, use placeholders instead
-
- set_clause ::=
- * a comma-separated list of column = value pairs
- * see val_list for acceptable value formats
-
- where_clause ::=
- * a single "column/value <op> column/value" predicate, optionally
- preceded by "NOT"
- * note: multiple predicates combined with ORs or ANDs are not supported
- * see val_list for acceptable value formats
- * op may be one of:
- < > >= <= = <> LIKE CLIKE IS
- * CLIKE is a case insensitive LIKE
-
- order_clause ::= column_name [ASC|DESC]
- * a single column optional ORDER BY clause is supported
- * as in standard SQL, if neither ASC (ascending) nor
- DESC (descending) is specified, ASC becomes the default
-
-=head1 TABLES
-
-DBI::SQL::Nano::Statement operates on exactly one table. This table will be
-opened by inherit from DBI::SQL::Nano::Statement and implements the
-C<< open_table >> method.
-
- sub open_table ($$$$$)
- {
- ...
- return Your::Table->new( \%attributes );
- }
-
-DBI::SQL::Nano::Statement_ expects a rudimentary interface is implemented by
-the table object, as well as SQL::Statement expects.
-
- package Your::Table;
-
- use vars qw(@ISA);
- @ISA = qw(DBI::SQL::Nano::Table);
-
- sub drop ($$) { ... }
- sub fetch_row ($$$) { ... }
- sub push_row ($$$) { ... }
- sub push_names ($$$) { ... }
- sub truncate ($$) { ... }
- sub seek ($$$$) { ... }
-
-The base class interfaces are provided by DBI::SQL::Nano::Table_ in case of
-relying on DBI::SQL::Nano or SQL::Eval::Table (see L<SQL::Eval> for details)
-otherwise.
-
-=head1 BUGS AND LIMITATIONS
-
-There are no known bugs in DBI::SQL::Nano::Statement. If you find a one
-and want to report, please see L<DBI> for how to report bugs.
-
-DBI::SQL::Nano::Statement is designed to provide a minimal subset for
-executing SQL statements.
-
-The most important limitation might be the restriction on one table per
-statement. This implies, that no JOINs are supported and there cannot be
-any foreign key relation between tables.
-
-The where clause evaluation of DBI::SQL::Nano::Statement is very slow
-(SQL::Statement uses a precompiled evaluation).
-
-INSERT can handle only one row per statement. To insert multiple rows,
-use placeholders as explained in DBI.
-
-The DBI::SQL::Nano parser is very limited and does not support any
-additional syntax such as brackets, comments, functions, aggregations
-etc.
-
-In contrast to SQL::Statement, temporary tables are not supported.
-
-=head1 ACKNOWLEDGEMENTS
-
-Tim Bunce provided the original idea for this module, helped me out of the
-tangled trap of namespaces, and provided help and advice all along the way.
-Although I wrote it from the ground up, it is based on Jochen Wiedmann's
-original design of SQL::Statement, so much of the credit for the API goes
-to him.
-
-=head1 AUTHOR AND COPYRIGHT
-
-This module is originally written by Jeff Zucker < jzucker AT cpan.org >
-
-This module is currently maintained by Jens Rehsack < jrehsack AT cpan.org >
-
-Copyright (C) 2010 by Jens Rehsack, all rights reserved.
-Copyright (C) 2004 by Jeff Zucker, all rights reserved.
-
-You may freely distribute and/or modify this module under the terms of
-either the GNU General Public License (GPL) or the Artistic License,
-as specified in the Perl README file.
-
-=cut
-
+++ /dev/null
-package DBI::Util::CacheMemory;
-
-# $Id: CacheMemory.pm 10314 2007-11-26 22:25:33Z Tim $
-#
-# Copyright (c) 2007, Tim Bunce, Ireland
-#
-# You may distribute under the terms of either the GNU General Public
-# License or the Artistic License, as specified in the Perl README file.
-
-use strict;
-use warnings;
-
-=head1 NAME
-
-DBI::Util::CacheMemory - a very fast but very minimal subset of Cache::Memory
-
-=head1 DESCRIPTION
-
-Like Cache::Memory (part of the Cache distribution) but doesn't support any fancy features.
-
-This module aims to be a very fast compatible strict sub-set for simple cases,
-such as basic client-side caching for DBD::Gofer.
-
-Like Cache::Memory, and other caches in the Cache and Cache::Cache
-distributions, the data will remain in the cache until cleared, it expires,
-or the process dies. The cache object simply going out of scope will I<not>
-destroy the data.
-
-=head1 METHODS WITH CHANGES
-
-=head2 new
-
-All options except C<namespace> are ignored.
-
-=head2 set
-
-Doesn't support expiry.
-
-=head2 purge
-
-Same as clear() - deletes everything in the namespace.
-
-=head1 METHODS WITHOUT CHANGES
-
-=over
-
-=item clear
-
-=item count
-
-=item exists
-
-=item remove
-
-=back
-
-=head1 UNSUPPORTED METHODS
-
-If it's not listed above, it's not supported.
-
-=cut
-
-our $VERSION = "0.010315";
-
-my %cache;
-
-sub new {
- my ($class, %options ) = @_;
- my $namespace = $options{namespace} ||= 'Default';
- #$options{_cache} = \%cache; # can be handy for debugging/dumping
- my $self = bless \%options => $class;
- $cache{ $namespace } ||= {}; # init - ensure it exists
- return $self;
-}
-
-sub set {
- my ($self, $key, $value) = @_;
- $cache{ $self->{namespace} }->{$key} = $value;
-}
-
-sub get {
- my ($self, $key) = @_;
- return $cache{ $self->{namespace} }->{$key};
-}
-
-sub exists {
- my ($self, $key) = @_;
- return exists $cache{ $self->{namespace} }->{$key};
-}
-
-sub remove {
- my ($self, $key) = @_;
- return delete $cache{ $self->{namespace} }->{$key};
-}
-
-sub purge {
- return shift->clear;
-}
-
-sub clear {
- $cache{ shift->{namespace} } = {};
-}
-
-sub count {
- return scalar keys %{ $cache{ shift->{namespace} } };
-}
-
-sub size {
- my $c = $cache{ shift->{namespace} };
- my $size = 0;
- while ( my ($k,$v) = each %$c ) {
- $size += length($k) + length($v);
- }
- return $size;
-}
-
-1;
+++ /dev/null
-package DBI::Util::_accessor;
-use strict;
-use Carp;
-our $VERSION = "0.009479";
-
-# inspired by Class::Accessor::Fast
-
-sub new {
- my($proto, $fields) = @_;
- my($class) = ref $proto || $proto;
- $fields ||= {};
-
- my @dubious = grep { !m/^_/ && !$proto->can($_) } keys %$fields;
- carp "$class doesn't have accessors for fields: @dubious" if @dubious;
-
- # make a (shallow) copy of $fields.
- bless {%$fields}, $class;
-}
-
-sub mk_accessors {
- my($self, @fields) = @_;
- $self->mk_accessors_using('make_accessor', @fields);
-}
-
-sub mk_accessors_using {
- my($self, $maker, @fields) = @_;
- my $class = ref $self || $self;
-
- # So we don't have to do lots of lookups inside the loop.
- $maker = $self->can($maker) unless ref $maker;
-
- no strict 'refs';
- foreach my $field (@fields) {
- my $accessor = $self->$maker($field);
- *{$class."\:\:$field"} = $accessor
- unless defined &{$class."\:\:$field"};
- }
- #my $hash_ref = \%{$class."\:\:_accessors_hash};
- #$hash_ref->{$_}++ for @fields;
- # XXX also copy down _accessors_hash of base class(es)
- # so one in this class is complete
- return;
-}
-
-sub make_accessor {
- my($class, $field) = @_;
- return sub {
- my $self = shift;
- return $self->{$field} unless @_;
- croak "Too many arguments to $field" if @_ > 1;
- return $self->{$field} = shift;
- };
-}
-
-sub make_accessor_autoviv_hashref {
- my($class, $field) = @_;
- return sub {
- my $self = shift;
- return $self->{$field} ||= {} unless @_;
- croak "Too many arguments to $field" if @_ > 1;
- return $self->{$field} = shift;
- };
-}
-
-1;
+++ /dev/null
-package
- DBI; # hide this non-DBI package from simple indexers
-
-# $Id: W32ODBC.pm 8696 2007-01-24 23:12:38Z Tim $
-#
-# Copyright (c) 1997,1999 Tim Bunce
-# With many thanks to Patrick Hollins for polishing.
-#
-# You may distribute under the terms of either the GNU General Public
-# License or the Artistic License, as specified in the Perl README file.
-
-=head1 NAME
-
-DBI::W32ODBC - An experimental DBI emulation layer for Win32::ODBC
-
-=head1 SYNOPSIS
-
- use DBI::W32ODBC;
-
- # apart from the line above everything is just the same as with
- # the real DBI when using a basic driver with few features.
-
-=head1 DESCRIPTION
-
-This is an experimental pure perl DBI emulation layer for Win32::ODBC
-
-If you can improve this code I'd be interested in hearing about it. If
-you are having trouble using it please respect the fact that it's very
-experimental. Ideally fix it yourself and send me the details.
-
-=head2 Some Things Not Yet Implemented
-
- Most attributes including PrintError & RaiseError.
- type_info and table_info
-
-Volunteers welcome!
-
-=cut
-
-${'DBI::VERSION'} # hide version from PAUSE indexer
- = "0.01";
-
-my $Revision = sprintf("12.%06d", q$Revision: 8696 $ =~ /(\d+)/o);
-
-
-sub DBI::W32ODBC::import { } # must trick here since we're called DBI/W32ODBC.pm
-
-
-use Carp;
-
-use Win32::ODBC;
-
-@ISA = qw(Win32::ODBC);
-
-use strict;
-
-$DBI::dbi_debug = $ENV{PERL_DBI_DEBUG} || 0;
-carp "Loaded (W32ODBC) DBI.pm ${'DBI::VERSION'} (debug $DBI::dbi_debug)"
- if $DBI::dbi_debug;
-
-
-
-sub connect {
- my ($class, $dbname, $dbuser, $dbpasswd, $module, $attr) = @_;
- $dbname .= ";UID=$dbuser" if $dbuser;
- $dbname .= ";PWD=$dbpasswd" if $dbpasswd;
- my $h = new Win32::ODBC $dbname;
- warn "Error connecting to $dbname: ".Win32::ODBC::Error()."\n" unless $h;
- bless $h, $class if $h; # rebless into our class
- $h;
-}
-
-
-sub quote {
- my ($h, $string) = @_;
- return "NULL" if !defined $string;
- $string =~ s/'/''/g; # standard
- # This hack seems to be required for Access but probably breaks for
- # other databases when using \r and \n. It would be better if we could
- # use ODBC options to detect that we're actually using Access.
- $string =~ s/\r/' & chr\$(13) & '/g;
- $string =~ s/\n/' & chr\$(10) & '/g;
- "'$string'";
-}
-
-sub do {
- my($h, $statement, $attribs, @params) = @_;
- Carp::carp "\$h->do() attribs unused" if $attribs;
- my $new_h = $h->prepare($statement) or return undef; ##
- pop @{ $h->{'___sths'} }; ## certain death assured
- $new_h->execute(@params) or return undef; ##
- my $rows = $new_h->rows; ##
- $new_h->finish; ## bang bang
- ($rows == 0) ? "0E0" : $rows;
-}
-
-# ---
-
-sub prepare {
- my ($h, $sql) = @_;
- ## opens a new connection with every prepare to allow
- ## multiple, concurrent queries
- my $new_h = new Win32::ODBC $h->{DSN}; ##
- return undef if not $new_h; ## bail if no connection
- bless $new_h; ## shouldn't be sub-classed...
- $new_h->{'__prepare'} = $sql; ##
- $new_h->{NAME} = []; ##
- $new_h->{NUM_OF_FIELDS} = -1; ##
- push @{ $h->{'___sths'} } ,$new_h; ## save sth in parent for mass destruction
- return $new_h; ##
-}
-
-sub execute {
- my ($h) = @_;
- my $rc = $h->Sql($h->{'__prepare'});
- return undef if $rc;
- my @fields = $h->FieldNames;
- $h->{NAME} = \@fields;
- $h->{NUM_OF_FIELDS} = scalar @fields;
- $h; # return dbh as pseudo sth
-}
-
-
-sub fetchrow_hashref { ## provide DBI compatibility
- my $h = shift;
- my $NAME = shift || "NAME";
- my $row = $h->fetchrow_arrayref or return undef;
- my %hash;
- @hash{ @{ $h->{$NAME} } } = @$row;
- return \%hash;
-}
-
-sub fetchrow {
- my $h = shift;
- return unless $h->FetchRow();
- my $fields_r = $h->{NAME};
- return $h->Data(@$fields_r);
-}
-sub fetch {
- my @row = shift->fetchrow;
- return undef unless @row;
- return \@row;
-}
-*fetchrow_arrayref = \&fetch; ## provide DBI compatibility
-*fetchrow_array = \&fetchrow; ## provide DBI compatibility
-
-sub rows {
- shift->RowCount;
-}
-
-sub finish {
- shift->Close; ## uncommented this line
-}
-
-# ---
-
-sub commit {
- shift->Transact(ODBC::SQL_COMMIT);
-}
-sub rollback {
- shift->Transact(ODBC::SQL_ROLLBACK);
-}
-
-sub disconnect {
- my ($h) = shift; ## this will kill all the statement handles
- foreach (@{$h->{'___sths'}}) { ## created for a specific connection
- $_->Close if $_->{DSN}; ##
- } ##
- $h->Close; ##
-}
-
-sub err {
- (shift->Error)[0];
-}
-sub errstr {
- scalar( shift->Error );
-}
-
-# ---
-
-1;
+++ /dev/null
-package # hide this package from CPAN indexer
- Win32::ODBC;
-
-use strict;
-
-use DBI;
-
-# once we've been loaded we don't want perl to load the real Win32::ODBC
-$INC{'Win32/ODBC.pm'} = $INC{'Win32/DBIODBC.pm'} || 1;
-
-#my $db = new Win32::ODBC("DSN=$self->{'DSN'};UID=$self->{'UID'};PWD=$self->{'PWD'};");
-
-#EMU --- my $db = new Win32::ODBC("DSN=$DSN;UID=$login;PWD=$password;");
-sub new
-{
- shift;
- my $connect_line= shift;
-
-# [R] self-hack to allow empty UID and PWD
- my $temp_connect_line;
- $connect_line=~/DSN=\w+/;
- $temp_connect_line="$&;";
- if ($connect_line=~/UID=\w?/)
- {$temp_connect_line.="$&;";}
- else {$temp_connect_line.="UID=;";};
- if ($connect_line=~/PWD=\w?/)
- {$temp_connect_line.="$&;";}
- else {$temp_connect_line.="PWD=;";};
- $connect_line=$temp_connect_line;
-# -[R]-
-
- my $self= {};
-
-
- $_=$connect_line;
- /^(DSN=)(.*)(;UID=)(.*)(;PWD=)(.*)(;)$/;
-
- #---- DBI CONNECTION VARIABLES
-
- $self->{ODBC_DSN}=$2;
- $self->{ODBC_UID}=$4;
- $self->{ODBC_PWD}=$6;
-
-
- #---- DBI CONNECTION VARIABLES
- $self->{DBI_DBNAME}=$self->{ODBC_DSN};
- $self->{DBI_USER}=$self->{ODBC_UID};
- $self->{DBI_PASSWORD}=$self->{ODBC_PWD};
- $self->{DBI_DBD}='ODBC';
-
- #---- DBI CONNECTION
- $self->{'DBI_DBH'}=DBI->connect($self->{'DBI_DBNAME'},
- $self->{'DBI_USER'},$self->{'DBI_PASSWORD'},$self->{'DBI_DBD'});
-
- warn "Error($DBI::err) : $DBI::errstr\n" if ! $self->{'DBI_DBH'};
-
-
- #---- RETURN
-
- bless $self;
-}
-
-
-#EMU --- $db->Sql('SELECT * FROM DUAL');
-sub Sql
-{
- my $self= shift;
- my $SQL_statment=shift;
-
- # print " SQL : $SQL_statment \n";
-
- $self->{'DBI_SQL_STATMENT'}=$SQL_statment;
-
- my $dbh=$self->{'DBI_DBH'};
-
- # print " DBH : $dbh \n";
-
- my $sth=$dbh->prepare("$SQL_statment");
-
- # print " STH : $sth \n";
-
- $self->{'DBI_STH'}=$sth;
-
- if ($sth)
- {
- $sth->execute();
- }
-
- #--- GET ERROR MESSAGES
- $self->{DBI_ERR}=$DBI::err;
- $self->{DBI_ERRSTR}=$DBI::errstr;
-
- if ($sth)
- {
- #--- GET COLUMNS NAMES
- $self->{'DBI_NAME'} = $sth->{NAME};
- }
-
-# [R] provide compatibility with Win32::ODBC's way of identifying erroneous SQL statements
- return ($self->{'DBI_ERR'})?1:undef;
-# -[R]-
-}
-
-
-#EMU --- $db->FetchRow())
-sub FetchRow
-{
- my $self= shift;
-
- my $sth=$self->{'DBI_STH'};
- if ($sth)
- {
- my @row=$sth->fetchrow_array;
- $self->{'DBI_ROW'}=\@row;
-
- if (scalar(@row)>0)
- {
- #-- the row of result is not nul
- #-- return something nothing will be return else
- return 1;
- }
- }
- return undef;
-}
-
-# [R] provide compatibility with Win32::ODBC's Data() method.
-sub Data
-{
- my $self=shift;
- my @array=@{$self->{'DBI_ROW'}};
- foreach my $element (@array)
- {
- # remove padding of spaces by DBI
- $element=~s/(\s*$)//;
- };
- return (wantarray())?@array:join('', @array);
-};
-# -[R]-
-
-#EMU --- %record = $db->DataHash;
-sub DataHash
-{
- my $self= shift;
-
- my $p_name=$self->{'DBI_NAME'};
- my $p_row=$self->{'DBI_ROW'};
-
- my @name=@$p_name;
- my @row=@$p_row;
-
- my %DataHash;
-#print @name; print "\n"; print @row;
-# [R] new code that seems to work consistent with Win32::ODBC
- while (@name)
- {
- my $name=shift(@name);
- my $value=shift(@row);
-
- # remove padding of spaces by DBI
- $name=~s/(\s*$)//;
- $value=~s/(\s*$)//;
-
- $DataHash{$name}=$value;
- };
-# -[R]-
-
-# [R] old code that didn't appear to work
-# foreach my $name (@name)
-# {
-# $name=~s/(^\s*)|(\s*$)//;
-# my @arr=@$name;
-# foreach (@arr)
-# {
-# print "lot $name name col $_ or ROW= 0 $row[0] 1 $row[1] 2 $row[2] \n ";
-# $DataHash{$name}=shift(@row);
-# }
-# }
-# -[R]-
-
- #--- Return Hash
- return %DataHash;
-}
-
-
-#EMU --- $db->Error()
-sub Error
-{
- my $self= shift;
-
- if ($self->{'DBI_ERR'} ne '')
- {
- #--- Return error message
- $self->{'DBI_ERRSTR'};
- }
-
- #-- else good no error message
-
-}
-
-# [R] provide compatibility with Win32::ODBC's Close() method.
-sub Close
-{
- my $self=shift;
-
- my $dbh=$self->{'DBI_DBH'};
- $dbh->disconnect;
-}
-# -[R]-
-
-1;
-
-__END__
-
-# [R] to -[R]- indicate sections edited by me, Roy Lee
-
-=head1 NAME
-
-Win32::DBIODBC - Win32::ODBC emulation layer for the DBI
-
-=head1 SYNOPSIS
-
- use Win32::DBIODBC; # instead of use Win32::ODBC
-
-=head1 DESCRIPTION
-
-This is a I<very> basic I<very> alpha quality Win32::ODBC emulation
-for the DBI. To use it just replace
-
- use Win32::ODBC;
-
-in your scripts with
-
- use Win32::DBIODBC;
-
-or, while experimenting, you can pre-load this module without changing your
-scripts by doing
-
- perl -MWin32::DBIODBC your_script_name
-
-=head1 TO DO
-
-Error handling is virtually non-existent.
-
-=head1 AUTHOR
-
-Tom Horen <tho@melexis.com>
-
-=cut
+++ /dev/null
-#!perl -w
-use strict;
-
-my $dbixs_rev_file = "dbixs_rev.h";
-
-my $is_make_dist;
-my $svnversion;
-
-if (is_dbi_svn_dir(".")) {
- $svnversion = `svnversion -n`;
-}
-elsif (is_dbi_svn_dir("..")) {
- # presumably we're in a subdirectory because the user is doing a 'make dist'
- $svnversion = `svnversion -n ..`;
- $is_make_dist = 1;
-}
-else {
- # presumably we're being run by an end-user because their file timestamps
- # got messed up
- print "Skipping regeneration of $dbixs_rev_file\n";
- utime(time(), time(), $dbixs_rev_file); # update modification time
- exit 0;
-}
-
-my @warn;
-die "Neither current directory nor parent directory are an svn working copy\n"
- unless $svnversion and $svnversion =~ m/^\d+/;
-push @warn, "Mixed revision working copy ($svnversion:$1)"
- if $svnversion =~ s/:(\d+)//;
-push @warn, "Code modified since last checkin"
- if $svnversion =~ s/[MS]+$//;
-warn "$dbixs_rev_file warning: $_\n" for @warn;
-die "$0 failed\n" if $is_make_dist && @warn;
-
-write_header($dbixs_rev_file, DBIXS_REVISION => $svnversion, \@warn);
-
-sub write_header {
- my ($file, $macro, $version, $comments_ref) = @_;
- open my $fh, ">$file" or die "Can't open $file: $!\n";
- unshift @$comments_ref, scalar localtime(time);
- print $fh "/* $_ */\n" for @$comments_ref;
- print $fh "#define $macro $version\n";
- close $fh or die "Error closing $file: $!\n";
- print "Wrote $macro $version to $file\n";
-}
-
-sub is_dbi_svn_dir {
- my ($dir) = @_;
- return (-d "$dir/.svn" && -f "$dir/MANIFEST.SKIP");
-}
-
+++ /dev/null
-.\" Automatically generated by Pod::Man 2.28 (Pod::Simple 3.29)
-.\"
-.\" Standard preamble:
-.\" ========================================================================
-.de Sp \" Vertical space (when we can't use .PP)
-.if t .sp .5v
-.if n .sp
-..
-.de Vb \" Begin verbatim text
-.ft CW
-.nf
-.ne \\$1
-..
-.de Ve \" End verbatim text
-.ft R
-.fi
-..
-.\" Set up some character translations and predefined strings. \*(-- will
-.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
-.\" double quote, and \*(R" will give a right double quote. \*(C+ will
-.\" give a nicer C++. Capital omega is used to do unbreakable dashes and
-.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff,
-.\" nothing in troff, for use with C<>.
-.tr \(*W-
-.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
-.ie n \{\
-. ds -- \(*W-
-. ds PI pi
-. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
-. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch
-. ds L" ""
-. ds R" ""
-. ds C` ""
-. ds C' ""
-'br\}
-.el\{\
-. ds -- \|\(em\|
-. ds PI \(*p
-. ds L" ``
-. ds R" ''
-. ds C`
-. ds C'
-'br\}
-.\"
-.\" Escape single quotes in literal strings from groff's Unicode transform.
-.ie \n(.g .ds Aq \(aq
-.el .ds Aq '
-.\"
-.\" If the F register is turned on, we'll generate index entries on stderr for
-.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
-.\" entries marked with X<> in POD. Of course, you'll have to process the
-.\" output yourself in some meaningful fashion.
-.\"
-.\" Avoid warning from groff about undefined register 'F'.
-.de IX
-..
-.nr rF 0
-.if \n(.g .if rF .nr rF 1
-.if (\n(rF:(\n(.g==0)) \{
-. if \nF \{
-. de IX
-. tm Index:\\$1\t\\n%\t"\\$2"
-..
-. if !\nF==2 \{
-. nr % 0
-. nr F 2
-. \}
-. \}
-.\}
-.rr rF
-.\" ========================================================================
-.\"
-.IX Title "DBILOGSTRIP 1p"
-.TH DBILOGSTRIP 1p "2018-08-03" "perl v5.22.1" "User Contributed Perl Documentation"
-.\" For nroff, turn off justification. Always turn off hyphenation; it makes
-.\" way too many mistakes in technical documents.
-.if n .ad l
-.nh
-.SH "NAME"
-dbilogstrip \- filter to normalize DBI trace logs for diff'ing
-.SH "SYNOPSIS"
-.IX Header "SYNOPSIS"
-Read \s-1DBI\s0 trace file \f(CW\*(C`dbitrace.log\*(C'\fR and write out a stripped version to \f(CW\*(C`dbitrace_stripped.log\*(C'\fR
-.PP
-.Vb 1
-\& dbilogstrip dbitrace.log > dbitrace_stripped.log
-.Ve
-.PP
-Run \f(CW\*(C`yourscript.pl\*(C'\fR twice, each with different sets of arguments, with
-\&\s-1DBI_TRACE\s0 enabled. Filter the output and trace through \f(CW\*(C`dbilogstrip\*(C'\fR into a
-separate file for each run. Then compare using diff. (This example assumes
-you're using a standard shell.)
-.PP
-.Vb 3
-\& DBI_TRACE=2 perl yourscript.pl ...args1... 2>&1 | dbilogstrip > dbitrace1.log
-\& DBI_TRACE=2 perl yourscript.pl ...args2... 2>&1 | dbilogstrip > dbitrace2.log
-\& diff \-u dbitrace1.log dbitrace2.log
-.Ve
-.SH "DESCRIPTION"
-.IX Header "DESCRIPTION"
-Replaces any hex addresses, e.g, \f(CW0x128f72ce\fR with \f(CW\*(C`0xN\*(C'\fR.
-.PP
-Replaces any references to process id or thread id, like \f(CW\*(C`pid#6254\*(C'\fR with \f(CW\*(C`pidN\*(C'\fR.
-.PP
-So a \s-1DBI\s0 trace line like this:
-.PP
-.Vb 1
-\& \-> STORE for DBD::DBM::st (DBI::st=HASH(0x19162a0)~0x191f9c8 \*(Aqf_params\*(Aq ARRAY(0x1922018)) thr#1800400
-.Ve
-.PP
-will look like this:
-.PP
-.Vb 1
-\& \-> STORE for DBD::DBM::st (DBI::st=HASH(0xN)~0xN \*(Aqf_params\*(Aq ARRAY(0xN)) thrN
-.Ve
+++ /dev/null
-.\" Automatically generated by Pod::Man 2.28 (Pod::Simple 3.29)
-.\"
-.\" Standard preamble:
-.\" ========================================================================
-.de Sp \" Vertical space (when we can't use .PP)
-.if t .sp .5v
-.if n .sp
-..
-.de Vb \" Begin verbatim text
-.ft CW
-.nf
-.ne \\$1
-..
-.de Ve \" End verbatim text
-.ft R
-.fi
-..
-.\" Set up some character translations and predefined strings. \*(-- will
-.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
-.\" double quote, and \*(R" will give a right double quote. \*(C+ will
-.\" give a nicer C++. Capital omega is used to do unbreakable dashes and
-.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff,
-.\" nothing in troff, for use with C<>.
-.tr \(*W-
-.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
-.ie n \{\
-. ds -- \(*W-
-. ds PI pi
-. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
-. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch
-. ds L" ""
-. ds R" ""
-. ds C` ""
-. ds C' ""
-'br\}
-.el\{\
-. ds -- \|\(em\|
-. ds PI \(*p
-. ds L" ``
-. ds R" ''
-. ds C`
-. ds C'
-'br\}
-.\"
-.\" Escape single quotes in literal strings from groff's Unicode transform.
-.ie \n(.g .ds Aq \(aq
-.el .ds Aq '
-.\"
-.\" If the F register is turned on, we'll generate index entries on stderr for
-.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
-.\" entries marked with X<> in POD. Of course, you'll have to process the
-.\" output yourself in some meaningful fashion.
-.\"
-.\" Avoid warning from groff about undefined register 'F'.
-.de IX
-..
-.nr rF 0
-.if \n(.g .if rF .nr rF 1
-.if (\n(rF:(\n(.g==0)) \{
-. if \nF \{
-. de IX
-. tm Index:\\$1\t\\n%\t"\\$2"
-..
-. if !\nF==2 \{
-. nr % 0
-. nr F 2
-. \}
-. \}
-.\}
-.rr rF
-.\" ========================================================================
-.\"
-.IX Title "DBIPROF 1p"
-.TH DBIPROF 1p "2018-08-03" "perl v5.22.1" "User Contributed Perl Documentation"
-.\" For nroff, turn off justification. Always turn off hyphenation; it makes
-.\" way too many mistakes in technical documents.
-.if n .ad l
-.nh
-.SH "NAME"
-dbiprof \- command\-line client for DBI::ProfileData
-.SH "SYNOPSIS"
-.IX Header "SYNOPSIS"
-See a report of the ten queries with the longest total runtime in the
-profile dump file \fIprof1.out\fR:
-.PP
-.Vb 1
-\& dbiprof prof1.out
-.Ve
-.PP
-See the top 10 most frequently run queries in the profile file
-\&\fIdbi.prof\fR (the default):
-.PP
-.Vb 1
-\& dbiprof \-\-sort count
-.Ve
-.PP
-See the same report with 15 entries:
-.PP
-.Vb 1
-\& dbiprof \-\-sort count \-\-number 15
-.Ve
-.SH "DESCRIPTION"
-.IX Header "DESCRIPTION"
-This tool is a command-line client for the DBI::ProfileData. It
-allows you to analyze the profile data file produced by
-DBI::ProfileDumper and produce various useful reports.
-.SH "OPTIONS"
-.IX Header "OPTIONS"
-This program accepts the following options:
-.IP "\-\-number N" 4
-.IX Item "--number N"
-Produce this many items in the report. Defaults to 10. If set to
-\&\*(L"all\*(R" then all results are shown.
-.IP "\-\-sort field" 4
-.IX Item "--sort field"
-Sort results by the given field. Sorting by multiple fields isn't currently
-supported (patches welcome). The available sort fields are:
-.RS 4
-.IP "total" 4
-.IX Item "total"
-Sorts by total time run time across all runs. This is the default
-sort.
-.IP "longest" 4
-.IX Item "longest"
-Sorts by the longest single run.
-.IP "count" 4
-.IX Item "count"
-Sorts by total number of runs.
-.IP "first" 4
-.IX Item "first"
-Sorts by the time taken in the first run.
-.IP "shortest" 4
-.IX Item "shortest"
-Sorts by the shortest single run.
-.IP "key1" 4
-.IX Item "key1"
-Sorts by the value of the first element in the Path, which should be numeric.
-You can also sort by \f(CW\*(C`key2\*(C'\fR and \f(CW\*(C`key3\*(C'\fR.
-.RE
-.RS 4
-.RE
-.IP "\-\-reverse" 4
-.IX Item "--reverse"
-Reverses the selected sort. For example, to see a report of the
-shortest overall time:
-.Sp
-.Vb 1
-\& dbiprof \-\-sort total \-\-reverse
-.Ve
-.IP "\-\-match keyN=value" 4
-.IX Item "--match keyN=value"
-Consider only items where the specified key matches the given value.
-Keys are numbered from 1. For example, let's say you used a
-DBI::Profile Path of:
-.Sp
-.Vb 1
-\& [ DBIprofile_Statement, DBIprofile_Methodname ]
-.Ve
-.Sp
-And called dbiprof as in:
-.Sp
-.Vb 1
-\& dbiprof \-\-match key2=execute
-.Ve
-.Sp
-Your report would only show execute queries, leaving out prepares,
-fetches, etc.
-.Sp
-If the value given starts and ends with slashes (\f(CW\*(C`/\*(C'\fR) then it will be
-treated as a regular expression. For example, to only include \s-1SELECT\s0
-queries where key1 is the statement:
-.Sp
-.Vb 1
-\& dbiprof \-\-match key1=/^SELECT/
-.Ve
-.Sp
-By default the match expression is matched case-insensitively, but
-this can be changed with the \-\-case\-sensitive option.
-.IP "\-\-exclude keyN=value" 4
-.IX Item "--exclude keyN=value"
-Remove items for where the specified key matches the given value. For
-example, to exclude all prepare entries where key2 is the method name:
-.Sp
-.Vb 1
-\& dbiprof \-\-exclude key2=prepare
-.Ve
-.Sp
-Like \f(CW\*(C`\-\-match\*(C'\fR, If the value given starts and ends with slashes
-(\f(CW\*(C`/\*(C'\fR) then it will be treated as a regular expression. For example,
-to exclude \s-1UPDATE\s0 queries where key1 is the statement:
-.Sp
-.Vb 1
-\& dbiprof \-\-match key1=/^UPDATE/
-.Ve
-.Sp
-By default the exclude expression is matched case-insensitively, but
-this can be changed with the \-\-case\-sensitive option.
-.IP "\-\-case\-sensitive" 4
-.IX Item "--case-sensitive"
-Using this option causes \-\-match and \-\-exclude to work
-case-sensitively. Defaults to off.
-.IP "\-\-delete" 4
-.IX Item "--delete"
-Sets the \f(CW\*(C`DeleteFiles\*(C'\fR option to DBI::ProfileData which causes the
-files to be deleted after reading. See DBI::ProfileData for more details.
-.IP "\-\-dumpnodes" 4
-.IX Item "--dumpnodes"
-Print the list of nodes in the form of a perl data structure.
-Use the \f(CW\*(C`\-sort\*(C'\fR option if you want the list sorted.
-.IP "\-\-version" 4
-.IX Item "--version"
-Print the dbiprof version number and exit.
-.SH "AUTHOR"
-.IX Header "AUTHOR"
-Sam Tregar <sam@tregar.com>
-.SH "COPYRIGHT AND LICENSE"
-.IX Header "COPYRIGHT AND LICENSE"
-Copyright (C) 2002 Sam Tregar
-.PP
-This program is free software; you can redistribute it and/or modify
-it under the same terms as Perl 5 itself.
-.SH "SEE ALSO"
-.IX Header "SEE ALSO"
-DBI::ProfileDumper,
-DBI::Profile, \s-1DBI\s0.
+++ /dev/null
-.\" Automatically generated by Pod::Man 2.28 (Pod::Simple 3.29)
-.\"
-.\" Standard preamble:
-.\" ========================================================================
-.de Sp \" Vertical space (when we can't use .PP)
-.if t .sp .5v
-.if n .sp
-..
-.de Vb \" Begin verbatim text
-.ft CW
-.nf
-.ne \\$1
-..
-.de Ve \" End verbatim text
-.ft R
-.fi
-..
-.\" Set up some character translations and predefined strings. \*(-- will
-.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
-.\" double quote, and \*(R" will give a right double quote. \*(C+ will
-.\" give a nicer C++. Capital omega is used to do unbreakable dashes and
-.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff,
-.\" nothing in troff, for use with C<>.
-.tr \(*W-
-.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
-.ie n \{\
-. ds -- \(*W-
-. ds PI pi
-. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
-. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch
-. ds L" ""
-. ds R" ""
-. ds C` ""
-. ds C' ""
-'br\}
-.el\{\
-. ds -- \|\(em\|
-. ds PI \(*p
-. ds L" ``
-. ds R" ''
-. ds C`
-. ds C'
-'br\}
-.\"
-.\" Escape single quotes in literal strings from groff's Unicode transform.
-.ie \n(.g .ds Aq \(aq
-.el .ds Aq '
-.\"
-.\" If the F register is turned on, we'll generate index entries on stderr for
-.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
-.\" entries marked with X<> in POD. Of course, you'll have to process the
-.\" output yourself in some meaningful fashion.
-.\"
-.\" Avoid warning from groff about undefined register 'F'.
-.de IX
-..
-.nr rF 0
-.if \n(.g .if rF .nr rF 1
-.if (\n(rF:(\n(.g==0)) \{
-. if \nF \{
-. de IX
-. tm Index:\\$1\t\\n%\t"\\$2"
-..
-. if !\nF==2 \{
-. nr % 0
-. nr F 2
-. \}
-. \}
-.\}
-.rr rF
-.\" ========================================================================
-.\"
-.IX Title "DBIPROXY 1p"
-.TH DBIPROXY 1p "2018-08-03" "perl v5.22.1" "User Contributed Perl Documentation"
-.\" For nroff, turn off justification. Always turn off hyphenation; it makes
-.\" way too many mistakes in technical documents.
-.if n .ad l
-.nh
-.SH "NAME"
-dbiproxy \- A proxy server for the DBD::Proxy driver
-.SH "SYNOPSIS"
-.IX Header "SYNOPSIS"
-.Vb 1
-\& dbiproxy <options> \-\-localport=<port>
-.Ve
-.SH "DESCRIPTION"
-.IX Header "DESCRIPTION"
-This tool is just a front end for the DBI::ProxyServer package. All it
-does is picking options from the command line and calling
-\&\fIDBI::ProxyServer::main()\fR. See DBI::ProxyServer for details.
-.PP
-Available options include:
-.IP "\fB\-\-chroot=dir\fR" 4
-.IX Item "--chroot=dir"
-(\s-1UNIX\s0 only) After doing a \fIbind()\fR, change root directory to the given
-directory by doing a \fIchroot()\fR. This is useful for security, but it
-restricts the environment a lot. For example, you need to load \s-1DBI\s0
-drivers in the config file or you have to create hard links to Unix
-sockets, if your drivers are using them. For example, with MySQL, a
-config file might contain the following lines:
-.Sp
-.Vb 9
-\& my $rootdir = \*(Aq/var/dbiproxy\*(Aq;
-\& my $unixsockdir = \*(Aq/tmp\*(Aq;
-\& my $unixsockfile = \*(Aqmysql.sock\*(Aq;
-\& foreach $dir ($rootdir, "$rootdir$unixsockdir") {
-\& mkdir 0755, $dir;
-\& }
-\& link("$unixsockdir/$unixsockfile",
-\& "$rootdir$unixsockdir/$unixsockfile");
-\& require DBD::mysql;
-\&
-\& {
-\& \*(Aqchroot\*(Aq => $rootdir,
-\& ...
-\& }
-.Ve
-.Sp
-If you don't know \fIchroot()\fR, think of an \s-1FTP\s0 server where you can see a
-certain directory tree only after logging in. See also the \-\-group and
-\&\-\-user options.
-.IP "\fB\-\-configfile=file\fR" 4
-.IX Item "--configfile=file"
-Config files are assumed to return a single hash ref that overrides the
-arguments of the new method. However, command line arguments in turn take
-precedence over the config file. See the \*(L"\s-1CONFIGURATION FILE\*(R"\s0 section
-in the DBI::ProxyServer documentation for details on the config file.
-.IP "\fB\-\-debug\fR" 4
-.IX Item "--debug"
-Turn debugging mode on. Mainly this asserts that logging messages of
-level \*(L"debug\*(R" are created.
-.IP "\fB\-\-facility=mode\fR" 4
-.IX Item "--facility=mode"
-(\s-1UNIX\s0 only) Facility to use for Sys::Syslog. The default is
-\&\fBdaemon\fR.
-.IP "\fB\-\-group=gid\fR" 4
-.IX Item "--group=gid"
-After doing a \fIbind()\fR, change the real and effective \s-1GID\s0 to the given.
-This is useful, if you want your server to bind to a privileged port
-(<1024), but don't want the server to execute as root. See also
-the \-\-user option.
-.Sp
-\&\s-1GID\s0's can be passed as group names or numeric values.
-.IP "\fB\-\-localaddr=ip\fR" 4
-.IX Item "--localaddr=ip"
-By default a daemon is listening to any \s-1IP\s0 number that a machine
-has. This attribute allows one to restrict the server to the given
-\&\s-1IP\s0 number.
-.IP "\fB\-\-localport=port\fR" 4
-.IX Item "--localport=port"
-This attribute sets the port on which the daemon is listening. It
-must be given somehow, as there's no default.
-.IP "\fB\-\-logfile=file\fR" 4
-.IX Item "--logfile=file"
-Be default logging messages will be written to the syslog (Unix) or
-to the event log (Windows \s-1NT\s0). On other operating systems you need to
-specify a log file. The special value \*(L"\s-1STDERR\*(R"\s0 forces logging to
-stderr. See Net::Daemon::Log for details.
-.IP "\fB\-\-mode=modename\fR" 4
-.IX Item "--mode=modename"
-The server can run in three different modes, depending on the environment.
-.Sp
-If you are running Perl 5.005 and did compile it for threads, then the
-server will create a new thread for each connection. The thread will
-execute the server's \fIRun()\fR method and then terminate. This mode is the
-default, you can force it with \*(L"\-\-mode=threads\*(R".
-.Sp
-If threads are not available, but you have a working \fIfork()\fR, then the
-server will behave similar by creating a new process for each connection.
-This mode will be used automatically in the absence of threads or if
-you use the \*(L"\-\-mode=fork\*(R" option.
-.Sp
-Finally there's a single-connection mode: If the server has accepted a
-connection, he will enter the \fIRun()\fR method. No other connections are
-accepted until the \fIRun()\fR method returns (if the client disconnects).
-This operation mode is useful if you have neither threads nor \fIfork()\fR,
-for example on the Macintosh. For debugging purposes you can force this
-mode with \*(L"\-\-mode=single\*(R".
-.IP "\fB\-\-pidfile=file\fR" 4
-.IX Item "--pidfile=file"
-(\s-1UNIX\s0 only) If this option is present, a \s-1PID\s0 file will be created at the
-given location. Default is to not create a pidfile.
-.IP "\fB\-\-user=uid\fR" 4
-.IX Item "--user=uid"
-After doing a \fIbind()\fR, change the real and effective \s-1UID\s0 to the given.
-This is useful, if you want your server to bind to a privileged port
-(<1024), but don't want the server to execute as root. See also
-the \-\-group and the \-\-chroot options.
-.Sp
-\&\s-1UID\s0's can be passed as group names or numeric values.
-.IP "\fB\-\-version\fR" 4
-.IX Item "--version"
-Suppresses startup of the server; instead the version string will
-be printed and the program exits immediately.
-.SH "AUTHOR"
-.IX Header "AUTHOR"
-.Vb 4
-\& Copyright (c) 1997 Jochen Wiedmann
-\& Am Eisteich 9
-\& 72555 Metzingen
-\& Germany
-\&
-\& Email: joe@ispsoft.de
-\& Phone: +49 7123 14881
-.Ve
-.PP
-The DBI::ProxyServer module is free software; you can redistribute it
-and/or modify it under the same terms as Perl itself. In particular
-permission is granted to Tim Bunce for distributing this as a part of
-the \s-1DBI.\s0
-.SH "SEE ALSO"
-.IX Header "SEE ALSO"
-DBI::ProxyServer, DBD::Proxy, \s-1DBI\s0
+++ /dev/null
-.\" Automatically generated by Pod::Man 2.28 (Pod::Simple 3.29)
-.\"
-.\" Standard preamble:
-.\" ========================================================================
-.de Sp \" Vertical space (when we can't use .PP)
-.if t .sp .5v
-.if n .sp
-..
-.de Vb \" Begin verbatim text
-.ft CW
-.nf
-.ne \\$1
-..
-.de Ve \" End verbatim text
-.ft R
-.fi
-..
-.\" Set up some character translations and predefined strings. \*(-- will
-.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
-.\" double quote, and \*(R" will give a right double quote. \*(C+ will
-.\" give a nicer C++. Capital omega is used to do unbreakable dashes and
-.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff,
-.\" nothing in troff, for use with C<>.
-.tr \(*W-
-.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
-.ie n \{\
-. ds -- \(*W-
-. ds PI pi
-. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
-. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch
-. ds L" ""
-. ds R" ""
-. ds C` ""
-. ds C' ""
-'br\}
-.el\{\
-. ds -- \|\(em\|
-. ds PI \(*p
-. ds L" ``
-. ds R" ''
-. ds C`
-. ds C'
-'br\}
-.\"
-.\" Escape single quotes in literal strings from groff's Unicode transform.
-.ie \n(.g .ds Aq \(aq
-.el .ds Aq '
-.\"
-.\" If the F register is turned on, we'll generate index entries on stderr for
-.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
-.\" entries marked with X<> in POD. Of course, you'll have to process the
-.\" output yourself in some meaningful fashion.
-.\"
-.\" Avoid warning from groff about undefined register 'F'.
-.de IX
-..
-.nr rF 0
-.if \n(.g .if rF .nr rF 1
-.if (\n(rF:(\n(.g==0)) \{
-. if \nF \{
-. de IX
-. tm Index:\\$1\t\\n%\t"\\$2"
-..
-. if !\nF==2 \{
-. nr % 0
-. nr F 2
-. \}
-. \}
-.\}
-.rr rF
-.\" ========================================================================
-.\"
-.IX Title "Bundle::DBI 3pm"
-.TH Bundle::DBI 3pm "2015-05-26" "perl v5.22.1" "User Contributed Perl Documentation"
-.\" For nroff, turn off justification. Always turn off hyphenation; it makes
-.\" way too many mistakes in technical documents.
-.if n .ad l
-.nh
-.SH "NAME"
-Bundle::DBI \- A bundle to install DBI and required modules.
-.SH "SYNOPSIS"
-.IX Header "SYNOPSIS"
-.Vb 1
-\& perl \-MCPAN \-e \*(Aqinstall Bundle::DBI\*(Aq
-.Ve
-.SH "CONTENTS"
-.IX Header "CONTENTS"
-\&\s-1DBI \-\s0 for to get to know thyself
-.PP
-DBI::Shell 11.91 \- the \s-1DBI\s0 command line shell
-.PP
-Storable 2.06 \- for DBD::Proxy, DBI::ProxyServer, DBD::Forward
-.PP
-Net::Daemon 0.37 \- for DBD::Proxy and DBI::ProxyServer
-.PP
-RPC::PlServer 0.2016 \- for DBD::Proxy and DBI::ProxyServer
-.PP
-DBD::Multiplex 1.19 \- treat multiple db handles as one
-.SH "DESCRIPTION"
-.IX Header "DESCRIPTION"
-This bundle includes all the modules used by the Perl Database
-Interface (\s-1DBI\s0) module, created by Tim Bunce.
-.PP
-A \fIBundle\fR is a module that simply defines a collection of other
-modules. It is used by the \s-1CPAN\s0 module to automate the fetching,
-building and installing of modules from the \s-1CPAN\s0 ftp archive sites.
-.PP
-This bundle does not deal with the various database drivers (e.g.
-DBD::Informix, DBD::Oracle etc), most of which require software from
-sources other than \s-1CPAN.\s0 You'll need to fetch and build those drivers
-yourself.
-.SH "AUTHORS"
-.IX Header "AUTHORS"
-Jonathan Leffler, Jochen Wiedmann and Tim Bunce.
+++ /dev/null
-.\" Automatically generated by Pod::Man 2.28 (Pod::Simple 3.29)
-.\"
-.\" Standard preamble:
-.\" ========================================================================
-.de Sp \" Vertical space (when we can't use .PP)
-.if t .sp .5v
-.if n .sp
-..
-.de Vb \" Begin verbatim text
-.ft CW
-.nf
-.ne \\$1
-..
-.de Ve \" End verbatim text
-.ft R
-.fi
-..
-.\" Set up some character translations and predefined strings. \*(-- will
-.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
-.\" double quote, and \*(R" will give a right double quote. \*(C+ will
-.\" give a nicer C++. Capital omega is used to do unbreakable dashes and
-.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff,
-.\" nothing in troff, for use with C<>.
-.tr \(*W-
-.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
-.ie n \{\
-. ds -- \(*W-
-. ds PI pi
-. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
-. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch
-. ds L" ""
-. ds R" ""
-. ds C` ""
-. ds C' ""
-'br\}
-.el\{\
-. ds -- \|\(em\|
-. ds PI \(*p
-. ds L" ``
-. ds R" ''
-. ds C`
-. ds C'
-'br\}
-.\"
-.\" Escape single quotes in literal strings from groff's Unicode transform.
-.ie \n(.g .ds Aq \(aq
-.el .ds Aq '
-.\"
-.\" If the F register is turned on, we'll generate index entries on stderr for
-.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
-.\" entries marked with X<> in POD. Of course, you'll have to process the
-.\" output yourself in some meaningful fashion.
-.\"
-.\" Avoid warning from groff about undefined register 'F'.
-.de IX
-..
-.nr rF 0
-.if \n(.g .if rF .nr rF 1
-.if (\n(rF:(\n(.g==0)) \{
-. if \nF \{
-. de IX
-. tm Index:\\$1\t\\n%\t"\\$2"
-..
-. if !\nF==2 \{
-. nr % 0
-. nr F 2
-. \}
-. \}
-.\}
-.rr rF
-.\" ========================================================================
-.\"
-.IX Title "DBD::DBM 3pm"
-.TH DBD::DBM 3pm "2013-09-08" "perl v5.22.1" "User Contributed Perl Documentation"
-.\" For nroff, turn off justification. Always turn off hyphenation; it makes
-.\" way too many mistakes in technical documents.
-.if n .ad l
-.nh
-.SH "NAME"
-DBD::DBM \- a DBI driver for DBM & MLDBM files
-.SH "SYNOPSIS"
-.IX Header "SYNOPSIS"
-.Vb 5
-\& use DBI;
-\& $dbh = DBI\->connect(\*(Aqdbi:DBM:\*(Aq); # defaults to SDBM_File
-\& $dbh = DBI\->connect(\*(AqDBI:DBM(RaiseError=1):\*(Aq); # defaults to SDBM_File
-\& $dbh = DBI\->connect(\*(Aqdbi:DBM:dbm_type=DB_File\*(Aq); # defaults to DB_File
-\& $dbh = DBI\->connect(\*(Aqdbi:DBM:dbm_mldbm=Storable\*(Aq); # MLDBM with SDBM_File
-\&
-\& # or
-\& $dbh = DBI\->connect(\*(Aqdbi:DBM:\*(Aq, undef, undef);
-\& $dbh = DBI\->connect(\*(Aqdbi:DBM:\*(Aq, undef, undef, {
-\& f_ext => \*(Aq.db/r\*(Aq,
-\& f_dir => \*(Aq/path/to/dbfiles/\*(Aq,
-\& f_lockfile => \*(Aq.lck\*(Aq,
-\& dbm_type => \*(AqBerkeleyDB\*(Aq,
-\& dbm_mldbm => \*(AqFreezeThaw\*(Aq,
-\& dbm_store_metadata => 1,
-\& dbm_berkeley_flags => {
-\& \*(Aq\-Cachesize\*(Aq => 1000, # set a ::Hash flag
-\& },
-\& });
-.Ve
-.PP
-and other variations on \fIconnect()\fR as shown in the \s-1DBI\s0 docs,
-DBD::File metadata and \*(L"Metadata\*(R"
-shown below.
-.PP
-Use standard \s-1DBI\s0 prepare, execute, fetch, placeholders, etc.,
-see \*(L"\s-1QUICK START\*(R"\s0 for an example.
-.SH "DESCRIPTION"
-.IX Header "DESCRIPTION"
-\&\s-1DBD::DBM\s0 is a database management system that works right out of the
-box. If you have a standard installation of Perl and \s-1DBI\s0 you can
-begin creating, accessing, and modifying simple database tables
-without any further modules. You can add other modules (e.g.,
-SQL::Statement, DB_File etc) for improved functionality.
-.PP
-The module uses a \s-1DBM\s0 file storage layer. \s-1DBM\s0 file storage is common on
-many platforms and files can be created with it in many programming
-languages using different APIs. That means, in addition to creating
-files with \s-1DBI/SQL,\s0 you can also use \s-1DBI/SQL\s0 to access and modify files
-created by other \s-1DBM\s0 modules and programs and vice versa. \fBNote\fR that
-in those cases it might be necessary to use a common subset of the
-provided features.
-.PP
-\&\s-1DBM\s0 files are stored in binary format optimized for quick retrieval
-when using a key field. That optimization can be used advantageously
-to make \s-1DBD::DBM SQL\s0 operations that use key fields very fast. There
-are several different \*(L"flavors\*(R" of \s-1DBM\s0 which use different storage
-formats supported by perl modules such as SDBM_File and \s-1MLDBM. \s0 This
-module supports all of the flavors that perl supports and, when used
-with \s-1MLDBM,\s0 supports tables with any number of columns and insertion
-of Perl objects into tables.
-.PP
-\&\s-1DBD::DBM\s0 has been tested with the following \s-1DBM\s0 types: SDBM_File,
-NDBM_File, ODBM_File, GDBM_File, DB_File, BerkeleyDB. Each type was
-tested both with and without \s-1MLDBM\s0 and with the Data::Dumper,
-Storable, FreezeThaw, \s-1YAML\s0 and \s-1JSON\s0 serializers using the DBI::SQL::Nano
-or the SQL::Statement engines.
-.SH "QUICK START"
-.IX Header "QUICK START"
-\&\s-1DBD::DBM\s0 operates like all other \s-1DBD\s0 drivers \- it's basic syntax and
-operation is specified by \s-1DBI. \s0 If you're not familiar with \s-1DBI,\s0 you should
-start by reading \s-1DBI\s0 and the documents it points to and then come back
-and read this file. If you are familiar with \s-1DBI,\s0 you already know most of
-what you need to know to operate this module. Just jump in and create a
-test script something like the one shown below.
-.PP
-You should be aware that there are several options for the \s-1SQL\s0 engine
-underlying \s-1DBD::DBM,\s0 see \*(L"Supported \s-1SQL\s0 syntax\*(R". There are also many
-options for \s-1DBM\s0 support, see especially the section on \*(L"Adding
-multi-column support with \s-1MLDBM\*(R"\s0.
-.PP
-But here's a sample to get you started.
-.PP
-.Vb 10
-\& use DBI;
-\& my $dbh = DBI\->connect(\*(Aqdbi:DBM:\*(Aq);
-\& $dbh\->{RaiseError} = 1;
-\& for my $sql( split /;\en+/,"
-\& CREATE TABLE user ( user_name TEXT, phone TEXT );
-\& INSERT INTO user VALUES (\*(AqFred Bloggs\*(Aq,\*(Aq233\-7777\*(Aq);
-\& INSERT INTO user VALUES (\*(AqSanjay Patel\*(Aq,\*(Aq777\-3333\*(Aq);
-\& INSERT INTO user VALUES (\*(AqJunk\*(Aq,\*(Aqxxx\-xxxx\*(Aq);
-\& DELETE FROM user WHERE user_name = \*(AqJunk\*(Aq;
-\& UPDATE user SET phone = \*(Aq999\-4444\*(Aq WHERE user_name = \*(AqSanjay Patel\*(Aq;
-\& SELECT * FROM user
-\& "){
-\& my $sth = $dbh\->prepare($sql);
-\& $sth\->execute;
-\& $sth\->dump_results if $sth\->{NUM_OF_FIELDS};
-\& }
-\& $dbh\->disconnect;
-.Ve
-.SH "USAGE"
-.IX Header "USAGE"
-This section will explain some usage cases in more detail. To get an
-overview about the available attributes, see \*(L"Metadata\*(R".
-.SS "Specifying Files and Directories"
-.IX Subsection "Specifying Files and Directories"
-\&\s-1DBD::DBM\s0 will automatically supply an appropriate file extension for the
-type of \s-1DBM\s0 you are using. For example, if you use SDBM_File, a table
-called \*(L"fruit\*(R" will be stored in two files called \*(L"fruit.pag\*(R" and
-\&\*(L"fruit.dir\*(R". You should \fBnever\fR specify the file extensions in your \s-1SQL\s0
-statements.
-.PP
-\&\s-1DBD::DBM\s0 recognizes following default extensions for following types:
-.IP ".pag/r" 4
-.IX Item ".pag/r"
-Chosen for dbm_type \f(CW\*(C`SDBM_File\*(C'\fR, \f(CW\*(C`ODBM_File\*(C'\fR and \f(CW\*(C`NDBM_File\*(C'\fR
-when an implementation is detected which wraps \f(CW\*(C`\-ldbm\*(C'\fR for
-\&\f(CW\*(C`NDBM_File\*(C'\fR (e.g. Solaris, \s-1AIX, ...\s0).
-.Sp
-For those types, the \f(CW\*(C`.dir\*(C'\fR extension is recognized, too (for being
-deleted when dropping a table).
-.IP ".db/r" 4
-.IX Item ".db/r"
-Chosen for dbm_type \f(CW\*(C`NDBM_File\*(C'\fR when an implementation is detected
-which wraps BerkeleyDB 1.x for \f(CW\*(C`NDBM_File\*(C'\fR (typically \s-1BSD\s0's, Darwin).
-.PP
-\&\f(CW\*(C`GDBM_File\*(C'\fR, \f(CW\*(C`DB_File\*(C'\fR and \f(CW\*(C`BerkeleyDB\*(C'\fR don't usually
-use a file extension.
-.PP
-If your \s-1DBM\s0 type uses an extension other than one of the recognized
-types of extensions, you should set the \fIf_ext\fR attribute to the
-extension \fBand\fR file a bug report as described in \s-1DBI\s0 with the name
-of the implementation and extension so we can add it to \s-1DBD::DBM.\s0
-Thanks in advance for that :\-).
-.PP
-.Vb 2
-\& $dbh = DBI\->connect(\*(Aqdbi:DBM:f_ext=.db\*(Aq); # .db extension is used
-\& $dbh = DBI\->connect(\*(Aqdbi:DBM:f_ext=\*(Aq); # no extension is used
-\&
-\& # or
-\& $dbh\->{f_ext}=\*(Aq.db\*(Aq; # global setting
-\& $dbh\->{f_meta}\->{\*(Aqqux\*(Aq}\->{f_ext}=\*(Aq.db\*(Aq; # setting for table \*(Aqqux\*(Aq
-.Ve
-.PP
-By default files are assumed to be in the current working directory.
-To use other directories specify the \fIf_dir\fR attribute in either the
-connect string or by setting the database handle attribute.
-.PP
-For example, this will look for the file /foo/bar/fruit (or
-/foo/bar/fruit.pag for \s-1DBM\s0 types that use that extension)
-.PP
-.Vb 6
-\& my $dbh = DBI\->connect(\*(Aqdbi:DBM:f_dir=/foo/bar\*(Aq);
-\& # and this will too:
-\& my $dbh = DBI\->connect(\*(Aqdbi:DBM:\*(Aq);
-\& $dbh\->{f_dir} = \*(Aq/foo/bar\*(Aq;
-\& # but this is recommended
-\& my $dbh = DBI\->connect(\*(Aqdbi:DBM:\*(Aq, undef, undef, { f_dir => \*(Aq/foo/bar\*(Aq } );
-\&
-\& # now you can do
-\& my $ary = $dbh\->selectall_arrayref(q{ SELECT x FROM fruit });
-.Ve
-.PP
-You can also use delimited identifiers to specify paths directly in \s-1SQL\s0
-statements. This looks in the same place as the two examples above but
-without setting \fIf_dir\fR:
-.PP
-.Vb 4
-\& my $dbh = DBI\->connect(\*(Aqdbi:DBM:\*(Aq);
-\& my $ary = $dbh\->selectall_arrayref(q{
-\& SELECT x FROM "/foo/bar/fruit"
-\& });
-.Ve
-.PP
-You can also tell \s-1DBD::DBM\s0 to use a specified path for a specific table:
-.PP
-.Vb 1
-\& $dbh\->{dbm_tables}\->{f}\->{file} = q(/foo/bar/fruit);
-.Ve
-.PP
-Please be aware that you cannot specify this during connection.
-.PP
-If you have SQL::Statement installed, you can use table aliases:
-.PP
-.Vb 4
-\& my $dbh = DBI\->connect(\*(Aqdbi:DBM:\*(Aq);
-\& my $ary = $dbh\->selectall_arrayref(q{
-\& SELECT f.x FROM "/foo/bar/fruit" AS f
-\& });
-.Ve
-.PP
-See the \*(L"\s-1GOTCHAS AND WARNINGS\*(R"\s0 for using \s-1DROP\s0 on tables.
-.SS "Table locking and \fIflock()\fP"
-.IX Subsection "Table locking and flock()"
-Table locking is accomplished using a lockfile which has the same
-basename as the table's file but with the file extension '.lck' (or a
-lockfile extension that you supply, see below). This lock file is
-created with the table during a \s-1CREATE\s0 and removed during a \s-1DROP.\s0
-Every time the table itself is opened, the lockfile is \fIflocked()\fR. For
-\&\s-1SELECT,\s0 this is a shared lock. For all other operations, it is an
-exclusive lock (except when you specify something different using the
-\&\fIf_lock\fR attribute).
-.PP
-Since the locking depends on \fIflock()\fR, it only works on operating
-systems that support \fIflock()\fR. In cases where \fIflock()\fR is not
-implemented, \s-1DBD::DBM\s0 will simply behave as if the \fIflock()\fR had
-occurred although no actual locking will happen. Read the
-documentation for \fIflock()\fR for more information.
-.PP
-Even on those systems that do support \fIflock()\fR, locking is only
-advisory \- as is always the case with \fIflock()\fR. This means that if
-another program tries to access the table file while \s-1DBD::DBM\s0 has the
-table locked, that other program will *succeed* at opening unless
-it is also using flock on the '.lck' file. As a result \s-1DBD::DBM\s0's
-locking only really applies to other programs using \s-1DBD::DBM\s0 or other
-program written to cooperate with \s-1DBD::DBM\s0 locking.
-.SS "Specifying the \s-1DBM\s0 type"
-.IX Subsection "Specifying the DBM type"
-Each \*(L"flavor\*(R" of \s-1DBM\s0 stores its files in a different format and has
-different capabilities and limitations. See AnyDBM_File for a
-comparison of \s-1DBM\s0 types.
-.PP
-By default, \s-1DBD::DBM\s0 uses the \f(CW\*(C`SDBM_File\*(C'\fR type of storage since
-\&\f(CW\*(C`SDBM_File\*(C'\fR comes with Perl itself. If you have other types of
-\&\s-1DBM\s0 storage available, you can use any of them with \s-1DBD::DBM.\s0 It is
-strongly recommended to use at least \f(CW\*(C`DB_File\*(C'\fR, because \f(CW\*(C`SDBM_File\*(C'\fR has quirks and limitations and \f(CW\*(C`ODBM_file\*(C'\fR, \f(CW\*(C`NDBM_File\*(C'\fR and \f(CW\*(C`GDBM_File\*(C'\fR are not always available.
-.PP
-You can specify the \s-1DBM\s0 type using the \fIdbm_type\fR attribute which can
-be set in the connection string or with \f(CW\*(C`$dbh\->{dbm_type}\*(C'\fR and
-\&\f(CW\*(C`$dbh\->{f_meta}\->{$table_name}\->{type}\*(C'\fR for per-table settings in
-cases where a single script is accessing more than one kind of \s-1DBM\s0
-file.
-.PP
-In the connection string, just set \f(CW\*(C`dbm_type=TYPENAME\*(C'\fR where
-\&\f(CW\*(C`TYPENAME\*(C'\fR is any \s-1DBM\s0 type such as GDBM_File, DB_File, etc. Do \fInot\fR
-use \s-1MLDBM\s0 as your \fIdbm_type\fR as that is set differently, see below.
-.PP
-.Vb 2
-\& my $dbh=DBI\->connect(\*(Aqdbi:DBM:\*(Aq); # uses the default SDBM_File
-\& my $dbh=DBI\->connect(\*(Aqdbi:DBM:dbm_type=GDBM_File\*(Aq); # uses the GDBM_File
-\&
-\& # You can also use $dbh\->{dbm_type} to set the DBM type for the connection:
-\& $dbh\->{dbm_type} = \*(AqDB_File\*(Aq; # set the global DBM type
-\& print $dbh\->{dbm_type}; # display the global DBM type
-.Ve
-.PP
-If you have several tables in your script that use different \s-1DBM\s0
-types, you can use the \f(CW$dbh\fR\->{dbm_tables} hash to store different
-settings for the various tables. You can even use this to perform
-joins on files that have completely different storage mechanisms.
-.PP
-.Vb 2
-\& # sets global default of GDBM_File
-\& my $dbh\->(\*(Aqdbi:DBM:type=GDBM_File\*(Aq);
-\&
-\& # overrides the global setting, but only for the tables called
-\& # I<foo> and I<bar>
-\& my $dbh\->{f_meta}\->{foo}\->{dbm_type} = \*(AqDB_File\*(Aq;
-\& my $dbh\->{f_meta}\->{bar}\->{dbm_type} = \*(AqBerkeleyDB\*(Aq;
-\&
-\& # prints the dbm_type for the table "foo"
-\& print $dbh\->{f_meta}\->{foo}\->{dbm_type};
-.Ve
-.PP
-\&\fBNote\fR that you must change the \fIdbm_type\fR of a table before you access
-it for first time.
-.SS "Adding multi-column support with \s-1MLDBM\s0"
-.IX Subsection "Adding multi-column support with MLDBM"
-Most of the \s-1DBM\s0 types only support two columns and even if it would
-support more, \s-1DBD::DBM\s0 would only use two. However a \s-1CPAN\s0 module
-called \s-1MLDBM\s0 overcomes this limitation by allowing more than two
-columns. \s-1MLDBM\s0 does this by serializing the data \- basically it puts
-a reference to an array into the second column. It can also put almost
-any kind of Perl object or even \fBPerl coderefs\fR into columns.
-.PP
-If you want more than two columns, you \fBmust\fR install \s-1MLDBM.\s0 It's available
-for many platforms and is easy to install.
-.PP
-\&\s-1MLDBM\s0 is by default distributed with three serializers \- Data::Dumper,
-Storable, and FreezeThaw. Data::Dumper is the default and Storable is the
-fastest. \s-1MLDBM\s0 can also make use of user-defined serialization methods or
-other serialization modules (e.g. \s-1YAML::MLDBM\s0 or
-MLDBM::Serializer::JSON. You select the serializer using the
-\&\fIdbm_mldbm\fR attribute.
-.PP
-Some examples:
-.PP
-.Vb 10
-\& $dbh=DBI\->connect(\*(Aqdbi:DBM:dbm_mldbm=Storable\*(Aq); # use MLDBM with Storable
-\& $dbh=DBI\->connect(
-\& \*(Aqdbi:DBM:dbm_mldbm=MySerializer\*(Aq # use MLDBM with a user defined module
-\& );
-\& $dbh=DBI\->connect(\*(Aqdbi::dbm:\*(Aq, undef,
-\& undef, { dbm_mldbm => \*(AqYAML\*(Aq }); # use 3rd party serializer
-\& $dbh\->{dbm_mldbm} = \*(AqYAML\*(Aq; # same as above
-\& print $dbh\->{dbm_mldbm} # show the MLDBM serializer
-\& $dbh\->{f_meta}\->{foo}\->{dbm_mldbm}=\*(AqData::Dumper\*(Aq; # set Data::Dumper for table "foo"
-\& print $dbh\->{f_meta}\->{foo}\->{mldbm}; # show serializer for table "foo"
-.Ve
-.PP
-\&\s-1MLDBM\s0 works on top of other \s-1DBM\s0 modules so you can also set a \s-1DBM\s0 type
-along with setting dbm_mldbm. The examples above would default to using
-SDBM_File with \s-1MLDBM. \s0 If you wanted GDBM_File instead, here's how:
-.PP
-.Vb 5
-\& # uses DB_File with MLDBM and Storable
-\& $dbh = DBI\->connect(\*(Aqdbi:DBM:\*(Aq, undef, undef, {
-\& dbm_type => \*(AqDB_File\*(Aq,
-\& dbm_mldbm => \*(AqStorable\*(Aq,
-\& });
-.Ve
-.PP
-SDBM_File, the default \fIdbm_type\fR is quite limited, so if you are going to
-use \s-1MLDBM,\s0 you should probably use a different type, see AnyDBM_File.
-.PP
-See below for some \*(L"\s-1GOTCHAS AND WARNINGS\*(R"\s0 about \s-1MLDBM.\s0
-.SS "Support for Berkeley \s-1DB\s0"
-.IX Subsection "Support for Berkeley DB"
-The Berkeley \s-1DB\s0 storage type is supported through two different Perl
-modules \- DB_File (which supports only features in old versions of Berkeley
-\&\s-1DB\s0) and BerkeleyDB (which supports all versions). \s-1DBD::DBM\s0 supports
-specifying either \*(L"DB_File\*(R" or \*(L"BerkeleyDB\*(R" as a \fIdbm_type\fR, with or
-without \s-1MLDBM\s0 support.
-.PP
-The \*(L"BerkeleyDB\*(R" dbm_type is experimental and it's interface is likely to
-change. It currently defaults to BerkeleyDB::Hash and does not currently
-support ::Btree or ::Recno.
-.PP
-With BerkeleyDB, you can specify initialization flags by setting them in
-your script like this:
-.PP
-.Vb 12
-\& use BerkeleyDB;
-\& my $env = new BerkeleyDB::Env \-Home => $dir; # and/or other Env flags
-\& $dbh = DBI\->connect(\*(Aqdbi:DBM:\*(Aq, undef, undef, {
-\& dbm_type => \*(AqBerkeleyDB\*(Aq,
-\& dbm_mldbm => \*(AqStorable\*(Aq,
-\& dbm_berkeley_flags => {
-\& \*(AqDB_CREATE\*(Aq => DB_CREATE, # pass in constants
-\& \*(AqDB_RDONLY\*(Aq => DB_RDONLY, # pass in constants
-\& \*(Aq\-Cachesize\*(Aq => 1000, # set a ::Hash flag
-\& \*(Aq\-Env\*(Aq => $env, # pass in an environment
-\& },
-\& });
-.Ve
-.PP
-Do \fInot\fR set the \-Flags or \-Filename flags as those are determined and
-overwritten by the \s-1SQL \s0(e.g. \-Flags => \s-1DB_RDONLY\s0 is set automatically
-when you issue a \s-1SELECT\s0 statement).
-.PP
-Time has not permitted us to provide support in this release of \s-1DBD::DBM\s0
-for further Berkeley \s-1DB\s0 features such as transactions, concurrency,
-locking, etc. We will be working on these in the future and would value
-suggestions, patches, etc.
-.PP
-See DB_File and BerkeleyDB for further details.
-.SS "Optimizing the use of key fields"
-.IX Subsection "Optimizing the use of key fields"
-Most \*(L"flavors\*(R" of \s-1DBM\s0 have only two physical columns (but can contain
-multiple logical columns as explained above in
-\&\*(L"Adding multi-column support with \s-1MLDBM\*(R"\s0). They work similarly to a
-Perl hash with the first column serving as the key. Like a Perl hash, \s-1DBM\s0
-files permit you to do quick lookups by specifying the key and thus avoid
-looping through all records (supported by DBI::SQL::Nano only). Also like
-a Perl hash, the keys must be unique. It is impossible to create two
-records with the same key. To put this more simply and in \s-1SQL\s0 terms,
-the key column functions as the \fI\s-1PRIMARY KEY\s0\fR or \s-1UNIQUE INDEX.\s0
-.PP
-In \s-1DBD::DBM,\s0 you can take advantage of the speed of keyed lookups by using
-DBI::SQL::Nano and a \s-1WHERE\s0 clause with a single equal comparison on the key
-field. For example, the following \s-1SQL\s0 statements are optimized for keyed
-lookup:
-.PP
-.Vb 4
-\& CREATE TABLE user ( user_name TEXT, phone TEXT);
-\& INSERT INTO user VALUES (\*(AqFred Bloggs\*(Aq,\*(Aq233\-7777\*(Aq);
-\& # ... many more inserts
-\& SELECT phone FROM user WHERE user_name=\*(AqFred Bloggs\*(Aq;
-.Ve
-.PP
-The \*(L"user_name\*(R" column is the key column since it is the first
-column. The \s-1SELECT\s0 statement uses the key column in a single equal
-comparison \- \*(L"user_name='Fred Bloggs'\*(R" \- so the search will find it
-very quickly without having to loop through all the names which were
-inserted into the table.
-.PP
-In contrast, these searches on the same table are not optimized:
-.PP
-.Vb 2
-\& 1. SELECT phone FROM user WHERE user_name < \*(AqFred\*(Aq;
-\& 2. SELECT user_name FROM user WHERE phone = \*(Aq233\-7777\*(Aq;
-.Ve
-.PP
-In #1, the operation uses a less-than (<) comparison rather than an equals
-comparison, so it will not be optimized for key searching. In #2, the key
-field \*(L"user_name\*(R" is not specified in the \s-1WHERE\s0 clause, and therefore the
-search will need to loop through all rows to find the requested row(s).
-.PP
-\&\fBNote\fR that the underlying \s-1DBM\s0 storage needs to loop over all \fIkey/value\fR
-pairs when the optimized fetch is used. SQL::Statement has a massively
-improved where clause evaluation which costs around 15% of the evaluation
-in DBI::SQL::Nano \- combined with the loop in the \s-1DBM\s0 storage the speed
-improvement isn't so impressive.
-.PP
-Even if lookups are faster by around 50%, DBI::SQL::Nano and
-SQL::Statement can benefit from the key field optimizations on
-updating and deleting rows \- and here the improved where clause
-evaluation of SQL::Statement might beat DBI::SQL::Nano every time the
-where clause contains not only the key field (or more than one).
-.SS "Supported \s-1SQL\s0 syntax"
-.IX Subsection "Supported SQL syntax"
-\&\s-1DBD::DBM\s0 uses a subset of \s-1SQL. \s0 The robustness of that subset depends on
-what other modules you have installed. Both options support basic \s-1SQL\s0
-operations including \s-1CREATE TABLE, DROP TABLE, INSERT, DELETE, UPDATE,\s0 and
-\&\s-1SELECT.\s0
-.PP
-\&\fBOption #1:\fR By default, this module inherits its \s-1SQL\s0 support from
-DBI::SQL::Nano that comes with \s-1DBI. \s0 Nano is, as its name implies, a *very*
-small \s-1SQL\s0 engine. Although limited in scope, it is faster than option #2
-for some operations (especially single \fIprimary key\fR lookups). See
-DBI::SQL::Nano for a description of the \s-1SQL\s0 it supports and comparisons
-of it with option #2.
-.PP
-\&\fBOption #2:\fR If you install the pure Perl \s-1CPAN\s0 module SQL::Statement,
-\&\s-1DBD::DBM\s0 will use it instead of Nano. This adds support for table aliases,
-functions, joins, and much more. If you're going to use \s-1DBD::DBM\s0
-for anything other than very simple tables and queries, you should install
-SQL::Statement. You don't have to change \s-1DBD::DBM\s0 or your scripts in any
-way, simply installing SQL::Statement will give you the more robust \s-1SQL\s0
-capabilities without breaking scripts written for DBI::SQL::Nano. See
-SQL::Statement for a description of the \s-1SQL\s0 it supports.
-.PP
-To find out which \s-1SQL\s0 module is working in a given script, you can use the
-\&\fIdbm_versions()\fR method or, if you don't need the full output and version
-numbers, just do this:
-.PP
-.Vb 1
-\& print $dbh\->{sql_handler}, "\en";
-.Ve
-.PP
-That will print out either \*(L"SQL::Statement\*(R" or \*(L"DBI::SQL::Nano\*(R".
-.PP
-Baring the section about optimized access to the \s-1DBM\s0 storage in mind,
-comparing the benefits of both engines:
-.PP
-.Vb 6
-\& # DBI::SQL::Nano is faster
-\& $sth = $dbh\->prepare( "update foo set value=\*(Aqnew\*(Aq where key=15" );
-\& $sth\->execute();
-\& $sth = $dbh\->prepare( "delete from foo where key=27" );
-\& $sth\->execute();
-\& $sth = $dbh\->prepare( "select * from foo where key=\*(Aqabc\*(Aq" );
-\&
-\& # SQL::Statement might faster (depending on DB size)
-\& $sth = $dbh\->prepare( "update foo set value=\*(Aqnew\*(Aq where key=?" );
-\& $sth\->execute(15);
-\& $sth = $dbh\->prepare( "update foo set value=? where key=15" );
-\& $sth\->execute(\*(Aqnew\*(Aq);
-\& $sth = $dbh\->prepare( "delete from foo where key=?" );
-\& $sth\->execute(27);
-\&
-\& # SQL::Statement is faster
-\& $sth = $dbh\->prepare( "update foo set value=\*(Aqnew\*(Aq where value=\*(Aqold\*(Aq" );
-\& $sth\->execute();
-\& # must be expressed using "where key = 15 or key = 27 or key = 42 or key = \*(Aqabc\*(Aq"
-\& # in DBI::SQL::Nano
-\& $sth = $dbh\->prepare( "delete from foo where key in (15,27,42,\*(Aqabc\*(Aq)" );
-\& $sth\->execute();
-\& # must be expressed using "where key > 10 and key < 90" in DBI::SQL::Nano
-\& $sth = $dbh\->prepare( "select * from foo where key between (10,90)" );
-\& $sth\->execute();
-\&
-\& # only SQL::Statement can handle
-\& $sth\->prepare( "select * from foo,bar where foo.name = bar.name" );
-\& $sth\->execute();
-\& $sth\->prepare( "insert into foo values ( 1, \*(Aqfoo\*(Aq ), ( 2, \*(Aqbar\*(Aq )" );
-\& $sth\->execute();
-.Ve
-.SS "Specifying Column Names"
-.IX Subsection "Specifying Column Names"
-\&\s-1DBM\s0 files don't have a standard way to store column names. \s-1DBD::DBM\s0 gets
-around this issue with a \s-1DBD::DBM\s0 specific way of storing the column names.
-\&\fBIf you are working only with \s-1DBD::DBM\s0 and not using files created by or
-accessed with other \s-1DBM\s0 programs, you can ignore this section.\fR
-.PP
-\&\s-1DBD::DBM\s0 stores column names as a row in the file with the key \fI_metadata
-\&\e0\fR. So this code
-.PP
-.Vb 3
-\& my $dbh = DBI\->connect(\*(Aqdbi:DBM:\*(Aq);
-\& $dbh\->do("CREATE TABLE baz (foo CHAR(10), bar INTEGER)");
-\& $dbh\->do("INSERT INTO baz (foo,bar) VALUES (\*(Aqzippy\*(Aq,1)");
-.Ve
-.PP
-Will create a file that has a structure something like this:
-.PP
-.Vb 2
-\& _metadata \e0 | <dbd_metadata><schema></schema><col_names>foo,bar</col_names></dbd_metadata>
-\& zippy | 1
-.Ve
-.PP
-The next time you access this table with \s-1DBD::DBM,\s0 it will treat the
-\&\fI_metadata \e0\fR row as a header rather than as data and will pull the column
-names from there. However, if you access the file with something other
-than \s-1DBD::DBM,\s0 the row will be treated as a regular data row.
-.PP
-If you do not want the column names stored as a data row in the table you
-can set the \fIdbm_store_metadata\fR attribute to 0.
-.PP
-.Vb 1
-\& my $dbh = DBI\->connect(\*(Aqdbi:DBM:\*(Aq, undef, undef, { dbm_store_metadata => 0 });
-\&
-\& # or
-\& $dbh\->{dbm_store_metadata} = 0;
-\&
-\& # or for per\-table setting
-\& $dbh\->{f_meta}\->{qux}\->{dbm_store_metadata} = 0;
-.Ve
-.PP
-By default, \s-1DBD::DBM\s0 assumes that you have two columns named \*(L"k\*(R" and \*(L"v\*(R"
-(short for \*(L"key\*(R" and \*(L"value\*(R"). So if you have \fIdbm_store_metadata\fR set to
-1 and you want to use alternate column names, you need to specify the
-column names like this:
-.PP
-.Vb 4
-\& my $dbh = DBI\->connect(\*(Aqdbi:DBM:\*(Aq, undef, undef, {
-\& dbm_store_metadata => 0,
-\& dbm_cols => [ qw(foo bar) ],
-\& });
-\&
-\& # or
-\& $dbh\->{dbm_store_metadata} = 0;
-\& $dbh\->{dbm_cols} = \*(Aqfoo,bar\*(Aq;
-\&
-\& # or to set the column names on per\-table basis, do this:
-\& # sets the column names only for table "qux"
-\& $dbh\->{f_meta}\->{qux}\->{dbm_store_metadata} = 0;
-\& $dbh\->{f_meta}\->{qux}\->{col_names} = [qw(foo bar)];
-.Ve
-.PP
-If you have a file that was created by another \s-1DBM\s0 program or created with
-\&\fIdbm_store_metadata\fR set to zero and you want to convert it to using
-\&\s-1DBD::DBM\s0's column name storage, just use one of the methods above to name
-the columns but *without* specifying \fIdbm_store_metadata\fR as zero. You
-only have to do that once \- thereafter you can get by without setting
-either \fIdbm_store_metadata\fR or setting \fIdbm_cols\fR because the names will
-be stored in the file.
-.SH "DBI database handle attributes"
-.IX Header "DBI database handle attributes"
-.SS "Metadata"
-.IX Subsection "Metadata"
-\fIStatement handle ($sth) attributes and methods\fR
-.IX Subsection "Statement handle ($sth) attributes and methods"
-.PP
-Most statement handle attributes such as \s-1NAME, NUM_OF_FIELDS,\s0 etc. are
-available only after an execute. The same is true of \f(CW$sth\fR\->rows which is
-available after the execute but does \fInot\fR require a fetch.
-.PP
-\fIDriver handle ($dbh) attributes\fR
-.IX Subsection "Driver handle ($dbh) attributes"
-.PP
-It is not supported anymore to use dbm-attributes without the dbm_\-prefix.
-Currently, if an \s-1DBD::DBM\s0 private attribute is accessed without an
-underscore in it's name, dbm_ is prepended to that attribute and it's
-processed further. If the resulting attribute name is invalid, an error is
-thrown.
-.PP
-dbm_cols
-.IX Subsection "dbm_cols"
-.PP
-Contains a comma separated list of column names or an array reference to
-the column names.
-.PP
-dbm_type
-.IX Subsection "dbm_type"
-.PP
-Contains the \s-1DBM\s0 storage type. Currently known supported type are
-\&\f(CW\*(C`ODBM_File\*(C'\fR, \f(CW\*(C`NDBM_File\*(C'\fR, \f(CW\*(C`SDBM_File\*(C'\fR, \f(CW\*(C`GDBM_File\*(C'\fR,
-\&\f(CW\*(C`DB_File\*(C'\fR and \f(CW\*(C`BerkeleyDB\*(C'\fR. It is not recommended to use one
-of the first three types \- even if \f(CW\*(C`SDBM_File\*(C'\fR is the most commonly
-available \fIdbm_type\fR.
-.PP
-dbm_mldbm
-.IX Subsection "dbm_mldbm"
-.PP
-Contains the serializer for \s-1DBM\s0 storage (value column). Requires the
-\&\s-1CPAN\s0 module \s-1MLDBM\s0 installed. Currently known supported serializers
-are:
-.IP "Data::Dumper" 8
-.IX Item "Data::Dumper"
-Default serializer. Deployed with Perl core.
-.IP "Storable" 8
-.IX Item "Storable"
-Faster serializer. Deployed with Perl core.
-.IP "FreezeThaw" 8
-.IX Item "FreezeThaw"
-Pure Perl serializer, requires FreezeThaw to be installed.
-.IP "\s-1YAML\s0" 8
-.IX Item "YAML"
-Portable serializer (between languages but not architectures).
-Requires \s-1YAML::MLDBM\s0 installation.
-.IP "\s-1JSON\s0" 8
-.IX Item "JSON"
-Portable, fast serializer (between languages but not architectures).
-Requires MLDBM::Serializer::JSON installation.
-.PP
-dbm_store_metadata
-.IX Subsection "dbm_store_metadata"
-.PP
-Boolean value which determines if the metadata in \s-1DBM\s0 is stored or not.
-.PP
-dbm_berkeley_flags
-.IX Subsection "dbm_berkeley_flags"
-.PP
-Hash reference with additional flags for BerkeleyDB::Hash instantiation.
-.PP
-dbm_version
-.IX Subsection "dbm_version"
-.PP
-Readonly attribute containing the version of \s-1DBD::DBM.\s0
-.PP
-f_meta
-.IX Subsection "f_meta"
-.PP
-In addition to the attributes DBD::File recognizes, \s-1DBD::DBM\s0 knows
-about the (public) attributes \f(CW\*(C`col_names\*(C'\fR (\fBNote\fR not \fIdbm_cols\fR
-here!), \f(CW\*(C`dbm_type\*(C'\fR, \f(CW\*(C`dbm_mldbm\*(C'\fR, \f(CW\*(C`dbm_store_metadata\*(C'\fR and
-\&\f(CW\*(C`dbm_berkeley_flags\*(C'\fR. As in DBD::File, there are undocumented,
-internal attributes in \s-1DBD::DBM. \s0 Be very careful when modifying
-attributes you do not know; the consequence might a destroyed or
-corrupted table.
-.PP
-dbm_tables
-.IX Subsection "dbm_tables"
-.PP
-This attribute provides restricted access to the table meta data. See
-f_meta and \*(L"f_meta\*(R" in DBD::File for attribute details.
-.PP
-dbm_tables is a tied hash providing the internal table names as keys
-(accessing unknown tables might create an entry) and their meta
-data as another tied hash. The table meta storage is obtained via
-the \f(CW\*(C`get_table_meta\*(C'\fR method from the table implementation (see
-DBD::File::Developers). Attribute setting and getting within the
-table meta data is handled via the methods \f(CW\*(C`set_table_meta_attr\*(C'\fR and
-\&\f(CW\*(C`get_table_meta_attr\*(C'\fR.
-.PP
-\fIFollowing attributes are no longer handled by \s-1DBD::DBM:\s0\fR
-.IX Subsection "Following attributes are no longer handled by DBD::DBM:"
-.PP
-dbm_ext
-.IX Subsection "dbm_ext"
-.PP
-This attribute is silently mapped to DBD::File's attribute \fIf_ext\fR.
-Later versions of \s-1DBI\s0 might show a depreciated warning when this attribute
-is used and eventually it will be removed.
-.PP
-dbm_lockfile
-.IX Subsection "dbm_lockfile"
-.PP
-This attribute is silently mapped to DBD::File's attribute \fIf_lockfile\fR.
-Later versions of \s-1DBI\s0 might show a depreciated warning when this attribute
-is used and eventually it will be removed.
-.SH "DBI database handle methods"
-.IX Header "DBI database handle methods"
-.ie n .SS "The $dbh\->\fIdbm_versions()\fP method"
-.el .SS "The \f(CW$dbh\fP\->\fIdbm_versions()\fP method"
-.IX Subsection "The $dbh->dbm_versions() method"
-The private method \fIdbm_versions()\fR returns a summary of what other modules
-are being used at any given time. \s-1DBD::DBM\s0 can work with or without many
-other modules \- it can use either SQL::Statement or DBI::SQL::Nano as its
-\&\s-1SQL\s0 engine, it can be run with \s-1DBI\s0 or DBI::PurePerl, it can use many kinds
-of \s-1DBM\s0 modules, and many kinds of serializers when run with \s-1MLDBM. \s0 The
-\&\fIdbm_versions()\fR method reports all of that and more.
-.PP
-.Vb 2
-\& print $dbh\->dbm_versions; # displays global settings
-\& print $dbh\->dbm_versions($table_name); # displays per table settings
-.Ve
-.PP
-An important thing to note about this method is that when it called
-with no arguments, it displays the *global* settings. If you override
-these by setting per-table attributes, these will \fInot\fR be shown
-unless you specify a table name as an argument to the method call.
-.SS "Storing Objects"
-.IX Subsection "Storing Objects"
-If you are using \s-1MLDBM,\s0 you can use \s-1DBD::DBM\s0 to take advantage of its
-serializing abilities to serialize any Perl object that \s-1MLDBM\s0 can handle.
-To store objects in columns, you should (but don't absolutely need to)
-declare it as a column of type \s-1BLOB \s0(the type is *currently* ignored by
-the \s-1SQL\s0 engine, but it's good form).
-.SH "EXTENSIBILITY"
-.IX Header "EXTENSIBILITY"
-.ie n .IP """SQL::Statement""" 8
-.el .IP "\f(CWSQL::Statement\fR" 8
-.IX Item "SQL::Statement"
-Improved \s-1SQL\s0 engine compared to the built-in DBI::SQL::Nano \- see
-\&\*(L"Supported \s-1SQL\s0 syntax\*(R".
-.ie n .IP """DB_File""" 8
-.el .IP "\f(CWDB_File\fR" 8
-.IX Item "DB_File"
-Berkeley \s-1DB\s0 version 1. This database library is available on many
-systems without additional installation and most systems are
-supported.
-.ie n .IP """GDBM_File""" 8
-.el .IP "\f(CWGDBM_File\fR" 8
-.IX Item "GDBM_File"
-Simple dbm type (comparable to \f(CW\*(C`DB_File\*(C'\fR) under the \s-1GNU\s0 license.
-Typically not available (or requires extra installation) on non-GNU
-operating systems.
-.ie n .IP """BerkeleyDB""" 8
-.el .IP "\f(CWBerkeleyDB\fR" 8
-.IX Item "BerkeleyDB"
-Berkeley \s-1DB\s0 version up to v4 (and maybe higher) \- requires additional
-installation but is easier than GDBM_File on non-GNU systems.
-.Sp
-db4 comes with a many tools which allow repairing and migrating
-databases. This is the \fBrecommended\fR dbm type for production use.
-.ie n .IP """MLDBM""" 8
-.el .IP "\f(CWMLDBM\fR" 8
-.IX Item "MLDBM"
-Serializer wrapper to support more than one column for the files.
-Comes with serializers using \f(CW\*(C`Data::Dumper\*(C'\fR, \f(CW\*(C`FreezeThaw\*(C'\fR and
-\&\f(CW\*(C`Storable\*(C'\fR.
-.ie n .IP """YAML::MLDBM""" 8
-.el .IP "\f(CWYAML::MLDBM\fR" 8
-.IX Item "YAML::MLDBM"
-Additional serializer for \s-1MLDBM. YAML\s0 is very portable between languages.
-.ie n .IP """MLDBM::Serializer::JSON""" 8
-.el .IP "\f(CWMLDBM::Serializer::JSON\fR" 8
-.IX Item "MLDBM::Serializer::JSON"
-Additional serializer for \s-1MLDBM. JSON\s0 is very portable between languages,
-probably more than \s-1YAML.\s0
-.SH "GOTCHAS AND WARNINGS"
-.IX Header "GOTCHAS AND WARNINGS"
-Using the \s-1SQL DROP\s0 command will remove any file that has the name specified
-in the command with either '.pag' and '.dir', '.db' or your {f_ext} appended
-to it. So this be dangerous if you aren't sure what file it refers to:
-.PP
-.Vb 1
-\& $dbh\->do(qq{DROP TABLE "/path/to/any/file"});
-.Ve
-.PP
-Each \s-1DBM\s0 type has limitations. SDBM_File, for example, can only store
-values of less than 1,000 characters. *You* as the script author must
-ensure that you don't exceed those bounds. If you try to insert a value
-that is larger than \s-1DBM\s0 can store, the results will be unpredictable.
-See the documentation for whatever \s-1DBM\s0 you are using for details.
-.PP
-Different \s-1DBM\s0 implementations return records in different orders.
-That means that you \fIshould not\fR rely on the order of records unless
-you use an \s-1ORDER BY\s0 statement.
-.PP
-\&\s-1DBM\s0 data files are platform-specific. To move them from one platform to
-another, you'll need to do something along the lines of dumping your data
-to \s-1CSV\s0 on platform #1 and then dumping from \s-1CSV\s0 to \s-1DBM\s0 on platform #2.
-DBD::AnyData and \s-1DBD::CSV\s0 can help with that. There may also be \s-1DBM\s0
-conversion tools for your platforms which would probably be quicker.
-.PP
-When using \s-1MLDBM,\s0 there is a very powerful serializer \- it will allow
-you to store Perl code or objects in database columns. When these get
-de-serialized, they may be eval'ed \- in other words \s-1MLDBM \s0(or actually
-Data::Dumper when used by \s-1MLDBM\s0) may take the values and try to
-execute them in Perl. Obviously, this can present dangers, so if you
-do not know what is in a file, be careful before you access it with
-\&\s-1MLDBM\s0 turned on!
-.PP
-See the entire section on \*(L"Table locking and \fIflock()\fR\*(R" for gotchas and
-warnings about the use of \fIflock()\fR.
-.SH "BUGS AND LIMITATIONS"
-.IX Header "BUGS AND LIMITATIONS"
-This module uses hash interfaces of two column file databases. While
-none of supported \s-1SQL\s0 engines have support for indices, the following
-statements really do the same (even if they mean something completely
-different) for each dbm type which lacks \f(CW\*(C`EXISTS\*(C'\fR support:
-.PP
-.Vb 1
-\& $sth\->do( "insert into foo values (1, \*(Aqhello\*(Aq)" );
-\&
-\& # this statement does ...
-\& $sth\->do( "update foo set v=\*(Aqworld\*(Aq where k=1" );
-\& # ... the same as this statement
-\& $sth\->do( "insert into foo values (1, \*(Aqworld\*(Aq)" );
-.Ve
-.PP
-This is considered to be a bug and might change in a future release.
-.PP
-Known affected dbm types are \f(CW\*(C`ODBM_File\*(C'\fR and \f(CW\*(C`NDBM_File\*(C'\fR. We highly
-recommended you use a more modern dbm type such as \f(CW\*(C`DB_File\*(C'\fR.
-.SH "GETTING HELP, MAKING SUGGESTIONS, AND REPORTING BUGS"
-.IX Header "GETTING HELP, MAKING SUGGESTIONS, AND REPORTING BUGS"
-If you need help installing or using \s-1DBD::DBM,\s0 please write to the \s-1DBI\s0
-users mailing list at dbi\-users@perl.org or to the
-comp.lang.perl.modules newsgroup on usenet. I cannot always answer
-every question quickly but there are many on the mailing list or in
-the newsgroup who can.
-.PP
-\&\s-1DBD\s0 developers for \s-1DBD\s0's which rely on DBD::File or \s-1DBD::DBM\s0 or use
-one of them as an example are suggested to join the \s-1DBI\s0 developers
-mailing list at dbi\-dev@perl.org and strongly encouraged to join our
-\&\s-1IRC\s0 channel at <irc://irc.perl.org/dbi>.
-.PP
-If you have suggestions, ideas for improvements, or bugs to report, please
-report a bug as described in \s-1DBI.\s0 Do not mail any of the authors directly,
-you might not get an answer.
-.PP
-When reporting bugs, please send the output of \f(CW$dbh\fR\->dbm_versions($table)
-for a table that exhibits the bug and as small a sample as you can make of
-the code that produces the bug. And of course, patches are welcome, too
-:\-).
-.PP
-If you need enhancements quickly, you can get commercial support as
-described at <http://dbi.perl.org/support/> or you can contact Jens Rehsack
-at rehsack@cpan.org for commercial support in Germany.
-.PP
-Please don't bother Jochen Wiedmann or Jeff Zucker for support \- they
-handed over further maintenance to H.Merijn Brand and Jens Rehsack.
-.SH "ACKNOWLEDGEMENTS"
-.IX Header "ACKNOWLEDGEMENTS"
-Many, many thanks to Tim Bunce for prodding me to write this, and for
-copious, wise, and patient suggestions all along the way. (Jeff Zucker)
-.PP
-I send my thanks and acknowledgements to H.Merijn Brand for his
-initial refactoring of DBD::File and his strong and ongoing support of
-SQL::Statement. Without him, the current progress would never have
-been made. And I have to name Martin J. Evans for each laugh (and
-correction) of all those funny word creations I (as non-native
-speaker) made to the documentation. And \- of course \- I have to thank
-all those unnamed contributors and testers from the Perl
-community. (Jens Rehsack)
-.SH "AUTHOR AND COPYRIGHT"
-.IX Header "AUTHOR AND COPYRIGHT"
-This module is written by Jeff Zucker < jzucker \s-1AT\s0 cpan.org >, who also
-maintained it till 2007. After that, in 2010, Jens Rehsack & H.Merijn Brand
-took over maintenance.
-.PP
-.Vb 2
-\& Copyright (c) 2004 by Jeff Zucker, all rights reserved.
-\& Copyright (c) 2010\-2013 by Jens Rehsack & H.Merijn Brand, all rights reserved.
-.Ve
-.PP
-You may freely distribute and/or modify this module under the terms of
-either the \s-1GNU\s0 General Public License (\s-1GPL\s0) or the Artistic License, as
-specified in the Perl \s-1README\s0 file.
-.SH "SEE ALSO"
-.IX Header "SEE ALSO"
-\&\s-1DBI\s0,
-SQL::Statement, DBI::SQL::Nano,
-AnyDBM_File, DB_File, BerkeleyDB,
-\&\s-1MLDBM\s0, \s-1YAML::MLDBM\s0, MLDBM::Serializer::JSON
+++ /dev/null
-.\" Automatically generated by Pod::Man 2.28 (Pod::Simple 3.29)
-.\"
-.\" Standard preamble:
-.\" ========================================================================
-.de Sp \" Vertical space (when we can't use .PP)
-.if t .sp .5v
-.if n .sp
-..
-.de Vb \" Begin verbatim text
-.ft CW
-.nf
-.ne \\$1
-..
-.de Ve \" End verbatim text
-.ft R
-.fi
-..
-.\" Set up some character translations and predefined strings. \*(-- will
-.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
-.\" double quote, and \*(R" will give a right double quote. \*(C+ will
-.\" give a nicer C++. Capital omega is used to do unbreakable dashes and
-.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff,
-.\" nothing in troff, for use with C<>.
-.tr \(*W-
-.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
-.ie n \{\
-. ds -- \(*W-
-. ds PI pi
-. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
-. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch
-. ds L" ""
-. ds R" ""
-. ds C` ""
-. ds C' ""
-'br\}
-.el\{\
-. ds -- \|\(em\|
-. ds PI \(*p
-. ds L" ``
-. ds R" ''
-. ds C`
-. ds C'
-'br\}
-.\"
-.\" Escape single quotes in literal strings from groff's Unicode transform.
-.ie \n(.g .ds Aq \(aq
-.el .ds Aq '
-.\"
-.\" If the F register is turned on, we'll generate index entries on stderr for
-.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
-.\" entries marked with X<> in POD. Of course, you'll have to process the
-.\" output yourself in some meaningful fashion.
-.\"
-.\" Avoid warning from groff about undefined register 'F'.
-.de IX
-..
-.nr rF 0
-.if \n(.g .if rF .nr rF 1
-.if (\n(rF:(\n(.g==0)) \{
-. if \nF \{
-. de IX
-. tm Index:\\$1\t\\n%\t"\\$2"
-..
-. if !\nF==2 \{
-. nr % 0
-. nr F 2
-. \}
-. \}
-.\}
-.rr rF
-.\" ========================================================================
-.\"
-.IX Title "DBD::File 3pm"
-.TH DBD::File 3pm "2016-11-09" "perl v5.22.1" "User Contributed Perl Documentation"
-.\" For nroff, turn off justification. Always turn off hyphenation; it makes
-.\" way too many mistakes in technical documents.
-.if n .ad l
-.nh
-.SH "NAME"
-DBD::File \- Base class for writing file based DBI drivers
-.SH "SYNOPSIS"
-.IX Header "SYNOPSIS"
-This module is a base class for writing other \s-1DBD\s0s.
-It is not intended to function as a \s-1DBD\s0 itself (though it is possible).
-If you want to access flat files, use DBD::AnyData, or
-\&\s-1DBD::CSV\s0 (both of which are subclasses of DBD::File).
-.SH "DESCRIPTION"
-.IX Header "DESCRIPTION"
-The DBD::File module is not a true \s-1DBI\s0 driver, but an abstract
-base class for deriving concrete \s-1DBI\s0 drivers from it. The implication
-is, that these drivers work with plain files, for example \s-1CSV\s0 files or
-\&\s-1INI\s0 files. The module is based on the SQL::Statement
-module, a simple \s-1SQL\s0 engine.
-.PP
-See \s-1DBI\s0 for details on \s-1DBI, \s0SQL::Statement for
-details on SQL::Statement and \s-1DBD::CSV\s0, \s-1DBD::DBM\s0
-or DBD::AnyData for example drivers.
-.SS "Metadata"
-.IX Subsection "Metadata"
-The following attributes are handled by \s-1DBI\s0 itself and not by DBD::File,
-thus they all work as expected:
-.PP
-.Vb 10
-\& Active
-\& ActiveKids
-\& CachedKids
-\& CompatMode (Not used)
-\& InactiveDestroy
-\& AutoInactiveDestroy
-\& Kids
-\& PrintError
-\& RaiseError
-\& Warn (Not used)
-.Ve
-.PP
-\fIThe following \s-1DBI\s0 attributes are handled by DBD::File:\fR
-.IX Subsection "The following DBI attributes are handled by DBD::File:"
-.PP
-AutoCommit
-.IX Subsection "AutoCommit"
-.PP
-Always on.
-.PP
-ChopBlanks
-.IX Subsection "ChopBlanks"
-.PP
-Works.
-.PP
-\s-1NUM_OF_FIELDS\s0
-.IX Subsection "NUM_OF_FIELDS"
-.PP
-Valid after \f(CW\*(C`$sth\->execute\*(C'\fR.
-.PP
-\s-1NUM_OF_PARAMS\s0
-.IX Subsection "NUM_OF_PARAMS"
-.PP
-Valid after \f(CW\*(C`$sth\->prepare\*(C'\fR.
-.PP
-\s-1NAME\s0
-.IX Subsection "NAME"
-.PP
-Valid after \f(CW\*(C`$sth\->execute\*(C'\fR; undef for Non-Select statements.
-.PP
-\s-1NULLABLE\s0
-.IX Subsection "NULLABLE"
-.PP
-Not really working, always returns an array ref of ones, except the
-affected table has been created in this session. Valid after
-\&\f(CW\*(C`$sth\->execute\*(C'\fR; undef for non-select statements.
-.PP
-\fIUnsupported \s-1DBI\s0 attributes and methods\fR
-.IX Subsection "Unsupported DBI attributes and methods"
-.PP
-bind_param_inout
-.IX Subsection "bind_param_inout"
-.PP
-CursorName
-.IX Subsection "CursorName"
-.PP
-LongReadLen
-.IX Subsection "LongReadLen"
-.PP
-LongTruncOk
-.IX Subsection "LongTruncOk"
-.PP
-\fIDBD::File specific attributes\fR
-.IX Subsection "DBD::File specific attributes"
-.PP
-In addition to the \s-1DBI\s0 attributes, you can use the following dbh
-attributes:
-.PP
-f_dir
-.IX Subsection "f_dir"
-.PP
-This attribute is used for setting the directory where the files are
-opened and it defaults to the current directory (\fI.\fR). Usually you set
-it on the dbh but it may be overridden per table (see f_meta).
-.PP
-When the value for \f(CW\*(C`f_dir\*(C'\fR is a relative path, it is converted into
-the appropriate absolute path name (based on the current working
-directory) when the dbh attribute is set.
-.PP
-.Vb 1
-\& f_dir => "/data/foo/csv",
-.Ve
-.PP
-See \*(L"\s-1KNOWN BUGS AND LIMITATIONS\*(R"\s0.
-.PP
-f_dir_search
-.IX Subsection "f_dir_search"
-.PP
-This optional attribute can be set to pass a list of folders to also
-find existing tables. It will \fBnot\fR be used to create new files.
-.PP
-.Vb 1
-\& f_dir_search => [ "/data/bar/csv", "/dump/blargh/data" ],
-.Ve
-.PP
-f_ext
-.IX Subsection "f_ext"
-.PP
-This attribute is used for setting the file extension. The format is:
-.PP
-.Vb 1
-\& extension{/flag}
-.Ve
-.PP
-where the /flag is optional and the extension is case-insensitive.
-\&\f(CW\*(C`f_ext\*(C'\fR allows you to specify an extension which:
-.PP
-.Vb 1
-\& f_ext => ".csv/r",
-.Ve
-.IP "\(bu" 4
-makes DBD::File prefer \fItable.extension\fR over \fItable\fR.
-.IP "\(bu" 4
-makes the table name the filename minus the extension.
-.PP
-.Vb 1
-\& DBI:CSV:f_dir=data;f_ext=.csv
-.Ve
-.PP
-In the above example and when \f(CW\*(C`f_dir\*(C'\fR contains both \fItable.csv\fR and
-\&\fItable\fR, DBD::File will open \fItable.csv\fR and the table will be
-named \*(L"table\*(R". If \fItable.csv\fR does not exist but \fItable\fR does
-that file is opened and the table is also called \*(L"table\*(R".
-.PP
-If \f(CW\*(C`f_ext\*(C'\fR is not specified and \fItable.csv\fR exists it will be opened
-and the table will be called \*(L"table.csv\*(R" which is probably not what
-you want.
-.PP
-\&\s-1NOTE:\s0 even though extensions are case-insensitive, table names are
-not.
-.PP
-.Vb 1
-\& DBI:CSV:f_dir=data;f_ext=.csv/r
-.Ve
-.PP
-The \f(CW\*(C`r\*(C'\fR flag means the file extension is required and any filename
-that does not match the extension is ignored.
-.PP
-Usually you set it on the dbh but it may be overridden per table
-(see f_meta).
-.PP
-f_schema
-.IX Subsection "f_schema"
-.PP
-This will set the schema name and defaults to the owner of the
-directory in which the table file resides. You can set \f(CW\*(C`f_schema\*(C'\fR to
-\&\f(CW\*(C`undef\*(C'\fR.
-.PP
-.Vb 5
-\& my $dbh = DBI\->connect ("dbi:CSV:", "", "", {
-\& f_schema => undef,
-\& f_dir => "data",
-\& f_ext => ".csv/r",
-\& }) or die $DBI::errstr;
-.Ve
-.PP
-By setting the schema you affect the results from the tables call:
-.PP
-.Vb 1
-\& my @tables = $dbh\->tables ();
-\&
-\& # no f_schema
-\& "merijn".foo
-\& "merijn".bar
-\&
-\& # f_schema => "dbi"
-\& "dbi".foo
-\& "dbi".bar
-\&
-\& # f_schema => undef
-\& foo
-\& bar
-.Ve
-.PP
-Defining \f(CW\*(C`f_schema\*(C'\fR to the empty string is equal to setting it to \f(CW\*(C`undef\*(C'\fR
-so the \s-1DSN\s0 can be \f(CW"dbi:CSV:f_schema=;f_dir=."\fR.
-.PP
-f_lock
-.IX Subsection "f_lock"
-.PP
-The \f(CW\*(C`f_lock\*(C'\fR attribute is used to set the locking mode on the opened
-table files. Note that not all platforms support locking. By default,
-tables are opened with a shared lock for reading, and with an
-exclusive lock for writing. The supported modes are:
-.PP
-.Vb 1
-\& 0: No locking at all.
-\&
-\& 1: Shared locks will be used.
-\&
-\& 2: Exclusive locks will be used.
-.Ve
-.PP
-But see \s-1KNOWN BUGS\s0 below.
-.PP
-f_lockfile
-.IX Subsection "f_lockfile"
-.PP
-If you wish to use a lockfile extension other than \f(CW\*(C`.lck\*(C'\fR, simply specify
-the \f(CW\*(C`f_lockfile\*(C'\fR attribute:
-.PP
-.Vb 3
-\& $dbh = DBI\->connect ("dbi:DBM:f_lockfile=.foo");
-\& $dbh\->{f_lockfile} = ".foo";
-\& $dbh\->{dbm_tables}{qux}{f_lockfile} = ".foo";
-.Ve
-.PP
-If you wish to disable locking, set the \f(CW\*(C`f_lockfile\*(C'\fR to \f(CW0\fR.
-.PP
-.Vb 3
-\& $dbh = DBI\->connect ("dbi:DBM:f_lockfile=0");
-\& $dbh\->{f_lockfile} = 0;
-\& $dbh\->{dbm_tables}{qux}{f_lockfile} = 0;
-.Ve
-.PP
-f_encoding
-.IX Subsection "f_encoding"
-.PP
-With this attribute, you can set the encoding in which the file is opened.
-This is implemented using \f(CW\*(C`binmode $fh, ":encoding(<f_encoding>)"\*(C'\fR.
-.PP
-f_meta
-.IX Subsection "f_meta"
-.PP
-Private data area aliasing \*(L"sql_meta\*(R" in DBI::DBD::SqlEngine which
-contains information about the tables this module handles. Table meta
-data might not be available until the table has been accessed for the
-first time e.g., by issuing a select on it however it is possible to
-pre-initialize attributes for each table you use.
-.PP
-DBD::File recognizes the (public) attributes \f(CW\*(C`f_ext\*(C'\fR, \f(CW\*(C`f_dir\*(C'\fR,
-\&\f(CW\*(C`f_file\*(C'\fR, \f(CW\*(C`f_encoding\*(C'\fR, \f(CW\*(C`f_lock\*(C'\fR, \f(CW\*(C`f_lockfile\*(C'\fR, \f(CW\*(C`f_schema\*(C'\fR,
-in addition to the attributes \*(L"sql_meta\*(R" in DBI::DBD::SqlEngine already
-supports. Be very careful when modifying attributes you do not know,
-the consequence might be a destroyed or corrupted table.
-.PP
-\&\f(CW\*(C`f_file\*(C'\fR is an attribute applicable to table meta data only and you
-will not find a corresponding attribute in the dbh. Whilst it may be
-reasonable to have several tables with the same column names, it is
-not for the same file name. If you need access to the same file using
-different table names, use \f(CW\*(C`SQL::Statement\*(C'\fR as the \s-1SQL\s0 engine and the
-\&\f(CW\*(C`AS\*(C'\fR keyword:
-.PP
-.Vb 1
-\& SELECT * FROM tbl AS t1, tbl AS t2 WHERE t1.id = t2.id
-.Ve
-.PP
-\&\f(CW\*(C`f_file\*(C'\fR can be an absolute path name or a relative path name but if
-it is relative, it is interpreted as being relative to the \f(CW\*(C`f_dir\*(C'\fR
-attribute of the table meta data. When \f(CW\*(C`f_file\*(C'\fR is set DBD::File will
-use \f(CW\*(C`f_file\*(C'\fR as specified and will not attempt to work out an
-alternative for \f(CW\*(C`f_file\*(C'\fR using the \f(CW\*(C`table name\*(C'\fR and \f(CW\*(C`f_ext\*(C'\fR
-attribute.
-.PP
-While \f(CW\*(C`f_meta\*(C'\fR is a private and readonly attribute (which means, you
-cannot modify it's values), derived drivers might provide restricted
-write access through another attribute. Well known accessors are
-\&\f(CW\*(C`csv_tables\*(C'\fR for \s-1DBD::CSV\s0, \f(CW\*(C`ad_tables\*(C'\fR for DBD::AnyData and
-\&\f(CW\*(C`dbm_tables\*(C'\fR for \s-1DBD::DBM\s0.
-.PP
-\fINew opportunities for attributes from DBI::DBD::SqlEngine\fR
-.IX Subsection "New opportunities for attributes from DBI::DBD::SqlEngine"
-.PP
-sql_table_source
-.IX Subsection "sql_table_source"
-.PP
-\&\f(CW\*(C`$dbh\->{sql_table_source}\*(C'\fR can be set to
-\&\fIDBD::File::TableSource::FileSystem\fR (and is the default setting
-of DBD::File). This provides usual behaviour of previous DBD::File
-releases on
-.PP
-.Vb 2
-\& @ary = DBI\->data_sources ($driver);
-\& @ary = DBI\->data_sources ($driver, \e%attr);
-\&
-\& @ary = $dbh\->data_sources ();
-\& @ary = $dbh\->data_sources (\e%attr);
-\&
-\& @names = $dbh\->tables ($catalog, $schema, $table, $type);
-\&
-\& $sth = $dbh\->table_info ($catalog, $schema, $table, $type);
-\& $sth = $dbh\->table_info ($catalog, $schema, $table, $type, \e%attr);
-\&
-\& $dbh\->func ("list_tables");
-.Ve
-.PP
-sql_data_source
-.IX Subsection "sql_data_source"
-.PP
-\&\f(CW\*(C`$dbh\->{sql_data_source}\*(C'\fR can be set to either
-\&\fIDBD::File::DataSource::File\fR, which is default and provides the
-well known behavior of DBD::File releases prior to 0.41, or
-\&\fIDBD::File::DataSource::Stream\fR, which reuses already opened
-file-handle for operations.
-.PP
-\fIInternally private attributes to deal with \s-1SQL\s0 backends\fR
-.IX Subsection "Internally private attributes to deal with SQL backends"
-.PP
-Do not modify any of these private attributes unless you understand
-the implications of doing so. The behavior of DBD::File and derived
-DBDs might be unpredictable when one or more of those attributes are
-modified.
-.PP
-sql_nano_version
-.IX Subsection "sql_nano_version"
-.PP
-Contains the version of loaded DBI::SQL::Nano.
-.PP
-sql_statement_version
-.IX Subsection "sql_statement_version"
-.PP
-Contains the version of loaded SQL::Statement.
-.PP
-sql_handler
-.IX Subsection "sql_handler"
-.PP
-Contains either the text 'SQL::Statement' or 'DBI::SQL::Nano'.
-.PP
-sql_ram_tables
-.IX Subsection "sql_ram_tables"
-.PP
-Contains optionally temporary tables.
-.PP
-sql_flags
-.IX Subsection "sql_flags"
-.PP
-Contains optional flags to instantiate the SQL::Parser parsing engine
-when SQL::Statement is used as \s-1SQL\s0 engine. See SQL::Parser for valid
-flags.
-.SS "Driver private methods"
-.IX Subsection "Driver private methods"
-\fIDefault \s-1DBI\s0 methods\fR
-.IX Subsection "Default DBI methods"
-.PP
-data_sources
-.IX Subsection "data_sources"
-.PP
-The \f(CW\*(C`data_sources\*(C'\fR method returns a list of subdirectories of the current
-directory in the form \*(L"dbi:CSV:f_dir=$dirname\*(R".
-.PP
-If you want to read the subdirectories of another directory, use
-.PP
-.Vb 2
-\& my ($drh) = DBI\->install_driver ("CSV");
-\& my (@list) = $drh\->data_sources (f_dir => "/usr/local/csv_data");
-.Ve
-.PP
-\fIAdditional methods\fR
-.IX Subsection "Additional methods"
-.PP
-The following methods are only available via their documented name when
-DBD::File is used directly. Because this is only reasonable for testing
-purposes, the real names must be used instead. Those names can be computed
-by replacing the \f(CW\*(C`f_\*(C'\fR in the method name with the driver prefix.
-.PP
-f_versions
-.IX Subsection "f_versions"
-.PP
-Signature:
-.PP
-.Vb 6
-\& sub f_versions (;$)
-\& {
-\& my ($table_name) = @_;
-\& $table_name ||= ".";
-\& ...
-\& }
-.Ve
-.PP
-Returns the versions of the driver, including the \s-1DBI\s0 version, the Perl
-version, DBI::PurePerl version (if DBI::PurePerl is active) and the version
-of the \s-1SQL\s0 engine in use.
-.PP
-.Vb 9
-\& my $dbh = DBI\->connect ("dbi:File:");
-\& my $f_versions = $dbh\->func ("f_versions");
-\& print "$f_versions\en";
-\& _\|_END_\|_
-\& # DBD::File 0.41 using IO::File (1.16)
-\& # DBI::DBD::SqlEngine 0.05 using SQL::Statement 1.406
-\& # DBI 1.623
-\& # OS darwin (12.2.1)
-\& # Perl 5.017006 (darwin\-thread\-multi\-ld\-2level)
-.Ve
-.PP
-Called in list context, f_versions will return an array containing each
-line as single entry.
-.PP
-Some drivers might use the optional (table name) argument and modify
-version information related to the table (e.g. \s-1DBD::DBM\s0 provides storage
-backend information for the requested table, when it has a table name).
-.SH "KNOWN BUGS AND LIMITATIONS"
-.IX Header "KNOWN BUGS AND LIMITATIONS"
-.IP "\(bu" 4
-This module uses flock () internally but flock is not available on all
-platforms. On MacOS and Windows 95 there is no locking at all (perhaps
-not so important on MacOS and Windows 95, as there is only a single
-user).
-.IP "\(bu" 4
-The module stores details about the handled tables in a private area
-of the driver handle (\f(CW$drh\fR). This data area is not shared between
-different driver instances, so several \f(CW\*(C`DBI\->connect ()\*(C'\fR calls will
-cause different table instances and private data areas.
-.Sp
-This data area is filled for the first time when a table is accessed,
-either via an \s-1SQL\s0 statement or via \f(CW\*(C`table_info\*(C'\fR and is not
-destroyed until the table is dropped or the driver handle is released.
-Manual destruction is possible via f_clear_meta.
-.Sp
-The following attributes are preserved in the data area and will
-evaluated instead of driver globals:
-.RS 4
-.IP "f_ext" 8
-.IX Item "f_ext"
-.PD 0
-.IP "f_dir" 8
-.IX Item "f_dir"
-.IP "f_dir_search" 8
-.IX Item "f_dir_search"
-.IP "f_lock" 8
-.IX Item "f_lock"
-.IP "f_lockfile" 8
-.IX Item "f_lockfile"
-.IP "f_encoding" 8
-.IX Item "f_encoding"
-.IP "f_schema" 8
-.IX Item "f_schema"
-.IP "col_names" 8
-.IX Item "col_names"
-.IP "sql_identifier_case" 8
-.IX Item "sql_identifier_case"
-.RE
-.RS 4
-.PD
-.Sp
-The following attributes are preserved in the data area only and
-cannot be set globally.
-.IP "f_file" 8
-.IX Item "f_file"
-.RE
-.RS 4
-.Sp
-The following attributes are preserved in the data area only and are
-computed when initializing the data area:
-.IP "f_fqfn" 8
-.IX Item "f_fqfn"
-.PD 0
-.IP "f_fqbn" 8
-.IX Item "f_fqbn"
-.IP "f_fqln" 8
-.IX Item "f_fqln"
-.IP "table_name" 8
-.IX Item "table_name"
-.RE
-.RS 4
-.PD
-.Sp
-For \s-1DBD::CSV\s0 tables this means, once opened \*(L"foo.csv\*(R" as table named \*(L"foo\*(R",
-another table named \*(L"foo\*(R" accessing the file \*(L"foo.txt\*(R" cannot be opened.
-Accessing \*(L"foo\*(R" will always access the file \*(L"foo.csv\*(R" in memorized
-\&\f(CW\*(C`f_dir\*(C'\fR, locking \f(CW\*(C`f_lockfile\*(C'\fR via memorized \f(CW\*(C`f_lock\*(C'\fR.
-.Sp
-You can use f_clear_meta or the \f(CW\*(C`f_file\*(C'\fR attribute for a specific table
-to work around this.
-.RE
-.IP "\(bu" 4
-When used with SQL::Statement and temporary tables e.g.,
-.Sp
-.Vb 1
-\& CREATE TEMP TABLE ...
-.Ve
-.Sp
-the table data processing bypasses DBD::File::Table. No file system
-calls will be made and there are no clashes with existing (file based)
-tables with the same name. Temporary tables are chosen over file
-tables, but they will not covered by \f(CW\*(C`table_info\*(C'\fR.
-.SH "AUTHOR"
-.IX Header "AUTHOR"
-This module is currently maintained by
-.PP
-H.Merijn Brand < h.m.brand at xs4all.nl > and
-Jens Rehsack < rehsack at googlemail.com >
-.PP
-The original author is Jochen Wiedmann.
-.SH "COPYRIGHT AND LICENSE"
-.IX Header "COPYRIGHT AND LICENSE"
-.Vb 3
-\& Copyright (C) 2009\-2013 by H.Merijn Brand & Jens Rehsack
-\& Copyright (C) 2004\-2009 by Jeff Zucker
-\& Copyright (C) 1998\-2004 by Jochen Wiedmann
-.Ve
-.PP
-All rights reserved.
-.PP
-You may freely distribute and/or modify this module under the terms of
-either the \s-1GNU\s0 General Public License (\s-1GPL\s0) or the Artistic License, as
-specified in the Perl \s-1README\s0 file.
-.SH "SEE ALSO"
-.IX Header "SEE ALSO"
-\&\s-1DBI\s0, \s-1DBD::DBM\s0, \s-1DBD::CSV\s0, Text::CSV,
-Text::CSV_XS, SQL::Statement, and
-DBI::SQL::Nano
+++ /dev/null
-.\" Automatically generated by Pod::Man 2.28 (Pod::Simple 3.29)
-.\"
-.\" Standard preamble:
-.\" ========================================================================
-.de Sp \" Vertical space (when we can't use .PP)
-.if t .sp .5v
-.if n .sp
-..
-.de Vb \" Begin verbatim text
-.ft CW
-.nf
-.ne \\$1
-..
-.de Ve \" End verbatim text
-.ft R
-.fi
-..
-.\" Set up some character translations and predefined strings. \*(-- will
-.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
-.\" double quote, and \*(R" will give a right double quote. \*(C+ will
-.\" give a nicer C++. Capital omega is used to do unbreakable dashes and
-.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff,
-.\" nothing in troff, for use with C<>.
-.tr \(*W-
-.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
-.ie n \{\
-. ds -- \(*W-
-. ds PI pi
-. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
-. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch
-. ds L" ""
-. ds R" ""
-. ds C` ""
-. ds C' ""
-'br\}
-.el\{\
-. ds -- \|\(em\|
-. ds PI \(*p
-. ds L" ``
-. ds R" ''
-. ds C`
-. ds C'
-'br\}
-.\"
-.\" Escape single quotes in literal strings from groff's Unicode transform.
-.ie \n(.g .ds Aq \(aq
-.el .ds Aq '
-.\"
-.\" If the F register is turned on, we'll generate index entries on stderr for
-.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
-.\" entries marked with X<> in POD. Of course, you'll have to process the
-.\" output yourself in some meaningful fashion.
-.\"
-.\" Avoid warning from groff about undefined register 'F'.
-.de IX
-..
-.nr rF 0
-.if \n(.g .if rF .nr rF 1
-.if (\n(rF:(\n(.g==0)) \{
-. if \nF \{
-. de IX
-. tm Index:\\$1\t\\n%\t"\\$2"
-..
-. if !\nF==2 \{
-. nr % 0
-. nr F 2
-. \}
-. \}
-.\}
-.rr rF
-.\" ========================================================================
-.\"
-.IX Title "DBD::File::Developers 3pm"
-.TH DBD::File::Developers 3pm "2013-04-04" "perl v5.22.1" "User Contributed Perl Documentation"
-.\" For nroff, turn off justification. Always turn off hyphenation; it makes
-.\" way too many mistakes in technical documents.
-.if n .ad l
-.nh
-.SH "NAME"
-DBD::File::Developers \- Developers documentation for DBD::File
-.SH "SYNOPSIS"
-.IX Header "SYNOPSIS"
-.Vb 1
-\& package DBD::myDriver;
-\&
-\& use base qw( DBD::File );
-\&
-\& sub driver
-\& {
-\& ...
-\& my $drh = $proto\->SUPER::driver ($attr);
-\& ...
-\& return $drh\->{class};
-\& }
-\&
-\& sub CLONE { ... }
-\&
-\& package DBD::myDriver::dr;
-\&
-\& @ISA = qw( DBD::File::dr );
-\&
-\& sub data_sources { ... }
-\& ...
-\&
-\& package DBD::myDriver::db;
-\&
-\& @ISA = qw( DBD::File::db );
-\&
-\& sub init_valid_attributes { ... }
-\& sub init_default_attributes { ... }
-\& sub set_versions { ... }
-\& sub validate_STORE_attr { my ($dbh, $attrib, $value) = @_; ... }
-\& sub validate_FETCH_attr { my ($dbh, $attrib) = @_; ... }
-\& sub get_myd_versions { ... }
-\&
-\& package DBD::myDriver::st;
-\&
-\& @ISA = qw( DBD::File::st );
-\&
-\& sub FETCH { ... }
-\& sub STORE { ... }
-\&
-\& package DBD::myDriver::Statement;
-\&
-\& @ISA = qw( DBD::File::Statement );
-\&
-\& package DBD::myDriver::Table;
-\&
-\& @ISA = qw( DBD::File::Table );
-\&
-\& my %reset_on_modify = (
-\& myd_abc => "myd_foo",
-\& myd_mno => "myd_bar",
-\& );
-\& _\|_PACKAGE_\|_\->register_reset_on_modify (\e%reset_on_modify);
-\& my %compat_map = (
-\& abc => \*(Aqfoo_abc\*(Aq,
-\& xyz => \*(Aqfoo_xyz\*(Aq,
-\& );
-\& _\|_PACKAGE_\|_\->register_compat_map (\e%compat_map);
-\&
-\& sub bootstrap_table_meta { ... }
-\& sub init_table_meta { ... }
-\& sub table_meta_attr_changed { ... }
-\& sub open_data { ... }
-\&
-\& sub fetch_row { ... }
-\& sub push_row { ... }
-\& sub push_names { ... }
-\&
-\& # optimize the SQL engine by add one or more of
-\& sub update_current_row { ... }
-\& # or
-\& sub update_specific_row { ... }
-\& # or
-\& sub update_one_row { ... }
-\& # or
-\& sub insert_new_row { ... }
-\& # or
-\& sub delete_current_row { ... }
-\& # or
-\& sub delete_one_row { ... }
-.Ve
-.SH "DESCRIPTION"
-.IX Header "DESCRIPTION"
-This document describes how \s-1DBD\s0 developers can write DBD::File based \s-1DBI\s0
-drivers. It supplements \s-1DBI::DBD\s0 and DBI::DBD::SqlEngine::Developers,
-which you should read first.
-.SH "CLASSES"
-.IX Header "CLASSES"
-Each \s-1DBI\s0 driver must provide a package global \f(CW\*(C`driver\*(C'\fR method and three
-\&\s-1DBI\s0 related classes:
-.IP "DBD::File::dr" 4
-.IX Item "DBD::File::dr"
-Driver package, contains the methods \s-1DBI\s0 calls indirectly via \s-1DBI\s0
-interface:
-.Sp
-.Vb 1
-\& DBI\->connect (\*(AqDBI:DBM:\*(Aq, undef, undef, {})
-\&
-\& # invokes
-\& package DBD::DBM::dr;
-\& @DBD::DBM::dr::ISA = qw( DBD::File::dr );
-\&
-\& sub connect ($$;$$$)
-\& {
-\& ...
-\& }
-.Ve
-.Sp
-Similar for \f(CW\*(C`data_sources\*(C'\fR and \f(CW\*(C`disconnect_all\*(C'\fR.
-.Sp
-Pure Perl \s-1DBI\s0 drivers derived from DBD::File do not usually need to
-override any of the methods provided through the DBD::XXX::dr package
-however if you need additional initialization in the connect method
-you may need to.
-.IP "DBD::File::db" 4
-.IX Item "DBD::File::db"
-Contains the methods which are called through \s-1DBI\s0 database handles
-(\f(CW$dbh\fR). e.g.,
-.Sp
-.Vb 3
-\& $sth = $dbh\->prepare ("select * from foo");
-\& # returns the f_encoding setting for table foo
-\& $dbh\->csv_get_meta ("foo", "f_encoding");
-.Ve
-.Sp
-DBD::File provides the typical methods required here. Developers who
-write \s-1DBI\s0 drivers based on DBD::File need to override the methods \f(CW\*(C`set_versions\*(C'\fR and \f(CW\*(C`init_valid_attributes\*(C'\fR.
-.IP "DBD::File::st" 4
-.IX Item "DBD::File::st"
-Contains the methods to deal with prepared statement handles. e.g.,
-.Sp
-.Vb 1
-\& $sth\->execute () or die $sth\->errstr;
-.Ve
-.SS "DBD::File"
-.IX Subsection "DBD::File"
-This is the main package containing the routines to initialize
-DBD::File based \s-1DBI\s0 drivers. Primarily the \f(CW\*(C`DBD::File::driver\*(C'\fR
-method is invoked, either directly from \s-1DBI\s0 when the driver is
-initialized or from the derived class.
-.PP
-.Vb 1
-\& package DBD::DBM;
-\&
-\& use base qw( DBD::File );
-\&
-\& sub driver
-\& {
-\& my ($class, $attr) = @_;
-\& ...
-\& my $drh = $class\->SUPER::driver ($attr);
-\& ...
-\& return $drh;
-\& }
-.Ve
-.PP
-It is not necessary to implement your own driver method as long as
-additional initialization (e.g. installing more private driver
-methods) is not required. You do not need to call \f(CW\*(C`setup_driver\*(C'\fR
-as DBD::File takes care of it.
-.SS "DBD::File::dr"
-.IX Subsection "DBD::File::dr"
-The driver package contains the methods \s-1DBI\s0 calls indirectly via the \s-1DBI\s0
-interface (see \*(L"\s-1DBI\s0 Class Methods\*(R" in \s-1DBI\s0).
-.PP
-DBD::File based \s-1DBI\s0 drivers usually do not need to implement anything here,
-it is enough to do the basic initialization:
-.PP
-.Vb 1
-\& package DBD:XXX::dr;
-\&
-\& @DBD::XXX::dr::ISA = qw (DBD::File::dr);
-\& $DBD::XXX::dr::imp_data_size = 0;
-\& $DBD::XXX::dr::data_sources_attr = undef;
-\& $DBD::XXX::ATTRIBUTION = "DBD::XXX $DBD::XXX::VERSION by Hans Mustermann";
-.Ve
-.SS "DBD::File::db"
-.IX Subsection "DBD::File::db"
-This package defines the database methods, which are called via the \s-1DBI\s0
-database handle \f(CW$dbh\fR.
-.PP
-Methods provided by DBD::File:
-.IP "ping" 4
-.IX Item "ping"
-Simply returns the content of the \f(CW\*(C`Active\*(C'\fR attribute. Override
-when your driver needs more complicated actions here.
-.IP "prepare" 4
-.IX Item "prepare"
-Prepares a new \s-1SQL\s0 statement to execute. Returns a statement handle,
-\&\f(CW$sth\fR \- instance of the DBD:XXX::st. It is neither required nor
-recommended to override this method.
-.IP "\s-1FETCH\s0" 4
-.IX Item "FETCH"
-Fetches an attribute of a \s-1DBI\s0 database object. Private handle attributes
-must have a prefix (this is mandatory). If a requested attribute is
-detected as a private attribute without a valid prefix, the driver prefix
-(written as \f(CW$drv_prefix\fR) is added.
-.Sp
-The driver prefix is extracted from the attribute name and verified against
-\&\f(CW\*(C`$dbh\->{$drv_prefix . "valid_attrs"}\*(C'\fR (when it exists). If the
-requested attribute value is not listed as a valid attribute, this method
-croaks. If the attribute is valid and readonly (listed in \f(CW\*(C`$dbh\->{
-$drv_prefix . "readonly_attrs" }\*(C'\fR when it exists), a real copy of the
-attribute value is returned. So it's not possible to modify
-\&\f(CW\*(C`f_valid_attrs\*(C'\fR from outside of DBD::File::db or a derived class.
-.IP "\s-1STORE\s0" 4
-.IX Item "STORE"
-Stores a database private attribute. Private handle attributes must have a
-prefix (this is mandatory). If a requested attribute is detected as a private
-attribute without a valid prefix, the driver prefix (written as
-\&\f(CW$drv_prefix\fR) is added. If the database handle has an attribute
-\&\f(CW\*(C`${drv_prefix}_valid_attrs\*(C'\fR \- for attribute names which are not listed in
-that hash, this method croaks. If the database handle has an attribute
-\&\f(CW\*(C`${drv_prefix}_readonly_attrs\*(C'\fR, only attributes which are not listed there
-can be stored (once they are initialized). Trying to overwrite such an
-immutable attribute forces this method to croak.
-.Sp
-An example of a valid attributes list can be found in
-\&\f(CW\*(C`DBD::File::db::init_valid_attributes\*(C'\fR.
-.IP "set_versions" 4
-.IX Item "set_versions"
-This method sets the attribute \f(CW\*(C`f_version\*(C'\fR with the version of DBD::File.
-.Sp
-This method is called at the begin of the \f(CW\*(C`connect ()\*(C'\fR phase.
-.Sp
-When overriding this method, do not forget to invoke the superior one.
-.IP "init_valid_attributes" 4
-.IX Item "init_valid_attributes"
-This method is called after the database handle is instantiated as the
-first attribute initialization.
-.Sp
-\&\f(CW\*(C`DBD::File::db::init_valid_attributes\*(C'\fR initializes the attributes
-\&\f(CW\*(C`f_valid_attrs\*(C'\fR and \f(CW\*(C`f_readonly_attrs\*(C'\fR.
-.Sp
-When overriding this method, do not forget to invoke the superior one,
-preferably before doing anything else. Compatibility table attribute
-access must be initialized here to allow DBD::File to instantiate the
-map tie:
-.Sp
-.Vb 6
-\& # for DBD::CSV
-\& $dbh\->{csv_meta} = "csv_tables";
-\& # for DBD::DBM
-\& $dbh\->{dbm_meta} = "dbm_tables";
-\& # for DBD::AnyData
-\& $dbh\->{ad_meta} = "ad_tables";
-.Ve
-.IP "init_default_attributes" 4
-.IX Item "init_default_attributes"
-This method is called after the database handle is instantiated to
-initialize the default attributes.
-.Sp
-\&\f(CW\*(C`DBD::File::db::init_default_attributes\*(C'\fR initializes the attributes
-\&\f(CW\*(C`f_dir\*(C'\fR, \f(CW\*(C`f_meta\*(C'\fR, \f(CW\*(C`f_meta_map\*(C'\fR, \f(CW\*(C`f_version\*(C'\fR.
-.Sp
-When the derived implementor class provides the attribute to validate
-attributes (e.g. \f(CW\*(C`$dbh\->{dbm_valid_attrs} = {...};\*(C'\fR) or the attribute
-containing the immutable attributes (e.g.
-\&\f(CW\*(C`$dbh\->{dbm_readonly_attrs} = {...};\*(C'\fR), the attributes
-\&\f(CW\*(C`drv_valid_attrs\*(C'\fR, \f(CW\*(C`drv_readonly_attrs\*(C'\fR, \f(CW\*(C`drv_version\*(C'\fR and \f(CW\*(C`drv_meta\*(C'\fR
-are added (when available) to the list of valid and immutable attributes
-(where \f(CW\*(C`drv_\*(C'\fR is interpreted as the driver prefix).
-.Sp
-If \f(CW\*(C`drv_meta\*(C'\fR is set, an attribute with the name in \f(CW\*(C`drv_meta\*(C'\fR is
-initialized providing restricted read/write access to the meta data of the
-tables using \f(CW\*(C`DBD::File::TieTables\*(C'\fR in the first (table) level and
-\&\f(CW\*(C`DBD::File::TieMeta\*(C'\fR for the meta attribute level. \f(CW\*(C`DBD::File::TieTables\*(C'\fR
-uses \f(CW\*(C`DBD::DRV::Table::get_table_meta\*(C'\fR to initialize the second level
-tied hash on \s-1FETCH/STORE.\s0 The \f(CW\*(C`DBD::File::TieMeta\*(C'\fR class uses
-\&\f(CW\*(C`DBD::DRV::Table::get_table_meta_attr\*(C'\fR to \s-1FETCH\s0 attribute values and
-\&\f(CW\*(C`DBD::DRV::Table::set_table_meta_attr\*(C'\fR to \s-1STORE\s0 attribute values. This
-allows it to map meta attributes for compatibility reasons.
-.IP "get_single_table_meta" 4
-.IX Item "get_single_table_meta"
-.PD 0
-.IP "get_file_meta" 4
-.IX Item "get_file_meta"
-.PD
-Retrieve an attribute from a table's meta information. The method
-signature is \f(CW\*(C`get_file_meta ($dbh, $table, $attr)\*(C'\fR. This method
-is called by the injected db handle method \f(CW\*(C`${drv_prefix}get_meta\*(C'\fR.
-.Sp
-While get_file_meta allows \f(CW$table\fR or \f(CW$attr\fR to be a list of tables or
-attributes to retrieve, get_single_table_meta allows only one table name
-and only one attribute name. A table name of \f(CW\*(Aq.\*(Aq\fR (single dot) is
-interpreted as the default table and this will retrieve the appropriate
-attribute globally from the dbh. This has the same restrictions as
-\&\f(CW\*(C`$dbh\->{$attrib}\*(C'\fR.
-.Sp
-get_file_meta allows \f(CW\*(Aq+\*(Aq\fR and \f(CW\*(Aq*\*(Aq\fR as wildcards for table names and
-\&\f(CW$table\fR being a regular expression matching against the table names
-(evaluated without the default table). The table name \f(CW\*(Aq*\*(Aq\fR is
-\&\fIall currently known tables, including the default one\fR. The table
-name \f(CW\*(Aq+\*(Aq\fR is \fIall table names which conform to
-\&\s-1ANSI\s0 file name restrictions\fR (/^[_A\-Za\-z0\-9]+$/).
-.Sp
-The table meta information is retrieved using the get_table_meta and
-get_table_meta_attr methods of the table class of the implementation.
-.IP "set_single_table_meta" 4
-.IX Item "set_single_table_meta"
-.PD 0
-.IP "set_file_meta" 4
-.IX Item "set_file_meta"
-.PD
-Sets an attribute in a table's meta information. The method signature is
-\&\f(CW\*(C`set_file_meta ($dbh, $table, $attr, $value)\*(C'\fR. This method is called
-by the injected db handle method \f(CW\*(C`${drv_prefix}set_meta\*(C'\fR.
-.Sp
-While set_file_meta allows \f(CW$table\fR to be a list of tables and \f(CW$attr\fR
-to be a hash of several attributes to set, set_single_table_meta allows
-only one table name and only one attribute name/value pair.
-.Sp
-The wildcard characters for the table name are the same as for
-get_file_meta.
-.Sp
-The table meta information is updated using the get_table_meta and
-set_table_meta_attr methods of the table class of the implementation.
-.IP "clear_file_meta" 4
-.IX Item "clear_file_meta"
-Clears all meta information cached about a table. The method signature is
-\&\f(CW\*(C`clear_file_meta ($dbh, $table)\*(C'\fR. This method is called
-by the injected db handle method \f(CW\*(C`${drv_prefix}clear_meta\*(C'\fR.
-.SS "DBD::File::st"
-.IX Subsection "DBD::File::st"
-Contains the methods to deal with prepared statement handles:
-.IP "\s-1FETCH\s0" 4
-.IX Item "FETCH"
-Fetches statement handle attributes. Supported attributes (for full overview
-see \*(L"Statement Handle Attributes\*(R" in \s-1DBI\s0) are \f(CW\*(C`NAME\*(C'\fR, \f(CW\*(C`TYPE\*(C'\fR, \f(CW\*(C`PRECISION\*(C'\fR
-and \f(CW\*(C`NULLABLE\*(C'\fR in case that SQL::Statement is used as \s-1SQL\s0 execution engine
-and a statement is successful prepared. When SQL::Statement has additional
-information about a table, those information are returned. Otherwise, the
-same defaults as in DBI::DBD::SqlEngine are used.
-.Sp
-This method usually requires extending in a derived implementation.
-See \s-1DBD::CSV\s0 or \s-1DBD::DBM\s0 for some example.
-.SS "DBD::File::TableSource::FileSystem"
-.IX Subsection "DBD::File::TableSource::FileSystem"
-Provides data sources and table information on database driver and database
-handle level.
-.PP
-.Vb 1
-\& package DBD::File::TableSource::FileSystem;
-\&
-\& sub data_sources ($;$)
-\& {
-\& my ($class, $drh, $attrs) = @_;
-\& ...
-\& }
-\&
-\& sub avail_tables
-\& {
-\& my ($class, $drh) = @_;
-\& ...
-\& }
-.Ve
-.PP
-The \f(CW\*(C`data_sources\*(C'\fR method is called when the user invokes any of the
-following:
-.PP
-.Vb 2
-\& @ary = DBI\->data_sources ($driver);
-\& @ary = DBI\->data_sources ($driver, \e%attr);
-\&
-\& @ary = $dbh\->data_sources ();
-\& @ary = $dbh\->data_sources (\e%attr);
-.Ve
-.PP
-The \f(CW\*(C`avail_tables\*(C'\fR method is called when the user invokes any of the
-following:
-.PP
-.Vb 1
-\& @names = $dbh\->tables ($catalog, $schema, $table, $type);
-\&
-\& $sth = $dbh\->table_info ($catalog, $schema, $table, $type);
-\& $sth = $dbh\->table_info ($catalog, $schema, $table, $type, \e%attr);
-\&
-\& $dbh\->func ("list_tables");
-.Ve
-.PP
-Every time where an \f(CW\*(C`\e%attr\*(C'\fR argument can be specified, this \f(CW\*(C`\e%attr\*(C'\fR
-object's \f(CW\*(C`sql_table_source\*(C'\fR attribute is preferred over the \f(CW$dbh\fR
-attribute or the driver default.
-.SS "DBD::File::DataSource::Stream"
-.IX Subsection "DBD::File::DataSource::Stream"
-.Vb 1
-\& package DBD::File::DataSource::Stream;
-\&
-\& @DBD::File::DataSource::Stream::ISA = \*(AqDBI::DBD::SqlEngine::DataSource\*(Aq;
-\&
-\& sub complete_table_name
-\& {
-\& my ($self, $meta, $file, $respect_case) = @_;
-\& ...
-\& }
-.Ve
-.PP
-Clears all meta attributes identifying a file: \f(CW\*(C`f_fqfn\*(C'\fR, \f(CW\*(C`f_fqbn\*(C'\fR and
-\&\f(CW\*(C`f_fqln\*(C'\fR. The table name is set according to \f(CW$respect_case\fR and
-\&\f(CW\*(C`$meta\->{sql_identifier_case}\*(C'\fR (\s-1SQL_IC_LOWER, SQL_IC_UPPER\s0).
-.PP
-.Vb 1
-\& package DBD::File::DataSource::Stream;
-\&
-\& sub apply_encoding
-\& {
-\& my ($self, $meta, $fn) = @_;
-\& ...
-\& }
-.Ve
-.PP
-Applies the encoding from \fImeta information\fR (\f(CW\*(C`$meta\->{f_encoding}\*(C'\fR)
-to the file handled opened in \f(CW\*(C`open_data\*(C'\fR.
-.PP
-.Vb 1
-\& package DBD::File::DataSource::Stream;
-\&
-\& sub open_data
-\& {
-\& my ($self, $meta, $attrs, $flags) = @_;
-\& ...
-\& }
-.Ve
-.PP
-Opens (\f(CW\*(C`dup (2)\*(C'\fR) the file handle provided in \f(CW\*(C`$meta\->{f_file}\*(C'\fR.
-.PP
-.Vb 1
-\& package DBD::File::DataSource::Stream;
-\&
-\& sub can_flock { ... }
-.Ve
-.PP
-Returns whether \f(CW\*(C`flock (2)\*(C'\fR is available or not (avoids retesting in
-subclasses).
-.SS "DBD::File::DataSource::File"
-.IX Subsection "DBD::File::DataSource::File"
-.Vb 1
-\& package DBD::File::DataSource::File;
-\&
-\& sub complete_table_name ($$;$)
-\& {
-\& my ($self, $meta, $table, $respect_case) = @_;
-\& ...
-\& }
-.Ve
-.PP
-The method \f(CW\*(C`complete_table_name\*(C'\fR tries to map a filename to the associated
-table name. It is called with a partially filled meta structure for the
-resulting table containing at least the following attributes:
-\&\f(CW\*(C`f_ext\*(C'\fR, \f(CW\*(C`f_dir\*(C'\fR, \f(CW\*(C`f_lockfile\*(C'\fR and \f(CW\*(C`sql_identifier_case\*(C'\fR.
-.PP
-If a file/table map can be found then this method sets the \f(CW\*(C`f_fqfn\*(C'\fR, \f(CW\*(C`f_fqbn\*(C'\fR, \f(CW\*(C`f_fqln\*(C'\fR and \f(CW\*(C`table_name\*(C'\fR attributes in
-the meta structure. If a map cannot be found the table name will be
-undef.
-.PP
-.Vb 1
-\& package DBD::File::DataSource::File;
-\&
-\& sub open_data ($)
-\& {
-\& my ($self, $meta, $attrs, $flags) = @_;
-\& ...
-\& }
-.Ve
-.PP
-Depending on the attributes set in the table's meta data, the
-following steps are performed. Unless \f(CW\*(C`f_dontopen\*(C'\fR is set to a
-true value, \f(CW\*(C`f_fqfn\*(C'\fR must contain the full qualified file name
-for the table to work on (file2table ensures this). The encoding in
-\&\f(CW\*(C`f_encoding\*(C'\fR is applied if set and the file is opened. If
-\&\f(CW\*(C`<f_fqln \*(C'\fR> (full qualified lock name) is set, this file is opened,
-too. Depending on the value in \f(CW\*(C`f_lock\*(C'\fR, the appropriate lock is
-set on the opened data file or lock file.
-.SS "DBD::File::Statement"
-.IX Subsection "DBD::File::Statement"
-Derives from DBI::SQL::Nano::Statement to provide following method:
-.IP "open_table" 4
-.IX Item "open_table"
-Implements the open_table method required by SQL::Statement and
-DBI::SQL::Nano. All the work for opening the file(s) belonging to the
-table is handled and parametrized in DBD::File::Table. Unless you intend
-to add anything to the following implementation, an empty DBD::XXX::Statement
-package satisfies DBD::File.
-.Sp
-.Vb 3
-\& sub open_table ($$$$$)
-\& {
-\& my ($self, $data, $table, $createMode, $lockMode) = @_;
-\&
-\& my $class = ref $self;
-\& $class =~ s/::Statement/::Table/;
-\&
-\& my $flags = {
-\& createMode => $createMode,
-\& lockMode => $lockMode,
-\& };
-\& $self\->{command} eq "DROP" and $flags\->{dropMode} = 1;
-\&
-\& return $class\->new ($data, { table => $table }, $flags);
-\& } # open_table
-.Ve
-.SS "DBD::File::Table"
-.IX Subsection "DBD::File::Table"
-Derives from DBI::SQL::Nano::Table and provides physical file access for
-the table data which are stored in the files.
-.IP "bootstrap_table_meta" 4
-.IX Item "bootstrap_table_meta"
-Initializes a table meta structure. Can be safely overridden in a
-derived class, as long as the \f(CW\*(C`SUPER\*(C'\fR method is called at the end
-of the overridden method.
-.Sp
-It copies the following attributes from the database into the table meta data
-\&\f(CW\*(C`f_dir\*(C'\fR, \f(CW\*(C`f_ext\*(C'\fR, \f(CW\*(C`f_encoding\*(C'\fR, \f(CW\*(C`f_lock\*(C'\fR, \f(CW\*(C`f_schema\*(C'\fR
-and \f(CW\*(C`f_lockfile\*(C'\fR and makes them sticky to the table.
-.Sp
-This method should be called before you attempt to map between file
-name and table name to ensure the correct directory, extension etc. are
-used.
-.IP "init_table_meta" 4
-.IX Item "init_table_meta"
-Initializes more attributes of the table meta data \- usually more
-expensive ones (e.g. those which require class instantiations) \- when
-the file name and the table name could mapped.
-.IP "get_table_meta" 4
-.IX Item "get_table_meta"
-Returns the table meta data. If there are none for the required
-table, a new one is initialized. When it fails, nothing is
-returned. On success, the name of the table and the meta data
-structure is returned.
-.IP "get_table_meta_attr" 4
-.IX Item "get_table_meta_attr"
-Returns a single attribute from the table meta data. If the attribute
-name appears in \f(CW%compat_map\fR, the attribute name is updated from
-there.
-.IP "set_table_meta_attr" 4
-.IX Item "set_table_meta_attr"
-Sets a single attribute in the table meta data. If the attribute
-name appears in \f(CW%compat_map\fR, the attribute name is updated from
-there.
-.IP "table_meta_attr_changed" 4
-.IX Item "table_meta_attr_changed"
-Called when an attribute of the meta data is modified.
-.Sp
-If the modified attribute requires to reset a calculated attribute, the
-calculated attribute is reset (deleted from meta data structure) and
-the \fIinitialized\fR flag is removed, too. The decision is made based on
-\&\f(CW%register_reset_on_modify\fR.
-.IP "register_reset_on_modify" 4
-.IX Item "register_reset_on_modify"
-Allows \f(CW\*(C`set_table_meta_attr\*(C'\fR to reset meta attributes when special
-attributes are modified. For DBD::File, modifying one of \f(CW\*(C`f_file\*(C'\fR, \f(CW\*(C`f_dir\*(C'\fR,
-\&\f(CW\*(C`f_ext\*(C'\fR or \f(CW\*(C`f_lockfile\*(C'\fR will reset \f(CW\*(C`f_fqfn\*(C'\fR. \s-1DBD::DBM\s0 extends the
-list for \f(CW\*(C`dbm_type\*(C'\fR and \f(CW\*(C`dbm_mldbm\*(C'\fR to reset the value of \f(CW\*(C`dbm_tietype\*(C'\fR.
-.Sp
-If your \s-1DBD\s0 has calculated values in the meta data area, then call
-\&\f(CW\*(C`register_reset_on_modify\*(C'\fR:
-.Sp
-.Vb 2
-\& my %reset_on_modify = (xxx_foo => "xxx_bar");
-\& _\|_PACKAGE_\|_\->register_reset_on_modify (\e%reset_on_modify);
-.Ve
-.IP "register_compat_map" 4
-.IX Item "register_compat_map"
-Allows \f(CW\*(C`get_table_meta_attr\*(C'\fR and \f(CW\*(C`set_table_meta_attr\*(C'\fR to update the
-attribute name to the current favored one:
-.Sp
-.Vb 3
-\& # from DBD::DBM
-\& my %compat_map = (dbm_ext => "f_ext");
-\& _\|_PACKAGE_\|_\->register_compat_map (\e%compat_map);
-.Ve
-.IP "open_file" 4
-.IX Item "open_file"
-Called to open the table's data file.
-.Sp
-Depending on the attributes set in the table's meta data, the
-following steps are performed. Unless \f(CW\*(C`f_dontopen\*(C'\fR is set to a
-true value, \f(CW\*(C`f_fqfn\*(C'\fR must contain the full qualified file name
-for the table to work on (file2table ensures this). The encoding in
-\&\f(CW\*(C`f_encoding\*(C'\fR is applied if set and the file is opened. If
-\&\f(CW\*(C`<f_fqln \*(C'\fR> (full qualified lock name) is set, this file is opened,
-too. Depending on the value in \f(CW\*(C`f_lock\*(C'\fR, the appropriate lock is
-set on the opened data file or lock file.
-.Sp
-After this is done, a derived class might add more steps in an overridden
-\&\f(CW\*(C`open_file\*(C'\fR method.
-.IP "new" 4
-.IX Item "new"
-Instantiates the table. This is done in 3 steps:
-.Sp
-.Vb 3
-\& 1. get the table meta data
-\& 2. open the data file
-\& 3. bless the table data structure using inherited constructor new
-.Ve
-.Sp
-It is not recommended to override the constructor of the table class.
-Find a reasonable place to add you extensions in one of the above four
-methods.
-.IP "drop" 4
-.IX Item "drop"
-Implements the abstract table method for the \f(CW\*(C`DROP\*(C'\fR
-command. Discards table meta data after all files belonging to the
-table are closed and unlinked.
-.Sp
-Overriding this method might be reasonable in very rare cases.
-.IP "seek" 4
-.IX Item "seek"
-Implements the abstract table method used when accessing the table from the
-engine. \f(CW\*(C`seek\*(C'\fR is called every time the engine uses dumb algorithms
-for iterating over the table content.
-.IP "truncate" 4
-.IX Item "truncate"
-Implements the abstract table method used when dumb table algorithms
-for \f(CW\*(C`UPDATE\*(C'\fR or \f(CW\*(C`DELETE\*(C'\fR need to truncate the table storage
-after the last written row.
-.PP
-You should consult the documentation of \f(CW\*(C`SQL::Eval::Table\*(C'\fR (see
-SQL::Eval) to get more information about the abstract methods of the
-table's base class you have to override and a description of the table
-meta information expected by the \s-1SQL\s0 engines.
-.SH "AUTHOR"
-.IX Header "AUTHOR"
-The module DBD::File is currently maintained by
-.PP
-H.Merijn Brand < h.m.brand at xs4all.nl > and
-Jens Rehsack < rehsack at googlemail.com >
-.PP
-The original author is Jochen Wiedmann.
-.SH "COPYRIGHT AND LICENSE"
-.IX Header "COPYRIGHT AND LICENSE"
-Copyright (C) 2010\-2013 by H.Merijn Brand & Jens Rehsack
-.PP
-All rights reserved.
-.PP
-You may freely distribute and/or modify this module under the terms of
-either the \s-1GNU\s0 General Public License (\s-1GPL\s0) or the Artistic License, as
-specified in the Perl \s-1README\s0 file.
+++ /dev/null
-.\" Automatically generated by Pod::Man 2.28 (Pod::Simple 3.29)
-.\"
-.\" Standard preamble:
-.\" ========================================================================
-.de Sp \" Vertical space (when we can't use .PP)
-.if t .sp .5v
-.if n .sp
-..
-.de Vb \" Begin verbatim text
-.ft CW
-.nf
-.ne \\$1
-..
-.de Ve \" End verbatim text
-.ft R
-.fi
-..
-.\" Set up some character translations and predefined strings. \*(-- will
-.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
-.\" double quote, and \*(R" will give a right double quote. \*(C+ will
-.\" give a nicer C++. Capital omega is used to do unbreakable dashes and
-.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff,
-.\" nothing in troff, for use with C<>.
-.tr \(*W-
-.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
-.ie n \{\
-. ds -- \(*W-
-. ds PI pi
-. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
-. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch
-. ds L" ""
-. ds R" ""
-. ds C` ""
-. ds C' ""
-'br\}
-.el\{\
-. ds -- \|\(em\|
-. ds PI \(*p
-. ds L" ``
-. ds R" ''
-. ds C`
-. ds C'
-'br\}
-.\"
-.\" Escape single quotes in literal strings from groff's Unicode transform.
-.ie \n(.g .ds Aq \(aq
-.el .ds Aq '
-.\"
-.\" If the F register is turned on, we'll generate index entries on stderr for
-.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
-.\" entries marked with X<> in POD. Of course, you'll have to process the
-.\" output yourself in some meaningful fashion.
-.\"
-.\" Avoid warning from groff about undefined register 'F'.
-.de IX
-..
-.nr rF 0
-.if \n(.g .if rF .nr rF 1
-.if (\n(rF:(\n(.g==0)) \{
-. if \nF \{
-. de IX
-. tm Index:\\$1\t\\n%\t"\\$2"
-..
-. if !\nF==2 \{
-. nr % 0
-. nr F 2
-. \}
-. \}
-.\}
-.rr rF
-.\" ========================================================================
-.\"
-.IX Title "DBD::File::HowTo 3pm"
-.TH DBD::File::HowTo 3pm "2013-04-04" "perl v5.22.1" "User Contributed Perl Documentation"
-.\" For nroff, turn off justification. Always turn off hyphenation; it makes
-.\" way too many mistakes in technical documents.
-.if n .ad l
-.nh
-.SH "NAME"
-DBD::File::HowTo \- Guide to create DBD::File based driver
-.SH "SYNOPSIS"
-.IX Header "SYNOPSIS"
-.Vb 12
-\& perldoc DBD::File::HowTo
-\& perldoc DBI
-\& perldoc DBI::DBD
-\& perldoc DBD::File::Developers
-\& perldoc DBI::DBD::SqlEngine::Developers
-\& perldoc DBI::DBD::SqlEngine
-\& perldoc SQL::Eval
-\& perldoc DBI::DBD::SqlEngine::HowTo
-\& perldoc SQL::Statement::Embed
-\& perldoc DBD::File
-\& perldoc DBD::File::HowTo
-\& perldoc DBD::File::Developers
-.Ve
-.SH "DESCRIPTION"
-.IX Header "DESCRIPTION"
-This document provides a step-by-step guide, how to create a new
-\&\f(CW\*(C`DBD::File\*(C'\fR based \s-1DBD.\s0 It expects that you carefully read the \s-1DBI\s0
-documentation and that you're familiar with \s-1DBI::DBD\s0 and had read and
-understood DBD::ExampleP.
-.PP
-This document addresses experienced developers who are really sure that
-they need to invest time when writing a new \s-1DBI\s0 Driver. Writing a \s-1DBI\s0
-Driver is neither a weekend project nor an easy job for hobby coders
-after work. Expect one or two man-month of time for the first start.
-.PP
-Those who are still reading, should be able to sing the rules of
-\&\*(L"\s-1CREATING A NEW DRIVER\*(R"\s0 in \s-1DBI::DBD\s0.
-.PP
-Of course, DBD::File is a DBI::DBD::SqlEngine and you surely read
-DBI::DBD::SqlEngine::HowTo before continuing here.
-.SH "CREATING DRIVER CLASSES"
-.IX Header "CREATING DRIVER CLASSES"
-Do you have an entry in \s-1DBI\s0's \s-1DBD\s0 registry? For this guide, a prefix of
-\&\f(CW\*(C`foo_\*(C'\fR is assumed.
-.SS "Sample Skeleton"
-.IX Subsection "Sample Skeleton"
-.Vb 1
-\& package DBD::Foo;
-\&
-\& use strict;
-\& use warnings;
-\& use vars qw(@ISA $VERSION);
-\& use base qw(DBD::File);
-\&
-\& use DBI ();
-\&
-\& $VERSION = "0.001";
-\&
-\& package DBD::Foo::dr;
-\&
-\& use vars qw(@ISA $imp_data_size);
-\&
-\& @ISA = qw(DBD::File::dr);
-\& $imp_data_size = 0;
-\&
-\& package DBD::Foo::db;
-\&
-\& use vars qw(@ISA $imp_data_size);
-\&
-\& @ISA = qw(DBD::File::db);
-\& $imp_data_size = 0;
-\&
-\& package DBD::Foo::st;
-\&
-\& use vars qw(@ISA $imp_data_size);
-\&
-\& @ISA = qw(DBD::File::st);
-\& $imp_data_size = 0;
-\&
-\& package DBD::Foo::Statement;
-\&
-\& use vars qw(@ISA);
-\&
-\& @ISA = qw(DBD::File::Statement);
-\&
-\& package DBD::Foo::Table;
-\&
-\& use vars qw(@ISA);
-\&
-\& @ISA = qw(DBD::File::Table);
-\&
-\& 1;
-.Ve
-.PP
-Tiny, eh? And all you have now is a \s-1DBD\s0 named foo which will is able to
-deal with temporary tables, as long as you use SQL::Statement. In
-DBI::SQL::Nano environments, this \s-1DBD\s0 can do nothing.
-.SS "Start over"
-.IX Subsection "Start over"
-Based on DBI::DBD::SqlEngine::HowTo, we're now having a driver which
-could do basic things. Of course, it should now derive from DBD::File
-instead of DBI::DBD::SqlEngine, shouldn't it?
-.PP
-DBD::File extends DBI::DBD::SqlEngine to deal with any kind of files.
-In principle, the only extensions required are to the table class:
-.PP
-.Vb 1
-\& package DBD::Foo::Table;
-\&
-\& sub bootstrap_table_meta
-\& {
-\& my ( $self, $dbh, $meta, $table ) = @_;
-\&
-\& # initialize all $meta attributes which might be relevant for
-\& # file2table
-\&
-\& return $self\->SUPER::bootstrap_table_meta($dbh, $meta, $table);
-\& }
-\&
-\& sub init_table_meta
-\& {
-\& my ( $self, $dbh, $meta, $table ) = @_;
-\&
-\& # called after $meta contains the results from file2table
-\& # initialize all missing $meta attributes
-\&
-\& $self\->SUPER::init_table_meta( $dbh, $meta, $table );
-\& }
-.Ve
-.PP
-In case \f(CW\*(C`DBD::File::Table::open_file\*(C'\fR doesn't open the files as the driver
-needs that, override it!
-.PP
-.Vb 7
-\& sub open_file
-\& {
-\& my ( $self, $meta, $attrs, $flags ) = @_;
-\& # ensure that $meta\->{f_dontopen} is set
-\& $self\->SUPER::open_file( $meta, $attrs, $flags );
-\& # now do what ever needs to be done
-\& }
-.Ve
-.PP
-Combined with the methods implemented using the SQL::Statement::Embed
-guide, the table is full working and you could try a start over.
-.SS "User comfort"
-.IX Subsection "User comfort"
-\&\f(CW\*(C`DBD::File\*(C'\fR since \f(CW0.39\fR consolidates all persistent meta data of a table
-into a single structure stored in \f(CW\*(C`$dbh\->{f_meta}\*(C'\fR. With \f(CW\*(C`DBD::File\*(C'\fR
-version \f(CW0.41\fR and \f(CW\*(C`DBI::DBD::SqlEngine\*(C'\fR version \f(CW0.05\fR, this
-consolidation moves to DBI::DBD::SqlEngine. It's still the
-\&\f(CW\*(C`$dbh\->{$drv_prefix . "_meta"}\*(C'\fR attribute which cares, so what you
-learned at this place before, is still valid.
-.PP
-.Vb 3
-\& sub init_valid_attributes
-\& {
-\& my $dbh = $_[0];
-\&
-\& $dbh\->SUPER::init_valid_attributes ();
-\&
-\& $dbh\->{foo_valid_attrs} = { ... };
-\& $dbh\->{foo_readonly_attrs} = { ... };
-\&
-\& $dbh\->{foo_meta} = "foo_tables";
-\&
-\& return $dbh;
-\& }
-.Ve
-.PP
-See updates at \*(L"User comfort\*(R" in DBI::DBD::SqlEngine::HowTo.
-.SS "Testing"
-.IX Subsection "Testing"
-Now you should have your own DBD::File based driver. Was easy, wasn't it?
-But does it work well? Prove it by writing tests and remember to use
-dbd_edit_mm_attribs from \s-1DBI::DBD\s0 to ensure testing even rare cases.
-.SH "AUTHOR"
-.IX Header "AUTHOR"
-This guide is written by Jens Rehsack. DBD::File is written by Jochen
-Wiedmann and Jeff Zucker.
-.PP
-The module DBD::File is currently maintained by
-.PP
-H.Merijn Brand < h.m.brand at xs4all.nl > and
-Jens Rehsack < rehsack at googlemail.com >
-.SH "COPYRIGHT AND LICENSE"
-.IX Header "COPYRIGHT AND LICENSE"
-Copyright (C) 2010 by H.Merijn Brand & Jens Rehsack
-.PP
-All rights reserved.
-.PP
-You may freely distribute and/or modify this module under the terms of
-either the \s-1GNU\s0 General Public License (\s-1GPL\s0) or the Artistic License, as
-specified in the Perl \s-1README\s0 file.
+++ /dev/null
-.\" Automatically generated by Pod::Man 2.28 (Pod::Simple 3.29)
-.\"
-.\" Standard preamble:
-.\" ========================================================================
-.de Sp \" Vertical space (when we can't use .PP)
-.if t .sp .5v
-.if n .sp
-..
-.de Vb \" Begin verbatim text
-.ft CW
-.nf
-.ne \\$1
-..
-.de Ve \" End verbatim text
-.ft R
-.fi
-..
-.\" Set up some character translations and predefined strings. \*(-- will
-.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
-.\" double quote, and \*(R" will give a right double quote. \*(C+ will
-.\" give a nicer C++. Capital omega is used to do unbreakable dashes and
-.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff,
-.\" nothing in troff, for use with C<>.
-.tr \(*W-
-.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
-.ie n \{\
-. ds -- \(*W-
-. ds PI pi
-. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
-. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch
-. ds L" ""
-. ds R" ""
-. ds C` ""
-. ds C' ""
-'br\}
-.el\{\
-. ds -- \|\(em\|
-. ds PI \(*p
-. ds L" ``
-. ds R" ''
-. ds C`
-. ds C'
-'br\}
-.\"
-.\" Escape single quotes in literal strings from groff's Unicode transform.
-.ie \n(.g .ds Aq \(aq
-.el .ds Aq '
-.\"
-.\" If the F register is turned on, we'll generate index entries on stderr for
-.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
-.\" entries marked with X<> in POD. Of course, you'll have to process the
-.\" output yourself in some meaningful fashion.
-.\"
-.\" Avoid warning from groff about undefined register 'F'.
-.de IX
-..
-.nr rF 0
-.if \n(.g .if rF .nr rF 1
-.if (\n(rF:(\n(.g==0)) \{
-. if \nF \{
-. de IX
-. tm Index:\\$1\t\\n%\t"\\$2"
-..
-. if !\nF==2 \{
-. nr % 0
-. nr F 2
-. \}
-. \}
-.\}
-.rr rF
-.\" ========================================================================
-.\"
-.IX Title "DBD::File::Roadmap 3pm"
-.TH DBD::File::Roadmap 3pm "2013-04-04" "perl v5.22.1" "User Contributed Perl Documentation"
-.\" For nroff, turn off justification. Always turn off hyphenation; it makes
-.\" way too many mistakes in technical documents.
-.if n .ad l
-.nh
-.SH "NAME"
-DBD::File::Roadmap \- Planned Enhancements for DBD::File and pure Perl DBD's
-.PP
-Jens Rehsack \- May 2010
-.SH "SYNOPSIS"
-.IX Header "SYNOPSIS"
-This document gives a high level overview of the future of the DBD::File \s-1DBI\s0
-driver and groundwork for pure Perl \s-1DBI\s0 drivers.
-.PP
-The planned enhancements cover features, testing, performance, reliability,
-extensibility and more.
-.SH "CHANGES AND ENHANCEMENTS"
-.IX Header "CHANGES AND ENHANCEMENTS"
-.SS "Features"
-.IX Subsection "Features"
-There are some features missing we would like to add, but there is
-no time plan:
-.IP "\s-1LOCK TABLE\s0" 4
-.IX Item "LOCK TABLE"
-The newly implemented internal common table meta storage area would allow
-us to implement \s-1LOCK TABLE\s0 support based on file system \f(CW\*(C`flock ()\*(C'\fR
-support.
-.IP "Transaction support" 4
-.IX Item "Transaction support"
-While DBD::AnyData recommends explicitly committing by importing and
-exporting tables, DBD::File might be enhanced in a future version to allow
-transparent transactions using the temporary tables of SQL::Statement as
-shadow (dirty) tables.
-.Sp
-Transaction support will heavily rely on lock table support.
-.IP "Data Dictionary Persistence" 4
-.IX Item "Data Dictionary Persistence"
-SQL::Statement provides dictionary information when a \*(L"\s-1CREATE TABLE ...\*(R"\s0
-statement is executed. This dictionary is preserved for some statement
-handle attribute fetches (as \f(CW\*(C`NULLABLE\*(C'\fR or \f(CW\*(C`PRECISION\*(C'\fR).
-.Sp
-It is planned to extend DBD::File to support data dictionaries to work
-on the tables in it. It is not planned to support one table in different
-dictionaries, but you can have several dictionaries in one directory.
-.IP "\s-1SQL\s0 Engine selecting on connect" 4
-.IX Item "SQL Engine selecting on connect"
-Currently the \s-1SQL\s0 engine selected is chosen during the loading of the module
-DBI::SQL::Nano. Ideally end users should be able to select the engine
-used in \f(CW\*(C`DBI\->connect ()\*(C'\fR with a special DBD::File attribute.
-.PP
-Other points of view to the planned features (and more features for the
-SQL::Statement engine) are shown in SQL::Statement::Roadmap.
-.SS "Testing"
-.IX Subsection "Testing"
-DBD::File and the dependent \s-1DBD::DBM\s0 requires a lot more automated tests
-covering \s-1API\s0 stability and compatibility with optional modules
-like SQL::Statement.
-.SS "Performance"
-.IX Subsection "Performance"
-Several arguments for support of features like indexes on columns
-and cursors are made for \s-1DBD::CSV \s0(which is a DBD::File based driver,
-too). Similar arguments could be made for \s-1DBD::DBM,\s0 DBD::AnyData,
-\&\s-1DBD::RAM\s0 or \s-1DBD::PO\s0 etc.
-.PP
-To improve the performance of the underlying \s-1SQL\s0 engines, a clean
-re-implementation seems to be required. Currently both engines are
-prematurely optimized and therefore it is not trivial to provide
-further optimization without the risk of breaking existing features.
-.PP
-Join the \s-1DBI\s0 developers \s-1IRC\s0 channel at <irc://irc.perl.org/dbi> to
-participate or post to the \s-1DBI\s0 Developers Mailing List.
-.SS "Reliability"
-.IX Subsection "Reliability"
-DBD::File currently lacks the following points:
-.IP "duplicate table names" 4
-.IX Item "duplicate table names"
-It is currently possible to access a table quoted with a relative path
-(a) and additionally using an absolute path (b). If (a) and (b) are
-the same file that is not recognized (except for
-flock protection handled by the Operating System) and two independent
-tables are handled.
-.IP "invalid table names" 4
-.IX Item "invalid table names"
-The current implementation does not prevent someone choosing a
-directory name as a physical file name for the table to open.
-.SS "Extensibility"
-.IX Subsection "Extensibility"
-I (Jens Rehsack) have some (partially for example only) \s-1DBD\s0's in mind:
-.IP "DBD::Sys" 4
-.IX Item "DBD::Sys"
-Derive DBD::Sys from a common code base shared with DBD::File which handles
-all the emulation \s-1DBI\s0 needs (as getinfo, \s-1SQL\s0 engine handling, ...)
-.IP "DBD::Dir" 4
-.IX Item "DBD::Dir"
-Provide a DBD::File derived to work with fixed table definitions through the
-file system to demonstrate how \s-1DBI /\s0 Pure Perl DBDs could handle databases
-with hierarchical structures.
-.IP "DBD::Join" 4
-.IX Item "DBD::Join"
-Provide a \s-1DBI\s0 driver which is able to manage multiple connections to other
-Databases (as DBD::Multiplex), but allow them to point to different data
-sources and allow joins between the tables of them:
-.Sp
-.Vb 6
-\& # Example
-\& # Let table \*(Aqlsof\*(Aq being a table in DBD::Sys giving a list of open files using lsof utility
-\& # Let table \*(Aqdir\*(Aq being a atable from DBD::Dir
-\& $sth = $dbh\->prepare( "select * from dir,lsof where path=\*(Aq/documents\*(Aq and dir.entry = lsof.filename" )
-\& $sth\->execute(); # gives all open files in \*(Aq/documents\*(Aq
-\& ...
-\&
-\& # Let table \*(Aqfilesys\*(Aq a DBD::Sys table of known file systems on current host
-\& # Let table \*(Aqapplications\*(Aq a table of your Configuration Management Database
-\& # where current applications (relocatable, with mountpoints for filesystems)
-\& # are stored
-\& $sth = dbh\->prepare( "select * from applications,filesys where " .
-\& "application.mountpoint = filesys.mountpoint and ".
-\& "filesys.mounted is true" );
-\& $sth\->execute(); # gives all currently mounted applications on this host
-.Ve
-.SH "PRIORITIES"
-.IX Header "PRIORITIES"
-Our priorities are focused on current issues. Initially many new test
-cases for DBD::File and \s-1DBD::DBM\s0 should be added to the \s-1DBI\s0 test
-suite. After that some additional documentation on how to use the
-DBD::File \s-1API\s0 will be provided.
-.PP
-Any additional priorities will come later and can be modified by (paying)
-users.
-.SH "RESOURCES AND CONTRIBUTIONS"
-.IX Header "RESOURCES AND CONTRIBUTIONS"
-See <http://dbi.perl.org/contributing> for \fIhow you can help\fR.
-.PP
-If your company has benefited from \s-1DBI,\s0 please consider if
-it could make a donation to The Perl Foundation \*(L"\s-1DBI\s0 Development\*(R"
-fund at <http://dbi.perl.org/donate> to secure future development.
-.PP
-Alternatively, if your company would benefit from a specific new
-\&\s-1DBI\s0 feature, please consider sponsoring it's development through
-the options listed in the section \*(L"Commercial Support from the Author\*(R"
-on <http://dbi.perl.org/support/>.
-.PP
-Using such targeted financing allows you to contribute to \s-1DBI\s0
-development and rapidly get something specific and directly valuable
-to you in return.
-.PP
-My company also offers annual support contracts for the \s-1DBI,\s0 which
-provide another way to support the \s-1DBI\s0 and get something specific
-in return. Contact me for details.
-.PP
-Thank you.
+++ /dev/null
-.\" Automatically generated by Pod::Man 2.28 (Pod::Simple 3.29)
-.\"
-.\" Standard preamble:
-.\" ========================================================================
-.de Sp \" Vertical space (when we can't use .PP)
-.if t .sp .5v
-.if n .sp
-..
-.de Vb \" Begin verbatim text
-.ft CW
-.nf
-.ne \\$1
-..
-.de Ve \" End verbatim text
-.ft R
-.fi
-..
-.\" Set up some character translations and predefined strings. \*(-- will
-.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
-.\" double quote, and \*(R" will give a right double quote. \*(C+ will
-.\" give a nicer C++. Capital omega is used to do unbreakable dashes and
-.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff,
-.\" nothing in troff, for use with C<>.
-.tr \(*W-
-.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
-.ie n \{\
-. ds -- \(*W-
-. ds PI pi
-. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
-. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch
-. ds L" ""
-. ds R" ""
-. ds C` ""
-. ds C' ""
-'br\}
-.el\{\
-. ds -- \|\(em\|
-. ds PI \(*p
-. ds L" ``
-. ds R" ''
-. ds C`
-. ds C'
-'br\}
-.\"
-.\" Escape single quotes in literal strings from groff's Unicode transform.
-.ie \n(.g .ds Aq \(aq
-.el .ds Aq '
-.\"
-.\" If the F register is turned on, we'll generate index entries on stderr for
-.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
-.\" entries marked with X<> in POD. Of course, you'll have to process the
-.\" output yourself in some meaningful fashion.
-.\"
-.\" Avoid warning from groff about undefined register 'F'.
-.de IX
-..
-.nr rF 0
-.if \n(.g .if rF .nr rF 1
-.if (\n(rF:(\n(.g==0)) \{
-. if \nF \{
-. de IX
-. tm Index:\\$1\t\\n%\t"\\$2"
-..
-. if !\nF==2 \{
-. nr % 0
-. nr F 2
-. \}
-. \}
-.\}
-.rr rF
-.\" ========================================================================
-.\"
-.IX Title "DBD::Gofer 3pm"
-.TH DBD::Gofer 3pm "2014-02-05" "perl v5.22.1" "User Contributed Perl Documentation"
-.\" For nroff, turn off justification. Always turn off hyphenation; it makes
-.\" way too many mistakes in technical documents.
-.if n .ad l
-.nh
-.SH "NAME"
-DBD::Gofer \- A stateless\-proxy driver for communicating with a remote DBI
-.SH "SYNOPSIS"
-.IX Header "SYNOPSIS"
-.Vb 1
-\& use DBI;
-\&
-\& $original_dsn = "dbi:..."; # your original DBI Data Source Name
-\&
-\& $dbh = DBI\->connect("dbi:Gofer:transport=$transport;...;dsn=$original_dsn",
-\& $user, $passwd, \e%attributes);
-\&
-\& ... use $dbh as if it was connected to $original_dsn ...
-.Ve
-.PP
-The \f(CW\*(C`transport=$transport\*(C'\fR part specifies the name of the module to use to
-transport the requests to the remote \s-1DBI.\s0 If \f(CW$transport\fR doesn't contain any
-double colons then it's prefixed with \f(CW\*(C`DBD::Gofer::Transport::\*(C'\fR.
-.PP
-The \f(CW\*(C`dsn=$original_dsn\*(C'\fR part \fImust be the last element\fR of the \s-1DSN\s0 because
-everything after \f(CW\*(C`dsn=\*(C'\fR is assumed to be the \s-1DSN\s0 that the remote \s-1DBI\s0 should
-use.
-.PP
-The \f(CW\*(C`...\*(C'\fR represents attributes that influence the operation of the Gofer
-driver or transport. These are described below or in the documentation of the
-transport module being used.
-.SH "DESCRIPTION"
-.IX Header "DESCRIPTION"
-DBD::Gofer is a \s-1DBI\s0 database driver that forwards requests to another \s-1DBI\s0
-driver, usually in a separate process, often on a separate machine. It tries to
-be as transparent as possible so it appears that you are using the remote
-driver directly.
-.PP
-DBD::Gofer is very similar to DBD::Proxy. The major difference is that with
-DBD::Gofer no state is maintained on the remote end. That means every
-request contains all the information needed to create the required state. (So,
-for example, every request includes the \s-1DSN\s0 to connect to.) Each request can be
-sent to any available server. The server executes the request and returns a
-single response that includes all the data.
-.PP
-This is very similar to the way http works as a stateless protocol for the web.
-Each request from your web browser can be handled by a different web server process.
-.SS "Use Cases"
-.IX Subsection "Use Cases"
-This may seem like pointless overhead but there are situations where this is a
-very good thing. Let's consider a specific case.
-.PP
-Imagine using DBD::Gofer with an http transport. Your application calls
-\&\fIconnect()\fR, prepare(\*(L"select * from table where foo=?\*(R"), \fIbind_param()\fR, and \fIexecute()\fR.
-At this point DBD::Gofer builds a request containing all the information
-about the method calls. It then uses the httpd transport to send that request
-to an apache web server.
-.PP
-This 'dbi execute' web server executes the request (using DBI::Gofer::Execute
-and related modules) and builds a response that contains all the rows of data,
-if the statement returned any, along with all the attributes that describe the
-results, such as \f(CW$sth\fR\->{\s-1NAME\s0}. This response is sent back to DBD::Gofer which
-unpacks it and presents it to the application as if it had executed the
-statement itself.
-.SS "Advantages"
-.IX Subsection "Advantages"
-Okay, but you still don't see the point? Well let's consider what we've gained:
-.PP
-\fIConnection Pooling and Throttling\fR
-.IX Subsection "Connection Pooling and Throttling"
-.PP
-The 'dbi execute' web server leverages all the functionality of web
-infrastructure in terms of load balancing, high-availability, firewalls, access
-management, proxying, caching.
-.PP
-At its most basic level you get a configurable pool of persistent database connections.
-.PP
-\fISimple Scaling\fR
-.IX Subsection "Simple Scaling"
-.PP
-Got thousands of processes all trying to connect to the database? You can use
-DBD::Gofer to connect them to your smaller pool of 'dbi execute' web servers instead.
-.PP
-\fICaching\fR
-.IX Subsection "Caching"
-.PP
-Client-side caching is as simple as adding "\f(CW\*(C`cache=1\*(C'\fR" to the \s-1DSN.\s0
-This feature alone can be worth using DBD::Gofer for.
-.PP
-\fIFewer Network Round-trips\fR
-.IX Subsection "Fewer Network Round-trips"
-.PP
-DBD::Gofer sends as few requests as possible (dependent on the policy being used).
-.PP
-\fIThin Clients / Unsupported Platforms\fR
-.IX Subsection "Thin Clients / Unsupported Platforms"
-.PP
-You no longer need drivers for your database on every system. DBD::Gofer is pure perl.
-.SH "CONSTRAINTS"
-.IX Header "CONSTRAINTS"
-There are some natural constraints imposed by the DBD::Gofer 'stateless' approach.
-But not many:
-.SS "You can't change database handle attributes after \fIconnect()\fP"
-.IX Subsection "You can't change database handle attributes after connect()"
-You can't change database handle attributes after you've connected.
-Use the \fIconnect()\fR call to specify all the attribute settings you want.
-.PP
-This is because it's critical that when a request is complete the database
-handle is left in the same state it was when first connected.
-.PP
-An exception is made for attributes with names starting "\f(CW\*(C`private_\*(C'\fR":
-They can be set after \fIconnect()\fR but the change is only applied locally.
-.SS "You can't change statement handle attributes after \fIprepare()\fP"
-.IX Subsection "You can't change statement handle attributes after prepare()"
-You can't change statement handle attributes after prepare.
-.PP
-An exception is made for attributes with names starting "\f(CW\*(C`private_\*(C'\fR":
-They can be set after \fIprepare()\fR but the change is only applied locally.
-.SS "You can't use transactions"
-.IX Subsection "You can't use transactions"
-AutoCommit only. Transactions aren't supported.
-.PP
-(In theory transactions could be supported when using a transport that
-maintains a connection, like \f(CW\*(C`stream\*(C'\fR does. If you're interested in this
-please get in touch via dbi\-dev@perl.org)
-.SS "You can't call driver-private sth methods"
-.IX Subsection "You can't call driver-private sth methods"
-But that's rarely needed anyway.
-.SH "GENERAL CAVEATS"
-.IX Header "GENERAL CAVEATS"
-A few important things to keep in mind when using DBD::Gofer:
-.SS "Temporary tables, locks, and other per-connection persistent state"
-.IX Subsection "Temporary tables, locks, and other per-connection persistent state"
-You shouldn't expect any per-session state to persist between requests.
-This includes locks and temporary tables.
-.PP
-Because the server-side may execute your requests via a different
-database connections, you can't rely on any per-connection persistent state,
-such as temporary tables, being available from one request to the next.
-.PP
-This is an easy trap to fall into. A good way to check for this is to test your
-code with a Gofer policy package that sets the \f(CW\*(C`connect_method\*(C'\fR policy to
-\&'connect' to force a new connection for each request. The \f(CW\*(C`pedantic\*(C'\fR policy does this.
-.SS "Driver-private Database Handle Attributes"
-.IX Subsection "Driver-private Database Handle Attributes"
-Some driver-private dbh attributes may not be available if the driver has not
-implemented the \fIprivate_attribute_info()\fR method (added in \s-1DBI 1.54\s0).
-.SS "Driver-private Statement Handle Attributes"
-.IX Subsection "Driver-private Statement Handle Attributes"
-Driver-private sth attributes can be set in the \fIprepare()\fR call. \s-1TODO\s0
-.PP
-Some driver-private sth attributes may not be available if the driver has not
-implemented the \fIprivate_attribute_info()\fR method (added in \s-1DBI 1.54\s0).
-.SS "Multiple Resultsets"
-.IX Subsection "Multiple Resultsets"
-Multiple resultsets are supported only if the driver supports the \fImore_results()\fR method
-(an exception is made for DBD::Sybase).
-.SS "Statement activity that also updates dbh attributes"
-.IX Subsection "Statement activity that also updates dbh attributes"
-Some drivers may update one or more dbh attributes after performing activity on
-a child sth. For example, DBD::mysql provides \f(CW$dbh\fR\->{mysql_insertid} in addition to
-\&\f(CW$sth\fR\->{mysql_insertid}. Currently mysql_insertid is supported via a hack but a
-more general mechanism is needed for other drivers to use.
-.SS "Methods that report an error always return undef"
-.IX Subsection "Methods that report an error always return undef"
-With DBD::Gofer, a method that sets an error always return an undef or empty list.
-That shouldn't be a problem in practice because the \s-1DBI\s0 doesn't define any
-methods that return meaningful values while also reporting an error.
-.SS "Subclassing only applies to client-side"
-.IX Subsection "Subclassing only applies to client-side"
-The RootClass and DbTypeSubclass attributes are not passed to the Gofer server.
-.SH "CAVEATS FOR SPECIFIC METHODS"
-.IX Header "CAVEATS FOR SPECIFIC METHODS"
-.SS "last_insert_id"
-.IX Subsection "last_insert_id"
-To enable use of last_insert_id you need to indicate to DBD::Gofer that you'd
-like to use it. You do that my adding a \f(CW\*(C`go_last_insert_id_args\*(C'\fR attribute to
-the \fIdo()\fR or \fIprepare()\fR method calls. For example:
-.PP
-.Vb 1
-\& $dbh\->do($sql, { go_last_insert_id_args => [...] });
-.Ve
-.PP
-or
-.PP
-.Vb 1
-\& $sth = $dbh\->prepare($sql, { go_last_insert_id_args => [...] });
-.Ve
-.PP
-The array reference should contains the args that you want passed to the
-\&\fIlast_insert_id()\fR method.
-.SS "execute_for_fetch"
-.IX Subsection "execute_for_fetch"
-The array methods \fIbind_param_array()\fR and \fIexecute_array()\fR are supported.
-When \fIexecute_array()\fR is called the data is serialized and executed in a single
-round-trip to the Gofer server. This makes it very fast, but requires enough
-memory to store all the serialized data.
-.PP
-The \fIexecute_for_fetch()\fR method currently isn't optimised, it uses the \s-1DBI\s0
-fallback behaviour of executing each tuple individually.
-(It could be implemented as a wrapper for \fIexecute_array()\fR \- patches welcome.)
-.SH "TRANSPORTS"
-.IX Header "TRANSPORTS"
-DBD::Gofer doesn't concern itself with transporting requests and responses to and fro.
-For that it uses special Gofer transport modules.
-.PP
-Gofer transport modules usually come in pairs: one for the 'client' DBD::Gofer
-driver to use and one for the remote 'server' end. They have very similar names:
-.PP
-.Vb 2
-\& DBD::Gofer::Transport::<foo>
-\& DBI::Gofer::Transport::<foo>
-.Ve
-.PP
-Sometimes the transports on the \s-1DBD\s0 and \s-1DBI\s0 sides may have different names. For
-example DBD::Gofer::Transport::http is typically used with DBI::Gofer::Transport::mod_perl
-(DBD::Gofer::Transport::http and DBI::Gofer::Transport::mod_perl modules are
-part of the GoferTransport-http distribution).
-.SS "Bundled Transports"
-.IX Subsection "Bundled Transports"
-Several transport modules are provided with DBD::Gofer:
-.PP
-\fInull\fR
-.IX Subsection "null"
-.PP
-The null transport is the simplest of them all. It doesn't actually transport the request anywhere.
-It just serializes (freezes) the request into a string, then thaws it back into
-a data structure before passing it to DBI::Gofer::Execute to execute. The same
-freeze and thaw is applied to the results.
-.PP
-The null transport is the best way to test if your application will work with Gofer.
-Just set the \s-1DBI_AUTOPROXY\s0 environment variable to "\f(CW\*(C`dbi:Gofer:transport=null;policy=pedantic\*(C'\fR"
-(see \*(L"Using \s-1DBI_AUTOPROXY\*(R"\s0 below) and run your application, or ideally its test suite, as usual.
-.PP
-It doesn't take any parameters.
-.PP
-\fIpipeone\fR
-.IX Subsection "pipeone"
-.PP
-The pipeone transport launches a subprocess for each request. It passes in the
-request and reads the response.
-.PP
-The fact that a new subprocess is started for each request ensures that the
-server side is truly stateless. While this does make the transport \fIvery\fR slow,
-it is useful as a way to test that your application doesn't depend on
-per-connection state, such as temporary tables, persisting between requests.
-.PP
-It's also useful both as a proof of concept and as a base class for the stream
-driver.
-.PP
-\fIstream\fR
-.IX Subsection "stream"
-.PP
-The stream driver also launches a subprocess and writes requests and reads
-responses, like the pipeone transport. In this case, however, the subprocess
-is expected to handle more that one request. (Though it will be automatically
-restarted if it exits.)
-.PP
-This is the first transport that is truly useful because it can launch the
-subprocess on a remote machine using \f(CW\*(C`ssh\*(C'\fR. This means you can now use DBD::Gofer
-to easily access any databases that's accessible from any system you can login to.
-You also get all the benefits of ssh, including encryption and optional compression.
-.PP
-See \*(L"Using \s-1DBI_AUTOPROXY\*(R"\s0 below for an example.
-.SS "Other Transports"
-.IX Subsection "Other Transports"
-Implementing a Gofer transport is \fIvery\fR simple, and more transports are very welcome.
-Just take a look at any existing transports that are similar to your needs.
-.PP
-\fIhttp\fR
-.IX Subsection "http"
-.PP
-See the GoferTransport-http distribution on \s-1CPAN:\s0 http://search.cpan.org/dist/GoferTransport\-http/
-.PP
-\fIGearman\fR
-.IX Subsection "Gearman"
-.PP
-I know Ask Bjørn Hansen has implemented a transport for the \f(CW\*(C`gearman\*(C'\fR distributed
-job system, though it's not on \s-1CPAN\s0 at the time of writing this.
-.SH "CONNECTING"
-.IX Header "CONNECTING"
-Simply prefix your existing \s-1DSN\s0 with "\f(CW\*(C`dbi:Gofer:transport=$transport;dsn=\*(C'\fR"
-where \f(CW$transport\fR is the name of the Gofer transport you want to use (see \*(L"\s-1TRANSPORTS\*(R"\s0).
-The \f(CW\*(C`transport\*(C'\fR and \f(CW\*(C`dsn\*(C'\fR attributes must be specified and the \f(CW\*(C`dsn\*(C'\fR attributes must be last.
-.PP
-Other attributes can be specified in the \s-1DSN\s0 to configure DBD::Gofer and/or the
-Gofer transport module being used. The main attributes after \f(CW\*(C`transport\*(C'\fR, are
-\&\f(CW\*(C`url\*(C'\fR and \f(CW\*(C`policy\*(C'\fR. These and other attributes are described below.
-.SS "Using \s-1DBI_AUTOPROXY\s0"
-.IX Subsection "Using DBI_AUTOPROXY"
-The simplest way to try out DBD::Gofer is to set the \s-1DBI_AUTOPROXY\s0 environment variable.
-In this case you don't include the \f(CW\*(C`dsn=\*(C'\fR part. For example:
-.PP
-.Vb 1
-\& export DBI_AUTOPROXY="dbi:Gofer:transport=null"
-.Ve
-.PP
-or, for a more useful example, try:
-.PP
-.Vb 1
-\& export DBI_AUTOPROXY="dbi:Gofer:transport=stream;url=ssh:user@example.com"
-.Ve
-.SS "Connection Attributes"
-.IX Subsection "Connection Attributes"
-These attributes can be specified in the \s-1DSN.\s0 They can also be passed in the
-\&\e%attr parameter of the \s-1DBI\s0 connect method by adding a "\f(CW\*(C`go_\*(C'\fR" prefix to the name.
-.PP
-\fItransport\fR
-.IX Subsection "transport"
-.PP
-Specifies the Gofer transport class to use. Required. See \*(L"\s-1TRANSPORTS\*(R"\s0 above.
-.PP
-If the value does not include \f(CW\*(C`::\*(C'\fR then "\f(CW\*(C`DBD::Gofer::Transport::\*(C'\fR" is prefixed.
-.PP
-The transport object can be accessed via \f(CW$h\fR\->{go_transport}.
-.PP
-\fIdsn\fR
-.IX Subsection "dsn"
-.PP
-Specifies the \s-1DSN\s0 for the remote side to connect to. Required, and must be last.
-.PP
-\fIurl\fR
-.IX Subsection "url"
-.PP
-Used to tell the transport where to connect to. The exact form of the value depends on the transport used.
-.PP
-\fIpolicy\fR
-.IX Subsection "policy"
-.PP
-Specifies the policy to use. See \*(L"\s-1CONFIGURING BEHAVIOUR POLICY\*(R"\s0.
-.PP
-If the value does not include \f(CW\*(C`::\*(C'\fR then "\f(CW\*(C`DBD::Gofer::Policy\*(C'\fR" is prefixed.
-.PP
-The policy object can be accessed via \f(CW$h\fR\->{go_policy}.
-.PP
-\fItimeout\fR
-.IX Subsection "timeout"
-.PP
-Specifies a timeout, in seconds, to use when waiting for responses from the server side.
-.PP
-\fIretry_limit\fR
-.IX Subsection "retry_limit"
-.PP
-Specifies the number of times a failed request will be retried. Default is 0.
-.PP
-\fIretry_hook\fR
-.IX Subsection "retry_hook"
-.PP
-Specifies a code reference to be called to decide if a failed request should be retried.
-The code reference is called like this:
-.PP
-.Vb 2
-\& $transport = $h\->{go_transport};
-\& $retry = $transport\->go_retry_hook\->($request, $response, $transport);
-.Ve
-.PP
-If it returns true then the request will be retried, up to the \f(CW\*(C`retry_limit\*(C'\fR.
-If it returns a false but defined value then the request will not be retried.
-If it returns undef then the default behaviour will be used, as if \f(CW\*(C`retry_hook\*(C'\fR
-had not been specified.
-.PP
-The default behaviour is to retry requests where \f(CW$request\fR\->is_idempotent is true,
-or the error message matches \f(CW\*(C`/induced by DBI_GOFER_RANDOM/\*(C'\fR.
-.PP
-\fIcache\fR
-.IX Subsection "cache"
-.PP
-Specifies that client-side caching should be performed. The value is the name
-of a cache class to use.
-.PP
-Any class implementing get($key) and set($key, \f(CW$value\fR) methods can be used.
-That includes a great many powerful caching classes on \s-1CPAN,\s0 including the
-Cache and Cache::Cache distributions.
-.PP
-You can use "\f(CW\*(C`cache=1\*(C'\fR\*(L" is a shortcut for \*(R"\f(CW\*(C`cache=DBI::Util::CacheMemory\*(C'\fR".
-See DBI::Util::CacheMemory for a description of this simple fast default cache.
-.PP
-The cache object can be accessed via \f(CW$h\fR\->go_cache. For example:
-.PP
-.Vb 1
-\& $dbh\->go_cache\->clear; # free up memory being used by the cache
-.Ve
-.PP
-The cache keys are the frozen (serialized) requests, and the values are the
-frozen responses.
-.PP
-The default behaviour is to only use the cache for requests where
-\&\f(CW$request\fR\->is_idempotent is true (i.e., the dbh has the ReadOnly attribute set
-or the \s-1SQL\s0 statement is obviously a \s-1SELECT\s0 without a \s-1FOR UPDATE\s0 clause.)
-.PP
-For even more control you can use the \f(CW\*(C`go_cache\*(C'\fR attribute to pass in an
-instantiated cache object. Individual methods, including \fIprepare()\fR, can also
-specify alternative caches via the \f(CW\*(C`go_cache\*(C'\fR attribute. For example, to
-specify no caching for a particular query, you could use
-.PP
-.Vb 1
-\& $sth = $dbh\->prepare( $sql, { go_cache => 0 } );
-.Ve
-.PP
-This can be used to implement different caching policies for different statements.
-.PP
-It's interesting to note that DBD::Gofer can be used to add client-side caching
-to any (gofer compatible) application, with no code changes and no need for a
-gofer server. Just set the \s-1DBI_AUTOPROXY\s0 environment variable like this:
-.PP
-.Vb 1
-\& DBI_AUTOPROXY=\*(Aqdbi:Gofer:transport=null;cache=1\*(Aq
-.Ve
-.SH "CONFIGURING BEHAVIOUR POLICY"
-.IX Header "CONFIGURING BEHAVIOUR POLICY"
-DBD::Gofer supports a 'policy' mechanism that allows you to fine-tune the number of round-trips to the Gofer server.
-The policies are grouped into classes (which may be subclassed) and referenced by the name of the class.
-.PP
-The DBD::Gofer::Policy::Base class is the base class for all the policy
-packages and describes all the available policies.
-.PP
-Three policy packages are supplied with DBD::Gofer:
-.PP
-DBD::Gofer::Policy::pedantic is most 'transparent' but slowest because it
-makes more round-trips to the Gofer server.
-.PP
-DBD::Gofer::Policy::classic is a reasonable compromise \- it's the default policy.
-.PP
-DBD::Gofer::Policy::rush is fastest, but may require code changes in your applications.
-.PP
-Generally the default \f(CW\*(C`classic\*(C'\fR policy is fine. When first testing an existing
-application with Gofer it is a good idea to start with the \f(CW\*(C`pedantic\*(C'\fR policy
-first and then switch to \f(CW\*(C`classic\*(C'\fR or a custom policy, for final testing.
-.SH "AUTHOR"
-.IX Header "AUTHOR"
-Tim Bunce, <http://www.tim.bunce.name>
-.SH "LICENCE AND COPYRIGHT"
-.IX Header "LICENCE AND COPYRIGHT"
-Copyright (c) 2007, Tim Bunce, Ireland. All rights reserved.
-.PP
-This module is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself. See perlartistic.
-.SH "ACKNOWLEDGEMENTS"
-.IX Header "ACKNOWLEDGEMENTS"
-The development of DBD::Gofer and related modules was sponsored by
-Shopzilla.com (<http://Shopzilla.com>), where I currently work.
-.SH "SEE ALSO"
-.IX Header "SEE ALSO"
-DBI::Gofer::Request, DBI::Gofer::Response, DBI::Gofer::Execute.
-.PP
-DBI::Gofer::Transport::Base, DBD::Gofer::Policy::Base.
-.PP
-\&\s-1DBI\s0
-.SH "Caveats for specific drivers"
-.IX Header "Caveats for specific drivers"
-This section aims to record issues to be aware of when using Gofer with specific drivers.
-It usually only documents issues that are not natural consequences of the limitations
-of the Gofer approach \- as documented above.
-.SH "TODO"
-.IX Header "TODO"
-This is just a random brain dump... (There's more in the source of the Changes file, not the pod)
-.PP
-Document policy mechanism
-.PP
-Add mechanism for transports to list config params and for Gofer to apply any that match (and warn if any left over?)
-.PP
-Driver-private sth attributes \- set via \fIprepare()\fR \- change \s-1DBI\s0 spec
-.PP
-add hooks into transport base class for checking & updating a result set cache
- ie via a standard cache interface such as:
- http://search.cpan.org/~robm/Cache\-FastMmap/FastMmap.pm
- http://search.cpan.org/~bradfitz/Cache\-Memcached/lib/Cache/Memcached.pm
- http://search.cpan.org/~dclinton/Cache\-Cache/
- http://search.cpan.org/~cleishman/Cache/
-Also caching instructions could be passed through the httpd transport layer
-in such a way that appropriate http cache headers are added to the results
-so that web caches (squid etc) could be used to implement the caching.
-(\s-1MUST\s0 require the use of \s-1GET\s0 rather than \s-1POST\s0 requests.)
-.PP
-Rework handling of installed_methods to not piggyback on dbh_attributes?
-.PP
-Perhaps support transactions for transports where it's possible (ie null and stream)?
-Would make stream transport (ie ssh) more useful to more people.
-.PP
-Make sth_result_attr more like dbh_attributes (using '*' etc)
-.PP
-Add \f(CW@val\fR = FETCH_many(@names) to \s-1DBI\s0 in C and use in Gofer/Execute?
-.PP
-Implement _new_sth in C.
+++ /dev/null
-.\" Automatically generated by Pod::Man 2.28 (Pod::Simple 3.29)
-.\"
-.\" Standard preamble:
-.\" ========================================================================
-.de Sp \" Vertical space (when we can't use .PP)
-.if t .sp .5v
-.if n .sp
-..
-.de Vb \" Begin verbatim text
-.ft CW
-.nf
-.ne \\$1
-..
-.de Ve \" End verbatim text
-.ft R
-.fi
-..
-.\" Set up some character translations and predefined strings. \*(-- will
-.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
-.\" double quote, and \*(R" will give a right double quote. \*(C+ will
-.\" give a nicer C++. Capital omega is used to do unbreakable dashes and
-.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff,
-.\" nothing in troff, for use with C<>.
-.tr \(*W-
-.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
-.ie n \{\
-. ds -- \(*W-
-. ds PI pi
-. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
-. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch
-. ds L" ""
-. ds R" ""
-. ds C` ""
-. ds C' ""
-'br\}
-.el\{\
-. ds -- \|\(em\|
-. ds PI \(*p
-. ds L" ``
-. ds R" ''
-. ds C`
-. ds C'
-'br\}
-.\"
-.\" Escape single quotes in literal strings from groff's Unicode transform.
-.ie \n(.g .ds Aq \(aq
-.el .ds Aq '
-.\"
-.\" If the F register is turned on, we'll generate index entries on stderr for
-.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
-.\" entries marked with X<> in POD. Of course, you'll have to process the
-.\" output yourself in some meaningful fashion.
-.\"
-.\" Avoid warning from groff about undefined register 'F'.
-.de IX
-..
-.nr rF 0
-.if \n(.g .if rF .nr rF 1
-.if (\n(rF:(\n(.g==0)) \{
-. if \nF \{
-. de IX
-. tm Index:\\$1\t\\n%\t"\\$2"
-..
-. if !\nF==2 \{
-. nr % 0
-. nr F 2
-. \}
-. \}
-.\}
-.rr rF
-.\" ========================================================================
-.\"
-.IX Title "DBD::Gofer::Policy::Base 3pm"
-.TH DBD::Gofer::Policy::Base 3pm "2013-06-24" "perl v5.22.1" "User Contributed Perl Documentation"
-.\" For nroff, turn off justification. Always turn off hyphenation; it makes
-.\" way too many mistakes in technical documents.
-.if n .ad l
-.nh
-.SH "NAME"
-DBD::Gofer::Policy::Base \- Base class for DBD::Gofer policies
-.SH "SYNOPSIS"
-.IX Header "SYNOPSIS"
-.Vb 1
-\& $dbh = DBI\->connect("dbi:Gofer:transport=...;policy=...", ...)
-.Ve
-.SH "DESCRIPTION"
-.IX Header "DESCRIPTION"
-DBD::Gofer can be configured via a 'policy' mechanism that allows you to
-fine-tune the number of round-trips to the Gofer server. The policies are
-grouped into classes (which may be subclassed) and referenced by the name of
-the class.
-.PP
-The DBD::Gofer::Policy::Base class is the base class for all the policy
-classes and describes all the individual policy items.
-.PP
-The Base policy is not used directly. You should use a policy class derived from it.
-.SH "POLICY CLASSES"
-.IX Header "POLICY CLASSES"
-Three policy classes are supplied with DBD::Gofer:
-.PP
-DBD::Gofer::Policy::pedantic is most 'transparent' but slowest because it
-makes more round-trips to the Gofer server.
-.PP
-DBD::Gofer::Policy::classic is a reasonable compromise \- it's the default policy.
-.PP
-DBD::Gofer::Policy::rush is fastest, but may require code changes in your applications.
-.PP
-Generally the default \f(CW\*(C`classic\*(C'\fR policy is fine. When first testing an existing
-application with Gofer it is a good idea to start with the \f(CW\*(C`pedantic\*(C'\fR policy
-first and then switch to \f(CW\*(C`classic\*(C'\fR or a custom policy, for final testing.
-.SH "POLICY ITEMS"
-.IX Header "POLICY ITEMS"
-These are temporary docs: See the source code for list of policies and their defaults.
-.PP
-In a future version the policies and their defaults will be defined in the pod and parsed out at load-time.
-.PP
-See the source code to this module for more details.
-.SH "POLICY CUSTOMIZATION"
-.IX Header "POLICY CUSTOMIZATION"
-\&\s-1XXX\s0 This area of DBD::Gofer is subject to change.
-.PP
-There are three ways to customize policies:
-.PP
-Policy classes are designed to influence the overall behaviour of DBD::Gofer
-with existing, unaltered programs, so they work in a reasonably optimal way
-without requiring code changes. You can implement new policy classes as
-subclasses of existing policies.
-.PP
-In many cases individual policy items can be overridden on a case-by-case basis
-within your application code. You do this by passing a corresponding
-\&\f(CW\*(C`<go_<policy_name\*(C'\fR>> attribute into \s-1DBI\s0 methods by your application code.
-This let's you fine-tune the behaviour for special cases.
-.PP
-The policy items are implemented as methods. In many cases the methods are
-passed parameters relating to the DBD::Gofer code being executed. This means
-the policy can implement dynamic behaviour that varies depending on the
-particular circumstances, such as the particular statement being executed.
-.SH "AUTHOR"
-.IX Header "AUTHOR"
-Tim Bunce, <http://www.tim.bunce.name>
-.SH "LICENCE AND COPYRIGHT"
-.IX Header "LICENCE AND COPYRIGHT"
-Copyright (c) 2007, Tim Bunce, Ireland. All rights reserved.
-.PP
-This module is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself. See perlartistic.
+++ /dev/null
-.\" Automatically generated by Pod::Man 2.28 (Pod::Simple 3.29)
-.\"
-.\" Standard preamble:
-.\" ========================================================================
-.de Sp \" Vertical space (when we can't use .PP)
-.if t .sp .5v
-.if n .sp
-..
-.de Vb \" Begin verbatim text
-.ft CW
-.nf
-.ne \\$1
-..
-.de Ve \" End verbatim text
-.ft R
-.fi
-..
-.\" Set up some character translations and predefined strings. \*(-- will
-.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
-.\" double quote, and \*(R" will give a right double quote. \*(C+ will
-.\" give a nicer C++. Capital omega is used to do unbreakable dashes and
-.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff,
-.\" nothing in troff, for use with C<>.
-.tr \(*W-
-.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
-.ie n \{\
-. ds -- \(*W-
-. ds PI pi
-. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
-. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch
-. ds L" ""
-. ds R" ""
-. ds C` ""
-. ds C' ""
-'br\}
-.el\{\
-. ds -- \|\(em\|
-. ds PI \(*p
-. ds L" ``
-. ds R" ''
-. ds C`
-. ds C'
-'br\}
-.\"
-.\" Escape single quotes in literal strings from groff's Unicode transform.
-.ie \n(.g .ds Aq \(aq
-.el .ds Aq '
-.\"
-.\" If the F register is turned on, we'll generate index entries on stderr for
-.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
-.\" entries marked with X<> in POD. Of course, you'll have to process the
-.\" output yourself in some meaningful fashion.
-.\"
-.\" Avoid warning from groff about undefined register 'F'.
-.de IX
-..
-.nr rF 0
-.if \n(.g .if rF .nr rF 1
-.if (\n(rF:(\n(.g==0)) \{
-. if \nF \{
-. de IX
-. tm Index:\\$1\t\\n%\t"\\$2"
-..
-. if !\nF==2 \{
-. nr % 0
-. nr F 2
-. \}
-. \}
-.\}
-.rr rF
-.\" ========================================================================
-.\"
-.IX Title "DBD::Gofer::Policy::classic 3pm"
-.TH DBD::Gofer::Policy::classic 3pm "2013-06-24" "perl v5.22.1" "User Contributed Perl Documentation"
-.\" For nroff, turn off justification. Always turn off hyphenation; it makes
-.\" way too many mistakes in technical documents.
-.if n .ad l
-.nh
-.SH "NAME"
-DBD::Gofer::Policy::classic \- The 'classic' policy for DBD::Gofer
-.SH "SYNOPSIS"
-.IX Header "SYNOPSIS"
-.Vb 1
-\& $dbh = DBI\->connect("dbi:Gofer:transport=...;policy=classic", ...)
-.Ve
-.PP
-The \f(CW\*(C`classic\*(C'\fR policy is the default DBD::Gofer policy, so need not be included in the \s-1DSN.\s0
-.SH "DESCRIPTION"
-.IX Header "DESCRIPTION"
-Temporary docs: See the source code for list of policies and their defaults.
-.PP
-In a future version the policies and their defaults will be defined in the pod and parsed out at load-time.
-.SH "AUTHOR"
-.IX Header "AUTHOR"
-Tim Bunce, <http://www.tim.bunce.name>
-.SH "LICENCE AND COPYRIGHT"
-.IX Header "LICENCE AND COPYRIGHT"
-Copyright (c) 2007, Tim Bunce, Ireland. All rights reserved.
-.PP
-This module is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself. See perlartistic.
+++ /dev/null
-.\" Automatically generated by Pod::Man 2.28 (Pod::Simple 3.29)
-.\"
-.\" Standard preamble:
-.\" ========================================================================
-.de Sp \" Vertical space (when we can't use .PP)
-.if t .sp .5v
-.if n .sp
-..
-.de Vb \" Begin verbatim text
-.ft CW
-.nf
-.ne \\$1
-..
-.de Ve \" End verbatim text
-.ft R
-.fi
-..
-.\" Set up some character translations and predefined strings. \*(-- will
-.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
-.\" double quote, and \*(R" will give a right double quote. \*(C+ will
-.\" give a nicer C++. Capital omega is used to do unbreakable dashes and
-.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff,
-.\" nothing in troff, for use with C<>.
-.tr \(*W-
-.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
-.ie n \{\
-. ds -- \(*W-
-. ds PI pi
-. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
-. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch
-. ds L" ""
-. ds R" ""
-. ds C` ""
-. ds C' ""
-'br\}
-.el\{\
-. ds -- \|\(em\|
-. ds PI \(*p
-. ds L" ``
-. ds R" ''
-. ds C`
-. ds C'
-'br\}
-.\"
-.\" Escape single quotes in literal strings from groff's Unicode transform.
-.ie \n(.g .ds Aq \(aq
-.el .ds Aq '
-.\"
-.\" If the F register is turned on, we'll generate index entries on stderr for
-.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
-.\" entries marked with X<> in POD. Of course, you'll have to process the
-.\" output yourself in some meaningful fashion.
-.\"
-.\" Avoid warning from groff about undefined register 'F'.
-.de IX
-..
-.nr rF 0
-.if \n(.g .if rF .nr rF 1
-.if (\n(rF:(\n(.g==0)) \{
-. if \nF \{
-. de IX
-. tm Index:\\$1\t\\n%\t"\\$2"
-..
-. if !\nF==2 \{
-. nr % 0
-. nr F 2
-. \}
-. \}
-.\}
-.rr rF
-.\" ========================================================================
-.\"
-.IX Title "DBD::Gofer::Policy::pedantic 3pm"
-.TH DBD::Gofer::Policy::pedantic 3pm "2013-06-24" "perl v5.22.1" "User Contributed Perl Documentation"
-.\" For nroff, turn off justification. Always turn off hyphenation; it makes
-.\" way too many mistakes in technical documents.
-.if n .ad l
-.nh
-.SH "NAME"
-DBD::Gofer::Policy::pedantic \- The 'pedantic' policy for DBD::Gofer
-.SH "SYNOPSIS"
-.IX Header "SYNOPSIS"
-.Vb 1
-\& $dbh = DBI\->connect("dbi:Gofer:transport=...;policy=pedantic", ...)
-.Ve
-.SH "DESCRIPTION"
-.IX Header "DESCRIPTION"
-The \f(CW\*(C`pedantic\*(C'\fR policy tries to be as transparent as possible. To do this it
-makes round-trips to the server for almost every \s-1DBI\s0 method call.
-.PP
-This is the best policy to use when first testing existing code with Gofer.
-Once it's working well you should consider moving to the \f(CW\*(C`classic\*(C'\fR policy or defining your own policy class.
-.PP
-Temporary docs: See the source code for list of policies and their defaults.
-.PP
-In a future version the policies and their defaults will be defined in the pod and parsed out at load-time.
-.SH "AUTHOR"
-.IX Header "AUTHOR"
-Tim Bunce, <http://www.tim.bunce.name>
-.SH "LICENCE AND COPYRIGHT"
-.IX Header "LICENCE AND COPYRIGHT"
-Copyright (c) 2007, Tim Bunce, Ireland. All rights reserved.
-.PP
-This module is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself. See perlartistic.
+++ /dev/null
-.\" Automatically generated by Pod::Man 2.28 (Pod::Simple 3.29)
-.\"
-.\" Standard preamble:
-.\" ========================================================================
-.de Sp \" Vertical space (when we can't use .PP)
-.if t .sp .5v
-.if n .sp
-..
-.de Vb \" Begin verbatim text
-.ft CW
-.nf
-.ne \\$1
-..
-.de Ve \" End verbatim text
-.ft R
-.fi
-..
-.\" Set up some character translations and predefined strings. \*(-- will
-.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
-.\" double quote, and \*(R" will give a right double quote. \*(C+ will
-.\" give a nicer C++. Capital omega is used to do unbreakable dashes and
-.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff,
-.\" nothing in troff, for use with C<>.
-.tr \(*W-
-.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
-.ie n \{\
-. ds -- \(*W-
-. ds PI pi
-. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
-. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch
-. ds L" ""
-. ds R" ""
-. ds C` ""
-. ds C' ""
-'br\}
-.el\{\
-. ds -- \|\(em\|
-. ds PI \(*p
-. ds L" ``
-. ds R" ''
-. ds C`
-. ds C'
-'br\}
-.\"
-.\" Escape single quotes in literal strings from groff's Unicode transform.
-.ie \n(.g .ds Aq \(aq
-.el .ds Aq '
-.\"
-.\" If the F register is turned on, we'll generate index entries on stderr for
-.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
-.\" entries marked with X<> in POD. Of course, you'll have to process the
-.\" output yourself in some meaningful fashion.
-.\"
-.\" Avoid warning from groff about undefined register 'F'.
-.de IX
-..
-.nr rF 0
-.if \n(.g .if rF .nr rF 1
-.if (\n(rF:(\n(.g==0)) \{
-. if \nF \{
-. de IX
-. tm Index:\\$1\t\\n%\t"\\$2"
-..
-. if !\nF==2 \{
-. nr % 0
-. nr F 2
-. \}
-. \}
-.\}
-.rr rF
-.\" ========================================================================
-.\"
-.IX Title "DBD::Gofer::Policy::rush 3pm"
-.TH DBD::Gofer::Policy::rush 3pm "2013-06-24" "perl v5.22.1" "User Contributed Perl Documentation"
-.\" For nroff, turn off justification. Always turn off hyphenation; it makes
-.\" way too many mistakes in technical documents.
-.if n .ad l
-.nh
-.SH "NAME"
-DBD::Gofer::Policy::rush \- The 'rush' policy for DBD::Gofer
-.SH "SYNOPSIS"
-.IX Header "SYNOPSIS"
-.Vb 1
-\& $dbh = DBI\->connect("dbi:Gofer:transport=...;policy=rush", ...)
-.Ve
-.SH "DESCRIPTION"
-.IX Header "DESCRIPTION"
-The \f(CW\*(C`rush\*(C'\fR policy tries to make as few round-trips as possible.
-It's the opposite end of the policy spectrum to the \f(CW\*(C`pedantic\*(C'\fR policy.
-.PP
-Temporary docs: See the source code for list of policies and their defaults.
-.PP
-In a future version the policies and their defaults will be defined in the pod and parsed out at load-time.
-.SH "AUTHOR"
-.IX Header "AUTHOR"
-Tim Bunce, <http://www.tim.bunce.name>
-.SH "LICENCE AND COPYRIGHT"
-.IX Header "LICENCE AND COPYRIGHT"
-Copyright (c) 2007, Tim Bunce, Ireland. All rights reserved.
-.PP
-This module is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself. See perlartistic.
+++ /dev/null
-.\" Automatically generated by Pod::Man 2.28 (Pod::Simple 3.29)
-.\"
-.\" Standard preamble:
-.\" ========================================================================
-.de Sp \" Vertical space (when we can't use .PP)
-.if t .sp .5v
-.if n .sp
-..
-.de Vb \" Begin verbatim text
-.ft CW
-.nf
-.ne \\$1
-..
-.de Ve \" End verbatim text
-.ft R
-.fi
-..
-.\" Set up some character translations and predefined strings. \*(-- will
-.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
-.\" double quote, and \*(R" will give a right double quote. \*(C+ will
-.\" give a nicer C++. Capital omega is used to do unbreakable dashes and
-.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff,
-.\" nothing in troff, for use with C<>.
-.tr \(*W-
-.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
-.ie n \{\
-. ds -- \(*W-
-. ds PI pi
-. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
-. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch
-. ds L" ""
-. ds R" ""
-. ds C` ""
-. ds C' ""
-'br\}
-.el\{\
-. ds -- \|\(em\|
-. ds PI \(*p
-. ds L" ``
-. ds R" ''
-. ds C`
-. ds C'
-'br\}
-.\"
-.\" Escape single quotes in literal strings from groff's Unicode transform.
-.ie \n(.g .ds Aq \(aq
-.el .ds Aq '
-.\"
-.\" If the F register is turned on, we'll generate index entries on stderr for
-.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
-.\" entries marked with X<> in POD. Of course, you'll have to process the
-.\" output yourself in some meaningful fashion.
-.\"
-.\" Avoid warning from groff about undefined register 'F'.
-.de IX
-..
-.nr rF 0
-.if \n(.g .if rF .nr rF 1
-.if (\n(rF:(\n(.g==0)) \{
-. if \nF \{
-. de IX
-. tm Index:\\$1\t\\n%\t"\\$2"
-..
-. if !\nF==2 \{
-. nr % 0
-. nr F 2
-. \}
-. \}
-.\}
-.rr rF
-.\" ========================================================================
-.\"
-.IX Title "DBD::Gofer::Transport::Base 3pm"
-.TH DBD::Gofer::Transport::Base 3pm "2013-06-24" "perl v5.22.1" "User Contributed Perl Documentation"
-.\" For nroff, turn off justification. Always turn off hyphenation; it makes
-.\" way too many mistakes in technical documents.
-.if n .ad l
-.nh
-.SH "NAME"
-DBD::Gofer::Transport::Base \- base class for DBD::Gofer client transports
-.SH "SYNOPSIS"
-.IX Header "SYNOPSIS"
-.Vb 2
-\& my $remote_dsn = "..."
-\& DBI\->connect("dbi:Gofer:transport=...;url=...;timeout=...;retry_limit=...;dsn=$remote_dsn",...)
-.Ve
-.PP
-or, enable by setting the \s-1DBI_AUTOPROXY\s0 environment variable:
-.PP
-.Vb 1
-\& export DBI_AUTOPROXY=\*(Aqdbi:Gofer:transport=...;url=...\*(Aq
-.Ve
-.PP
-which will force \fIall\fR \s-1DBI\s0 connections to be made via that Gofer server.
-.SH "DESCRIPTION"
-.IX Header "DESCRIPTION"
-This is the base class for all DBD::Gofer client transports.
-.SH "ATTRIBUTES"
-.IX Header "ATTRIBUTES"
-Gofer transport attributes can be specified either in the attributes parameter
-of the \fIconnect()\fR method call, or in the \s-1DSN\s0 string. When used in the \s-1DSN\s0
-string, attribute names don't have the \f(CW\*(C`go_\*(C'\fR prefix.
-.SS "go_dsn"
-.IX Subsection "go_dsn"
-The full \s-1DBI DSN\s0 that the Gofer server should connect to on your behalf.
-.PP
-When used in the \s-1DSN\s0 it must be the last element in the \s-1DSN\s0 string.
-.SS "go_timeout"
-.IX Subsection "go_timeout"
-A time limit for sending a request and receiving a response. Some drivers may
-implement sending and receiving as separate steps, in which case (currently)
-the timeout applies to each separately.
-.PP
-If a request needs to be resent then the timeout is restarted for each sending
-of a request and receiving of a response.
-.SS "go_retry_limit"
-.IX Subsection "go_retry_limit"
-The maximum number of times an request may be retried. The default is 2.
-.SS "go_retry_hook"
-.IX Subsection "go_retry_hook"
-This subroutine reference is called, if defined, for each response received where \f(CW$response\fR\->err is true.
-.PP
-The subroutine is pass three parameters: the request object, the response object, and the transport object.
-.PP
-If it returns an undefined value then the default retry behaviour is used. See \*(L"\s-1RETRY ON ERROR\*(R"\s0 below.
-.PP
-If it returns a defined but false value then the request is not resent.
-.PP
-If it returns true value then the request is resent, so long as the number of retries does not exceed \f(CW\*(C`go_retry_limit\*(C'\fR.
-.SH "RETRY ON ERROR"
-.IX Header "RETRY ON ERROR"
-The default retry on error behaviour is:
-.PP
-.Vb 1
-\& \- Retry if the error was due to DBI_GOFER_RANDOM. See L<DBI::Gofer::Execute>.
-\&
-\& \- Retry if $request\->is_idempotent returns true. See L<DBI::Gofer::Request>.
-.Ve
-.PP
-A retry won't be allowed if the number of previous retries has reached \f(CW\*(C`go_retry_limit\*(C'\fR.
-.SH "TRACING"
-.IX Header "TRACING"
-Tracing of gofer requests and responses can be enabled by setting the
-\&\f(CW\*(C`DBD_GOFER_TRACE\*(C'\fR environment variable. A value of 1 gives a reasonably
-compact summary of each request and response. A value of 2 or more gives a
-detailed, and voluminous, dump.
-.PP
-The trace is written using \s-1DBI\-\s0>\fItrace_msg()\fR and so is written to the default
-\&\s-1DBI\s0 trace output, which is usually \s-1STDERR.\s0
-.SH "METHODS"
-.IX Header "METHODS"
-\&\fIThis section is currently far from complete.\fR
-.SS "response_retry_preference"
-.IX Subsection "response_retry_preference"
-.Vb 1
-\& $retry = $transport\->response_retry_preference($request, $response);
-.Ve
-.PP
-The response_retry_preference is called by DBD::Gofer when considering if a
-request should be retried after an error.
-.PP
-Returns true (would like to retry), false (must not retry), undef (no preference).
-.PP
-If a true value is returned in the form of a \s-1CODE\s0 ref then, if DBD::Gofer does
-decide to retry the request, it calls the code ref passing \f(CW$retry_count\fR, \f(CW$retry_limit\fR.
-Can be used for logging and/or to implement exponential backoff behaviour.
-Currently the called code must return using \f(CW\*(C`return;\*(C'\fR to allow for future extensions.
-.SH "AUTHOR"
-.IX Header "AUTHOR"
-Tim Bunce, <http://www.tim.bunce.name>
-.SH "LICENCE AND COPYRIGHT"
-.IX Header "LICENCE AND COPYRIGHT"
-Copyright (c) 2007\-2008, Tim Bunce, Ireland. All rights reserved.
-.PP
-This module is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself. See perlartistic.
-.SH "SEE ALSO"
-.IX Header "SEE ALSO"
-DBD::Gofer, DBI::Gofer::Request, DBI::Gofer::Response, DBI::Gofer::Execute.
-.PP
-and some example transports:
-.PP
-DBD::Gofer::Transport::stream
-.PP
-DBD::Gofer::Transport::http
-.PP
-DBI::Gofer::Transport::mod_perl
+++ /dev/null
-.\" Automatically generated by Pod::Man 2.28 (Pod::Simple 3.29)
-.\"
-.\" Standard preamble:
-.\" ========================================================================
-.de Sp \" Vertical space (when we can't use .PP)
-.if t .sp .5v
-.if n .sp
-..
-.de Vb \" Begin verbatim text
-.ft CW
-.nf
-.ne \\$1
-..
-.de Ve \" End verbatim text
-.ft R
-.fi
-..
-.\" Set up some character translations and predefined strings. \*(-- will
-.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
-.\" double quote, and \*(R" will give a right double quote. \*(C+ will
-.\" give a nicer C++. Capital omega is used to do unbreakable dashes and
-.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff,
-.\" nothing in troff, for use with C<>.
-.tr \(*W-
-.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
-.ie n \{\
-. ds -- \(*W-
-. ds PI pi
-. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
-. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch
-. ds L" ""
-. ds R" ""
-. ds C` ""
-. ds C' ""
-'br\}
-.el\{\
-. ds -- \|\(em\|
-. ds PI \(*p
-. ds L" ``
-. ds R" ''
-. ds C`
-. ds C'
-'br\}
-.\"
-.\" Escape single quotes in literal strings from groff's Unicode transform.
-.ie \n(.g .ds Aq \(aq
-.el .ds Aq '
-.\"
-.\" If the F register is turned on, we'll generate index entries on stderr for
-.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
-.\" entries marked with X<> in POD. Of course, you'll have to process the
-.\" output yourself in some meaningful fashion.
-.\"
-.\" Avoid warning from groff about undefined register 'F'.
-.de IX
-..
-.nr rF 0
-.if \n(.g .if rF .nr rF 1
-.if (\n(rF:(\n(.g==0)) \{
-. if \nF \{
-. de IX
-. tm Index:\\$1\t\\n%\t"\\$2"
-..
-. if !\nF==2 \{
-. nr % 0
-. nr F 2
-. \}
-. \}
-.\}
-.rr rF
-.\" ========================================================================
-.\"
-.IX Title "DBD::Gofer::Transport::corostream 3pm"
-.TH DBD::Gofer::Transport::corostream 3pm "2013-04-04" "perl v5.22.1" "User Contributed Perl Documentation"
-.\" For nroff, turn off justification. Always turn off hyphenation; it makes
-.\" way too many mistakes in technical documents.
-.if n .ad l
-.nh
-.SH "NAME"
-DBD::Gofer::Transport::corostream \- Async DBD::Gofer stream transport using Coro and AnyEvent
-.SH "SYNOPSIS"
-.IX Header "SYNOPSIS"
-.Vb 1
-\& DBI_AUTOPROXY="dbi:Gofer:transport=corostream" perl some\-perl\-script\-using\-dbi.pl
-.Ve
-.PP
-or
-.PP
-.Vb 2
-\& $dsn = ...; # the DSN for the driver and database you want to use
-\& $dbh = DBI\->connect("dbi:Gofer:transport=corostream;dsn=$dsn", ...);
-.Ve
-.SH "DESCRIPTION"
-.IX Header "DESCRIPTION"
-The \fI\s-1BIG WIN\s0\fR from using Coro is that it enables the use of existing
-\&\s-1DBI\s0 frameworks like DBIx::Class.
-.SH "KNOWN ISSUES AND LIMITATIONS"
-.IX Header "KNOWN ISSUES AND LIMITATIONS"
-.Vb 2
-\& \- Uses Coro::Select so alters CORE::select globally
-\& Parent class probably needs refactoring to enable a more encapsulated approach.
-\&
-\& \- Doesn\*(Aqt prevent multiple concurrent requests
-\& Probably just needs a per\-connection semaphore
-\&
-\& \- Coro has many caveats. Caveat emptor.
-.Ve
-.SH "STATUS"
-.IX Header "STATUS"
-\&\s-1THIS IS CURRENTLY JUST A\s0 PROOF-OF-CONCEPT \s-1IMPLEMENTATION FOR EXPERIMENTATION.\s0
-.PP
-Please note that I have no plans to develop this code further myself.
-I'd very much welcome contributions. Interested? Let me know!
-.SH "AUTHOR"
-.IX Header "AUTHOR"
-Tim Bunce, <http://www.tim.bunce.name>
-.SH "LICENCE AND COPYRIGHT"
-.IX Header "LICENCE AND COPYRIGHT"
-Copyright (c) 2010, Tim Bunce, Ireland. All rights reserved.
-.PP
-This module is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself. See perlartistic.
-.SH "SEE ALSO"
-.IX Header "SEE ALSO"
-DBD::Gofer::Transport::stream
-.PP
-DBD::Gofer
-.SH "APPENDIX"
-.IX Header "APPENDIX"
-Example code:
-.PP
-.Vb 1
-\& #!perl
-\&
-\& use strict;
-\& use warnings;
-\& use Time::HiRes qw(time);
-\&
-\& BEGIN { $ENV{PERL_ANYEVENT_STRICT} = 1; $ENV{PERL_ANYEVENT_VERBOSE} = 1; }
-\&
-\& use AnyEvent;
-\&
-\& BEGIN { $ENV{DBI_TRACE} = 0; $ENV{DBI_GOFER_TRACE} = 0; $ENV{DBD_GOFER_TRACE} = 0; };
-\&
-\& use DBI;
-\&
-\& $ENV{DBI_AUTOPROXY} = \*(Aqdbi:Gofer:transport=corostream\*(Aq;
-\&
-\& my $ticker = AnyEvent\->timer( after => 0, interval => 0.1, cb => sub {
-\& warn sprintf "\-tick\- %.2f\en", time
-\& } );
-\&
-\& warn "connecting...\en";
-\& my $dbh = DBI\->connect("dbi:NullP:");
-\& warn "...connected\en";
-\&
-\& for (1..3) {
-\& warn "entering DBI...\en";
-\& $dbh\->do("sleep 0.3"); # pseudo\-sql understood by the DBD::NullP driver
-\& warn "...returned\en";
-\& }
-\&
-\& warn "done.";
-.Ve
-.PP
-Example output:
-.PP
-.Vb 10
-\& $ perl corogofer.pl
-\& connecting...
-\& \-tick\- 1293631437.14
-\& \-tick\- 1293631437.14
-\& ...connected
-\& entering DBI...
-\& \-tick\- 1293631437.25
-\& \-tick\- 1293631437.35
-\& \-tick\- 1293631437.45
-\& \-tick\- 1293631437.55
-\& ...returned
-\& entering DBI...
-\& \-tick\- 1293631437.66
-\& \-tick\- 1293631437.76
-\& \-tick\- 1293631437.86
-\& ...returned
-\& entering DBI...
-\& \-tick\- 1293631437.96
-\& \-tick\- 1293631438.06
-\& \-tick\- 1293631438.16
-\& ...returned
-\& done. at corogofer.pl line 39.
-.Ve
-.PP
-You can see that the timer callback is firing while the code 'waits' inside the
-\&\fIdo()\fR method for the response from the database. Normally that would block.
+++ /dev/null
-.\" Automatically generated by Pod::Man 2.28 (Pod::Simple 3.29)
-.\"
-.\" Standard preamble:
-.\" ========================================================================
-.de Sp \" Vertical space (when we can't use .PP)
-.if t .sp .5v
-.if n .sp
-..
-.de Vb \" Begin verbatim text
-.ft CW
-.nf
-.ne \\$1
-..
-.de Ve \" End verbatim text
-.ft R
-.fi
-..
-.\" Set up some character translations and predefined strings. \*(-- will
-.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
-.\" double quote, and \*(R" will give a right double quote. \*(C+ will
-.\" give a nicer C++. Capital omega is used to do unbreakable dashes and
-.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff,
-.\" nothing in troff, for use with C<>.
-.tr \(*W-
-.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
-.ie n \{\
-. ds -- \(*W-
-. ds PI pi
-. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
-. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch
-. ds L" ""
-. ds R" ""
-. ds C` ""
-. ds C' ""
-'br\}
-.el\{\
-. ds -- \|\(em\|
-. ds PI \(*p
-. ds L" ``
-. ds R" ''
-. ds C`
-. ds C'
-'br\}
-.\"
-.\" Escape single quotes in literal strings from groff's Unicode transform.
-.ie \n(.g .ds Aq \(aq
-.el .ds Aq '
-.\"
-.\" If the F register is turned on, we'll generate index entries on stderr for
-.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
-.\" entries marked with X<> in POD. Of course, you'll have to process the
-.\" output yourself in some meaningful fashion.
-.\"
-.\" Avoid warning from groff about undefined register 'F'.
-.de IX
-..
-.nr rF 0
-.if \n(.g .if rF .nr rF 1
-.if (\n(rF:(\n(.g==0)) \{
-. if \nF \{
-. de IX
-. tm Index:\\$1\t\\n%\t"\\$2"
-..
-. if !\nF==2 \{
-. nr % 0
-. nr F 2
-. \}
-. \}
-.\}
-.rr rF
-.\" ========================================================================
-.\"
-.IX Title "DBD::Gofer::Transport::null 3pm"
-.TH DBD::Gofer::Transport::null 3pm "2013-06-24" "perl v5.22.1" "User Contributed Perl Documentation"
-.\" For nroff, turn off justification. Always turn off hyphenation; it makes
-.\" way too many mistakes in technical documents.
-.if n .ad l
-.nh
-.SH "NAME"
-DBD::Gofer::Transport::null \- DBD::Gofer client transport for testing
-.SH "SYNOPSIS"
-.IX Header "SYNOPSIS"
-.Vb 2
-\& my $original_dsn = "..."
-\& DBI\->connect("dbi:Gofer:transport=null;dsn=$original_dsn",...)
-.Ve
-.PP
-or, enable by setting the \s-1DBI_AUTOPROXY\s0 environment variable:
-.PP
-.Vb 1
-\& export DBI_AUTOPROXY="dbi:Gofer:transport=null"
-.Ve
-.SH "DESCRIPTION"
-.IX Header "DESCRIPTION"
-Connect via DBD::Gofer but execute the requests within the same process.
-.PP
-This is a quick and simple way to test applications for compatibility with the
-(few) restrictions that DBD::Gofer imposes.
-.PP
-It also provides a simple, portable way for the \s-1DBI\s0 test suite to be used to
-test DBD::Gofer on all platforms with no setup.
-.PP
-Also, by measuring the difference in performance between normal connections and
-connections via \f(CW\*(C`dbi:Gofer:transport=null\*(C'\fR the basic cost of using DBD::Gofer
-can be measured. Furthermore, the additional cost of more advanced transports can be
-isolated by comparing their performance with the null transport.
-.PP
-The \f(CW\*(C`t/85gofer.t\*(C'\fR script in the \s-1DBI\s0 distribution includes a comparative benchmark.
-.SH "AUTHOR"
-.IX Header "AUTHOR"
-Tim Bunce, <http://www.tim.bunce.name>
-.SH "LICENCE AND COPYRIGHT"
-.IX Header "LICENCE AND COPYRIGHT"
-Copyright (c) 2007, Tim Bunce, Ireland. All rights reserved.
-.PP
-This module is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself. See perlartistic.
-.SH "SEE ALSO"
-.IX Header "SEE ALSO"
-DBD::Gofer::Transport::Base
-.PP
-DBD::Gofer
+++ /dev/null
-.\" Automatically generated by Pod::Man 2.28 (Pod::Simple 3.29)
-.\"
-.\" Standard preamble:
-.\" ========================================================================
-.de Sp \" Vertical space (when we can't use .PP)
-.if t .sp .5v
-.if n .sp
-..
-.de Vb \" Begin verbatim text
-.ft CW
-.nf
-.ne \\$1
-..
-.de Ve \" End verbatim text
-.ft R
-.fi
-..
-.\" Set up some character translations and predefined strings. \*(-- will
-.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
-.\" double quote, and \*(R" will give a right double quote. \*(C+ will
-.\" give a nicer C++. Capital omega is used to do unbreakable dashes and
-.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff,
-.\" nothing in troff, for use with C<>.
-.tr \(*W-
-.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
-.ie n \{\
-. ds -- \(*W-
-. ds PI pi
-. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
-. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch
-. ds L" ""
-. ds R" ""
-. ds C` ""
-. ds C' ""
-'br\}
-.el\{\
-. ds -- \|\(em\|
-. ds PI \(*p
-. ds L" ``
-. ds R" ''
-. ds C`
-. ds C'
-'br\}
-.\"
-.\" Escape single quotes in literal strings from groff's Unicode transform.
-.ie \n(.g .ds Aq \(aq
-.el .ds Aq '
-.\"
-.\" If the F register is turned on, we'll generate index entries on stderr for
-.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
-.\" entries marked with X<> in POD. Of course, you'll have to process the
-.\" output yourself in some meaningful fashion.
-.\"
-.\" Avoid warning from groff about undefined register 'F'.
-.de IX
-..
-.nr rF 0
-.if \n(.g .if rF .nr rF 1
-.if (\n(rF:(\n(.g==0)) \{
-. if \nF \{
-. de IX
-. tm Index:\\$1\t\\n%\t"\\$2"
-..
-. if !\nF==2 \{
-. nr % 0
-. nr F 2
-. \}
-. \}
-.\}
-.rr rF
-.\" ========================================================================
-.\"
-.IX Title "DBD::Gofer::Transport::pipeone 3pm"
-.TH DBD::Gofer::Transport::pipeone 3pm "2013-06-24" "perl v5.22.1" "User Contributed Perl Documentation"
-.\" For nroff, turn off justification. Always turn off hyphenation; it makes
-.\" way too many mistakes in technical documents.
-.if n .ad l
-.nh
-.SH "NAME"
-DBD::Gofer::Transport::pipeone \- DBD::Gofer client transport for testing
-.SH "SYNOPSIS"
-.IX Header "SYNOPSIS"
-.Vb 2
-\& $original_dsn = "...";
-\& DBI\->connect("dbi:Gofer:transport=pipeone;dsn=$original_dsn",...)
-.Ve
-.PP
-or, enable by setting the \s-1DBI_AUTOPROXY\s0 environment variable:
-.PP
-.Vb 1
-\& export DBI_AUTOPROXY="dbi:Gofer:transport=pipeone"
-.Ve
-.SH "DESCRIPTION"
-.IX Header "DESCRIPTION"
-Connect via DBD::Gofer and execute each request by starting executing a subprocess.
-.PP
-This is, as you might imagine, spectacularly inefficient!
-.PP
-It's only intended for testing. Specifically it demonstrates that the server
-side is completely stateless.
-.PP
-It also provides a base class for the much more useful DBD::Gofer::Transport::stream
-transport.
-.SH "AUTHOR"
-.IX Header "AUTHOR"
-Tim Bunce, <http://www.tim.bunce.name>
-.SH "LICENCE AND COPYRIGHT"
-.IX Header "LICENCE AND COPYRIGHT"
-Copyright (c) 2007, Tim Bunce, Ireland. All rights reserved.
-.PP
-This module is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself. See perlartistic.
-.SH "SEE ALSO"
-.IX Header "SEE ALSO"
-DBD::Gofer::Transport::Base
-.PP
-DBD::Gofer
+++ /dev/null
-.\" Automatically generated by Pod::Man 2.28 (Pod::Simple 3.29)
-.\"
-.\" Standard preamble:
-.\" ========================================================================
-.de Sp \" Vertical space (when we can't use .PP)
-.if t .sp .5v
-.if n .sp
-..
-.de Vb \" Begin verbatim text
-.ft CW
-.nf
-.ne \\$1
-..
-.de Ve \" End verbatim text
-.ft R
-.fi
-..
-.\" Set up some character translations and predefined strings. \*(-- will
-.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
-.\" double quote, and \*(R" will give a right double quote. \*(C+ will
-.\" give a nicer C++. Capital omega is used to do unbreakable dashes and
-.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff,
-.\" nothing in troff, for use with C<>.
-.tr \(*W-
-.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
-.ie n \{\
-. ds -- \(*W-
-. ds PI pi
-. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
-. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch
-. ds L" ""
-. ds R" ""
-. ds C` ""
-. ds C' ""
-'br\}
-.el\{\
-. ds -- \|\(em\|
-. ds PI \(*p
-. ds L" ``
-. ds R" ''
-. ds C`
-. ds C'
-'br\}
-.\"
-.\" Escape single quotes in literal strings from groff's Unicode transform.
-.ie \n(.g .ds Aq \(aq
-.el .ds Aq '
-.\"
-.\" If the F register is turned on, we'll generate index entries on stderr for
-.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
-.\" entries marked with X<> in POD. Of course, you'll have to process the
-.\" output yourself in some meaningful fashion.
-.\"
-.\" Avoid warning from groff about undefined register 'F'.
-.de IX
-..
-.nr rF 0
-.if \n(.g .if rF .nr rF 1
-.if (\n(rF:(\n(.g==0)) \{
-. if \nF \{
-. de IX
-. tm Index:\\$1\t\\n%\t"\\$2"
-..
-. if !\nF==2 \{
-. nr % 0
-. nr F 2
-. \}
-. \}
-.\}
-.rr rF
-.\" ========================================================================
-.\"
-.IX Title "DBD::Gofer::Transport::stream 3pm"
-.TH DBD::Gofer::Transport::stream 3pm "2013-06-24" "perl v5.22.1" "User Contributed Perl Documentation"
-.\" For nroff, turn off justification. Always turn off hyphenation; it makes
-.\" way too many mistakes in technical documents.
-.if n .ad l
-.nh
-.SH "NAME"
-DBD::Gofer::Transport::stream \- DBD::Gofer transport for stdio streaming
-.SH "SYNOPSIS"
-.IX Header "SYNOPSIS"
-.Vb 1
-\& DBI\->connect(\*(Aqdbi:Gofer:transport=stream;url=ssh:username@host.example.com;dsn=dbi:...\*(Aq,...)
-.Ve
-.PP
-or, enable by setting the \s-1DBI_AUTOPROXY\s0 environment variable:
-.PP
-.Vb 1
-\& export DBI_AUTOPROXY=\*(Aqdbi:Gofer:transport=stream;url=ssh:username@host.example.com\*(Aq
-.Ve
-.SH "DESCRIPTION"
-.IX Header "DESCRIPTION"
-Without the \f(CW\*(C`url=\*(C'\fR parameter it launches a subprocess as
-.PP
-.Vb 1
-\& perl \-MDBI::Gofer::Transport::stream \-e run_stdio_hex
-.Ve
-.PP
-and feeds requests into it and reads responses from it. But that's not very useful.
-.PP
-With a \f(CW\*(C`url=ssh:username@host.example.com\*(C'\fR parameter it uses ssh to launch the subprocess
-on a remote system. That's much more useful!
-.PP
-It gives you secure remote access to \s-1DBI\s0 databases on any system you can login to.
-Using ssh also gives you optional compression and many other features (see the
-ssh manual for how to configure that and many other options via ~/.ssh/config file).
-.PP
-The actual command invoked is something like:
-.PP
-.Vb 1
-\& ssh \-xq ssh:username@host.example.com bash \-c $setup $run
-.Ve
-.PP
-where \f(CW$run\fR is the command shown above, and \f(CW$command\fR is
-.PP
-.Vb 1
-\& . .bash_profile 2>/dev/null || . .bash_login 2>/dev/null || . .profile 2>/dev/null; exec "$@"
-.Ve
-.PP
-which is trying (in a limited and fairly unportable way) to setup the environment
-(\s-1PATH, PERL5LIB\s0 etc) as it would be if you had logged in to that system.
-.PP
-The "\f(CW\*(C`perl\*(C'\fR" used in the command will default to the value of $^X when not using ssh.
-On most systems that's the full path to the perl that's currently executing.
-.SH "PERSISTENCE"
-.IX Header "PERSISTENCE"
-Currently gofer stream connections persist (remain connected) after all
-database handles have been disconnected. This makes later connections in the
-same process very fast.
-.PP
-Currently up to 5 different gofer stream connections (based on url) can
-persist. If more than 5 are in the cache when a new connection is made then
-the cache is cleared before adding the new connection. Simple but effective.
-.SH "TO DO"
-.IX Header "TO DO"
-Document go_perl attribute
-.PP
-Automatically reconnect (within reason) if there's a transport error.
-.PP
-Decide on default for persistent connection \- on or off? limits? ttl?
-.SH "AUTHOR"
-.IX Header "AUTHOR"
-Tim Bunce, <http://www.tim.bunce.name>
-.SH "LICENCE AND COPYRIGHT"
-.IX Header "LICENCE AND COPYRIGHT"
-Copyright (c) 2007, Tim Bunce, Ireland. All rights reserved.
-.PP
-This module is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself. See perlartistic.
-.SH "SEE ALSO"
-.IX Header "SEE ALSO"
-DBD::Gofer::Transport::Base
-.PP
-DBD::Gofer
+++ /dev/null
-.\" Automatically generated by Pod::Man 2.28 (Pod::Simple 3.29)
-.\"
-.\" Standard preamble:
-.\" ========================================================================
-.de Sp \" Vertical space (when we can't use .PP)
-.if t .sp .5v
-.if n .sp
-..
-.de Vb \" Begin verbatim text
-.ft CW
-.nf
-.ne \\$1
-..
-.de Ve \" End verbatim text
-.ft R
-.fi
-..
-.\" Set up some character translations and predefined strings. \*(-- will
-.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
-.\" double quote, and \*(R" will give a right double quote. \*(C+ will
-.\" give a nicer C++. Capital omega is used to do unbreakable dashes and
-.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff,
-.\" nothing in troff, for use with C<>.
-.tr \(*W-
-.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
-.ie n \{\
-. ds -- \(*W-
-. ds PI pi
-. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
-. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch
-. ds L" ""
-. ds R" ""
-. ds C` ""
-. ds C' ""
-'br\}
-.el\{\
-. ds -- \|\(em\|
-. ds PI \(*p
-. ds L" ``
-. ds R" ''
-. ds C`
-. ds C'
-'br\}
-.\"
-.\" Escape single quotes in literal strings from groff's Unicode transform.
-.ie \n(.g .ds Aq \(aq
-.el .ds Aq '
-.\"
-.\" If the F register is turned on, we'll generate index entries on stderr for
-.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
-.\" entries marked with X<> in POD. Of course, you'll have to process the
-.\" output yourself in some meaningful fashion.
-.\"
-.\" Avoid warning from groff about undefined register 'F'.
-.de IX
-..
-.nr rF 0
-.if \n(.g .if rF .nr rF 1
-.if (\n(rF:(\n(.g==0)) \{
-. if \nF \{
-. de IX
-. tm Index:\\$1\t\\n%\t"\\$2"
-..
-. if !\nF==2 \{
-. nr % 0
-. nr F 2
-. \}
-. \}
-.\}
-.rr rF
-.\" ========================================================================
-.\"
-.IX Title "DBD::Mem 3pm"
-.TH DBD::Mem 3pm "2017-12-28" "perl v5.22.1" "User Contributed Perl Documentation"
-.\" For nroff, turn off justification. Always turn off hyphenation; it makes
-.\" way too many mistakes in technical documents.
-.if n .ad l
-.nh
-.SH "NAME"
-DBD::Mem \- a DBI driver for Mem & MLMem files
-.SH "SYNOPSIS"
-.IX Header "SYNOPSIS"
-.Vb 3
-\& use DBI;
-\& $dbh = DBI\->connect(\*(Aqdbi:Mem:\*(Aq, undef, undef, {});
-\& $dbh = DBI\->connect(\*(Aqdbi:Mem:\*(Aq, undef, undef, {RaiseError => 1});
-\&
-\& # or
-\& $dbh = DBI\->connect(\*(Aqdbi:Mem:\*(Aq);
-\& $dbh = DBI\->connect(\*(AqDBI:Mem(RaiseError=1):\*(Aq);
-.Ve
-.PP
-and other variations on \fIconnect()\fR as shown in the \s-1DBI\s0 docs and
-<DBI::DBD::SqlEngine metadata|DBI::DBD::SqlEngine/Metadata>.
-.PP
-Use standard \s-1DBI\s0 prepare, execute, fetch, placeholders, etc.,
-see \*(L"\s-1QUICK START\*(R"\s0 for an example.
-.SH "DESCRIPTION"
-.IX Header "DESCRIPTION"
-DBD::Mem is a database management system that works right out of the box.
-If you have a standard installation of Perl and \s-1DBI\s0 you can begin creating,
-accessing, and modifying simple database tables without any further modules.
-You can add other modules (e.g., SQL::Statement) for improved functionality.
-.PP
-DBD::Mem doesn't store any data persistently \- all data has the lifetime of
-the instantiated \f(CW$dbh\fR. The main reason to use DBD::Mem is to use extended
-features of SQL::Statement where temporary tables are required. One can
-use DBD::Mem to simulate \f(CW\*(C`VIEWS\*(C'\fR or sub-queries.
-.PP
-Bundling \f(CW\*(C`DBD::Mem\*(C'\fR with \s-1DBI\s0 will allow us further compatibility checks
-of DBI::DBD::SqlEngine beyond the capabilities of DBD::File and
-\&\s-1DBD::DBM\s0. This will ensure \s-1DBI\s0 provided basis for drivers like
-DBD::AnyData2 or DBD::Amazon are better prepared and tested for
-not-file based backends.
-.SS "Metadata"
-.IX Subsection "Metadata"
-There're no new meta data introduced by \f(CW\*(C`DBD::Mem\*(C'\fR. See
-\&\*(L"Metadata\*(R" in DBI::DBD::SqlEngine for full description.
-.SH "GETTING HELP, MAKING SUGGESTIONS, AND REPORTING BUGS"
-.IX Header "GETTING HELP, MAKING SUGGESTIONS, AND REPORTING BUGS"
-If you need help installing or using DBD::Mem, please write to the \s-1DBI\s0
-users mailing list at <mailto:dbi\-users@perl.org> or to the
-comp.lang.perl.modules newsgroup on usenet. I cannot always answer
-every question quickly but there are many on the mailing list or in
-the newsgroup who can.
-.PP
-\&\s-1DBD\s0 developers for \s-1DBD\s0's which rely on DBI::DBD::SqlEngine or DBD::Mem or
-use one of them as an example are suggested to join the \s-1DBI\s0 developers
-mailing list at <mailto:dbi\-dev@perl.org> and strongly encouraged to join our
-\&\s-1IRC\s0 channel at <irc://irc.perl.org/dbi>.
-.PP
-If you have suggestions, ideas for improvements, or bugs to report, please
-report a bug as described in \s-1DBI.\s0 Do not mail any of the authors directly,
-you might not get an answer.
-.PP
-When reporting bugs, please send the output of \f(CW\*(C`$dbh\->mem_versions($table)\*(C'\fR
-for a table that exhibits the bug and as small a sample as you can make of
-the code that produces the bug. And of course, patches are welcome, too
-:\-).
-.PP
-If you need enhancements quickly, you can get commercial support as
-described at <http://dbi.perl.org/support/> or you can contact Jens Rehsack
-at rehsack@cpan.org for commercial support.
-.SH "AUTHOR AND COPYRIGHT"
-.IX Header "AUTHOR AND COPYRIGHT"
-This module is written by Jens Rehsack < rehsack \s-1AT\s0 cpan.org >.
-.PP
-.Vb 1
-\& Copyright (c) 2016\- by Jens Rehsack, all rights reserved.
-.Ve
-.PP
-You may freely distribute and/or modify this module under the terms of
-either the \s-1GNU\s0 General Public License (\s-1GPL\s0) or the Artistic License, as
-specified in the Perl \s-1README\s0 file.
-.SH "SEE ALSO"
-.IX Header "SEE ALSO"
-\&\s-1DBI\s0 for the Database interface of the Perl Programming Language.
-.PP
-SQL::Statement and DBI::SQL::Nano for the available \s-1SQL\s0 engines.
-.PP
-SQL::Statement::RAM where the implementation is shamelessly stolen from
-to allow \s-1DBI\s0 bundled Pure-Perl drivers increase the test coverage.
-.PP
-DBD::SQLite using \f(CW\*(C`dbname=:memory:\*(C'\fR for an incredible fast in-memory database engine.
+++ /dev/null
-.\" Automatically generated by Pod::Man 2.28 (Pod::Simple 3.29)
-.\"
-.\" Standard preamble:
-.\" ========================================================================
-.de Sp \" Vertical space (when we can't use .PP)
-.if t .sp .5v
-.if n .sp
-..
-.de Vb \" Begin verbatim text
-.ft CW
-.nf
-.ne \\$1
-..
-.de Ve \" End verbatim text
-.ft R
-.fi
-..
-.\" Set up some character translations and predefined strings. \*(-- will
-.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
-.\" double quote, and \*(R" will give a right double quote. \*(C+ will
-.\" give a nicer C++. Capital omega is used to do unbreakable dashes and
-.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff,
-.\" nothing in troff, for use with C<>.
-.tr \(*W-
-.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
-.ie n \{\
-. ds -- \(*W-
-. ds PI pi
-. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
-. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch
-. ds L" ""
-. ds R" ""
-. ds C` ""
-. ds C' ""
-'br\}
-.el\{\
-. ds -- \|\(em\|
-. ds PI \(*p
-. ds L" ``
-. ds R" ''
-. ds C`
-. ds C'
-'br\}
-.\"
-.\" Escape single quotes in literal strings from groff's Unicode transform.
-.ie \n(.g .ds Aq \(aq
-.el .ds Aq '
-.\"
-.\" If the F register is turned on, we'll generate index entries on stderr for
-.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
-.\" entries marked with X<> in POD. Of course, you'll have to process the
-.\" output yourself in some meaningful fashion.
-.\"
-.\" Avoid warning from groff about undefined register 'F'.
-.de IX
-..
-.nr rF 0
-.if \n(.g .if rF .nr rF 1
-.if (\n(rF:(\n(.g==0)) \{
-. if \nF \{
-. de IX
-. tm Index:\\$1\t\\n%\t"\\$2"
-..
-. if !\nF==2 \{
-. nr % 0
-. nr F 2
-. \}
-. \}
-.\}
-.rr rF
-.\" ========================================================================
-.\"
-.IX Title "DBD::Proxy 3pm"
-.TH DBD::Proxy 3pm "2014-09-21" "perl v5.22.1" "User Contributed Perl Documentation"
-.\" For nroff, turn off justification. Always turn off hyphenation; it makes
-.\" way too many mistakes in technical documents.
-.if n .ad l
-.nh
-.SH "NAME"
-DBD::Proxy \- A proxy driver for the DBI
-.SH "SYNOPSIS"
-.IX Header "SYNOPSIS"
-.Vb 1
-\& use DBI;
-\&
-\& $dbh = DBI\->connect("dbi:Proxy:hostname=$host;port=$port;dsn=$db",
-\& $user, $passwd);
-\&
-\& # See the DBI module documentation for full details
-.Ve
-.SH "DESCRIPTION"
-.IX Header "DESCRIPTION"
-DBD::Proxy is a Perl module for connecting to a database via a remote
-\&\s-1DBI\s0 driver. See DBD::Gofer for an alternative with different trade-offs.
-.PP
-This is of course not needed for \s-1DBI\s0 drivers which already
-support connecting to a remote database, but there are engines which
-don't offer network connectivity.
-.PP
-Another application is offering database access through a firewall, as
-the driver offers query based restrictions. For example you can
-restrict queries to exactly those that are used in a given \s-1CGI\s0
-application.
-.PP
-Speaking of \s-1CGI,\s0 another application is (or rather, will be) to reduce
-the database connect/disconnect overhead from \s-1CGI\s0 scripts by using
-proxying the connect_cached method. The proxy server will hold the
-database connections open in a cache. The \s-1CGI\s0 script then trades the
-database connect/disconnect overhead for the DBD::Proxy
-connect/disconnect overhead which is typically much less.
-.SH "CONNECTING TO THE DATABASE"
-.IX Header "CONNECTING TO THE DATABASE"
-Before connecting to a remote database, you must ensure, that a Proxy
-server is running on the remote machine. There's no default port, so
-you have to ask your system administrator for the port number. See
-DBI::ProxyServer for details.
-.PP
-Say, your Proxy server is running on machine \*(L"alpha\*(R", port 3334, and
-you'd like to connect to an \s-1ODBC\s0 database called \*(L"mydb\*(R" as user \*(L"joe\*(R"
-with password \*(L"hello\*(R". When using \s-1DBD::ODBC\s0 directly, you'd do a
-.PP
-.Vb 1
-\& $dbh = DBI\->connect("DBI:ODBC:mydb", "joe", "hello");
-.Ve
-.PP
-With DBD::Proxy this becomes
-.PP
-.Vb 2
-\& $dsn = "DBI:Proxy:hostname=alpha;port=3334;dsn=DBI:ODBC:mydb";
-\& $dbh = DBI\->connect($dsn, "joe", "hello");
-.Ve
-.PP
-You see, this is mainly the same. The DBD::Proxy module will create a
-connection to the Proxy server on \*(L"alpha\*(R" which in turn will connect
-to the \s-1ODBC\s0 database.
-.PP
-Refer to the \s-1DBI\s0 documentation on the \f(CW\*(C`connect\*(C'\fR method for a way
-to automatically use DBD::Proxy without having to change your code.
-.PP
-DBD::Proxy's \s-1DSN\s0 string has the format
-.PP
-.Vb 1
-\& $dsn = "DBI:Proxy:key1=val1; ... ;keyN=valN;dsn=valDSN";
-.Ve
-.PP
-In other words, it is a collection of key/value pairs. The following
-keys are recognized:
-.IP "hostname" 4
-.IX Item "hostname"
-.PD 0
-.IP "port" 4
-.IX Item "port"
-.PD
-Hostname and port of the Proxy server; these keys must be present,
-no defaults. Example:
-.Sp
-.Vb 1
-\& hostname=alpha;port=3334
-.Ve
-.IP "dsn" 4
-.IX Item "dsn"
-The value of this attribute will be used as a dsn name by the Proxy
-server. Thus it must have the format \f(CW\*(C`DBI:driver:...\*(C'\fR, in particular
-it will contain colons. The \fIdsn\fR value may contain semicolons, hence
-this key *must* be the last and it's value will be the complete
-remaining part of the dsn. Example:
-.Sp
-.Vb 1
-\& dsn=DBI:ODBC:mydb
-.Ve
-.IP "cipher" 4
-.IX Item "cipher"
-.PD 0
-.IP "key" 4
-.IX Item "key"
-.IP "usercipher" 4
-.IX Item "usercipher"
-.IP "userkey" 4
-.IX Item "userkey"
-.PD
-By using these fields you can enable encryption. If you set,
-for example,
-.Sp
-.Vb 1
-\& cipher=$class;key=$key
-.Ve
-.Sp
-(note the semicolon) then DBD::Proxy will create a new cipher object
-by executing
-.Sp
-.Vb 1
-\& $cipherRef = $class\->new(pack("H*", $key));
-.Ve
-.Sp
-and pass this object to the RPC::PlClient module when creating a
-client. See RPC::PlClient. Example:
-.Sp
-.Vb 1
-\& cipher=IDEA;key=97cd2375efa329aceef2098babdc9721
-.Ve
-.Sp
-The usercipher/userkey attributes allow you to use two phase encryption:
-The cipher/key encryption will be used in the login and authorisation
-phase. Once the client is authorised, he will change to usercipher/userkey
-encryption. Thus the cipher/key pair is a \fBhost\fR based secret, typically
-less secure than the usercipher/userkey secret and readable by anyone.
-The usercipher/userkey secret is \fByour\fR private secret.
-.Sp
-Of course encryption requires an appropriately configured server. See
-\&\*(L"\s-1CONFIGURATION FILE\*(R"\s0 in DBD::ProxyServer.
-.IP "debug" 4
-.IX Item "debug"
-Turn on debugging mode
-.IP "stderr" 4
-.IX Item "stderr"
-This attribute will set the corresponding attribute of the RPC::PlClient
-object, thus logging will not use \fIsyslog()\fR, but redirected to stderr.
-This is the default under Windows.
-.Sp
-.Vb 1
-\& stderr=1
-.Ve
-.IP "logfile" 4
-.IX Item "logfile"
-Similar to the stderr attribute, but output will be redirected to the
-given file.
-.Sp
-.Vb 1
-\& logfile=/dev/null
-.Ve
-.IP "RowCacheSize" 4
-.IX Item "RowCacheSize"
-The DBD::Proxy driver supports this attribute (which is \s-1DBI\s0 standard,
-as of \s-1DBI 1.02\s0). It's used to reduce network round-trips by fetching
-multiple rows in one go. The current default value is 20, but this may
-change.
-.IP "proxy_no_finish" 4
-.IX Item "proxy_no_finish"
-This attribute can be used to reduce network traffic: If the
-application is calling \f(CW$sth\fR\->\fIfinish()\fR then the proxy tells the server
-to finish the remote statement handle. Of course this slows down things
-quite a lot, but is perfectly good for reducing memory usage with
-persistent connections.
-.Sp
-However, if you set the \fIproxy_no_finish\fR attribute to a \s-1TRUE\s0 value,
-either in the database handle or in the statement handle, then \fIfinish()\fR
-calls will be suppressed. This is what you want, for example, in small
-and fast \s-1CGI\s0 applications.
-.IP "proxy_quote" 4
-.IX Item "proxy_quote"
-This attribute can be used to reduce network traffic: By default calls
-to \f(CW$dbh\fR\->\fIquote()\fR are passed to the remote driver. Of course this slows
-down things quite a lot, but is the safest default behaviour.
-.Sp
-However, if you set the \fIproxy_quote\fR attribute to the value '\f(CW\*(C`local\*(C'\fR'
-either in the database handle or in the statement handle, and the call
-to quote has only one parameter, then the local default \s-1DBI\s0 quote
-method will be used (which will be faster but may be wrong).
-.SH "KNOWN ISSUES"
-.IX Header "KNOWN ISSUES"
-.SS "Unproxied method calls"
-.IX Subsection "Unproxied method calls"
-If a method isn't being proxied, try declaring a stub sub in the appropriate
-package (DBD::Proxy::db for a dbh method, and DBD::Proxy::st for an sth method).
-For example:
-.PP
-.Vb 1
-\& sub DBD::Proxy::db::selectall_arrayref;
-.Ve
-.PP
-That will enable selectall_arrayref to be proxied.
-.PP
-Currently many methods aren't explicitly proxied and so you get the \s-1DBI\s0's
-default methods executed on the client.
-.PP
-Some of those methods, like selectall_arrayref, may then call other methods
-that are proxied (selectall_arrayref calls fetchall_arrayref which calls fetch
-which is proxied). So things may appear to work but operate more slowly than
-the could.
-.PP
-This may all change in a later version.
-.SS "Complex handle attributes"
-.IX Subsection "Complex handle attributes"
-Sometimes handles are having complex attributes like hash refs or
-array refs and not simple strings or integers. For example, with
-\&\s-1DBD::CSV,\s0 you would like to write something like
-.PP
-.Vb 2
-\& $dbh\->{"csv_tables"}\->{"passwd"} =
-\& { "sep_char" => ":", "eol" => "\en";
-.Ve
-.PP
-The above example would advice the \s-1CSV\s0 driver to assume the file
-\&\*(L"passwd\*(R" to be in the format of the /etc/passwd file: Colons as
-separators and a line feed without carriage return as line
-terminator.
-.PP
-Surprisingly this example doesn't work with the proxy driver. To understand
-the reasons, you should consider the following: The Perl compiler is
-executing the above example in two steps:
-.IP "1." 4
-The first step is fetching the value of the key \*(L"csv_tables\*(R" in the
-handle \f(CW$dbh\fR. The value returned is complex, a hash ref.
-.IP "2." 4
-The second step is storing some value (the right hand side of the
-assignment) as the key \*(L"passwd\*(R" in the hash ref from step 1.
-.PP
-This becomes a little bit clearer, if we rewrite the above code:
-.PP
-.Vb 2
-\& $tables = $dbh\->{"csv_tables"};
-\& $tables\->{"passwd"} = { "sep_char" => ":", "eol" => "\en";
-.Ve
-.PP
-While the examples work fine without the proxy, the fail due to a
-subtle difference in step 1: By \s-1DBI\s0 magic, the hash ref
-\&\f(CW$dbh\fR\->{'csv_tables'} is returned from the server to the client.
-The client creates a local copy. This local copy is the result of
-step 1. In other words, step 2 modifies a local copy of the hash ref,
-but not the server's hash ref.
-.PP
-The workaround is storing the modified local copy back to the server:
-.PP
-.Vb 3
-\& $tables = $dbh\->{"csv_tables"};
-\& $tables\->{"passwd"} = { "sep_char" => ":", "eol" => "\en";
-\& $dbh\->{"csv_tables"} = $tables;
-.Ve
-.SH "SECURITY WARNING"
-.IX Header "SECURITY WARNING"
-RPC::PlClient used underneath is not secure due to serializing and
-deserializing data with Storable module. Use the proxy driver only in
-trusted environment.
-.SH "AUTHOR AND COPYRIGHT"
-.IX Header "AUTHOR AND COPYRIGHT"
-This module is Copyright (c) 1997, 1998
-.PP
-.Vb 4
-\& Jochen Wiedmann
-\& Am Eisteich 9
-\& 72555 Metzingen
-\& Germany
-\&
-\& Email: joe@ispsoft.de
-\& Phone: +49 7123 14887
-.Ve
-.PP
-The DBD::Proxy module is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself. In particular permission
-is granted to Tim Bunce for distributing this as a part of the \s-1DBI.\s0
-.SH "SEE ALSO"
-.IX Header "SEE ALSO"
-\&\s-1DBI\s0, RPC::PlClient, Storable
+++ /dev/null
-.\" Automatically generated by Pod::Man 2.28 (Pod::Simple 3.29)
-.\"
-.\" Standard preamble:
-.\" ========================================================================
-.de Sp \" Vertical space (when we can't use .PP)
-.if t .sp .5v
-.if n .sp
-..
-.de Vb \" Begin verbatim text
-.ft CW
-.nf
-.ne \\$1
-..
-.de Ve \" End verbatim text
-.ft R
-.fi
-..
-.\" Set up some character translations and predefined strings. \*(-- will
-.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
-.\" double quote, and \*(R" will give a right double quote. \*(C+ will
-.\" give a nicer C++. Capital omega is used to do unbreakable dashes and
-.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff,
-.\" nothing in troff, for use with C<>.
-.tr \(*W-
-.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
-.ie n \{\
-. ds -- \(*W-
-. ds PI pi
-. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
-. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch
-. ds L" ""
-. ds R" ""
-. ds C` ""
-. ds C' ""
-'br\}
-.el\{\
-. ds -- \|\(em\|
-. ds PI \(*p
-. ds L" ``
-. ds R" ''
-. ds C`
-. ds C'
-'br\}
-.\"
-.\" Escape single quotes in literal strings from groff's Unicode transform.
-.ie \n(.g .ds Aq \(aq
-.el .ds Aq '
-.\"
-.\" If the F register is turned on, we'll generate index entries on stderr for
-.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
-.\" entries marked with X<> in POD. Of course, you'll have to process the
-.\" output yourself in some meaningful fashion.
-.\"
-.\" Avoid warning from groff about undefined register 'F'.
-.de IX
-..
-.nr rF 0
-.if \n(.g .if rF .nr rF 1
-.if (\n(rF:(\n(.g==0)) \{
-. if \nF \{
-. de IX
-. tm Index:\\$1\t\\n%\t"\\$2"
-..
-. if !\nF==2 \{
-. nr % 0
-. nr F 2
-. \}
-. \}
-.\}
-.rr rF
-.\" ========================================================================
-.\"
-.IX Title "DBD::Sponge 3pm"
-.TH DBD::Sponge 3pm "2015-05-26" "perl v5.22.1" "User Contributed Perl Documentation"
-.\" For nroff, turn off justification. Always turn off hyphenation; it makes
-.\" way too many mistakes in technical documents.
-.if n .ad l
-.nh
-.SH "NAME"
-DBD::Sponge \- Create a DBI statement handle from Perl data
-.SH "SYNOPSIS"
-.IX Header "SYNOPSIS"
-.Vb 7
-\& my $sponge = DBI\->connect("dbi:Sponge:","","",{ RaiseError => 1 });
-\& my $sth = $sponge\->prepare($statement, {
-\& rows => $data,
-\& NAME => $names,
-\& %attr
-\& }
-\& );
-.Ve
-.SH "DESCRIPTION"
-.IX Header "DESCRIPTION"
-DBD::Sponge is useful for making a Perl data structure accessible through a
-standard \s-1DBI\s0 statement handle. This may be useful to \s-1DBD\s0 module authors who
-need to transform data in this way.
-.SH "METHODS"
-.IX Header "METHODS"
-.SS "\fIconnect()\fP"
-.IX Subsection "connect()"
-.Vb 1
-\& my $sponge = DBI\->connect("dbi:Sponge:","","",{ RaiseError => 1 });
-.Ve
-.PP
-Here's a sample syntax for creating a database handle for the Sponge driver.
-No username and password are needed.
-.SS "\fIprepare()\fP"
-.IX Subsection "prepare()"
-.Vb 6
-\& my $sth = $sponge\->prepare($statement, {
-\& rows => $data,
-\& NAME => $names,
-\& %attr
-\& }
-\& );
-.Ve
-.IP "\(bu" 4
-The \f(CW$statement\fR here is an arbitrary statement or name you want
-to provide as identity of your data. If you're using DBI::Profile
-it will appear in the profile data.
-.Sp
-Generally it's expected that you are preparing a statement handle
-as if a \f(CW\*(C`select\*(C'\fR statement happened.
-.IP "\(bu" 4
-\&\f(CW$data\fR is a reference to the data you are providing, given as an array of arrays.
-.IP "\(bu" 4
-\&\f(CW$names\fR is a reference an array of column names for the \f(CW$data\fR you are providing.
-The number and order should match the number and ordering of the \f(CW$data\fR columns.
-.IP "\(bu" 4
-\&\f(CW%attr\fR is a hash of other standard \s-1DBI\s0 attributes that you might pass to a prepare statement.
-.Sp
-Currently only \s-1NAME, TYPE,\s0 and \s-1PRECISION\s0 are supported.
-.SH "BUGS"
-.IX Header "BUGS"
-Using this module to prepare INSERT-like statements is not currently documented.
-.SH "AUTHOR AND COPYRIGHT"
-.IX Header "AUTHOR AND COPYRIGHT"
-This module is Copyright (c) 2003 Tim Bunce
-.PP
-Documentation initially written by Mark Stosberg
-.PP
-The DBD::Sponge module is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself. In particular permission
-is granted to Tim Bunce for distributing this as a part of the \s-1DBI.\s0
-.SH "SEE ALSO"
-.IX Header "SEE ALSO"
-\&\s-1DBI\s0
+++ /dev/null
-.\" Automatically generated by Pod::Man 2.28 (Pod::Simple 3.29)
-.\"
-.\" Standard preamble:
-.\" ========================================================================
-.de Sp \" Vertical space (when we can't use .PP)
-.if t .sp .5v
-.if n .sp
-..
-.de Vb \" Begin verbatim text
-.ft CW
-.nf
-.ne \\$1
-..
-.de Ve \" End verbatim text
-.ft R
-.fi
-..
-.\" Set up some character translations and predefined strings. \*(-- will
-.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
-.\" double quote, and \*(R" will give a right double quote. \*(C+ will
-.\" give a nicer C++. Capital omega is used to do unbreakable dashes and
-.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff,
-.\" nothing in troff, for use with C<>.
-.tr \(*W-
-.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
-.ie n \{\
-. ds -- \(*W-
-. ds PI pi
-. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
-. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch
-. ds L" ""
-. ds R" ""
-. ds C` ""
-. ds C' ""
-'br\}
-.el\{\
-. ds -- \|\(em\|
-. ds PI \(*p
-. ds L" ``
-. ds R" ''
-. ds C`
-. ds C'
-'br\}
-.\"
-.\" Escape single quotes in literal strings from groff's Unicode transform.
-.ie \n(.g .ds Aq \(aq
-.el .ds Aq '
-.\"
-.\" If the F register is turned on, we'll generate index entries on stderr for
-.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
-.\" entries marked with X<> in POD. Of course, you'll have to process the
-.\" output yourself in some meaningful fashion.
-.\"
-.\" Avoid warning from groff about undefined register 'F'.
-.de IX
-..
-.nr rF 0
-.if \n(.g .if rF .nr rF 1
-.if (\n(rF:(\n(.g==0)) \{
-. if \nF \{
-. de IX
-. tm Index:\\$1\t\\n%\t"\\$2"
-..
-. if !\nF==2 \{
-. nr % 0
-. nr F 2
-. \}
-. \}
-.\}
-.rr rF
-.\" ========================================================================
-.\"
-.IX Title "DBI 3pm"
-.TH DBI 3pm "2018-03-19" "perl v5.22.1" "User Contributed Perl Documentation"
-.\" For nroff, turn off justification. Always turn off hyphenation; it makes
-.\" way too many mistakes in technical documents.
-.if n .ad l
-.nh
-.SH "NAME"
-DBI \- Database independent interface for Perl
-.SH "SYNOPSIS"
-.IX Header "SYNOPSIS"
-.Vb 1
-\& use DBI;
-\&
-\& @driver_names = DBI\->available_drivers;
-\& %drivers = DBI\->installed_drivers;
-\& @data_sources = DBI\->data_sources($driver_name, \e%attr);
-\&
-\& $dbh = DBI\->connect($data_source, $username, $auth, \e%attr);
-\&
-\& $rv = $dbh\->do($statement);
-\& $rv = $dbh\->do($statement, \e%attr);
-\& $rv = $dbh\->do($statement, \e%attr, @bind_values);
-\&
-\& $ary_ref = $dbh\->selectall_arrayref($statement);
-\& $hash_ref = $dbh\->selectall_hashref($statement, $key_field);
-\&
-\& $ary_ref = $dbh\->selectcol_arrayref($statement);
-\& $ary_ref = $dbh\->selectcol_arrayref($statement, \e%attr);
-\&
-\& @row_ary = $dbh\->selectrow_array($statement);
-\& $ary_ref = $dbh\->selectrow_arrayref($statement);
-\& $hash_ref = $dbh\->selectrow_hashref($statement);
-\&
-\& $sth = $dbh\->prepare($statement);
-\& $sth = $dbh\->prepare_cached($statement);
-\&
-\& $rc = $sth\->bind_param($p_num, $bind_value);
-\& $rc = $sth\->bind_param($p_num, $bind_value, $bind_type);
-\& $rc = $sth\->bind_param($p_num, $bind_value, \e%attr);
-\&
-\& $rv = $sth\->execute;
-\& $rv = $sth\->execute(@bind_values);
-\& $rv = $sth\->execute_array(\e%attr, ...);
-\&
-\& $rc = $sth\->bind_col($col_num, \e$col_variable);
-\& $rc = $sth\->bind_columns(@list_of_refs_to_vars_to_bind);
-\&
-\& @row_ary = $sth\->fetchrow_array;
-\& $ary_ref = $sth\->fetchrow_arrayref;
-\& $hash_ref = $sth\->fetchrow_hashref;
-\&
-\& $ary_ref = $sth\->fetchall_arrayref;
-\& $ary_ref = $sth\->fetchall_arrayref( $slice, $max_rows );
-\&
-\& $hash_ref = $sth\->fetchall_hashref( $key_field );
-\&
-\& $rv = $sth\->rows;
-\&
-\& $rc = $dbh\->begin_work;
-\& $rc = $dbh\->commit;
-\& $rc = $dbh\->rollback;
-\&
-\& $quoted_string = $dbh\->quote($string);
-\&
-\& $rc = $h\->err;
-\& $str = $h\->errstr;
-\& $rv = $h\->state;
-\&
-\& $rc = $dbh\->disconnect;
-.Ve
-.PP
-\&\fIThe synopsis above only lists the major methods and parameters.\fR
-.SS "\s-1GETTING HELP\s0"
-.IX Subsection "GETTING HELP"
-\fIGeneral\fR
-.IX Subsection "General"
-.PP
-Before asking any questions, reread this document, consult the
-archives and read the \s-1DBI FAQ.\s0 The archives are listed
-at the end of this document and on the \s-1DBI\s0 home page <http://dbi.perl.org/support/>
-.PP
-You might also like to read the Advanced \s-1DBI\s0 Tutorial at
-<http://www.slideshare.net/Tim.Bunce/dbi\-advanced\-tutorial\-2007>
-.PP
-To help you make the best use of the dbi-users mailing list,
-and any other lists or forums you may use, I recommend that you read
-\&\*(L"Getting Answers\*(R" by Mike Ash: <http://mikeash.com/getting_answers.html>.
-.PP
-\fIMailing Lists\fR
-.IX Subsection "Mailing Lists"
-.PP
-If you have questions about \s-1DBI,\s0 or \s-1DBD\s0 driver modules, you can get
-help from the \fIdbi\-users@perl.org\fR mailing list. This is the best way to get
-help. You don't have to subscribe to the list in order to post, though I'd
-recommend it. You can get help on subscribing and using the list by emailing
-\&\fIdbi\-users\-help@perl.org\fR.
-.PP
-Please note that Tim Bunce does not maintain the mailing lists or the
-web pages (generous volunteers do that). So please don't send mail
-directly to him; he just doesn't have the time to answer questions
-personally. The \fIdbi-users\fR mailing list has lots of experienced
-people who should be able to help you if you need it. If you do email
-Tim he is very likely to just forward it to the mailing list.
-.PP
-\fI\s-1IRC\s0\fR
-.IX Subsection "IRC"
-.PP
-\&\s-1DBI IRC\s0 Channel: #dbi on irc.perl.org (<irc://irc.perl.org/#dbi>)
-.PP
-\fIOnline\fR
-.IX Subsection "Online"
-.PP
-StackOverflow has a \s-1DBI\s0 tag <http://stackoverflow.com/questions/tagged/dbi>
-with over 800 questions.
-.PP
-The \s-1DBI\s0 home page at <http://dbi.perl.org/> and the \s-1DBI FAQ\s0
-at <http://faq.dbi\-support.com/> may be worth a visit.
-They include links to other resources, but \fIare rather out-dated\fR.
-.PP
-\fIReporting a Bug\fR
-.IX Subsection "Reporting a Bug"
-.PP
-If you think you've found a bug then please read
-\&\*(L"How to Report Bugs Effectively\*(R" by Simon Tatham:
-<http://www.chiark.greenend.org.uk/~sgtatham/bugs.html>.
-.PP
-If you think you've found a memory leak then read \*(L"Memory Leaks\*(R".
-.PP
-Your problem is most likely related to the specific \s-1DBD\s0 driver module you're
-using. If that's the case then click on the 'Bugs' link on the <http://metacpan.org>
-page for your driver. Only submit a bug report against the \s-1DBI\s0 itself if you're
-sure that your issue isn't related to the driver you're using.
-.SS "\s-1NOTES\s0"
-.IX Subsection "NOTES"
-This is the \s-1DBI\s0 specification that corresponds to \s-1DBI\s0 version 1.641
-(see DBI::Changes for details).
-.PP
-The \s-1DBI\s0 is evolving at a steady pace, so it's good to check that
-you have the latest copy.
-.PP
-The significant user-visible changes in each release are documented
-in the DBI::Changes module so you can read them by executing
-\&\f(CW\*(C`perldoc DBI::Changes\*(C'\fR.
-.PP
-Some \s-1DBI\s0 changes require changes in the drivers, but the drivers
-can take some time to catch up. Newer versions of the \s-1DBI\s0 have
-added features that may not yet be supported by the drivers you
-use. Talk to the authors of your drivers if you need a new feature
-that is not yet supported.
-.PP
-Features added after \s-1DBI 1.21 \s0(February 2002) are marked in the
-text with the version number of the \s-1DBI\s0 release they first appeared in.
-.PP
-Extensions to the \s-1DBI API\s0 often use the \f(CW\*(C`DBIx::*\*(C'\fR namespace.
-See \*(L"Naming Conventions and Name Space\*(R". \s-1DBI\s0 extension modules
-can be found at <https://metacpan.org/search?q=DBIx>. And all modules
-related to the \s-1DBI\s0 can be found at <https://metacpan.org/search?q=DBI>.
-.SH "DESCRIPTION"
-.IX Header "DESCRIPTION"
-The \s-1DBI\s0 is a database access module for the Perl programming language. It defines
-a set of methods, variables, and conventions that provide a consistent
-database interface, independent of the actual database being used.
-.PP
-It is important to remember that the \s-1DBI\s0 is just an interface.
-The \s-1DBI\s0 is a layer
-of \*(L"glue\*(R" between an application and one or more database \fIdriver\fR
-modules. It is the driver modules which do most of the real work. The \s-1DBI\s0
-provides a standard interface and framework for the drivers to operate
-within.
-.PP
-This document often uses terms like \fIreferences\fR, \fIobjects\fR,
-\&\fImethods\fR. If you're not familiar with those terms then it would
-be a good idea to read at least the following perl manuals first:
-perlreftut, perldsc, perllol, and perlboot.
-.SS "Architecture of a \s-1DBI\s0 Application"
-.IX Subsection "Architecture of a DBI Application"
-.Vb 11
-\& |<\- Scope of DBI \->|
-\& .\-. .\-\-\-\-\-\-\-\-\-\-\-\-\-\-. .\-\-\-\-\-\-\-\-\-\-\-\-\-.
-\& .\-\-\-\-\-\-\-. | |\-\-\-| XYZ Driver |\-\-\-| XYZ Engine |
-\& | Perl | | | \`\-\-\-\-\-\-\-\-\-\-\-\-\-\-\*(Aq \`\-\-\-\-\-\-\-\-\-\-\-\-\-\*(Aq
-\& | script| |A| |D| .\-\-\-\-\-\-\-\-\-\-\-\-\-\-. .\-\-\-\-\-\-\-\-\-\-\-\-\-.
-\& | using |\-\-|P|\-\-|B|\-\-\-|Oracle Driver |\-\-\-|Oracle Engine|
-\& | DBI | |I| |I| \`\-\-\-\-\-\-\-\-\-\-\-\-\-\-\*(Aq \`\-\-\-\-\-\-\-\-\-\-\-\-\-\*(Aq
-\& | API | | |...
-\& |methods| | |... Other drivers
-\& \`\-\-\-\-\-\-\-\*(Aq | |...
-\& \`\-\*(Aq
-.Ve
-.PP
-The \s-1API,\s0 or Application Programming Interface, defines the
-call interface and variables for Perl scripts to use. The \s-1API\s0
-is implemented by the Perl \s-1DBI\s0 extension.
-.PP
-The \s-1DBI \s0\*(L"dispatches\*(R" the method calls to the appropriate driver for
-actual execution. The \s-1DBI\s0 is also responsible for the dynamic loading
-of drivers, error checking and handling, providing default
-implementations for methods, and many other non-database specific duties.
-.PP
-Each driver
-contains implementations of the \s-1DBI\s0 methods using the
-private interface functions of the corresponding database engine. Only authors
-of sophisticated/multi\-database applications or generic library
-functions need be concerned with drivers.
-.SS "Notation and Conventions"
-.IX Subsection "Notation and Conventions"
-The following conventions are used in this document:
-.PP
-.Vb 11
-\& $dbh Database handle object
-\& $sth Statement handle object
-\& $drh Driver handle object (rarely seen or used in applications)
-\& $h Any of the handle types above ($dbh, $sth, or $drh)
-\& $rc General Return Code (boolean: true=ok, false=error)
-\& $rv General Return Value (typically an integer)
-\& @ary List of values returned from the database, typically a row of data
-\& $rows Number of rows processed (if available, else \-1)
-\& $fh A filehandle
-\& undef NULL values are represented by undefined values in Perl
-\& \e%attr Reference to a hash of attribute values passed to methods
-.Ve
-.PP
-Note that Perl will automatically destroy database and statement handle objects
-if all references to them are deleted.
-.SS "Outline Usage"
-.IX Subsection "Outline Usage"
-To use \s-1DBI,\s0
-first you need to load the \s-1DBI\s0 module:
-.PP
-.Vb 2
-\& use DBI;
-\& use strict;
-.Ve
-.PP
-(The \f(CW\*(C`use strict;\*(C'\fR isn't required but is strongly recommended.)
-.PP
-Then you need to \*(L"connect\*(R" to your data source and get a \fIhandle\fR for that
-connection:
-.PP
-.Vb 2
-\& $dbh = DBI\->connect($dsn, $user, $password,
-\& { RaiseError => 1, AutoCommit => 0 });
-.Ve
-.PP
-Since connecting can be expensive, you generally just connect at the
-start of your program and disconnect at the end.
-.PP
-Explicitly defining the required \f(CW\*(C`AutoCommit\*(C'\fR behaviour is strongly
-recommended and may become mandatory in a later version. This
-determines whether changes are automatically committed to the
-database when executed, or need to be explicitly committed later.
-.PP
-The \s-1DBI\s0 allows an application to \*(L"prepare\*(R" statements for later
-execution. A prepared statement is identified by a statement handle
-held in a Perl variable.
-We'll call the Perl variable \f(CW$sth\fR in our examples.
-.PP
-The typical method call sequence for a \f(CW\*(C`SELECT\*(C'\fR statement is:
-.PP
-.Vb 4
-\& prepare,
-\& execute, fetch, fetch, ...
-\& execute, fetch, fetch, ...
-\& execute, fetch, fetch, ...
-.Ve
-.PP
-for example:
-.PP
-.Vb 1
-\& $sth = $dbh\->prepare("SELECT foo, bar FROM table WHERE baz=?");
-\&
-\& $sth\->execute( $baz );
-\&
-\& while ( @row = $sth\->fetchrow_array ) {
-\& print "@row\en";
-\& }
-.Ve
-.PP
-The typical method call sequence for a \fInon\fR\-\f(CW\*(C`SELECT\*(C'\fR statement is:
-.PP
-.Vb 4
-\& prepare,
-\& execute,
-\& execute,
-\& execute.
-.Ve
-.PP
-for example:
-.PP
-.Vb 1
-\& $sth = $dbh\->prepare("INSERT INTO table(foo,bar,baz) VALUES (?,?,?)");
-\&
-\& while(<CSV>) {
-\& chomp;
-\& my ($foo,$bar,$baz) = split /,/;
-\& $sth\->execute( $foo, $bar, $baz );
-\& }
-.Ve
-.PP
-The \f(CW\*(C`do()\*(C'\fR method can be used for non repeated \fInon\fR\-\f(CW\*(C`SELECT\*(C'\fR statement
-(or with drivers that don't support placeholders):
-.PP
-.Vb 1
-\& $rows_affected = $dbh\->do("UPDATE your_table SET foo = foo + 1");
-.Ve
-.PP
-To commit your changes to the database (when \*(L"AutoCommit\*(R" is off):
-.PP
-.Vb 1
-\& $dbh\->commit; # or call $dbh\->rollback; to undo changes
-.Ve
-.PP
-Finally, when you have finished working with the data source, you should
-\&\*(L"disconnect\*(R" from it:
-.PP
-.Vb 1
-\& $dbh\->disconnect;
-.Ve
-.SS "General Interface Rules & Caveats"
-.IX Subsection "General Interface Rules & Caveats"
-The \s-1DBI\s0 does not have a concept of a \*(L"current session\*(R". Every session
-has a handle object (i.e., a \f(CW$dbh\fR) returned from the \f(CW\*(C`connect\*(C'\fR method.
-That handle object is used to invoke database related methods.
-.PP
-Most data is returned to the Perl script as strings. (Null values are
-returned as \f(CW\*(C`undef\*(C'\fR.) This allows arbitrary precision numeric data to be
-handled without loss of accuracy. Beware that Perl may not preserve
-the same accuracy when the string is used as a number.
-.PP
-Dates and times are returned as character strings in the current
-default format of the corresponding database engine. Time zone effects
-are database/driver dependent.
-.PP
-Perl supports binary data in Perl strings, and the \s-1DBI\s0 will pass binary
-data to and from the driver without change. It is up to the driver
-implementors to decide how they wish to handle such binary data.
-.PP
-Perl supports two kinds of strings: Unicode (utf8 internally) and non-Unicode
-(defaults to iso\-8859\-1 if forced to assume an encoding). Drivers should
-accept both kinds of strings and, if required, convert them to the character
-set of the database being used. Similarly, when fetching from the database
-character data that isn't iso\-8859\-1 the driver should convert it into utf8.
-.PP
-Multiple \s-1SQL\s0 statements may not be combined in a single statement
-handle (\f(CW$sth\fR), although some databases and drivers do support this
-(notably Sybase and \s-1SQL\s0 Server).
-.PP
-Non-sequential record reads are not supported in this version of the \s-1DBI.\s0
-In other words, records can only be fetched in the order that the
-database returned them, and once fetched they are forgotten.
-.PP
-Positioned updates and deletes are not directly supported by the \s-1DBI.\s0
-See the description of the \f(CW\*(C`CursorName\*(C'\fR attribute for an alternative.
-.PP
-Individual driver implementors are free to provide any private
-functions and/or handle attributes that they feel are useful.
-Private driver functions can be invoked using the \s-1DBI \s0\f(CW\*(C`func()\*(C'\fR method.
-Private driver attributes are accessed just like standard attributes.
-.PP
-Many methods have an optional \f(CW\*(C`\e%attr\*(C'\fR parameter which can be used to
-pass information to the driver implementing the method. Except where
-specifically documented, the \f(CW\*(C`\e%attr\*(C'\fR parameter can only be used to pass
-driver specific hints. In general, you can ignore \f(CW\*(C`\e%attr\*(C'\fR parameters
-or pass it as \f(CW\*(C`undef\*(C'\fR.
-.SS "Naming Conventions and Name Space"
-.IX Subsection "Naming Conventions and Name Space"
-The \s-1DBI\s0 package and all packages below it (\f(CW\*(C`DBI::*\*(C'\fR) are reserved for
-use by the \s-1DBI.\s0 Extensions and related modules use the \f(CW\*(C`DBIx::\*(C'\fR
-namespace (see <http://www.perl.com/CPAN/modules/by\-module/DBIx/>).
-Package names beginning with \f(CW\*(C`DBD::\*(C'\fR are reserved for use
-by \s-1DBI\s0 database drivers. All environment variables used by the \s-1DBI\s0
-or by individual DBDs begin with "\f(CW\*(C`DBI_\*(C'\fR\*(L" or \*(R"\f(CW\*(C`DBD_\*(C'\fR".
-.PP
-The letter case used for attribute names is significant and plays an
-important part in the portability of \s-1DBI\s0 scripts. The case of the
-attribute name is used to signify who defined the meaning of that name
-and its values.
-.PP
-.Vb 5
-\& Case of name Has a meaning defined by
-\& \-\-\-\-\-\-\-\-\-\-\-\- \-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-
-\& UPPER_CASE Standards, e.g., X/Open, ISO SQL92 etc (portable)
-\& MixedCase DBI API (portable), underscores are not used.
-\& lower_case Driver or database engine specific (non\-portable)
-.Ve
-.PP
-It is of the utmost importance that Driver developers only use
-lowercase attribute names when defining private attributes. Private
-attribute names must be prefixed with the driver name or suitable
-abbreviation (e.g., "\f(CW\*(C`ora_\*(C'\fR\*(L" for Oracle, \*(R"\f(CW\*(C`ing_\*(C'\fR" for Ingres, etc).
-.SS "\s-1SQL \- A\s0 Query Language"
-.IX Subsection "SQL - A Query Language"
-Most \s-1DBI\s0 drivers require applications to use a dialect of \s-1SQL
-\&\s0(Structured Query Language) to interact with the database engine.
-The \*(L"Standards Reference Information\*(R" section provides links
-to useful information about \s-1SQL.\s0
-.PP
-The \s-1DBI\s0 itself does not mandate or require any particular language to
-be used; it is language independent. In \s-1ODBC\s0 terms, the \s-1DBI\s0 is in
-\&\*(L"pass-thru\*(R" mode, although individual drivers might not be. The only requirement
-is that queries and other statements must be expressed as a single
-string of characters passed as the first argument to the \*(L"prepare\*(R" or
-\&\*(L"do\*(R" methods.
-.PP
-For an interesting diversion on the \fIreal\fR history of \s-1RDBMS\s0 and \s-1SQL,\s0
-from the people who made it happen, see:
-.PP
-.Vb 1
-\& http://www.mcjones.org/System_R/SQL_Reunion_95/sqlr95.html
-.Ve
-.PP
-Follow the \*(L"Full Contents\*(R" then \*(L"Intergalactic dataspeak\*(R" links for the
-\&\s-1SQL\s0 history.
-.SS "Placeholders and Bind Values"
-.IX Subsection "Placeholders and Bind Values"
-Some drivers support placeholders and bind values.
-\&\fIPlaceholders\fR, also called parameter markers, are used to indicate
-values in a database statement that will be supplied later,
-before the prepared statement is executed. For example, an application
-might use the following to insert a row of data into the \s-1SALES\s0 table:
-.PP
-.Vb 1
-\& INSERT INTO sales (product_code, qty, price) VALUES (?, ?, ?)
-.Ve
-.PP
-or the following, to select the description for a product:
-.PP
-.Vb 1
-\& SELECT description FROM products WHERE product_code = ?
-.Ve
-.PP
-The \f(CW\*(C`?\*(C'\fR characters are the placeholders. The association of actual
-values with placeholders is known as \fIbinding\fR, and the values are
-referred to as \fIbind values\fR.
-Note that the \f(CW\*(C`?\*(C'\fR is not enclosed in quotation marks, even when the
-placeholder represents a string.
-.PP
-Some drivers also allow placeholders like \f(CW\*(C`:\*(C'\fR\fIname\fR and \f(CW\*(C`:\*(C'\fR\fIN\fR (e.g.,
-\&\f(CW\*(C`:1\*(C'\fR, \f(CW\*(C`:2\*(C'\fR, and so on) in addition to \f(CW\*(C`?\*(C'\fR, but their use is not portable.
-.PP
-If the \f(CW\*(C`:\*(C'\fR\fIN\fR form of placeholder is supported by the driver you're using,
-then you should be able to use either \*(L"bind_param\*(R" or \*(L"execute\*(R" to bind
-values. Check your driver documentation.
-.PP
-Some drivers allow you to prevent the recognition of a placeholder by placing a
-single backslash character (\f(CW\*(C`\e\*(C'\fR) immediately before it. The driver will remove
-the backslash character and ignore the placeholder, passing it unchanged to the
-backend. If the driver supports this then \*(L"get_info\*(R"(9000) will return true.
-.PP
-With most drivers, placeholders can't be used for any element of a
-statement that would prevent the database server from validating the
-statement and creating a query execution plan for it. For example:
-.PP
-.Vb 2
-\& "SELECT name, age FROM ?" # wrong (will probably fail)
-\& "SELECT name, ? FROM people" # wrong (but may not \*(Aqfail\*(Aq)
-.Ve
-.PP
-Also, placeholders can only represent single scalar values.
-For example, the following
-statement won't work as expected for more than one value:
-.PP
-.Vb 2
-\& "SELECT name, age FROM people WHERE name IN (?)" # wrong
-\& "SELECT name, age FROM people WHERE name IN (?,?)" # two names
-.Ve
-.PP
-When using placeholders with the \s-1SQL \s0\f(CW\*(C`LIKE\*(C'\fR qualifier, you must
-remember that the placeholder substitutes for the whole string.
-So you should use "\f(CW\*(C`... LIKE ? ...\*(C'\fR" and include any wildcard
-characters in the value that you bind to the placeholder.
-.PP
-\&\fB\s-1NULL\s0 Values\fR
-.PP
-Undefined values, or \f(CW\*(C`undef\*(C'\fR, are used to indicate \s-1NULL\s0 values.
-You can insert and update columns with a \s-1NULL\s0 value as you would a
-non-NULL value. These examples insert and update the column
-\&\f(CW\*(C`age\*(C'\fR with a \s-1NULL\s0 value:
-.PP
-.Vb 4
-\& $sth = $dbh\->prepare(qq{
-\& INSERT INTO people (fullname, age) VALUES (?, ?)
-\& });
-\& $sth\->execute("Joe Bloggs", undef);
-\&
-\& $sth = $dbh\->prepare(qq{
-\& UPDATE people SET age = ? WHERE fullname = ?
-\& });
-\& $sth\->execute(undef, "Joe Bloggs");
-.Ve
-.PP
-However, care must be taken when trying to use \s-1NULL\s0 values in a
-\&\f(CW\*(C`WHERE\*(C'\fR clause. Consider:
-.PP
-.Vb 1
-\& SELECT fullname FROM people WHERE age = ?
-.Ve
-.PP
-Binding an \f(CW\*(C`undef\*(C'\fR (\s-1NULL\s0) to the placeholder will \fInot\fR select rows
-which have a \s-1NULL \s0\f(CW\*(C`age\*(C'\fR! At least for database engines that
-conform to the \s-1SQL\s0 standard. Refer to the \s-1SQL\s0 manual for your database
-engine or any \s-1SQL\s0 book for the reasons for this. To explicitly select
-NULLs you have to say "\f(CW\*(C`WHERE age IS NULL\*(C'\fR".
-.PP
-A common issue is to have a code fragment handle a value that could be
-either \f(CW\*(C`defined\*(C'\fR or \f(CW\*(C`undef\*(C'\fR (non-NULL or \s-1NULL\s0) at runtime.
-A simple technique is to prepare the appropriate statement as needed,
-and substitute the placeholder for non-NULL cases:
-.PP
-.Vb 5
-\& $sql_clause = defined $age? "age = ?" : "age IS NULL";
-\& $sth = $dbh\->prepare(qq{
-\& SELECT fullname FROM people WHERE $sql_clause
-\& });
-\& $sth\->execute(defined $age ? $age : ());
-.Ve
-.PP
-The following technique illustrates qualifying a \f(CW\*(C`WHERE\*(C'\fR clause with
-several columns, whose associated values (\f(CW\*(C`defined\*(C'\fR or \f(CW\*(C`undef\*(C'\fR) are
-in a hash \f(CW%h:\fR
-.PP
-.Vb 10
-\& for my $col ("age", "phone", "email") {
-\& if (defined $h{$col}) {
-\& push @sql_qual, "$col = ?";
-\& push @sql_bind, $h{$col};
-\& }
-\& else {
-\& push @sql_qual, "$col IS NULL";
-\& }
-\& }
-\& $sql_clause = join(" AND ", @sql_qual);
-\& $sth = $dbh\->prepare(qq{
-\& SELECT fullname FROM people WHERE $sql_clause
-\& });
-\& $sth\->execute(@sql_bind);
-.Ve
-.PP
-The techniques above call prepare for the \s-1SQL\s0 statement with each call to
-execute. Because calls to \fIprepare()\fR can be expensive, performance
-can suffer when an application iterates many times over statements
-like the above.
-.PP
-A better solution is a single \f(CW\*(C`WHERE\*(C'\fR clause that supports both
-\&\s-1NULL\s0 and non-NULL comparisons. Its \s-1SQL\s0 statement would need to be
-prepared only once for all cases, thus improving performance.
-Several examples of \f(CW\*(C`WHERE\*(C'\fR clauses that support this are presented
-below. But each example lacks portability, robustness, or simplicity.
-Whether an example is supported on your database engine depends on
-what \s-1SQL\s0 extensions it provides, and where it supports the \f(CW\*(C`?\*(C'\fR
-placeholder in a statement.
-.PP
-.Vb 7
-\& 0) age = ?
-\& 1) NVL(age, xx) = NVL(?, xx)
-\& 2) ISNULL(age, xx) = ISNULL(?, xx)
-\& 3) DECODE(age, ?, 1, 0) = 1
-\& 4) age = ? OR (age IS NULL AND ? IS NULL)
-\& 5) age = ? OR (age IS NULL AND SP_ISNULL(?) = 1)
-\& 6) age = ? OR (age IS NULL AND ? = 1)
-.Ve
-.PP
-Statements formed with the above \f(CW\*(C`WHERE\*(C'\fR clauses require execute
-statements as follows. The arguments are required, whether their
-values are \f(CW\*(C`defined\*(C'\fR or \f(CW\*(C`undef\*(C'\fR.
-.PP
-.Vb 3
-\& 0,1,2,3) $sth\->execute($age);
-\& 4,5) $sth\->execute($age, $age);
-\& 6) $sth\->execute($age, defined($age) ? 0 : 1);
-.Ve
-.PP
-Example 0 should not work (as mentioned earlier), but may work on
-a few database engines anyway (e.g. Sybase). Example 0 is part
-of examples 4, 5, and 6, so if example 0 works, these other
-examples may work, even if the engine does not properly support
-the right hand side of the \f(CW\*(C`OR\*(C'\fR expression.
-.PP
-Examples 1 and 2 are not robust: they require that you provide a
-valid column value xx (e.g. '~') which is not present in any row.
-That means you must have some notion of what data won't be stored
-in the column, and expect clients to adhere to that.
-.PP
-Example 5 requires that you provide a stored procedure (\s-1SP_ISNULL\s0
-in this example) that acts as a function: it checks whether a value
-is null, and returns 1 if it is, or 0 if not.
-.PP
-Example 6, the least simple, is probably the most portable, i.e., it
-should work with most, if not all, database engines.
-.PP
-Here is a table that indicates which examples above are known to
-work on various database engines:
-.PP
-.Vb 10
-\& \-\-\-\-\-Examples\-\-\-\-\-\-
-\& 0 1 2 3 4 5 6
-\& \- \- \- \- \- \- \-
-\& Oracle 9 N Y N Y Y ? Y
-\& Informix IDS 9 N N N Y N Y Y
-\& MS SQL N N Y N Y ? Y
-\& Sybase Y N N N N N Y
-\& AnyData,DBM,CSV Y N N N Y Y* Y
-\& SQLite 3.3 N N N N Y N N
-\& MSAccess N N N N Y N Y
-.Ve
-.PP
-* Works only because Example 0 works.
-.PP
-\&\s-1DBI\s0 provides a sample perl script that will test the examples above
-on your database engine and tell you which ones work. It is located
-in the \fIex/\fR subdirectory of the \s-1DBI\s0 source distribution, or here:
-<https://github.com/perl5\-dbi/dbi/blob/master/ex/perl_dbi_nulls_test.pl>
-Please use the script to help us fill-in and maintain this table.
-.PP
-\&\fBPerformance\fR
-.PP
-Without using placeholders, the insert statement shown previously would have to
-contain the literal values to be inserted and would have to be
-re-prepared and re-executed for each row. With placeholders, the insert
-statement only needs to be prepared once. The bind values for each row
-can be given to the \f(CW\*(C`execute\*(C'\fR method each time it's called. By avoiding
-the need to re-prepare the statement for each row, the application
-typically runs many times faster. Here's an example:
-.PP
-.Vb 9
-\& my $sth = $dbh\->prepare(q{
-\& INSERT INTO sales (product_code, qty, price) VALUES (?, ?, ?)
-\& }) or die $dbh\->errstr;
-\& while (<>) {
-\& chomp;
-\& my ($product_code, $qty, $price) = split /,/;
-\& $sth\->execute($product_code, $qty, $price) or die $dbh\->errstr;
-\& }
-\& $dbh\->commit or die $dbh\->errstr;
-.Ve
-.PP
-See \*(L"execute\*(R" and \*(L"bind_param\*(R" for more details.
-.PP
-The \f(CW\*(C`q{...}\*(C'\fR style quoting used in this example avoids clashing with
-quotes that may be used in the \s-1SQL\s0 statement. Use the double-quote like
-\&\f(CW\*(C`qq{...}\*(C'\fR operator if you want to interpolate variables into the string.
-See \*(L"Quote and Quote-like Operators\*(R" in perlop for more details.
-.PP
-See also the \*(L"bind_columns\*(R" method, which is used to associate Perl
-variables with the output columns of a \f(CW\*(C`SELECT\*(C'\fR statement.
-.SH "THE DBI PACKAGE AND CLASS"
-.IX Header "THE DBI PACKAGE AND CLASS"
-In this section, we cover the \s-1DBI\s0 class methods, utility functions,
-and the dynamic attributes associated with generic \s-1DBI\s0 handles.
-.SS "\s-1DBI\s0 Constants"
-.IX Subsection "DBI Constants"
-Constants representing the values of the \s-1SQL\s0 standard types can be
-imported individually by name, or all together by importing the
-special \f(CW\*(C`:sql_types\*(C'\fR tag.
-.PP
-The names and values of all the defined \s-1SQL\s0 standard types can be
-produced like this:
-.PP
-.Vb 3
-\& foreach (@{ $DBI::EXPORT_TAGS{sql_types} }) {
-\& printf "%s=%d\en", $_, &{"DBI::$_"};
-\& }
-.Ve
-.PP
-These constants are defined by \s-1SQL/CLI, ODBC\s0 or both.
-\&\f(CW\*(C`SQL_BIGINT\*(C'\fR has conflicting codes in \s-1SQL/CLI\s0 and \s-1ODBC,
-DBI\s0 uses the \s-1ODBC\s0 one.
-.PP
-See the \*(L"type_info\*(R", \*(L"type_info_all\*(R", and \*(L"bind_param\*(R" methods
-for possible uses.
-.PP
-Note that just because the \s-1DBI\s0 defines a named constant for a given
-data type doesn't mean that drivers will support that data type.
-.SS "\s-1DBI\s0 Class Methods"
-.IX Subsection "DBI Class Methods"
-The following methods are provided by the \s-1DBI\s0 class:
-.PP
-\fI\f(CI\*(C`parse_dsn\*(C'\fI\fR
-.IX Subsection "parse_dsn"
-.PP
-.Vb 2
-\& ($scheme, $driver, $attr_string, $attr_hash, $driver_dsn) = DBI\->parse_dsn($dsn)
-\& or die "Can\*(Aqt parse DBI DSN \*(Aq$dsn\*(Aq";
-.Ve
-.PP
-Breaks apart a \s-1DBI\s0 Data Source Name (\s-1DSN\s0) and returns the individual
-parts. If \f(CW$dsn\fR doesn't contain a valid \s-1DSN\s0 then \fIparse_dsn()\fR returns
-an empty list.
-.PP
-\&\f(CW$scheme\fR is the first part of the \s-1DSN\s0 and is currently always 'dbi'.
-\&\f(CW$driver\fR is the driver name, possibly defaulted to \f(CW$ENV\fR{\s-1DBI_DRIVER\s0},
-and may be undefined. \f(CW$attr_string\fR is the contents of the optional attribute
-string, which may be undefined. If \f(CW$attr_string\fR is not empty then \f(CW$attr_hash\fR
-is a reference to a hash containing the parsed attribute names and values.
-\&\f(CW$driver_dsn\fR is the last part of the \s-1DBI DSN\s0 string. For example:
-.PP
-.Vb 7
-\& ($scheme, $driver, $attr_string, $attr_hash, $driver_dsn)
-\& = DBI\->parse_dsn("dbi:MyDriver(RaiseError=>1):db=test;port=42");
-\& $scheme = \*(Aqdbi\*(Aq;
-\& $driver = \*(AqMyDriver\*(Aq;
-\& $attr_string = \*(AqRaiseError=>1\*(Aq;
-\& $attr_hash = { \*(AqRaiseError\*(Aq => \*(Aq1\*(Aq };
-\& $driver_dsn = \*(Aqdb=test;port=42\*(Aq;
-.Ve
-.PP
-The \fIparse_dsn()\fR method was added in \s-1DBI 1.43.\s0
-.PP
-\fI\f(CI\*(C`connect\*(C'\fI\fR
-.IX Subsection "connect"
-.PP
-.Vb 4
-\& $dbh = DBI\->connect($data_source, $username, $password)
-\& or die $DBI::errstr;
-\& $dbh = DBI\->connect($data_source, $username, $password, \e%attr)
-\& or die $DBI::errstr;
-.Ve
-.PP
-Establishes a database connection, or session, to the requested \f(CW$data_source\fR.
-Returns a database handle object if the connection succeeds. Use
-\&\f(CW\*(C`$dbh\->disconnect\*(C'\fR to terminate the connection.
-.PP
-If the connect fails (see below), it returns \f(CW\*(C`undef\*(C'\fR and sets both \f(CW$DBI::err\fR
-and \f(CW$DBI::errstr\fR. (It does \fInot\fR explicitly set \f(CW$!\fR.) You should generally
-test the return status of \f(CW\*(C`connect\*(C'\fR and \f(CW\*(C`print $DBI::errstr\*(C'\fR if it has failed.
-.PP
-Multiple simultaneous connections to multiple databases through multiple
-drivers can be made via the \s-1DBI.\s0 Simply make one \f(CW\*(C`connect\*(C'\fR call for each
-database and keep a copy of each returned database handle.
-.PP
-The \f(CW$data_source\fR value must begin with "\f(CW\*(C`dbi:\*(C'\fR\fIdriver_name\fR\f(CW\*(C`:\*(C'\fR".
-The \fIdriver_name\fR specifies the driver that will be used to make the
-connection. (Letter case is significant.)
-.PP
-As a convenience, if the \f(CW$data_source\fR parameter is undefined or empty,
-the \s-1DBI\s0 will substitute the value of the environment variable \f(CW\*(C`DBI_DSN\*(C'\fR.
-If just the \fIdriver_name\fR part is empty (i.e., the \f(CW$data_source\fR
-prefix is "\f(CW\*(C`dbi::\*(C'\fR"), the environment variable \f(CW\*(C`DBI_DRIVER\*(C'\fR is
-used. If neither variable is set, then \f(CW\*(C`connect\*(C'\fR dies.
-.PP
-Examples of \f(CW$data_source\fR values are:
-.PP
-.Vb 3
-\& dbi:DriverName:database_name
-\& dbi:DriverName:database_name@hostname:port
-\& dbi:DriverName:database=database_name;host=hostname;port=port
-.Ve
-.PP
-There is \fIno standard\fR for the text following the driver name. Each
-driver is free to use whatever syntax it wants. The only requirement the
-\&\s-1DBI\s0 makes is that all the information is supplied in a single string.
-You must consult the documentation for the drivers you are using for a
-description of the syntax they require.
-.PP
-It is recommended that drivers support the \s-1ODBC\s0 style, shown in the
-last example above. It is also recommended that they support the
-three common names '\f(CW\*(C`host\*(C'\fR', '\f(CW\*(C`port\*(C'\fR', and '\f(CW\*(C`database\*(C'\fR' (plus '\f(CW\*(C`db\*(C'\fR'
-as an alias for \f(CW\*(C`database\*(C'\fR). This simplifies automatic construction
-of basic DSNs: \f(CW"dbi:$driver:database=$db;host=$host;port=$port"\fR.
-Drivers should aim to 'do something reasonable' when given a \s-1DSN\s0
-in this form, but if any part is meaningless for that driver (such
-as 'port' for Informix) it should generate an error if that part
-is not empty.
-.PP
-If the environment variable \f(CW\*(C`DBI_AUTOPROXY\*(C'\fR is defined (and the
-driver in \f(CW$data_source\fR is not "\f(CW\*(C`Proxy\*(C'\fR") then the connect request
-will automatically be changed to:
-.PP
-.Vb 1
-\& $ENV{DBI_AUTOPROXY};dsn=$data_source
-.Ve
-.PP
-\&\f(CW\*(C`DBI_AUTOPROXY\*(C'\fR is typically set as "\f(CW\*(C`dbi:Proxy:hostname=...;port=...\*(C'\fR".
-If \f(CW$ENV\fR{\s-1DBI_AUTOPROXY\s0} doesn't begin with '\f(CW\*(C`dbi:\*(C'\fR' then \*(L"dbi:Proxy:\*(R"
-will be prepended to it first. See the DBD::Proxy documentation
-for more details.
-.PP
-If \f(CW$username\fR or \f(CW$password\fR are undefined (rather than just empty),
-then the \s-1DBI\s0 will substitute the values of the \f(CW\*(C`DBI_USER\*(C'\fR and \f(CW\*(C`DBI_PASS\*(C'\fR
-environment variables, respectively. The \s-1DBI\s0 will warn if the
-environment variables are not defined. However, the everyday use
-of these environment variables is not recommended for security
-reasons. The mechanism is primarily intended to simplify testing.
-See below for alternative way to specify the username and password.
-.PP
-\&\f(CW\*(C`DBI\->connect\*(C'\fR automatically installs the driver if it has not been
-installed yet. Driver installation either returns a valid driver
-handle, or it \fIdies\fR with an error message that includes the string
-"\f(CW\*(C`install_driver\*(C'\fR" and the underlying problem. So \f(CW\*(C`DBI\->connect\*(C'\fR
-will die
-on a driver installation failure and will only return \f(CW\*(C`undef\*(C'\fR on a
-connect failure, in which case \f(CW$DBI::errstr\fR will hold the error message.
-Use \f(CW\*(C`eval\*(C'\fR if you need to catch the "\f(CW\*(C`install_driver\*(C'\fR" error.
-.PP
-The \f(CW$data_source\fR argument (with the "\f(CW\*(C`dbi:...:\*(C'\fR" prefix removed) and the
-\&\f(CW$username\fR and \f(CW$password\fR arguments are then passed to the driver for
-processing. The \s-1DBI\s0 does not define any interpretation for the
-contents of these fields. The driver is free to interpret the
-\&\f(CW$data_source\fR, \f(CW$username\fR, and \f(CW$password\fR fields in any way, and supply
-whatever defaults are appropriate for the engine being accessed.
-(Oracle, for example, uses the \s-1ORACLE_SID\s0 and \s-1TWO_TASK\s0 environment
-variables if no \f(CW$data_source\fR is specified.)
-.PP
-The \f(CW\*(C`AutoCommit\*(C'\fR and \f(CW\*(C`PrintError\*(C'\fR attributes for each connection
-default to \*(L"on\*(R". (See \*(L"AutoCommit\*(R" and \*(L"PrintError\*(R" for more information.)
-However, it is strongly recommended that you explicitly define \f(CW\*(C`AutoCommit\*(C'\fR
-rather than rely on the default. The \f(CW\*(C`PrintWarn\*(C'\fR attribute defaults to true.
-.PP
-The \f(CW\*(C`\e%attr\*(C'\fR parameter can be used to alter the default settings of
-\&\f(CW\*(C`PrintError\*(C'\fR, \f(CW\*(C`RaiseError\*(C'\fR, \f(CW\*(C`AutoCommit\*(C'\fR, and other attributes. For example:
-.PP
-.Vb 4
-\& $dbh = DBI\->connect($data_source, $user, $pass, {
-\& PrintError => 0,
-\& AutoCommit => 0
-\& });
-.Ve
-.PP
-The username and password can also be specified using the attributes
-\&\f(CW\*(C`Username\*(C'\fR and \f(CW\*(C`Password\*(C'\fR, in which case they take precedence
-over the \f(CW$username\fR and \f(CW$password\fR parameters.
-.PP
-You can also define connection attribute values within the \f(CW$data_source\fR
-parameter. For example:
-.PP
-.Vb 1
-\& dbi:DriverName(PrintWarn=>0,PrintError=>0,Taint=>1):...
-.Ve
-.PP
-Individual attributes values specified in this way take precedence over
-any conflicting values specified via the \f(CW\*(C`\e%attr\*(C'\fR parameter to \f(CW\*(C`connect\*(C'\fR.
-.PP
-The \f(CW\*(C`dbi_connect_method\*(C'\fR attribute can be used to specify which driver
-method should be called to establish the connection. The only useful
-values are 'connect', 'connect_cached', or some specialized case like
-\&'Apache::DBI::connect' (which is automatically the default when running
-within Apache).
-.PP
-Where possible, each session (\f(CW$dbh\fR) is independent from the transactions
-in other sessions. This is useful when you need to hold cursors open
-across transactions\*(--for example, if you use one session for your long lifespan
-cursors (typically read-only) and another for your short update
-transactions.
-.PP
-For compatibility with old \s-1DBI\s0 scripts, the driver can be specified by
-passing its name as the fourth argument to \f(CW\*(C`connect\*(C'\fR (instead of \f(CW\*(C`\e%attr\*(C'\fR):
-.PP
-.Vb 1
-\& $dbh = DBI\->connect($data_source, $user, $pass, $driver);
-.Ve
-.PP
-In this \*(L"old-style\*(R" form of \f(CW\*(C`connect\*(C'\fR, the \f(CW$data_source\fR should not start
-with "\f(CW\*(C`dbi:driver_name:\*(C'\fR". (If it does, the embedded driver_name
-will be ignored). Also note that in this older form of \f(CW\*(C`connect\*(C'\fR,
-the \f(CW\*(C`$dbh\->{AutoCommit}\*(C'\fR attribute is \fIundefined\fR, the
-\&\f(CW\*(C`$dbh\->{PrintError}\*(C'\fR attribute is off, and the old \f(CW\*(C`DBI_DBNAME\*(C'\fR
-environment variable is
-checked if \f(CW\*(C`DBI_DSN\*(C'\fR is not defined. Beware that this \*(L"old-style\*(R"
-\&\f(CW\*(C`connect\*(C'\fR will soon be withdrawn in a future version of \s-1DBI.\s0
-.PP
-\fI\f(CI\*(C`connect_cached\*(C'\fI\fR
-.IX Subsection "connect_cached"
-.PP
-.Vb 4
-\& $dbh = DBI\->connect_cached($data_source, $username, $password)
-\& or die $DBI::errstr;
-\& $dbh = DBI\->connect_cached($data_source, $username, $password, \e%attr)
-\& or die $DBI::errstr;
-.Ve
-.PP
-\&\f(CW\*(C`connect_cached\*(C'\fR is like \*(L"connect\*(R", except that the database handle
-returned is also
-stored in a hash associated with the given parameters. If another call
-is made to \f(CW\*(C`connect_cached\*(C'\fR with the same parameter values, then the
-corresponding cached \f(CW$dbh\fR will be returned if it is still valid.
-The cached database handle is replaced with a new connection if it
-has been disconnected or if the \f(CW\*(C`ping\*(C'\fR method fails.
-.PP
-Note that the behaviour of this method differs in several respects from the
-behaviour of persistent connections implemented by Apache::DBI.
-However, if Apache::DBI is loaded then \f(CW\*(C`connect_cached\*(C'\fR will use it.
-.PP
-Caching connections can be useful in some applications, but it can
-also cause problems, such as too many connections, and so should
-be used with care. In particular, avoid changing the attributes of
-a database handle created via \fIconnect_cached()\fR because it will affect
-other code that may be using the same handle. When \fIconnect_cached()\fR
-returns a handle the attributes will be reset to their initial values.
-This can cause problems, especially with the \f(CW\*(C`AutoCommit\*(C'\fR attribute.
-.PP
-Also, to ensure that the attributes passed are always the same, avoid passing
-references inline. For example, the \f(CW\*(C`Callbacks\*(C'\fR attribute is specified as a
-hash reference. Be sure to declare it external to the call to
-\&\fIconnect_cached()\fR, such that the hash reference is not re-created on every
-call. A package-level lexical works well:
-.PP
-.Vb 4
-\& package MyDBH;
-\& my $cb = {
-\& \*(Aqconnect_cached.reused\*(Aq => sub { delete $_[4]\->{AutoCommit} },
-\& };
-\&
-\& sub dbh {
-\& DBI\->connect_cached( $dsn, $username, $auth, { Callbacks => $cb });
-\& }
-.Ve
-.PP
-Where multiple separate parts of a program are using \fIconnect_cached()\fR
-to connect to the same database with the same (initial) attributes
-it is a good idea to add a private attribute to the \fIconnect_cached()\fR
-call to effectively limit the scope of the caching. For example:
-.PP
-.Vb 1
-\& DBI\->connect_cached(..., { private_foo_cachekey => "Bar", ... });
-.Ve
-.PP
-Handles returned from that \fIconnect_cached()\fR call will only be returned
-by other \fIconnect_cached()\fR call elsewhere in the code if those other
-calls also pass in the same attribute values, including the private one.
-(I've used \f(CW\*(C`private_foo_cachekey\*(C'\fR here as an example, you can use
-any attribute name with a \f(CW\*(C`private_\*(C'\fR prefix.)
-.PP
-Taking that one step further, you can limit a particular \fIconnect_cached()\fR
-call to return handles unique to that one place in the code by setting the
-private attribute to a unique value for that place:
-.PP
-.Vb 1
-\& DBI\->connect_cached(..., { private_foo_cachekey => _\|_FILE_\|_._\|_LINE_\|_, ... });
-.Ve
-.PP
-By using a private attribute you still get connection caching for
-the individual calls to \fIconnect_cached()\fR but, by making separate
-database connections for separate parts of the code, the database
-handles are isolated from any attribute changes made to other handles.
-.PP
-The cache can be accessed (and cleared) via the \*(L"CachedKids\*(R" attribute:
-.PP
-.Vb 2
-\& my $CachedKids_hashref = $dbh\->{Driver}\->{CachedKids};
-\& %$CachedKids_hashref = () if $CachedKids_hashref;
-.Ve
-.PP
-\fI\f(CI\*(C`available_drivers\*(C'\fI\fR
-.IX Subsection "available_drivers"
-.PP
-.Vb 2
-\& @ary = DBI\->available_drivers;
-\& @ary = DBI\->available_drivers($quiet);
-.Ve
-.PP
-Returns a list of all available drivers by searching for \f(CW\*(C`DBD::*\*(C'\fR modules
-through the directories in \f(CW@INC\fR. By default, a warning is given if
-some drivers are hidden by others of the same name in earlier
-directories. Passing a true value for \f(CW$quiet\fR will inhibit the warning.
-.PP
-\fI\f(CI\*(C`installed_drivers\*(C'\fI\fR
-.IX Subsection "installed_drivers"
-.PP
-.Vb 1
-\& %drivers = DBI\->installed_drivers();
-.Ve
-.PP
-Returns a list of driver name and driver handle pairs for all drivers
-\&'installed' (loaded) into the current process. The driver name does not
-include the '\s-1DBD::\s0' prefix.
-.PP
-To get a list of all drivers available in your perl installation you can use
-\&\*(L"available_drivers\*(R".
-.PP
-Added in \s-1DBI 1.49.\s0
-.PP
-\fI\f(CI\*(C`installed_versions\*(C'\fI\fR
-.IX Subsection "installed_versions"
-.PP
-.Vb 3
-\& DBI\->installed_versions;
-\& @ary = DBI\->installed_versions;
-\& $hash = DBI\->installed_versions;
-.Ve
-.PP
-Calls \fIavailable_drivers()\fR and attempts to load each of them in turn
-using \fIinstall_driver()\fR. For each load that succeeds the driver
-name and version number are added to a hash. When running under
-DBI::PurePerl drivers which appear not be pure-perl are ignored.
-.PP
-When called in array context the list of successfully loaded drivers
-is returned (without the '\s-1DBD::\s0' prefix).
-.PP
-When called in scalar context an extra entry for the \f(CW\*(C`DBI\*(C'\fR is added (and
-\&\f(CW\*(C`DBI::PurePerl\*(C'\fR if appropriate) and a reference to the hash is returned.
-.PP
-When called in a void context the \fIinstalled_versions()\fR method will
-print out a formatted list of the hash contents, one per line, along with some
-other information about the \s-1DBI\s0 version and \s-1OS.\s0
-.PP
-Due to the potentially high memory cost and unknown risks of loading
-in an unknown number of drivers that just happen to be installed
-on the system, this method is not recommended for general use.
-Use \fIavailable_drivers()\fR instead.
-.PP
-The \fIinstalled_versions()\fR method is primarily intended as a quick
-way to see from the command line what's installed. For example:
-.PP
-.Vb 1
-\& perl \-MDBI \-e \*(AqDBI\->installed_versions\*(Aq
-.Ve
-.PP
-The \fIinstalled_versions()\fR method was added in \s-1DBI 1.38.\s0
-.PP
-\fI\f(CI\*(C`data_sources\*(C'\fI\fR
-.IX Subsection "data_sources"
-.PP
-.Vb 2
-\& @ary = DBI\->data_sources($driver);
-\& @ary = DBI\->data_sources($driver, \e%attr);
-.Ve
-.PP
-Returns a list of data sources (databases) available via the named
-driver. If \f(CW$driver\fR is empty or \f(CW\*(C`undef\*(C'\fR, then the value of the
-\&\f(CW\*(C`DBI_DRIVER\*(C'\fR environment variable is used.
-.PP
-The driver will be loaded if it hasn't been already. Note that if the
-driver loading fails then \fIdata_sources()\fR \fIdies\fR with an error message
-that includes the string "\f(CW\*(C`install_driver\*(C'\fR" and the underlying problem.
-.PP
-Data sources are returned in a form suitable for passing to the
-\&\*(L"connect\*(R" method (that is, they will include the "\f(CW\*(C`dbi:$driver:\*(C'\fR" prefix).
-.PP
-Note that many drivers have no way of knowing what data sources might
-be available for it. These drivers return an empty or incomplete list
-or may require driver-specific attributes.
-.PP
-There is also a \fIdata_sources()\fR method defined for database handles.
-.PP
-\fI\f(CI\*(C`trace\*(C'\fI\fR
-.IX Subsection "trace"
-.PP
-.Vb 4
-\& DBI\->trace($trace_setting)
-\& DBI\->trace($trace_setting, $trace_filename)
-\& DBI\->trace($trace_setting, $trace_filehandle)
-\& $trace_setting = DBI\->trace;
-.Ve
-.PP
-The \f(CW\*(C`DBI\->trace\*(C'\fR method sets the \fIglobal default\fR trace
-settings and returns the \fIprevious\fR trace settings. It can also
-be used to change where the trace output is sent.
-.PP
-There's a similar method, \f(CW\*(C`$h\->trace\*(C'\fR, which sets the trace
-settings for the specific handle it's called on.
-.PP
-See the \*(L"\s-1TRACING\*(R"\s0 section for full details about the \s-1DBI\s0's powerful
-tracing facilities.
-.PP
-\fI\f(CI\*(C`visit_handles\*(C'\fI\fR
-.IX Subsection "visit_handles"
-.PP
-.Vb 2
-\& DBI\->visit_handles( $coderef );
-\& DBI\->visit_handles( $coderef, $info );
-.Ve
-.PP
-Where \f(CW$coderef\fR is a reference to a subroutine and \f(CW$info\fR is an arbitrary value
-which, if undefined, defaults to a reference to an empty hash. Returns \f(CW$info\fR.
-.PP
-For each installed driver handle, if any, \f(CW$coderef\fR is invoked as:
-.PP
-.Vb 1
-\& $coderef\->($driver_handle, $info);
-.Ve
-.PP
-If the execution of \f(CW$coderef\fR returns a true value then \*(L"visit_child_handles\*(R"
-is called on that child handle and passed the returned value as \f(CW$info\fR.
-.PP
-For example:
-.PP
-.Vb 5
-\& my $info = $dbh\->{Driver}\->visit_child_handles(sub {
-\& my ($h, $info) = @_;
-\& ++$info\->{ $h\->{Type} }; # count types of handles (dr/db/st)
-\& return $info; # visit kids
-\& });
-.Ve
-.PP
-See also \*(L"visit_child_handles\*(R".
-.SS "\s-1DBI\s0 Utility Functions"
-.IX Subsection "DBI Utility Functions"
-In addition to the \s-1DBI\s0 methods listed in the previous section,
-the \s-1DBI\s0 package also provides several utility functions.
-.PP
-These can be imported into your code by listing them in
-the \f(CW\*(C`use\*(C'\fR statement. For example:
-.PP
-.Vb 1
-\& use DBI qw(neat data_diff);
-.Ve
-.PP
-Alternatively, all these utility functions (except hash) can be
-imported using the \f(CW\*(C`:utils\*(C'\fR import tag. For example:
-.PP
-.Vb 1
-\& use DBI qw(:utils);
-.Ve
-.PP
-\fI\f(CI\*(C`data_string_desc\*(C'\fI\fR
-.IX Subsection "data_string_desc"
-.PP
-.Vb 1
-\& $description = data_string_desc($string);
-.Ve
-.PP
-Returns an informal description of the string. For example:
-.PP
-.Vb 5
-\& UTF8 off, ASCII, 42 characters 42 bytes
-\& UTF8 off, non\-ASCII, 42 characters 42 bytes
-\& UTF8 on, non\-ASCII, 4 characters 6 bytes
-\& UTF8 on but INVALID encoding, non\-ASCII, 4 characters 6 bytes
-\& UTF8 off, undef
-.Ve
-.PP
-The initial \f(CW\*(C`UTF8\*(C'\fR on/off refers to Perl's internal SvUTF8 flag.
-If \f(CW$string\fR has the SvUTF8 flag set but the sequence of bytes it
-contains are not a valid \s-1UTF\-8\s0 encoding then \fIdata_string_desc()\fR
-will report \f(CW\*(C`UTF8 on but INVALID encoding\*(C'\fR.
-.PP
-The \f(CW\*(C`ASCII\*(C'\fR vs \f(CW\*(C`non\-ASCII\*(C'\fR portion shows \f(CW\*(C`ASCII\*(C'\fR if \fIall\fR the
-characters in the string are \s-1ASCII \s0(have code points <= 127).
-.PP
-The \fIdata_string_desc()\fR function was added in \s-1DBI 1.46.\s0
-.PP
-\fI\f(CI\*(C`data_string_diff\*(C'\fI\fR
-.IX Subsection "data_string_diff"
-.PP
-.Vb 1
-\& $diff = data_string_diff($a, $b);
-.Ve
-.PP
-Returns an informal description of the first character difference
-between the strings. If both \f(CW$a\fR and \f(CW$b\fR contain the same sequence
-of characters then \fIdata_string_diff()\fR returns an empty string.
-For example:
-.PP
-.Vb 6
-\& Params a & b Result
-\& \-\-\-\-\-\-\-\-\-\-\-\- \-\-\-\-\-\-
-\& \*(Aqaaa\*(Aq, \*(Aqaaa\*(Aq \*(Aq\*(Aq
-\& \*(Aqaaa\*(Aq, \*(Aqabc\*(Aq \*(AqStrings differ at index 2: a[2]=a, b[2]=b\*(Aq
-\& \*(Aqaaa\*(Aq, undef \*(AqString b is undef, string a has 3 characters\*(Aq
-\& \*(Aqaaa\*(Aq, \*(Aqaa\*(Aq \*(AqString b truncated after 2 characters\*(Aq
-.Ve
-.PP
-Unicode characters are reported in \f(CW\*(C`\ex{XXXX}\*(C'\fR format. Unicode
-code points in the range U+0800 to U+08FF are unassigned and most
-likely to occur due to double-encoding. Characters in this range
-are reported as \f(CW\*(C`\ex{08XX}=\*(AqC\*(Aq\*(C'\fR where \f(CW\*(C`C\*(C'\fR is the corresponding
-latin\-1 character.
-.PP
-The \fIdata_string_diff()\fR function only considers logical \fIcharacters\fR
-and not the underlying encoding. See \*(L"data_diff\*(R" for an alternative.
-.PP
-The \fIdata_string_diff()\fR function was added in \s-1DBI 1.46.\s0
-.PP
-\fI\f(CI\*(C`data_diff\*(C'\fI\fR
-.IX Subsection "data_diff"
-.PP
-.Vb 2
-\& $diff = data_diff($a, $b);
-\& $diff = data_diff($a, $b, $logical);
-.Ve
-.PP
-Returns an informal description of the difference between two strings.
-It calls \*(L"data_string_desc\*(R" and \*(L"data_string_diff\*(R"
-and returns the combined results as a multi-line string.
-.PP
-For example, \f(CW\*(C`data_diff("abc", "ab\ex{263a}")\*(C'\fR will return:
-.PP
-.Vb 3
-\& a: UTF8 off, ASCII, 3 characters 3 bytes
-\& b: UTF8 on, non\-ASCII, 3 characters 5 bytes
-\& Strings differ at index 2: a[2]=c, b[2]=\ex{263A}
-.Ve
-.PP
-If \f(CW$a\fR and \f(CW$b\fR are identical in both the characters they contain \fIand\fR
-their physical encoding then \fIdata_diff()\fR returns an empty string.
-If \f(CW$logical\fR is true then physical encoding differences are ignored
-(but are still reported if there is a difference in the characters).
-.PP
-The \fIdata_diff()\fR function was added in \s-1DBI 1.46.\s0
-.PP
-\fI\f(CI\*(C`neat\*(C'\fI\fR
-.IX Subsection "neat"
-.PP
-.Vb 2
-\& $str = neat($value);
-\& $str = neat($value, $maxlen);
-.Ve
-.PP
-Return a string containing a neat (and tidy) representation of the
-supplied value.
-.PP
-Strings will be quoted, although internal quotes will \fInot\fR be escaped.
-Values known to be numeric will be unquoted. Undefined (\s-1NULL\s0) values
-will be shown as \f(CW\*(C`undef\*(C'\fR (without quotes).
-.PP
-If the string is flagged internally as utf8 then double quotes will
-be used, otherwise single quotes are used and unprintable characters
-will be replaced by dot (.).
-.PP
-For result strings longer than \f(CW$maxlen\fR the result string will be
-truncated to \f(CW\*(C`$maxlen\-4\*(C'\fR and "\f(CW\*(C`...\*(Aq\*(C'\fR" will be appended. If \f(CW$maxlen\fR is 0
-or \f(CW\*(C`undef\*(C'\fR, it defaults to \f(CW$DBI::neat_maxlen\fR which, in turn, defaults to 400.
-.PP
-This function is designed to format values for human consumption.
-It is used internally by the \s-1DBI\s0 for \*(L"trace\*(R" output. It should
-typically \fInot\fR be used for formatting values for database use.
-(See also \*(L"quote\*(R".)
-.PP
-\fI\f(CI\*(C`neat_list\*(C'\fI\fR
-.IX Subsection "neat_list"
-.PP
-.Vb 1
-\& $str = neat_list(\e@listref, $maxlen, $field_sep);
-.Ve
-.PP
-Calls \f(CW\*(C`neat\*(C'\fR on each element of the list and returns a string
-containing the results joined with \f(CW$field_sep\fR. \f(CW$field_sep\fR defaults
-to \f(CW", "\fR.
-.PP
-\fI\f(CI\*(C`looks_like_number\*(C'\fI\fR
-.IX Subsection "looks_like_number"
-.PP
-.Vb 1
-\& @bool = looks_like_number(@array);
-.Ve
-.PP
-Returns true for each element that looks like a number.
-Returns false for each element that does not look like a number.
-Returns \f(CW\*(C`undef\*(C'\fR for each element that is undefined or empty.
-.PP
-\fI\f(CI\*(C`hash\*(C'\fI\fR
-.IX Subsection "hash"
-.PP
-.Vb 1
-\& $hash_value = DBI::hash($buffer, $type);
-.Ve
-.PP
-Return a 32\-bit integer 'hash' value corresponding to the contents of \f(CW$buffer\fR.
-The \f(CW$type\fR parameter selects which kind of hash algorithm should be used.
-.PP
-For the technically curious, type 0 (which is the default if \f(CW$type\fR
-isn't specified) is based on the Perl 5.1 hash except that the value
-is forced to be negative (for obscure historical reasons).
-Type 1 is the better \*(L"Fowler / Noll / Vo\*(R" (\s-1FNV\s0) hash. See
-<http://www.isthe.com/chongo/tech/comp/fnv/> for more information.
-Both types are implemented in C and are very fast.
-.PP
-This function doesn't have much to do with databases, except that
-it can sometimes be handy to store such values in a database.
-It also doesn't have much to do with perl hashes, like \f(CW%foo\fR.
-.PP
-\fI\f(CI\*(C`sql_type_cast\*(C'\fI\fR
-.IX Subsection "sql_type_cast"
-.PP
-.Vb 1
-\& $sts = DBI::sql_type_cast($sv, $sql_type, $flags);
-.Ve
-.PP
-sql_type_cast attempts to cast \f(CW$sv\fR to the \s-1SQL\s0 type (see \s-1DBI\s0
-Constants) specified in \f(CW$sql_type\fR. At present only the \s-1SQL\s0 types
-\&\f(CW\*(C`SQL_INTEGER\*(C'\fR, \f(CW\*(C`SQL_DOUBLE\*(C'\fR and \f(CW\*(C`SQL_NUMERIC\*(C'\fR are supported.
-.PP
-For \f(CW\*(C`SQL_INTEGER\*(C'\fR the effect is similar to using the value in an expression
-that requires an integer. It gives the perl scalar an 'integer aspect'.
-(Technically the value gains an \s-1IV,\s0 or possibly a \s-1UV\s0 or \s-1NV\s0 if the value is too
-large for an \s-1IV.\s0)
-.PP
-For \f(CW\*(C`SQL_DOUBLE\*(C'\fR the effect is similar to using the value in an expression
-that requires a general numeric value. It gives the perl scalar a 'numeric
-aspect'. (Technically the value gains an \s-1NV.\s0)
-.PP
-\&\f(CW\*(C`SQL_NUMERIC\*(C'\fR is similar to \f(CW\*(C`SQL_INTEGER\*(C'\fR or \f(CW\*(C`SQL_DOUBLE\*(C'\fR but more
-general and more cautious. It will look at the string first and if it
-looks like an integer (that will fit in an \s-1IV\s0 or \s-1UV\s0) it will act like
-\&\f(CW\*(C`SQL_INTEGER\*(C'\fR, if it looks like a floating point value it will act
-like \f(CW\*(C`SQL_DOUBLE\*(C'\fR, if it looks like neither then it will do nothing \-
-and thereby avoid the warnings that would be generated by
-\&\f(CW\*(C`SQL_INTEGER\*(C'\fR and \f(CW\*(C`SQL_DOUBLE\*(C'\fR when given non-numeric data.
-.PP
-\&\f(CW$flags\fR may be:
-.ie n .IP """DBIstcf_DISCARD_STRING""" 4
-.el .IP "\f(CWDBIstcf_DISCARD_STRING\fR" 4
-.IX Item "DBIstcf_DISCARD_STRING"
-If this flag is specified then when the driver successfully casts the
-bound perl scalar to a non-string type then the string portion of the
-scalar will be discarded.
-.ie n .IP """DBIstcf_STRICT""" 4
-.el .IP "\f(CWDBIstcf_STRICT\fR" 4
-.IX Item "DBIstcf_STRICT"
-If \f(CW$sv\fR cannot be cast to the requested \f(CW$sql_type\fR then by default
-it is left untouched and no error is generated. If you specify
-\&\f(CW\*(C`DBIstcf_STRICT\*(C'\fR and the cast fails, this will generate an error.
-.PP
-The returned \f(CW$sts\fR value is:
-.PP
-.Vb 5
-\& \-2 sql_type is not handled
-\& \-1 sv is undef so unchanged
-\& 0 sv could not be cast cleanly and DBIstcf_STRICT was used
-\& 1 sv could not be cast and DBIstcf_STRICT was not used
-\& 2 sv was cast successfully
-.Ve
-.PP
-This method is exported by the :utils tag and was introduced in \s-1DBI
-1.611.\s0
-.SS "\s-1DBI\s0 Dynamic Attributes"
-.IX Subsection "DBI Dynamic Attributes"
-Dynamic attributes are always associated with the \fIlast handle used\fR
-(that handle is represented by \f(CW$h\fR in the descriptions below).
-.PP
-Where an attribute is equivalent to a method call, then refer to
-the method call for all related documentation.
-.PP
-Warning: these attributes are provided as a convenience but they
-do have limitations. Specifically, they have a short lifespan:
-because they are associated with
-the last handle used, they should only be used \fIimmediately\fR after
-calling the method that \*(L"sets\*(R" them.
-If in any doubt, use the corresponding method call.
-.PP
-\fI\f(CI$DBI::err\fI\fR
-.IX Subsection "$DBI::err"
-.PP
-Equivalent to \f(CW\*(C`$h\->err\*(C'\fR.
-.PP
-\fI\f(CI$DBI::errstr\fI\fR
-.IX Subsection "$DBI::errstr"
-.PP
-Equivalent to \f(CW\*(C`$h\->errstr\*(C'\fR.
-.PP
-\fI\f(CI$DBI::state\fI\fR
-.IX Subsection "$DBI::state"
-.PP
-Equivalent to \f(CW\*(C`$h\->state\*(C'\fR.
-.PP
-\fI\f(CI$DBI::rows\fI\fR
-.IX Subsection "$DBI::rows"
-.PP
-Equivalent to \f(CW\*(C`$h\->rows\*(C'\fR. Please refer to the documentation
-for the \*(L"rows\*(R" method.
-.PP
-\fI\f(CI$DBI::lasth\fI\fR
-.IX Subsection "$DBI::lasth"
-.PP
-Returns the \s-1DBI\s0 object handle used for the most recent \s-1DBI\s0 method call.
-If the last \s-1DBI\s0 method call was a \s-1DESTROY\s0 then \f(CW$DBI::lasth\fR will return
-the handle of the parent of the destroyed handle, if there is one.
-.SH "METHODS COMMON TO ALL HANDLES"
-.IX Header "METHODS COMMON TO ALL HANDLES"
-The following methods can be used by all types of \s-1DBI\s0 handles.
-.PP
-\fI\f(CI\*(C`err\*(C'\fI\fR
-.IX Subsection "err"
-.PP
-.Vb 1
-\& $rv = $h\->err;
-.Ve
-.PP
-Returns the \fInative\fR database engine error code from the last driver
-method called. The code is typically an integer but you should not
-assume that.
-.PP
-The \s-1DBI\s0 resets \f(CW$h\fR\->err to undef before almost all \s-1DBI\s0 method calls, so the
-value only has a short lifespan. Also, for most drivers, the statement
-handles share the same error variable as the parent database handle,
-so calling a method on one handle may reset the error on the
-related handles.
-.PP
-(Methods which don't reset err before being called include \fIerr()\fR and \fIerrstr()\fR,
-obviously, \fIstate()\fR, \fIrows()\fR, \fIfunc()\fR, \fItrace()\fR, \fItrace_msg()\fR, \fIping()\fR, and the
-tied hash attribute \s-1\fIFETCH\s0()\fR and \s-1\fISTORE\s0()\fR methods.)
-.PP
-If you need to test for specific error conditions \fIand\fR have your program be
-portable to different database engines, then you'll need to determine what the
-corresponding error codes are for all those engines and test for all of them.
-.PP
-The \s-1DBI\s0 uses the value of \f(CW$DBI::stderr\fR as the \f(CW\*(C`err\*(C'\fR value for internal errors.
-Drivers should also do likewise. The default value for \f(CW$DBI::stderr\fR is 2000000000.
-.PP
-A driver may return \f(CW0\fR from \fIerr()\fR to indicate a warning condition
-after a method call. Similarly, a driver may return an empty string
-to indicate a 'success with information' condition. In both these
-cases the value is false but not undef. The \fIerrstr()\fR and \fIstate()\fR
-methods may be used to retrieve extra information in these cases.
-.PP
-See \*(L"set_err\*(R" for more information.
-.PP
-\fI\f(CI\*(C`errstr\*(C'\fI\fR
-.IX Subsection "errstr"
-.PP
-.Vb 1
-\& $str = $h\->errstr;
-.Ve
-.PP
-Returns the native database engine error message from the last \s-1DBI\s0
-method called. This has the same lifespan issues as the \*(L"err\*(R" method
-described above.
-.PP
-The returned string may contain multiple messages separated by
-newline characters.
-.PP
-The \fIerrstr()\fR method should not be used to test for errors, use \fIerr()\fR
-for that, because drivers may return 'success with information' or
-warning messages via \fIerrstr()\fR for methods that have not 'failed'.
-.PP
-See \*(L"set_err\*(R" for more information.
-.PP
-\fI\f(CI\*(C`state\*(C'\fI\fR
-.IX Subsection "state"
-.PP
-.Vb 1
-\& $str = $h\->state;
-.Ve
-.PP
-Returns a state code in the standard \s-1SQLSTATE\s0 five character format.
-Note that the specific success code \f(CW00000\fR is translated to any empty string
-(false). If the driver does not support \s-1SQLSTATE \s0(and most don't),
-then \fIstate()\fR will return \f(CW\*(C`S1000\*(C'\fR (General Error) for all errors.
-.PP
-The driver is free to return any value via \f(CW\*(C`state\*(C'\fR, e.g., warning
-codes, even if it has not declared an error by returning a true value
-via the \*(L"err\*(R" method described above.
-.PP
-The \fIstate()\fR method should not be used to test for errors, use \fIerr()\fR
-for that, because drivers may return a 'success with information' or
-warning state code via \fIstate()\fR for methods that have not 'failed'.
-.PP
-\fI\f(CI\*(C`set_err\*(C'\fI\fR
-.IX Subsection "set_err"
-.PP
-.Vb 4
-\& $rv = $h\->set_err($err, $errstr);
-\& $rv = $h\->set_err($err, $errstr, $state);
-\& $rv = $h\->set_err($err, $errstr, $state, $method);
-\& $rv = $h\->set_err($err, $errstr, $state, $method, $rv);
-.Ve
-.PP
-Set the \f(CW\*(C`err\*(C'\fR, \f(CW\*(C`errstr\*(C'\fR, and \f(CW\*(C`state\*(C'\fR values for the handle.
-This method is typically only used by \s-1DBI\s0 drivers and \s-1DBI\s0 subclasses.
-.PP
-If the \*(L"HandleSetErr\*(R" attribute holds a reference to a subroutine
-it is called first. The subroutine can alter the \f(CW$err\fR, \f(CW$errstr\fR, \f(CW$state\fR,
-and \f(CW$method\fR values. See \*(L"HandleSetErr\*(R" for full details.
-If the subroutine returns a true value then the handle \f(CW\*(C`err\*(C'\fR,
-\&\f(CW\*(C`errstr\*(C'\fR, and \f(CW\*(C`state\*(C'\fR values are not altered and \fIset_err()\fR returns
-an empty list (it normally returns \f(CW$rv\fR which defaults to undef, see below).
-.PP
-Setting \f(CW\*(C`err\*(C'\fR to a \fItrue\fR value indicates an error and will trigger
-the normal \s-1DBI\s0 error handling mechanisms, such as \f(CW\*(C`RaiseError\*(C'\fR and
-\&\f(CW\*(C`HandleError\*(C'\fR, if they are enabled, when execution returns from
-the \s-1DBI\s0 back to the application.
-.PP
-Setting \f(CW\*(C`err\*(C'\fR to \f(CW""\fR indicates an 'information' state, and setting
-it to \f(CW"0"\fR indicates a 'warning' state. Setting \f(CW\*(C`err\*(C'\fR to \f(CW\*(C`undef\*(C'\fR
-also sets \f(CW\*(C`errstr\*(C'\fR to undef, and \f(CW\*(C`state\*(C'\fR to \f(CW""\fR, irrespective
-of the values of the \f(CW$errstr\fR and \f(CW$state\fR parameters.
-.PP
-The \f(CW$method\fR parameter provides an alternate method name for the
-\&\f(CW\*(C`RaiseError\*(C'\fR/\f(CW\*(C`PrintError\*(C'\fR/\f(CW\*(C`PrintWarn\*(C'\fR error string instead of
-the fairly unhelpful '\f(CW\*(C`set_err\*(C'\fR'.
-.PP
-The \f(CW\*(C`set_err\*(C'\fR method normally returns undef. The \f(CW$rv\fR parameter
-provides an alternate return value.
-.PP
-Some special rules apply if the \f(CW\*(C`err\*(C'\fR or \f(CW\*(C`errstr\*(C'\fR
-values for the handle are \fIalready\fR set...
-.PP
-If \f(CW\*(C`errstr\*(C'\fR is true then: "\f(CW\*(C` [err was %s now %s]\*(C'\fR" is appended if \f(CW$err\fR is
-true and \f(CW\*(C`err\*(C'\fR is already true and the new err value differs from the original
-one. Similarly "\f(CW\*(C` [state was %s now %s]\*(C'\fR" is appended if \f(CW$state\fR is true and \f(CW\*(C`state\*(C'\fR is
-already true and the new state value differs from the original one. Finally
-"\f(CW\*(C`\en\*(C'\fR" and the new \f(CW$errstr\fR are appended if \f(CW$errstr\fR differs from the existing
-errstr value. Obviously the \f(CW%s\fR's above are replaced by the corresponding values.
-.PP
-The handle \f(CW\*(C`err\*(C'\fR value is set to \f(CW$err\fR if: \f(CW$err\fR is true; or handle
-\&\f(CW\*(C`err\*(C'\fR value is undef; or \f(CW$err\fR is defined and the length is greater
-than the handle \f(CW\*(C`err\*(C'\fR length. The effect is that an 'information'
-state only overrides undef; a 'warning' overrides undef or 'information',
-and an 'error' state overrides anything.
-.PP
-The handle \f(CW\*(C`state\*(C'\fR value is set to \f(CW$state\fR if \f(CW$state\fR is true and
-the handle \f(CW\*(C`err\*(C'\fR value was set (by the rules above).
-.PP
-Support for warning and information states was added in \s-1DBI 1.41.\s0
-.PP
-\fI\f(CI\*(C`trace\*(C'\fI\fR
-.IX Subsection "trace"
-.PP
-.Vb 3
-\& $h\->trace($trace_settings);
-\& $h\->trace($trace_settings, $trace_filename);
-\& $trace_settings = $h\->trace;
-.Ve
-.PP
-The \fItrace()\fR method is used to alter the trace settings for a handle
-(and any future children of that handle). It can also be used to
-change where the trace output is sent.
-.PP
-There's a similar method, \f(CW\*(C`DBI\->trace\*(C'\fR, which sets the global
-default trace settings.
-.PP
-See the \*(L"\s-1TRACING\*(R"\s0 section for full details about the \s-1DBI\s0's powerful
-tracing facilities.
-.PP
-\fI\f(CI\*(C`trace_msg\*(C'\fI\fR
-.IX Subsection "trace_msg"
-.PP
-.Vb 2
-\& $h\->trace_msg($message_text);
-\& $h\->trace_msg($message_text, $min_level);
-.Ve
-.PP
-Writes \f(CW$message_text\fR to the trace file if the trace level is
-greater than or equal to \f(CW$min_level\fR (which defaults to 1).
-Can also be called as \f(CW\*(C`DBI\->trace_msg($msg)\*(C'\fR.
-.PP
-See \*(L"\s-1TRACING\*(R"\s0 for more details.
-.PP
-\fI\f(CI\*(C`func\*(C'\fI\fR
-.IX Subsection "func"
-.PP
-.Vb 1
-\& $h\->func(@func_arguments, $func_name) or die ...;
-.Ve
-.PP
-The \f(CW\*(C`func\*(C'\fR method can be used to call private non-standard and
-non-portable methods implemented by the driver. Note that the function
-name is given as the \fIlast\fR argument.
-.PP
-It's also important to note that the \fIfunc()\fR method does not clear
-a previous error ($DBI::err etc.) and it does not trigger automatic
-error detection (RaiseError etc.) so you must check the return
-status and/or \f(CW$h\fR\->err to detect errors.
-.PP
-(This method is not directly related to calling stored procedures.
-Calling stored procedures is currently not defined by the \s-1DBI.\s0
-Some drivers, such as DBD::Oracle, support it in non-portable ways.
-See driver documentation for more details.)
-.PP
-See also \fIinstall_method()\fR in \s-1DBI::DBD\s0 for how you can avoid needing to
-use \fIfunc()\fR and gain direct access to driver-private methods.
-.PP
-\fI\f(CI\*(C`can\*(C'\fI\fR
-.IX Subsection "can"
-.PP
-.Vb 1
-\& $is_implemented = $h\->can($method_name);
-.Ve
-.PP
-Returns true if \f(CW$method_name\fR is implemented by the driver or a
-default method is provided by the \s-1DBI\s0's driver base class.
-It returns false where a driver hasn't implemented a method and the
-default method is provided by the \s-1DBI\s0's driver base class is just an empty stub.
-.PP
-\fI\f(CI\*(C`parse_trace_flags\*(C'\fI\fR
-.IX Subsection "parse_trace_flags"
-.PP
-.Vb 1
-\& $trace_settings_integer = $h\->parse_trace_flags($trace_settings);
-.Ve
-.PP
-Parses a string containing trace settings and returns the corresponding
-integer value used internally by the \s-1DBI\s0 and drivers.
-.PP
-The \f(CW$trace_settings\fR argument is a string containing a trace level
-between 0 and 15 and/or trace flag names separated by vertical bar
-("\f(CW\*(C`|\*(C'\fR\*(L") or comma (\*(R"\f(CW\*(C`,\*(C'\fR") characters. For example: \f(CW"SQL|3|foo"\fR.
-.PP
-It uses the \fIparse_trace_flag()\fR method, described below, to process
-the individual trace flag names.
-.PP
-The \fIparse_trace_flags()\fR method was added in \s-1DBI 1.42.\s0
-.PP
-\fI\f(CI\*(C`parse_trace_flag\*(C'\fI\fR
-.IX Subsection "parse_trace_flag"
-.PP
-.Vb 1
-\& $bit_flag = $h\->parse_trace_flag($trace_flag_name);
-.Ve
-.PP
-Returns the bit flag corresponding to the trace flag name in
-\&\f(CW$trace_flag_name\fR. Drivers are expected to override this method and
-check if \f(CW$trace_flag_name\fR is a driver specific trace flags and, if
-not, then call the \s-1DBI\s0's default \fIparse_trace_flag()\fR.
-.PP
-The \fIparse_trace_flag()\fR method was added in \s-1DBI 1.42.\s0
-.PP
-\fI\f(CI\*(C`private_attribute_info\*(C'\fI\fR
-.IX Subsection "private_attribute_info"
-.PP
-.Vb 1
-\& $hash_ref = $h\->private_attribute_info();
-.Ve
-.PP
-Returns a reference to a hash whose keys are the names of driver-private
-handle attributes available for the kind of handle (driver, database, statement)
-that the method was called on.
-.PP
-For example, the return value when called with a DBD::Sybase \f(CW$dbh\fR could look like this:
-.PP
-.Vb 6
-\& {
-\& syb_dynamic_supported => undef,
-\& syb_oc_version => undef,
-\& syb_server_version => undef,
-\& syb_server_version_string => undef,
-\& }
-.Ve
-.PP
-and when called with a DBD::Sybase \f(CW$sth\fR they could look like this:
-.PP
-.Vb 5
-\& {
-\& syb_types => undef,
-\& syb_proc_status => undef,
-\& syb_result_type => undef,
-\& }
-.Ve
-.PP
-The values should be undef. Meanings may be assigned to particular values in future.
-.PP
-\fI\f(CI\*(C`swap_inner_handle\*(C'\fI\fR
-.IX Subsection "swap_inner_handle"
-.PP
-.Vb 2
-\& $rc = $h1\->swap_inner_handle( $h2 );
-\& $rc = $h1\->swap_inner_handle( $h2, $allow_reparent );
-.Ve
-.PP
-Brain transplants for handles. You don't need to know about this
-unless you want to become a handle surgeon.
-.PP
-A \s-1DBI\s0 handle is a reference to a tied hash. A tied hash has an
-\&\fIinner\fR hash that actually holds the contents. The \fIswap_inner_handle()\fR
-method swaps the inner hashes between two handles. The \f(CW$h1\fR and \f(CW$h2\fR
-handles still point to the same tied hashes, but what those hashes
-are tied to has been swapped. In effect \f(CW$h1\fR \fIbecomes\fR \f(CW$h2\fR and
-vice-versa. This is powerful stuff, expect problems. Use with care.
-.PP
-As a small safety measure, the two handles, \f(CW$h1\fR and \f(CW$h2\fR, have to
-share the same parent unless \f(CW$allow_reparent\fR is true.
-.PP
-The \fIswap_inner_handle()\fR method was added in \s-1DBI 1.44.\s0
-.PP
-Here's a quick kind of 'diagram' as a worked example to help think about what's
-happening:
-.PP
-.Vb 4
-\& Original state:
-\& dbh1o \-> dbh1i
-\& sthAo \-> sthAi(dbh1i)
-\& dbh2o \-> dbh2i
-\&
-\& swap_inner_handle dbh1o with dbh2o:
-\& dbh2o \-> dbh1i
-\& sthAo \-> sthAi(dbh1i)
-\& dbh1o \-> dbh2i
-\&
-\& create new sth from dbh1o:
-\& dbh2o \-> dbh1i
-\& sthAo \-> sthAi(dbh1i)
-\& dbh1o \-> dbh2i
-\& sthBo \-> sthBi(dbh2i)
-\&
-\& swap_inner_handle sthAo with sthBo:
-\& dbh2o \-> dbh1i
-\& sthBo \-> sthAi(dbh1i)
-\& dbh1o \-> dbh2i
-\& sthAo \-> sthBi(dbh2i)
-.Ve
-.PP
-\fI\f(CI\*(C`visit_child_handles\*(C'\fI\fR
-.IX Subsection "visit_child_handles"
-.PP
-.Vb 2
-\& $h\->visit_child_handles( $coderef );
-\& $h\->visit_child_handles( $coderef, $info );
-.Ve
-.PP
-Where \f(CW$coderef\fR is a reference to a subroutine and \f(CW$info\fR is an arbitrary value
-which, if undefined, defaults to a reference to an empty hash. Returns \f(CW$info\fR.
-.PP
-For each child handle of \f(CW$h\fR, if any, \f(CW$coderef\fR is invoked as:
-.PP
-.Vb 1
-\& $coderef\->($child_handle, $info);
-.Ve
-.PP
-If the execution of \f(CW$coderef\fR returns a true value then \f(CW\*(C`visit_child_handles\*(C'\fR
-is called on that child handle and passed the returned value as \f(CW$info\fR.
-.PP
-For example:
-.PP
-.Vb 7
-\& # count database connections with names (DSN) matching a pattern
-\& my $connections = 0;
-\& $dbh\->{Driver}\->visit_child_handles(sub {
-\& my ($h, $info) = @_;
-\& ++$connections if $h\->{Name} =~ /foo/;
-\& return 0; # don\*(Aqt visit kids
-\& })
-.Ve
-.PP
-See also \*(L"visit_handles\*(R".
-.SH "ATTRIBUTES COMMON TO ALL HANDLES"
-.IX Header "ATTRIBUTES COMMON TO ALL HANDLES"
-These attributes are common to all types of \s-1DBI\s0 handles.
-.PP
-Some attributes are inherited by child handles. That is, the value
-of an inherited attribute in a newly created statement handle is the
-same as the value in the parent database handle. Changes to attributes
-in the new statement handle do not affect the parent database handle
-and changes to the database handle do not affect existing statement
-handles, only future ones.
-.PP
-Attempting to set or get the value of an unknown attribute generates a warning,
-except for private driver specific attributes (which all have names
-starting with a lowercase letter).
-.PP
-Example:
-.PP
-.Vb 2
-\& $h\->{AttributeName} = ...; # set/write
-\& ... = $h\->{AttributeName}; # get/read
-.Ve
-.PP
-\fI\f(CI\*(C`Warn\*(C'\fI\fR
-.IX Subsection "Warn"
-.PP
-Type: boolean, inherited
-.PP
-The \f(CW\*(C`Warn\*(C'\fR attribute enables useful warnings for certain bad
-practices. It is enabled by default and should only be disabled in
-rare circumstances. Since warnings are generated using the Perl
-\&\f(CW\*(C`warn\*(C'\fR function, they can be intercepted using the Perl \f(CW$SIG{_\|_WARN_\|_}\fR
-hook.
-.PP
-The \f(CW\*(C`Warn\*(C'\fR attribute is not related to the \f(CW\*(C`PrintWarn\*(C'\fR attribute.
-.PP
-\fI\f(CI\*(C`Active\*(C'\fI\fR
-.IX Subsection "Active"
-.PP
-Type: boolean, read-only
-.PP
-The \f(CW\*(C`Active\*(C'\fR attribute is true if the handle object is \*(L"active\*(R". This is rarely used in
-applications. The exact meaning of active is somewhat vague at the
-moment. For a database handle it typically means that the handle is
-connected to a database (\f(CW\*(C`$dbh\->disconnect\*(C'\fR sets \f(CW\*(C`Active\*(C'\fR off). For
-a statement handle it typically means that the handle is a \f(CW\*(C`SELECT\*(C'\fR
-that may have more data to fetch. (Fetching all the data or calling \f(CW\*(C`$sth\->finish\*(C'\fR
-sets \f(CW\*(C`Active\*(C'\fR off.)
-.PP
-\fI\f(CI\*(C`Executed\*(C'\fI\fR
-.IX Subsection "Executed"
-.PP
-Type: boolean
-.PP
-The \f(CW\*(C`Executed\*(C'\fR attribute is true if the handle object has been \*(L"executed\*(R".
-Currently only the \f(CW$dbh\fR \fIdo()\fR method and the \f(CW$sth\fR \fIexecute()\fR, \fIexecute_array()\fR,
-and \fIexecute_for_fetch()\fR methods set the \f(CW\*(C`Executed\*(C'\fR attribute.
-.PP
-When it's set on a handle it is also set on the parent handle at the
-same time. So calling \fIexecute()\fR on a \f(CW$sth\fR also sets the \f(CW\*(C`Executed\*(C'\fR
-attribute on the parent \f(CW$dbh\fR.
-.PP
-The \f(CW\*(C`Executed\*(C'\fR attribute for a database handle is cleared by the \fIcommit()\fR and
-\&\fIrollback()\fR methods (even if they fail). The \f(CW\*(C`Executed\*(C'\fR attribute of a
-statement handle is not cleared by the \s-1DBI\s0 under any circumstances and so acts
-as a permanent record of whether the statement handle was ever used.
-.PP
-The \f(CW\*(C`Executed\*(C'\fR attribute was added in \s-1DBI 1.41.\s0
-.PP
-\fI\f(CI\*(C`Kids\*(C'\fI\fR
-.IX Subsection "Kids"
-.PP
-Type: integer, read-only
-.PP
-For a driver handle, \f(CW\*(C`Kids\*(C'\fR is the number of currently existing database
-handles that were created from that driver handle. For a database
-handle, \f(CW\*(C`Kids\*(C'\fR is the number of currently existing statement handles that
-were created from that database handle.
-For a statement handle, the value is zero.
-.PP
-\fI\f(CI\*(C`ActiveKids\*(C'\fI\fR
-.IX Subsection "ActiveKids"
-.PP
-Type: integer, read-only
-.PP
-Like \f(CW\*(C`Kids\*(C'\fR, but only counting those that are \f(CW\*(C`Active\*(C'\fR (as above).
-.PP
-\fI\f(CI\*(C`CachedKids\*(C'\fI\fR
-.IX Subsection "CachedKids"
-.PP
-Type: hash ref
-.PP
-For a database handle, \f(CW\*(C`CachedKids\*(C'\fR returns a reference to the cache (hash) of
-statement handles created by the \*(L"prepare_cached\*(R" method. For a
-driver handle, returns a reference to the cache (hash) of
-database handles created by the \*(L"connect_cached\*(R" method.
-.PP
-\fI\f(CI\*(C`Type\*(C'\fI\fR
-.IX Subsection "Type"
-.PP
-Type: scalar, read-only
-.PP
-The \f(CW\*(C`Type\*(C'\fR attribute identifies the type of a \s-1DBI\s0 handle. Returns
-\&\*(L"dr\*(R" for driver handles, \*(L"db\*(R" for database handles and \*(L"st\*(R" for
-statement handles.
-.PP
-\fI\f(CI\*(C`ChildHandles\*(C'\fI\fR
-.IX Subsection "ChildHandles"
-.PP
-Type: array ref
-.PP
-The ChildHandles attribute contains a reference to an array of all the
-handles created by this handle which are still accessible. The
-contents of the array are weak-refs and will become undef when the
-handle goes out of scope. (They're cleared out occasionally.)
-.PP
-\&\f(CW\*(C`ChildHandles\*(C'\fR returns undef if your perl version does not support weak
-references (check the Scalar::Util module). The referenced
-array returned should be treated as read-only.
-.PP
-For example, to enumerate all driver handles, database handles and
-statement handles:
-.PP
-.Vb 6
-\& sub show_child_handles {
-\& my ($h, $level) = @_;
-\& printf "%sh %s %s\en", $h\->{Type}, "\et" x $level, $h;
-\& show_child_handles($_, $level + 1)
-\& for (grep { defined } @{$h\->{ChildHandles}});
-\& }
-\&
-\& my %drivers = DBI\->installed_drivers();
-\& show_child_handles($_, 0) for (values %drivers);
-.Ve
-.PP
-\fI\f(CI\*(C`CompatMode\*(C'\fI\fR
-.IX Subsection "CompatMode"
-.PP
-Type: boolean, inherited
-.PP
-The \f(CW\*(C`CompatMode\*(C'\fR attribute is used by emulation layers (such as
-Oraperl) to enable compatible behaviour in the underlying driver
-(e.g., DBD::Oracle) for this handle. Not normally set by application code.
-.PP
-It also has the effect of disabling the 'quick \s-1FETCH\s0' of attribute
-values from the handles attribute cache. So all attribute values
-are handled by the drivers own \s-1FETCH\s0 method. This makes them slightly
-slower but is useful for special-purpose drivers like DBD::Multiplex.
-.PP
-\fI\f(CI\*(C`InactiveDestroy\*(C'\fI\fR
-.IX Subsection "InactiveDestroy"
-.PP
-Type: boolean
-.PP
-The default value, false, means a handle will be fully destroyed
-as normal when the last reference to it is removed, just as you'd expect.
-.PP
-If set true then the handle will be treated by the \s-1DESTROY\s0 as if it was no
-longer Active, and so the \fIdatabase engine\fR related effects of DESTROYing a
-handle will be skipped. Think of the name as meaning 'treat the handle as
-not-Active in the \s-1DESTROY\s0 method'.
-.PP
-For a database handle, this attribute does not disable an \fIexplicit\fR
-call to the disconnect method, only the implicit call from \s-1DESTROY\s0
-that happens if the handle is still marked as \f(CW\*(C`Active\*(C'\fR.
-.PP
-This attribute is specifically designed for use in Unix applications
-that \*(L"fork\*(R" child processes. For some drivers, when the child process exits
-the destruction of inherited handles cause the corresponding handles in the
-parent process to cease working.
-.PP
-Either the parent or the child process, but not both, should set
-\&\f(CW\*(C`InactiveDestroy\*(C'\fR true on all their shared handles. Alternatively, and
-preferably, the \*(L"AutoInactiveDestroy\*(R" can be set in the parent on connect.
-.PP
-To help tracing applications using fork the process id is shown in
-the trace log whenever a \s-1DBI\s0 or handle \fItrace()\fR method is called.
-The process id also shown for \fIevery\fR method call if the \s-1DBI\s0 trace
-level (not handle trace level) is set high enough to show the trace
-from the \s-1DBI\s0's method dispatcher, e.g. >= 9.
-.PP
-\fI\f(CI\*(C`AutoInactiveDestroy\*(C'\fI\fR
-.IX Subsection "AutoInactiveDestroy"
-.PP
-Type: boolean, inherited
-.PP
-The \*(L"InactiveDestroy\*(R" attribute, described above, needs to be explicitly set
-in the child process after a \fIfork()\fR, on every active database and statement handle.
-This is a problem if the code that performs the \fIfork()\fR is not under your
-control, perhaps in a third-party module. Use \f(CW\*(C`AutoInactiveDestroy\*(C'\fR to get
-around this situation.
-.PP
-If set true, the \s-1DESTROY\s0 method will check the process id of the handle and, if
-different from the current process id, it will set the \fIInactiveDestroy\fR attribute.
-It is strongly recommended that \f(CW\*(C`AutoInactiveDestroy\*(C'\fR is enabled on all new code
-(it's only not enabled by default to avoid backwards compatibility problems).
-.PP
-This is the example it's designed to deal with:
-.PP
-.Vb 4
-\& my $dbh = DBI\->connect(...);
-\& some_code_that_forks(); # Perhaps without your knowledge
-\& # Child process dies, destroying the inherited dbh
-\& $dbh\->do(...); # Breaks because parent $dbh is now broken
-.Ve
-.PP
-The \f(CW\*(C`AutoInactiveDestroy\*(C'\fR attribute was added in \s-1DBI 1.614.\s0
-.PP
-\fI\f(CI\*(C`PrintWarn\*(C'\fI\fR
-.IX Subsection "PrintWarn"
-.PP
-Type: boolean, inherited
-.PP
-The \f(CW\*(C`PrintWarn\*(C'\fR attribute controls the printing of warnings recorded
-by the driver. When set to a true value (the default) the \s-1DBI\s0 will check method
-calls to see if a warning condition has been set. If so, the \s-1DBI\s0
-will effectively do a \f(CW\*(C`warn("$class $method warning: $DBI::errstr")\*(C'\fR
-where \f(CW$class\fR is the driver class and \f(CW$method\fR is the name of
-the method which failed. E.g.,
-.PP
-.Vb 1
-\& DBD::Oracle::db execute warning: ... warning text here ...
-.Ve
-.PP
-If desired, the warnings can be caught and processed using a \f(CW$SIG{_\|_WARN_\|_}\fR
-handler or modules like CGI::Carp and CGI::ErrorWrap.
-.PP
-See also \*(L"set_err\*(R" for how warnings are recorded and \*(L"HandleSetErr\*(R"
-for how to influence it.
-.PP
-Fetching the full details of warnings can require an extra round-trip
-to the database server for some drivers. In which case the driver
-may opt to only fetch the full details of warnings if the \f(CW\*(C`PrintWarn\*(C'\fR
-attribute is true. If \f(CW\*(C`PrintWarn\*(C'\fR is false then these drivers should
-still indicate the fact that there were warnings by setting the
-warning string to, for example: \*(L"3 warnings\*(R".
-.PP
-\fI\f(CI\*(C`PrintError\*(C'\fI\fR
-.IX Subsection "PrintError"
-.PP
-Type: boolean, inherited
-.PP
-The \f(CW\*(C`PrintError\*(C'\fR attribute can be used to force errors to generate warnings (using
-\&\f(CW\*(C`warn\*(C'\fR) in addition to returning error codes in the normal way. When set
-\&\*(L"on\*(R", any method which results in an error occurring will cause the \s-1DBI\s0 to
-effectively do a \f(CW\*(C`warn("$class $method failed: $DBI::errstr")\*(C'\fR where \f(CW$class\fR
-is the driver class and \f(CW$method\fR is the name of the method which failed. E.g.,
-.PP
-.Vb 1
-\& DBD::Oracle::db prepare failed: ... error text here ...
-.Ve
-.PP
-By default, \f(CW\*(C`DBI\->connect\*(C'\fR sets \f(CW\*(C`PrintError\*(C'\fR \*(L"on\*(R".
-.PP
-If desired, the warnings can be caught and processed using a \f(CW$SIG{_\|_WARN_\|_}\fR
-handler or modules like CGI::Carp and CGI::ErrorWrap.
-.PP
-\fI\f(CI\*(C`RaiseError\*(C'\fI\fR
-.IX Subsection "RaiseError"
-.PP
-Type: boolean, inherited
-.PP
-The \f(CW\*(C`RaiseError\*(C'\fR attribute can be used to force errors to raise exceptions rather
-than simply return error codes in the normal way. It is \*(L"off\*(R" by default.
-When set \*(L"on\*(R", any method which results in an error will cause
-the \s-1DBI\s0 to effectively do a \f(CW\*(C`die("$class $method failed: $DBI::errstr")\*(C'\fR,
-where \f(CW$class\fR is the driver class and \f(CW$method\fR is the name of the method
-that failed. E.g.,
-.PP
-.Vb 1
-\& DBD::Oracle::db prepare failed: ... error text here ...
-.Ve
-.PP
-If you turn \f(CW\*(C`RaiseError\*(C'\fR on then you'd normally turn \f(CW\*(C`PrintError\*(C'\fR off.
-If \f(CW\*(C`PrintError\*(C'\fR is also on, then the \f(CW\*(C`PrintError\*(C'\fR is done first (naturally).
-.PP
-Typically \f(CW\*(C`RaiseError\*(C'\fR is used in conjunction with \f(CW\*(C`eval\*(C'\fR,
-or a module like Try::Tiny or TryCatch,
-to catch the exception that's been thrown and handle it.
-For example:
-.PP
-.Vb 1
-\& use Try::Tiny;
-\&
-\& try {
-\& ...
-\& $sth\->execute();
-\& ...
-\& } catch {
-\& # $sth\->err and $DBI::err will be true if error was from DBI
-\& warn $_; # print the error (which Try::Tiny puts into $_)
-\& ... # do whatever you need to deal with the error
-\& };
-.Ve
-.PP
-In the catch block the \f(CW$DBI::lasth\fR variable can be useful for
-diagnosis and reporting if you can't be sure which handle triggered
-the error. For example, \f(CW$DBI::lasth\fR\->{Type} and \f(CW$DBI::lasth\fR\->{Statement}.
-.PP
-See also \*(L"Transactions\*(R".
-.PP
-If you want to temporarily turn \f(CW\*(C`RaiseError\*(C'\fR off (inside a library function
-that is likely to fail, for example), the recommended way is like this:
-.PP
-.Vb 4
-\& {
-\& local $h\->{RaiseError}; # localize and turn off for this block
-\& ...
-\& }
-.Ve
-.PP
-The original value will automatically and reliably be restored by Perl,
-regardless of how the block is exited.
-The same logic applies to other attributes, including \f(CW\*(C`PrintError\*(C'\fR.
-.PP
-\fI\f(CI\*(C`HandleError\*(C'\fI\fR
-.IX Subsection "HandleError"
-.PP
-Type: code ref, inherited
-.PP
-The \f(CW\*(C`HandleError\*(C'\fR attribute can be used to provide your own alternative behaviour
-in case of errors. If set to a reference to a subroutine then that
-subroutine is called when an error is detected (at the same point that
-\&\f(CW\*(C`RaiseError\*(C'\fR and \f(CW\*(C`PrintError\*(C'\fR are handled).
-.PP
-The subroutine is called with three parameters: the error message
-string that \f(CW\*(C`RaiseError\*(C'\fR and \f(CW\*(C`PrintError\*(C'\fR would use,
-the \s-1DBI\s0 handle being used, and the first value being returned by
-the method that failed (typically undef).
-.PP
-If the subroutine returns a false value then the \f(CW\*(C`RaiseError\*(C'\fR
-and/or \f(CW\*(C`PrintError\*(C'\fR attributes are checked and acted upon as normal.
-.PP
-For example, to \f(CW\*(C`die\*(C'\fR with a full stack trace for any error:
-.PP
-.Vb 2
-\& use Carp;
-\& $h\->{HandleError} = sub { confess(shift) };
-.Ve
-.PP
-Or to turn errors into exceptions:
-.PP
-.Vb 2
-\& use Exception; # or your own favourite exception module
-\& $h\->{HandleError} = sub { Exception\->new(\*(AqDBI\*(Aq)\->raise($_[0]) };
-.Ve
-.PP
-It is possible to 'stack' multiple HandleError handlers by using
-closures:
-.PP
-.Vb 7
-\& sub your_subroutine {
-\& my $previous_handler = $h\->{HandleError};
-\& $h\->{HandleError} = sub {
-\& return 1 if $previous_handler and &$previous_handler(@_);
-\& ... your code here ...
-\& };
-\& }
-.Ve
-.PP
-Using a \f(CW\*(C`my\*(C'\fR inside a subroutine to store the previous \f(CW\*(C`HandleError\*(C'\fR
-value is important. See perlsub and perlref for more information
-about \fIclosures\fR.
-.PP
-It is possible for \f(CW\*(C`HandleError\*(C'\fR to alter the error message that
-will be used by \f(CW\*(C`RaiseError\*(C'\fR and \f(CW\*(C`PrintError\*(C'\fR if it returns false.
-It can do that by altering the value of \f(CW$_\fR[0]. This example appends
-a stack trace to all errors and, unlike the previous example using
-Carp::confess, this will work \f(CW\*(C`PrintError\*(C'\fR as well as \f(CW\*(C`RaiseError\*(C'\fR:
-.PP
-.Vb 1
-\& $h\->{HandleError} = sub { $_[0]=Carp::longmess($_[0]); 0; };
-.Ve
-.PP
-It is also possible for \f(CW\*(C`HandleError\*(C'\fR to hide an error, to a limited
-degree, by using \*(L"set_err\*(R" to reset \f(CW$DBI::err\fR and \f(CW$DBI::errstr\fR,
-and altering the return value of the failed method. For example:
-.PP
-.Vb 7
-\& $h\->{HandleError} = sub {
-\& return 0 unless $_[0] =~ /^\eS+ fetchrow_arrayref failed:/;
-\& return 0 unless $_[1]\->err == 1234; # the error to \*(Aqhide\*(Aq
-\& $h\->set_err(undef,undef); # turn off the error
-\& $_[2] = [ ... ]; # supply alternative return value
-\& return 1;
-\& };
-.Ve
-.PP
-This only works for methods which return a single value and is hard
-to make reliable (avoiding infinite loops, for example) and so isn't
-recommended for general use! If you find a \fIgood\fR use for it then
-please let me know.
-.PP
-\fI\f(CI\*(C`HandleSetErr\*(C'\fI\fR
-.IX Subsection "HandleSetErr"
-.PP
-Type: code ref, inherited
-.PP
-The \f(CW\*(C`HandleSetErr\*(C'\fR attribute can be used to intercept
-the setting of handle \f(CW\*(C`err\*(C'\fR, \f(CW\*(C`errstr\*(C'\fR, and \f(CW\*(C`state\*(C'\fR values.
-If set to a reference to a subroutine then that subroutine is called
-whenever \fIset_err()\fR is called, typically by the driver or a subclass.
-.PP
-The subroutine is called with five arguments, the first five that
-were passed to \fIset_err()\fR: the handle, the \f(CW\*(C`err\*(C'\fR, \f(CW\*(C`errstr\*(C'\fR, and
-\&\f(CW\*(C`state\*(C'\fR values being set, and the method name. These can be altered
-by changing the values in the \f(CW@_\fR array. The return value affects
-\&\fIset_err()\fR behaviour, see \*(L"set_err\*(R" for details.
-.PP
-It is possible to 'stack' multiple HandleSetErr handlers by using
-closures. See \*(L"HandleError\*(R" for an example.
-.PP
-The \f(CW\*(C`HandleSetErr\*(C'\fR and \f(CW\*(C`HandleError\*(C'\fR subroutines differ in subtle
-but significant ways. HandleError is only invoked at the point where
-the \s-1DBI\s0 is about to return to the application with \f(CW\*(C`err\*(C'\fR set true.
-It's not invoked by the failure of a method that's been called by
-another \s-1DBI\s0 method. HandleSetErr, on the other hand, is called
-whenever \fIset_err()\fR is called with a defined \f(CW\*(C`err\*(C'\fR value, even if false.
-So it's not just for errors, despite the name, but also warn and info states.
-The \fIset_err()\fR method, and thus HandleSetErr, may be called multiple
-times within a method and is usually invoked from deep within driver code.
-.PP
-In theory a driver can use the return value from HandleSetErr via
-\&\fIset_err()\fR to decide whether to continue or not. If \fIset_err()\fR returns
-an empty list, indicating that the HandleSetErr code has 'handled'
-the 'error', the driver could then continue instead of failing (if
-that's a reasonable thing to do). This isn't excepted to be
-common and any such cases should be clearly marked in the driver
-documentation and discussed on the dbi-dev mailing list.
-.PP
-The \f(CW\*(C`HandleSetErr\*(C'\fR attribute was added in \s-1DBI 1.41.\s0
-.PP
-\fI\f(CI\*(C`ErrCount\*(C'\fI\fR
-.IX Subsection "ErrCount"
-.PP
-Type: unsigned integer
-.PP
-The \f(CW\*(C`ErrCount\*(C'\fR attribute is incremented whenever the \fIset_err()\fR
-method records an error. It isn't incremented by warnings or
-information states. It is not reset by the \s-1DBI\s0 at any time.
-.PP
-The \f(CW\*(C`ErrCount\*(C'\fR attribute was added in \s-1DBI 1.41.\s0 Older drivers may
-not have been updated to use \fIset_err()\fR to record errors and so this
-attribute may not be incremented when using them.
-.PP
-\fI\f(CI\*(C`ShowErrorStatement\*(C'\fI\fR
-.IX Subsection "ShowErrorStatement"
-.PP
-Type: boolean, inherited
-.PP
-The \f(CW\*(C`ShowErrorStatement\*(C'\fR attribute can be used to cause the relevant
-Statement text to be appended to the error messages generated by
-the \f(CW\*(C`RaiseError\*(C'\fR, \f(CW\*(C`PrintError\*(C'\fR, and \f(CW\*(C`PrintWarn\*(C'\fR attributes.
-Only applies to errors on statement handles
-plus the \fIprepare()\fR, \fIdo()\fR, and the various \f(CW\*(C`select*()\*(C'\fR database handle methods.
-(The exact format of the appended text is subject to change.)
-.PP
-If \f(CW\*(C`$h\->{ParamValues}\*(C'\fR returns a hash reference of parameter
-(placeholder) values then those are formatted and appended to the
-end of the Statement text in the error message.
-.PP
-\fI\f(CI\*(C`TraceLevel\*(C'\fI\fR
-.IX Subsection "TraceLevel"
-.PP
-Type: integer, inherited
-.PP
-The \f(CW\*(C`TraceLevel\*(C'\fR attribute can be used as an alternative to the
-\&\*(L"trace\*(R" method to set the \s-1DBI\s0 trace level and trace flags for a
-specific handle. See \*(L"\s-1TRACING\*(R"\s0 for more details.
-.PP
-The \f(CW\*(C`TraceLevel\*(C'\fR attribute is especially useful combined with
-\&\f(CW\*(C`local\*(C'\fR to alter the trace settings for just a single block of code.
-.PP
-\fI\f(CI\*(C`FetchHashKeyName\*(C'\fI\fR
-.IX Subsection "FetchHashKeyName"
-.PP
-Type: string, inherited
-.PP
-The \f(CW\*(C`FetchHashKeyName\*(C'\fR attribute is used to specify whether the \fIfetchrow_hashref()\fR
-method should perform case conversion on the field names used for
-the hash keys. For historical reasons it defaults to '\f(CW\*(C`NAME\*(C'\fR' but
-it is recommended to set it to '\f(CW\*(C`NAME_lc\*(C'\fR' (convert to lower case)
-or '\f(CW\*(C`NAME_uc\*(C'\fR' (convert to upper case) according to your preference.
-It can only be set for driver and database handles. For statement
-handles the value is frozen when \fIprepare()\fR is called.
-.PP
-\fI\f(CI\*(C`ChopBlanks\*(C'\fI\fR
-.IX Subsection "ChopBlanks"
-.PP
-Type: boolean, inherited
-.PP
-The \f(CW\*(C`ChopBlanks\*(C'\fR attribute can be used to control the trimming of trailing space
-characters from fixed width character (\s-1CHAR\s0) fields. No other field
-types are affected, even where field values have trailing spaces.
-.PP
-The default is false (although it is possible that the default may change).
-Applications that need specific behaviour should set the attribute as
-needed.
-.PP
-Drivers are not required to support this attribute, but any driver which
-does not support it must arrange to return \f(CW\*(C`undef\*(C'\fR as the attribute value.
-.PP
-\fI\f(CI\*(C`LongReadLen\*(C'\fI\fR
-.IX Subsection "LongReadLen"
-.PP
-Type: unsigned integer, inherited
-.PP
-The \f(CW\*(C`LongReadLen\*(C'\fR attribute may be used to control the maximum
-length of 'long' type fields (\s-1LONG, BLOB, CLOB, MEMO,\s0 etc.) which the driver will
-read from the database automatically when it fetches each row of data.
-.PP
-The \f(CW\*(C`LongReadLen\*(C'\fR attribute only relates to fetching and reading
-long values; it is not involved in inserting or updating them.
-.PP
-A value of 0 means not to automatically fetch any long data.
-Drivers may return undef or an empty string for long fields when
-\&\f(CW\*(C`LongReadLen\*(C'\fR is 0.
-.PP
-The default is typically 0 (zero) or 80 bytes but may vary between drivers.
-Applications fetching long fields should set this value to slightly
-larger than the longest long field value to be fetched.
-.PP
-Some databases return some long types encoded as pairs of hex digits.
-For these types, \f(CW\*(C`LongReadLen\*(C'\fR relates to the underlying data
-length and not the doubled-up length of the encoded string.
-.PP
-Changing the value of \f(CW\*(C`LongReadLen\*(C'\fR for a statement handle after it
-has been \f(CW\*(C`prepare\*(C'\fR'd will typically have no effect, so it's common to
-set \f(CW\*(C`LongReadLen\*(C'\fR on the \f(CW$dbh\fR before calling \f(CW\*(C`prepare\*(C'\fR.
-.PP
-For most drivers the value used here has a direct effect on the
-memory used by the statement handle while it's active, so don't be
-too generous. If you can't be sure what value to use you could
-execute an extra select statement to determine the longest value.
-For example:
-.PP
-.Vb 7
-\& $dbh\->{LongReadLen} = $dbh\->selectrow_array(qq{
-\& SELECT MAX(OCTET_LENGTH(long_column_name))
-\& FROM table WHERE ...
-\& });
-\& $sth = $dbh\->prepare(qq{
-\& SELECT long_column_name, ... FROM table WHERE ...
-\& });
-.Ve
-.PP
-You may need to take extra care if the table can be modified between
-the first select and the second being executed. You may also need to
-use a different function if \s-1\fIOCTET_LENGTH\s0()\fR does not work for long
-types in your database. For example, for Sybase use \s-1\fIDATALENGTH\s0()\fR and
-for Oracle use \s-1\fILENGTHB\s0()\fR.
-.PP
-See also \*(L"LongTruncOk\*(R" for information on truncation of long types.
-.PP
-\fI\f(CI\*(C`LongTruncOk\*(C'\fI\fR
-.IX Subsection "LongTruncOk"
-.PP
-Type: boolean, inherited
-.PP
-The \f(CW\*(C`LongTruncOk\*(C'\fR attribute may be used to control the effect of
-fetching a long field value which has been truncated (typically
-because it's longer than the value of the \f(CW\*(C`LongReadLen\*(C'\fR attribute).
-.PP
-By default, \f(CW\*(C`LongTruncOk\*(C'\fR is false and so fetching a long value that
-needs to be truncated will cause the fetch to fail.
-(Applications should always be sure to
-check for errors after a fetch loop in case an error, such as a divide
-by zero or long field truncation, caused the fetch to terminate
-prematurely.)
-.PP
-If a fetch fails due to a long field truncation when \f(CW\*(C`LongTruncOk\*(C'\fR is
-false, many drivers will allow you to continue fetching further rows.
-.PP
-See also \*(L"LongReadLen\*(R".
-.PP
-\fI\f(CI\*(C`TaintIn\*(C'\fI\fR
-.IX Subsection "TaintIn"
-.PP
-Type: boolean, inherited
-.PP
-If the \f(CW\*(C`TaintIn\*(C'\fR attribute is set to a true value \fIand\fR Perl is running in
-taint mode (e.g., started with the \f(CW\*(C`\-T\*(C'\fR option), then all the arguments
-to most \s-1DBI\s0 method calls are checked for being tainted. \fIThis may change.\fR
-.PP
-The attribute defaults to off, even if Perl is in taint mode.
-See perlsec for more about taint mode. If Perl is not
-running in taint mode, this attribute has no effect.
-.PP
-When fetching data that you trust you can turn off the TaintIn attribute,
-for that statement handle, for the duration of the fetch loop.
-.PP
-The \f(CW\*(C`TaintIn\*(C'\fR attribute was added in \s-1DBI 1.31.\s0
-.PP
-\fI\f(CI\*(C`TaintOut\*(C'\fI\fR
-.IX Subsection "TaintOut"
-.PP
-Type: boolean, inherited
-.PP
-If the \f(CW\*(C`TaintOut\*(C'\fR attribute is set to a true value \fIand\fR Perl is running in
-taint mode (e.g., started with the \f(CW\*(C`\-T\*(C'\fR option), then most data fetched
-from the database is considered tainted. \fIThis may change.\fR
-.PP
-The attribute defaults to off, even if Perl is in taint mode.
-See perlsec for more about taint mode. If Perl is not
-running in taint mode, this attribute has no effect.
-.PP
-When fetching data that you trust you can turn off the TaintOut attribute,
-for that statement handle, for the duration of the fetch loop.
-.PP
-Currently only fetched data is tainted. It is possible that the results
-of other \s-1DBI\s0 method calls, and the value of fetched attributes, may
-also be tainted in future versions. That change may well break your
-applications unless you take great care now. If you use \s-1DBI\s0 Taint mode,
-please report your experience and any suggestions for changes.
-.PP
-The \f(CW\*(C`TaintOut\*(C'\fR attribute was added in \s-1DBI 1.31.\s0
-.PP
-\fI\f(CI\*(C`Taint\*(C'\fI\fR
-.IX Subsection "Taint"
-.PP
-Type: boolean, inherited
-.PP
-The \f(CW\*(C`Taint\*(C'\fR attribute is a shortcut for \*(L"TaintIn\*(R" and \*(L"TaintOut\*(R" (it is also present
-for backwards compatibility).
-.PP
-Setting this attribute sets both \*(L"TaintIn\*(R" and \*(L"TaintOut\*(R", and retrieving
-it returns a true value if and only if \*(L"TaintIn\*(R" and \*(L"TaintOut\*(R" are
-both set to true values.
-.PP
-\fI\f(CI\*(C`Profile\*(C'\fI\fR
-.IX Subsection "Profile"
-.PP
-Type: inherited
-.PP
-The \f(CW\*(C`Profile\*(C'\fR attribute enables the collection and reporting of
-method call timing statistics. See the DBI::Profile module
-documentation for \fImuch\fR more detail.
-.PP
-The \f(CW\*(C`Profile\*(C'\fR attribute was added in \s-1DBI 1.24.\s0
-.PP
-\fI\f(CI\*(C`ReadOnly\*(C'\fI\fR
-.IX Subsection "ReadOnly"
-.PP
-Type: boolean, inherited
-.PP
-An application can set the \f(CW\*(C`ReadOnly\*(C'\fR attribute of a handle to a true value to
-indicate that it will not be attempting to make any changes using that handle
-or any children of it.
-.PP
-Note that the exact definition of 'read only' is rather fuzzy.
-For more details see the documentation for the driver you're using.
-.PP
-If the driver can make the handle truly read-only then it should
-(unless doing so would have unpleasant side effect, like changing the
-consistency level from per-statement to per-session).
-Otherwise the attribute is simply advisory.
-.PP
-A driver can set the \f(CW\*(C`ReadOnly\*(C'\fR attribute itself to indicate that the data it
-is connected to cannot be changed for some reason.
-.PP
-If the driver cannot ensure the \f(CW\*(C`ReadOnly\*(C'\fR attribute is adhered to it
-will record a warning. In this case reading the \f(CW\*(C`ReadOnly\*(C'\fR attribute
-back after it is set true will return true even if the underlying
-driver cannot ensure this (so any application knows the application
-declared itself ReadOnly).
-.PP
-Library modules and proxy drivers can use the attribute to influence
-their behavior. For example, the DBD::Gofer driver considers the
-\&\f(CW\*(C`ReadOnly\*(C'\fR attribute when making a decision about whether to retry an
-operation that failed.
-.PP
-The attribute should be set to 1 or 0 (or undef). Other values are reserved.
-.PP
-\fI\f(CI\*(C`Callbacks\*(C'\fI\fR
-.IX Subsection "Callbacks"
-.PP
-Type: hash ref
-.PP
-The \s-1DBI\s0 callback mechanism lets you intercept, and optionally replace, any
-method call on a \s-1DBI\s0 handle. At the extreme, it lets you become a puppet
-master, deceiving the application in any way you want.
-.PP
-The \f(CW\*(C`Callbacks\*(C'\fR attribute is a hash reference where the keys are \s-1DBI\s0 method
-names and the values are code references. For each key naming a method, the
-\&\s-1DBI\s0 will execute the associated code reference before executing the method.
-.PP
-The arguments to the code reference will be the same as to the method,
-including the invocant (a database handle or statement handle). For example,
-say that to callback to some code on a call to \f(CW\*(C`prepare()\*(C'\fR:
-.PP
-.Vb 6
-\& $dbh\->{Callbacks} = {
-\& prepare => sub {
-\& my ($dbh, $query, $attrs) = @_;
-\& print "Preparing q{$query}\en"
-\& },
-\& };
-.Ve
-.PP
-The callback would then be executed when you called the \f(CW\*(C`prepare()\*(C'\fR method:
-.PP
-.Vb 1
-\& $dbh\->prepare(\*(AqSELECT 1\*(Aq);
-.Ve
-.PP
-And the output of course would be:
-.PP
-.Vb 1
-\& Preparing q{SELECT 1}
-.Ve
-.PP
-Because callbacks are executed \fIbefore\fR the methods
-they're associated with, you can modify the arguments before they're passed on
-to the method call. For example, to make sure that all calls to \f(CW\*(C`prepare()\*(C'\fR
-are immediately prepared by DBD::Pg, add a callback that makes sure that
-the \f(CW\*(C`pg_prepare_now\*(C'\fR attribute is always set:
-.PP
-.Vb 9
-\& my $dbh = DBI\->connect($dsn, $username, $auth, {
-\& Callbacks => {
-\& prepare => sub {
-\& $_[2] ||= {};
-\& $_[2]\->{pg_prepare_now} = 1;
-\& return; # must return nothing
-\& },
-\& }
-\& });
-.Ve
-.PP
-Note that we are editing the contents of \f(CW@_\fR directly. In this case we've
-created the attributes hash if it's not passed to the \f(CW\*(C`prepare\*(C'\fR call.
-.PP
-You can also prevent the associated method from ever executing. While a
-callback executes, \f(CW$_\fR holds the method name. (This allows multiple callbacks
-to share the same code reference and still know what method was called.)
-To prevent the method from
-executing, simply \f(CW\*(C`undef $_\*(C'\fR. For example, if you wanted to disable calls to
-\&\f(CW\*(C`ping()\*(C'\fR, you could do this:
-.PP
-.Vb 8
-\& $dbh\->{Callbacks} = {
-\& ping => sub {
-\& # tell dispatch to not call the method:
-\& undef $_;
-\& # return this value instead:
-\& return "42 bells";
-\& }
-\& };
-.Ve
-.PP
-As with other attributes, Callbacks can be specified on a handle or via the
-attributes to \f(CW\*(C`connect()\*(C'\fR. Callbacks can also be applied to a statement
-methods on a statement handle. For example:
-.PP
-.Vb 5
-\& $sth\->{Callbacks} = {
-\& execute => sub {
-\& print "Executing ", shift\->{Statement}, "\en";
-\& }
-\& };
-.Ve
-.PP
-The \f(CW\*(C`Callbacks\*(C'\fR attribute of a database handle isn't copied to any statement
-handles it creates. So setting callbacks for a statement handle requires you to
-set the \f(CW\*(C`Callbacks\*(C'\fR attribute on the statement handle yourself, as in the
-example above, or use the special \f(CW\*(C`ChildCallbacks\*(C'\fR key described below.
-.PP
-\&\fBSpecial Keys in Callbacks Attribute\fR
-.PP
-In addition to \s-1DBI\s0 handle method names, the \f(CW\*(C`Callbacks\*(C'\fR hash reference
-supports four additional keys.
-.PP
-The first is the \f(CW\*(C`ChildCallbacks\*(C'\fR key. When a statement handle is created from
-a database handle the \f(CW\*(C`ChildCallbacks\*(C'\fR key of the database handle's
-\&\f(CW\*(C`Callbacks\*(C'\fR attribute, if any, becomes the new \f(CW\*(C`Callbacks\*(C'\fR attribute of the
-statement handle.
-This allows you to define callbacks for all statement handles created from a
-database handle. For example, if you wanted to count how many times \f(CW\*(C`execute\*(C'\fR
-was called in your application, you could write:
-.PP
-.Vb 8
-\& my $exec_count = 0;
-\& my $dbh = DBI\->connect( $dsn, $username, $auth, {
-\& Callbacks => {
-\& ChildCallbacks => {
-\& execute => sub { $exec_count++; return; }
-\& }
-\& }
-\& });
-\&
-\& END {
-\& print "The execute method was called $exec_count times\en";
-\& }
-.Ve
-.PP
-The other three special keys are \f(CW\*(C`connect_cached.new\*(C'\fR,
-\&\f(CW\*(C`connect_cached.connected\*(C'\fR, and \f(CW\*(C`connect_cached.reused\*(C'\fR. These keys define
-callbacks that are called when \f(CW\*(C`connect_cached()\*(C'\fR is called, but allow
-different behaviors depending on whether a new handle is created or a handle
-is returned. The callback is invoked with these arguments:
-\&\f(CW\*(C`$dbh, $dsn, $user, $auth, $attr\*(C'\fR.
-.PP
-For example, some applications uses \f(CW\*(C`connect_cached()\*(C'\fR to connect with
-\&\f(CW\*(C`AutoCommit\*(C'\fR enabled and then disable \f(CW\*(C`AutoCommit\*(C'\fR temporarily for
-transactions. If \f(CW\*(C`connect_cached()\*(C'\fR is called during a transaction, perhaps in
-a utility method, then it might select the same cached handle and then force
-\&\f(CW\*(C`AutoCommit\*(C'\fR on, forcing a commit of the transaction. See the \*(L"connect_cached\*(R"
-documentation for one way to deal with that. Here we'll describe an alternative
-approach using a callback.
-.PP
-Because the \f(CW\*(C`connect_cached.new\*(C'\fR and \f(CW\*(C`connect_cached.reused\*(C'\fR callbacks are
-invoked before \f(CW\*(C`connect_cached()\*(C'\fR has applied the connect attributes, you can
-use them to edit the attributes that will be applied. To prevent a cached
-handle from having its transactions committed before it's returned, you can
-eliminate the \f(CW\*(C`AutoCommit\*(C'\fR attribute in a \f(CW\*(C`connect_cached.reused\*(C'\fR callback,
-like so:
-.PP
-.Vb 3
-\& my $cb = {
-\& \*(Aqconnect_cached.reused\*(Aq => sub { delete $_[4]\->{AutoCommit} },
-\& };
-\&
-\& sub dbh {
-\& my $self = shift;
-\& DBI\->connect_cached( $dsn, $username, $auth, {
-\& PrintError => 0,
-\& RaiseError => 1,
-\& AutoCommit => 1,
-\& Callbacks => $cb,
-\& });
-\& }
-.Ve
-.PP
-The upshot is that new database handles are created with \f(CW\*(C`AutoCommit\*(C'\fR
-enabled, while cached database handles are left in whatever transaction state
-they happened to be in when retrieved from the cache.
-.PP
-Note that we've also used a lexical for the callbacks hash reference. This is
-because \f(CW\*(C`connect_cached()\*(C'\fR returns a new database handle if any of the
-attributes passed to is have changed. If we used an inline hash reference,
-\&\f(CW\*(C`connect_cached()\*(C'\fR would return a new database handle every time. Which would
-rather defeat the purpose.
-.PP
-A more common application for callbacks is setting connection state only when
-a new connection is made (by \fIconnect()\fR or \fIconnect_cached()\fR). Adding a callback
-to the connected method (when using \f(CW\*(C`connect\*(C'\fR) or via
-\&\f(CW\*(C`connect_cached.connected\*(C'\fR (when useing \fIconnect_cached()\fR>) makes this easy.
-The \fIconnected()\fR method is a no-op by default (unless you subclass the \s-1DBI\s0 and
-change it). The \s-1DBI\s0 calls it to indicate that a new connection has been made
-and the connection attributes have all been set. You can give it a bit of
-added functionality by applying a callback to it. For example, to make sure
-that MySQL understands your application's ANSI-compliant \s-1SQL,\s0 set it up like
-so:
-.PP
-.Vb 10
-\& my $dbh = DBI\->connect($dsn, $username, $auth, {
-\& Callbacks => {
-\& connected => sub {
-\& shift\->do(q{
-\& SET SESSION sql_mode=\*(Aqansi,strict_trans_tables,no_auto_value_on_zero\*(Aq;
-\& });
-\& return;
-\& },
-\& }
-\& });
-.Ve
-.PP
-If you're using \f(CW\*(C`connect_cached()\*(C'\fR, use the \f(CW\*(C`connect_cached.connected\*(C'\fR
-callback, instead. This is because \f(CW\*(C`connected()\*(C'\fR is called for both new and
-reused database handles, but you want to execute a callback only the when a
-new database handle is returned. For example, to set the time zone on
-connection to a PostgreSQL database, try this:
-.PP
-.Vb 5
-\& my $cb = {
-\& \*(Aqconnect_cached.connected\*(Aq => sub {
-\& shift\->do(\*(AqSET timezone = UTC\*(Aq);
-\& }
-\& };
-\&
-\& sub dbh {
-\& my $self = shift;
-\& DBI\->connect_cached( $dsn, $username, $auth, { Callbacks => $cb });
-\& }
-.Ve
-.PP
-One significant limitation with callbacks is that there can only be one per
-method per handle. This means it's easy for one use of callbacks to interfere
-with, or typically simply overwrite, another use of callbacks. For this reason
-modules using callbacks should document the fact clearly so application authors
-can tell if use of callbacks by the module will clash with use of callbacks by
-the application.
-.PP
-You might be able to work around this issue by taking a copy of the original
-callback and calling it within your own. For example:
-.PP
-.Vb 8
-\& my $prev_cb = $h\->{Callbacks}{method_name};
-\& $h\->{Callbacks}{method_name} = sub {
-\& if ($prev_cb) {
-\& my @result = $prev_cb\->(@_);
-\& return @result if not $_; # $prev_cb vetoed call
-\& }
-\& ... your callback logic here ...
-\& };
-.Ve
-.PP
-\fI\f(CI\*(C`private_your_module_name_*\*(C'\fI\fR
-.IX Subsection "private_your_module_name_*"
-.PP
-The \s-1DBI\s0 provides a way to store extra information in a \s-1DBI\s0 handle as
-\&\*(L"private\*(R" attributes. The \s-1DBI\s0 will allow you to store and retrieve any
-attribute which has a name starting with "\f(CW\*(C`private_\*(C'\fR".
-.PP
-It is \fIstrongly\fR recommended that you use just \fIone\fR private
-attribute (e.g., use a hash ref) \fIand\fR give it a long and unambiguous
-name that includes the module or application name that the attribute
-relates to (e.g., "\f(CW\*(C`private_YourFullModuleName_thingy\*(C'\fR").
-.PP
-Because of the way the Perl tie mechanism works you cannot reliably
-use the \f(CW\*(C`||=\*(C'\fR operator directly to initialise the attribute, like this:
-.PP
-.Vb 1
-\& my $foo = $dbh\->{private_yourmodname_foo} ||= { ... }; # WRONG
-.Ve
-.PP
-you should use a two step approach like this:
-.PP
-.Vb 2
-\& my $foo = $dbh\->{private_yourmodname_foo};
-\& $foo ||= $dbh\->{private_yourmodname_foo} = { ... };
-.Ve
-.PP
-This attribute is primarily of interest to people sub-classing \s-1DBI,\s0
-or for applications to piggy-back extra information onto \s-1DBI\s0 handles.
-.SH "DBI DATABASE HANDLE OBJECTS"
-.IX Header "DBI DATABASE HANDLE OBJECTS"
-This section covers the methods and attributes associated with
-database handles.
-.SS "Database Handle Methods"
-.IX Subsection "Database Handle Methods"
-The following methods are specified for \s-1DBI\s0 database handles:
-.PP
-\fI\f(CI\*(C`clone\*(C'\fI\fR
-.IX Subsection "clone"
-.PP
-.Vb 1
-\& $new_dbh = $dbh\->clone(\e%attr);
-.Ve
-.PP
-The \f(CW\*(C`clone\*(C'\fR method duplicates the \f(CW$dbh\fR connection by connecting
-with the same parameters ($dsn, \f(CW$user\fR, \f(CW$password\fR) as originally used.
-.PP
-The attributes for the cloned connect are the same as those used
-for the \fIoriginal\fR connect, with any other attributes in \f(CW\*(C`\e%attr\*(C'\fR
-merged over them. Effectively the same as doing:
-.PP
-.Vb 1
-\& %attributes_used = ( %original_attributes, %attr );
-.Ve
-.PP
-If \e%attr is not given then it defaults to a hash containing all
-the attributes in the attribute cache of \f(CW$dbh\fR excluding any non-code
-references, plus the main boolean attributes (RaiseError, PrintError,
-AutoCommit, etc.). \fIThis behaviour is unreliable and so use of clone without
-an argument is deprecated and may cause a warning in a future release.\fR
-.PP
-The clone method can be used even if the database handle is disconnected.
-.PP
-The \f(CW\*(C`clone\*(C'\fR method was added in \s-1DBI 1.33.\s0
-.PP
-\fI\f(CI\*(C`data_sources\*(C'\fI\fR
-.IX Subsection "data_sources"
-.PP
-.Vb 2
-\& @ary = $dbh\->data_sources();
-\& @ary = $dbh\->data_sources(\e%attr);
-.Ve
-.PP
-Returns a list of data sources (databases) available via the \f(CW$dbh\fR
-driver's \fIdata_sources()\fR method, plus any extra data sources that
-the driver can discover via the connected \f(CW$dbh\fR. Typically the extra
-data sources are other databases managed by the same server process
-that the \f(CW$dbh\fR is connected to.
-.PP
-Data sources are returned in a form suitable for passing to the
-\&\*(L"connect\*(R" method (that is, they will include the "\f(CW\*(C`dbi:$driver:\*(C'\fR" prefix).
-.PP
-The \fIdata_sources()\fR method, for a \f(CW$dbh\fR, was added in \s-1DBI 1.38.\s0
-.PP
-\fI\f(CI\*(C`do\*(C'\fI\fR
-.IX Subsection "do"
-.PP
-.Vb 3
-\& $rows = $dbh\->do($statement) or die $dbh\->errstr;
-\& $rows = $dbh\->do($statement, \e%attr) or die $dbh\->errstr;
-\& $rows = $dbh\->do($statement, \e%attr, @bind_values) or die ...
-.Ve
-.PP
-Prepare and execute a single statement. Returns the number of rows
-affected or \f(CW\*(C`undef\*(C'\fR on error. A return value of \f(CW\*(C`\-1\*(C'\fR means the
-number of rows is not known, not applicable, or not available.
-.PP
-This method is typically most useful for \fInon\fR\-\f(CW\*(C`SELECT\*(C'\fR statements that
-either cannot be prepared in advance (due to a limitation of the
-driver) or do not need to be executed repeatedly. It should not
-be used for \f(CW\*(C`SELECT\*(C'\fR statements because it does not return a statement
-handle (so you can't fetch any data).
-.PP
-The default \f(CW\*(C`do\*(C'\fR method is logically similar to:
-.PP
-.Vb 7
-\& sub do {
-\& my($dbh, $statement, $attr, @bind_values) = @_;
-\& my $sth = $dbh\->prepare($statement, $attr) or return undef;
-\& $sth\->execute(@bind_values) or return undef;
-\& my $rows = $sth\->rows;
-\& ($rows == 0) ? "0E0" : $rows; # always return true if no error
-\& }
-.Ve
-.PP
-For example:
-.PP
-.Vb 4
-\& my $rows_deleted = $dbh\->do(q{
-\& DELETE FROM table
-\& WHERE status = ?
-\& }, undef, \*(AqDONE\*(Aq) or die $dbh\->errstr;
-.Ve
-.PP
-Using placeholders and \f(CW@bind_values\fR with the \f(CW\*(C`do\*(C'\fR method can be
-useful because it avoids the need to correctly quote any variables
-in the \f(CW$statement\fR. But if you'll be executing the statement many
-times then it's more efficient to \f(CW\*(C`prepare\*(C'\fR it once and call
-\&\f(CW\*(C`execute\*(C'\fR many times instead.
-.PP
-The \f(CW\*(C`q{...}\*(C'\fR style quoting used in this example avoids clashing with
-quotes that may be used in the \s-1SQL\s0 statement. Use the double-quote-like
-\&\f(CW\*(C`qq{...}\*(C'\fR operator if you want to interpolate variables into the string.
-See \*(L"Quote and Quote-like Operators\*(R" in perlop for more details.
-.PP
-Note drivers are free to avoid the overhead of creating an \s-1DBI\s0
-statement handle for \fIdo()\fR, especially if there are no parameters. In
-this case error handlers, if invoked during \fIdo()\fR, will be passed the
-database handle.
-.PP
-\fI\f(CI\*(C`last_insert_id\*(C'\fI\fR
-.IX Subsection "last_insert_id"
-.PP
-.Vb 2
-\& $rv = $dbh\->last_insert_id($catalog, $schema, $table, $field);
-\& $rv = $dbh\->last_insert_id($catalog, $schema, $table, $field, \e%attr);
-.Ve
-.PP
-Returns a value 'identifying' the row just inserted, if possible.
-Typically this would be a value assigned by the database server
-to a column with an \fIauto_increment\fR or \fIserial\fR type.
-Returns undef if the driver does not support the method or can't
-determine the value.
-.PP
-The \f(CW$catalog\fR, \f(CW$schema\fR, \f(CW$table\fR, and \f(CW$field\fR parameters may be required
-for some drivers (see below). If you don't know the parameter values
-and your driver does not need them, then use \f(CW\*(C`undef\*(C'\fR for each.
-.PP
-There are several caveats to be aware of with this method if you want
-to use it for portable applications:
-.PP
-\&\fB*\fR For some drivers the value may only available immediately after
-the insert statement has executed (e.g., mysql, Informix).
-.PP
-\&\fB*\fR For some drivers the \f(CW$catalog\fR, \f(CW$schema\fR, \f(CW$table\fR, and \f(CW$field\fR parameters
-are required, for others they are ignored (e.g., mysql).
-.PP
-\&\fB*\fR Drivers may return an indeterminate value if no insert has
-been performed yet.
-.PP
-\&\fB*\fR For some drivers the value may only be available if placeholders
-have \fInot\fR been used (e.g., Sybase, \s-1MS SQL\s0). In this case the value
-returned would be from the last non-placeholder insert statement.
-.PP
-\&\fB*\fR Some drivers may need driver-specific hints about how to get
-the value. For example, being told the name of the database 'sequence'
-object that holds the value. Any such hints are passed as driver-specific
-attributes in the \e%attr parameter.
-.PP
-\&\fB*\fR If the underlying database offers nothing better, then some
-drivers may attempt to implement this method by executing
-"\f(CW\*(C`select max($field) from $table\*(C'\fR". Drivers using any approach
-like this should issue a warning if \f(CW\*(C`AutoCommit\*(C'\fR is true because
-it is generally unsafe \- another process may have modified the table
-between your insert and the select. For situations where you know
-it is safe, such as when you have locked the table, you can silence
-the warning by passing \f(CW\*(C`Warn\*(C'\fR => 0 in \e%attr.
-.PP
-\&\fB*\fR If no insert has been performed yet, or the last insert failed,
-then the value is implementation defined.
-.PP
-Given all the caveats above, it's clear that this method must be
-used with care.
-.PP
-The \f(CW\*(C`last_insert_id\*(C'\fR method was added in \s-1DBI 1.38.\s0
-.PP
-\fI\f(CI\*(C`selectrow_array\*(C'\fI\fR
-.IX Subsection "selectrow_array"
-.PP
-.Vb 3
-\& @row_ary = $dbh\->selectrow_array($statement);
-\& @row_ary = $dbh\->selectrow_array($statement, \e%attr);
-\& @row_ary = $dbh\->selectrow_array($statement, \e%attr, @bind_values);
-.Ve
-.PP
-This utility method combines \*(L"prepare\*(R", \*(L"execute\*(R" and
-\&\*(L"fetchrow_array\*(R" into a single call. If called in a list context, it
-returns the first row of data from the statement. The \f(CW$statement\fR
-parameter can be a previously prepared statement handle, in which case
-the \f(CW\*(C`prepare\*(C'\fR is skipped.
-.PP
-If any method fails, and \*(L"RaiseError\*(R" is not set, \f(CW\*(C`selectrow_array\*(C'\fR
-will return an empty list.
-.PP
-If called in a scalar context for a statement handle that has more
-than one column, it is undefined whether the driver will return
-the value of the first column or the last. So don't do that.
-Also, in a scalar context, an \f(CW\*(C`undef\*(C'\fR is returned if there are no
-more rows or if an error occurred. That \f(CW\*(C`undef\*(C'\fR can't be distinguished
-from an \f(CW\*(C`undef\*(C'\fR returned because the first field value was \s-1NULL.\s0
-For these reasons you should exercise some caution if you use
-\&\f(CW\*(C`selectrow_array\*(C'\fR in a scalar context, or just don't do that.
-.PP
-\fI\f(CI\*(C`selectrow_arrayref\*(C'\fI\fR
-.IX Subsection "selectrow_arrayref"
-.PP
-.Vb 3
-\& $ary_ref = $dbh\->selectrow_arrayref($statement);
-\& $ary_ref = $dbh\->selectrow_arrayref($statement, \e%attr);
-\& $ary_ref = $dbh\->selectrow_arrayref($statement, \e%attr, @bind_values);
-.Ve
-.PP
-This utility method combines \*(L"prepare\*(R", \*(L"execute\*(R" and
-\&\*(L"fetchrow_arrayref\*(R" into a single call. It returns the first row of
-data from the statement. The \f(CW$statement\fR parameter can be a previously
-prepared statement handle, in which case the \f(CW\*(C`prepare\*(C'\fR is skipped.
-.PP
-If any method fails, and \*(L"RaiseError\*(R" is not set, \f(CW\*(C`selectrow_arrayref\*(C'\fR
-will return undef.
-.PP
-\fI\f(CI\*(C`selectrow_hashref\*(C'\fI\fR
-.IX Subsection "selectrow_hashref"
-.PP
-.Vb 3
-\& $hash_ref = $dbh\->selectrow_hashref($statement);
-\& $hash_ref = $dbh\->selectrow_hashref($statement, \e%attr);
-\& $hash_ref = $dbh\->selectrow_hashref($statement, \e%attr, @bind_values);
-.Ve
-.PP
-This utility method combines \*(L"prepare\*(R", \*(L"execute\*(R" and
-\&\*(L"fetchrow_hashref\*(R" into a single call. It returns the first row of
-data from the statement. The \f(CW$statement\fR parameter can be a previously
-prepared statement handle, in which case the \f(CW\*(C`prepare\*(C'\fR is skipped.
-.PP
-If any method fails, and \*(L"RaiseError\*(R" is not set, \f(CW\*(C`selectrow_hashref\*(C'\fR
-will return undef.
-.PP
-\fI\f(CI\*(C`selectall_arrayref\*(C'\fI\fR
-.IX Subsection "selectall_arrayref"
-.PP
-.Vb 3
-\& $ary_ref = $dbh\->selectall_arrayref($statement);
-\& $ary_ref = $dbh\->selectall_arrayref($statement, \e%attr);
-\& $ary_ref = $dbh\->selectall_arrayref($statement, \e%attr, @bind_values);
-.Ve
-.PP
-This utility method combines \*(L"prepare\*(R", \*(L"execute\*(R" and
-\&\*(L"fetchall_arrayref\*(R" into a single call. It returns a reference to an
-array containing a reference to an array (or hash, see below) for each row of
-data fetched.
-.PP
-The \f(CW$statement\fR parameter can be a previously prepared statement handle,
-in which case the \f(CW\*(C`prepare\*(C'\fR is skipped. This is recommended if the
-statement is going to be executed many times.
-.PP
-If \*(L"RaiseError\*(R" is not set and any method except \f(CW\*(C`fetchall_arrayref\*(C'\fR
-fails then \f(CW\*(C`selectall_arrayref\*(C'\fR will return \f(CW\*(C`undef\*(C'\fR; if
-\&\f(CW\*(C`fetchall_arrayref\*(C'\fR fails then it will return with whatever data
-has been fetched thus far. You should check \f(CW\*(C`$dbh\->err\*(C'\fR
-afterwards (or use the \f(CW\*(C`RaiseError\*(C'\fR attribute) to discover if the data is
-complete or was truncated due to an error.
-.PP
-The \*(L"fetchall_arrayref\*(R" method called by \f(CW\*(C`selectall_arrayref\*(C'\fR
-supports a \f(CW$max_rows\fR parameter. You can specify a value for \f(CW$max_rows\fR
-by including a '\f(CW\*(C`MaxRows\*(C'\fR' attribute in \e%attr. In which case \fIfinish()\fR
-is called for you after \fIfetchall_arrayref()\fR returns.
-.PP
-The \*(L"fetchall_arrayref\*(R" method called by \f(CW\*(C`selectall_arrayref\*(C'\fR
-also supports a \f(CW$slice\fR parameter. You can specify a value for \f(CW$slice\fR by
-including a '\f(CW\*(C`Slice\*(C'\fR' or '\f(CW\*(C`Columns\*(C'\fR' attribute in \e%attr. The only
-difference between the two is that if \f(CW\*(C`Slice\*(C'\fR is not defined and
-\&\f(CW\*(C`Columns\*(C'\fR is an array ref, then the array is assumed to contain column
-index values (which count from 1), rather than perl array index values.
-In which case the array is copied and each value decremented before
-passing to \f(CW\*(C`/fetchall_arrayref\*(C'\fR.
-.PP
-You may often want to fetch an array of rows where each row is stored as a
-hash. That can be done simply using:
-.PP
-.Vb 7
-\& my $emps = $dbh\->selectall_arrayref(
-\& "SELECT ename FROM emp ORDER BY ename",
-\& { Slice => {} }
-\& );
-\& foreach my $emp ( @$emps ) {
-\& print "Employee: $emp\->{ename}\en";
-\& }
-.Ve
-.PP
-Or, to fetch into an array instead of an array ref:
-.PP
-.Vb 1
-\& @result = @{ $dbh\->selectall_arrayref($sql, { Slice => {} }) };
-.Ve
-.PP
-See \*(L"fetchall_arrayref\*(R" method for more details.
-.PP
-\fI\f(CI\*(C`selectall_array\*(C'\fI\fR
-.IX Subsection "selectall_array"
-.PP
-.Vb 3
-\& @ary = $dbh\->selectall_array($statement);
-\& @ary = $dbh\->selectall_array($statement, \e%attr);
-\& @ary = $dbh\->selectall_array($statement, \e%attr, @bind_values);
-.Ve
-.PP
-This is a convenience wrapper around selectall_arrayref that returns
-the rows directly as a list, rather than a reference to an array of rows.
-.PP
-Note that if \*(L"RaiseError\*(R" is not set then you can't tell the difference
-between returning no rows and an error. Using RaiseError is best practice.
-.PP
-\fI\f(CI\*(C`selectall_hashref\*(C'\fI\fR
-.IX Subsection "selectall_hashref"
-.PP
-.Vb 3
-\& $hash_ref = $dbh\->selectall_hashref($statement, $key_field);
-\& $hash_ref = $dbh\->selectall_hashref($statement, $key_field, \e%attr);
-\& $hash_ref = $dbh\->selectall_hashref($statement, $key_field, \e%attr, @bind_values);
-.Ve
-.PP
-This utility method combines \*(L"prepare\*(R", \*(L"execute\*(R" and
-\&\*(L"fetchall_hashref\*(R" into a single call. It returns a reference to a
-hash containing one entry, at most, for each row, as returned by \fIfetchall_hashref()\fR.
-.PP
-The \f(CW$statement\fR parameter can be a previously prepared statement handle,
-in which case the \f(CW\*(C`prepare\*(C'\fR is skipped. This is recommended if the
-statement is going to be executed many times.
-.PP
-The \f(CW$key_field\fR parameter defines which column, or columns, are used as keys
-in the returned hash. It can either be the name of a single field, or a
-reference to an array containing multiple field names. Using multiple names
-yields a tree of nested hashes.
-.PP
-If a row has the same key as an earlier row then it replaces the earlier row.
-.PP
-If any method except \f(CW\*(C`fetchrow_hashref\*(C'\fR fails, and \*(L"RaiseError\*(R" is not set,
-\&\f(CW\*(C`selectall_hashref\*(C'\fR will return \f(CW\*(C`undef\*(C'\fR. If \f(CW\*(C`fetchrow_hashref\*(C'\fR fails and
-\&\*(L"RaiseError\*(R" is not set, then it will return with whatever data it
-has fetched thus far. \f(CW$DBI::err\fR should be checked to catch that.
-.PP
-See \fIfetchall_hashref()\fR for more details.
-.PP
-\fI\f(CI\*(C`selectcol_arrayref\*(C'\fI\fR
-.IX Subsection "selectcol_arrayref"
-.PP
-.Vb 3
-\& $ary_ref = $dbh\->selectcol_arrayref($statement);
-\& $ary_ref = $dbh\->selectcol_arrayref($statement, \e%attr);
-\& $ary_ref = $dbh\->selectcol_arrayref($statement, \e%attr, @bind_values);
-.Ve
-.PP
-This utility method combines \*(L"prepare\*(R", \*(L"execute\*(R", and fetching one
-column from all the rows, into a single call. It returns a reference to
-an array containing the values of the first column from each row.
-.PP
-The \f(CW$statement\fR parameter can be a previously prepared statement handle,
-in which case the \f(CW\*(C`prepare\*(C'\fR is skipped. This is recommended if the
-statement is going to be executed many times.
-.PP
-If any method except \f(CW\*(C`fetch\*(C'\fR fails, and \*(L"RaiseError\*(R" is not set,
-\&\f(CW\*(C`selectcol_arrayref\*(C'\fR will return \f(CW\*(C`undef\*(C'\fR. If \f(CW\*(C`fetch\*(C'\fR fails and
-\&\*(L"RaiseError\*(R" is not set, then it will return with whatever data it
-has fetched thus far. \f(CW$DBI::err\fR should be checked to catch that.
-.PP
-The \f(CW\*(C`selectcol_arrayref\*(C'\fR method defaults to pushing a single column
-value (the first) from each row into the result array. However, it can
-also push another column, or even multiple columns per row, into the
-result array. This behaviour can be specified via a '\f(CW\*(C`Columns\*(C'\fR'
-attribute which must be a ref to an array containing the column number
-or numbers to use. For example:
-.PP
-.Vb 3
-\& # get array of id and name pairs:
-\& my $ary_ref = $dbh\->selectcol_arrayref("select id, name from table", { Columns=>[1,2] });
-\& my %hash = @$ary_ref; # build hash from key\-value pairs so $hash{$id} => name
-.Ve
-.PP
-You can specify a maximum number of rows to fetch by including a
-\&'\f(CW\*(C`MaxRows\*(C'\fR' attribute in \e%attr.
-.PP
-\fI\f(CI\*(C`prepare\*(C'\fI\fR
-.IX Subsection "prepare"
-.PP
-.Vb 2
-\& $sth = $dbh\->prepare($statement) or die $dbh\->errstr;
-\& $sth = $dbh\->prepare($statement, \e%attr) or die $dbh\->errstr;
-.Ve
-.PP
-Prepares a statement for later execution by the database
-engine and returns a reference to a statement handle object.
-.PP
-The returned statement handle can be used to get attributes of the
-statement and invoke the \*(L"execute\*(R" method. See \*(L"Statement Handle Methods\*(R".
-.PP
-Drivers for engines without the concept of preparing a
-statement will typically just store the statement in the returned
-handle and process it when \f(CW\*(C`$sth\->execute\*(C'\fR is called. Such drivers are
-unlikely to give much useful information about the
-statement, such as \f(CW\*(C`$sth\->{NUM_OF_FIELDS}\*(C'\fR, until after \f(CW\*(C`$sth\->execute\*(C'\fR
-has been called. Portable applications should take this into account.
-.PP
-In general, \s-1DBI\s0 drivers do not parse the contents of the statement
-(other than simply counting any Placeholders).
-The statement is
-passed directly to the database engine, sometimes known as pass-thru
-mode. This has advantages and disadvantages. On the plus side, you can
-access all the functionality of the engine being used. On the downside,
-you're limited if you're using a simple engine, and you need to take extra care if
-writing applications intended to be portable between engines.
-.PP
-Portable applications should not assume that a new statement can be
-prepared and/or executed while still fetching results from a previous
-statement.
-.PP
-Some command-line \s-1SQL\s0 tools use statement terminators, like a semicolon,
-to indicate the end of a statement. Such terminators should not normally
-be used with the \s-1DBI.\s0
-.PP
-\fI\f(CI\*(C`prepare_cached\*(C'\fI\fR
-.IX Subsection "prepare_cached"
-.PP
-.Vb 3
-\& $sth = $dbh\->prepare_cached($statement)
-\& $sth = $dbh\->prepare_cached($statement, \e%attr)
-\& $sth = $dbh\->prepare_cached($statement, \e%attr, $if_active)
-.Ve
-.PP
-Like \*(L"prepare\*(R" except that the statement handle returned will be
-stored in a hash associated with the \f(CW$dbh\fR. If another call is made to
-\&\f(CW\*(C`prepare_cached\*(C'\fR with the same \f(CW$statement\fR and \f(CW%attr\fR parameter values,
-then the corresponding cached \f(CW$sth\fR will be returned without contacting the
-database server. Be sure to understand the cautions and caveats noted below.
-.PP
-The \f(CW$if_active\fR parameter lets you adjust the behaviour if an
-already cached statement handle is still Active. There are several
-alternatives:
-.ie n .IP "\fB0\fR: A warning will be generated, and \fIfinish()\fR will be called on the statement handle before it is returned. This is the default behaviour if $if_active is not passed." 4
-.el .IP "\fB0\fR: A warning will be generated, and \fIfinish()\fR will be called on the statement handle before it is returned. This is the default behaviour if \f(CW$if_active\fR is not passed." 4
-.IX Item "0: A warning will be generated, and finish() will be called on the statement handle before it is returned. This is the default behaviour if $if_active is not passed."
-.PD 0
-.IP "\fB1\fR: \fIfinish()\fR will be called on the statement handle, but the warning is suppressed." 4
-.IX Item "1: finish() will be called on the statement handle, but the warning is suppressed."
-.IP "\fB2\fR: Disables any checking." 4
-.IX Item "2: Disables any checking."
-.IP "\fB3\fR: The existing active statement handle will be removed from the cache and a new statement handle prepared and cached in its place. This is the safest option because it doesn't affect the state of the old handle, it just removes it from the cache. [Added in \s-1DBI 1.40\s0]" 4
-.IX Item "3: The existing active statement handle will be removed from the cache and a new statement handle prepared and cached in its place. This is the safest option because it doesn't affect the state of the old handle, it just removes it from the cache. [Added in DBI 1.40]"
-.PD
-.PP
-Here are some examples of \f(CW\*(C`prepare_cached\*(C'\fR:
-.PP
-.Vb 10
-\& sub insert_hash {
-\& my ($table, $field_values) = @_;
-\& # sort to keep field order, and thus sql, stable for prepare_cached
-\& my @fields = sort keys %$field_values;
-\& my @values = @{$field_values}{@fields};
-\& my $sql = sprintf "insert into %s (%s) values (%s)",
-\& $table, join(",", @fields), join(",", ("?")x@fields);
-\& my $sth = $dbh\->prepare_cached($sql);
-\& return $sth\->execute(@values);
-\& }
-\&
-\& sub search_hash {
-\& my ($table, $field_values) = @_;
-\& # sort to keep field order, and thus sql, stable for prepare_cached
-\& my @fields = sort keys %$field_values;
-\& my @values = @{$field_values}{@fields};
-\& my $qualifier = "";
-\& $qualifier = "where ".join(" and ", map { "$_=?" } @fields) if @fields;
-\& $sth = $dbh\->prepare_cached("SELECT * FROM $table $qualifier");
-\& return $dbh\->selectall_arrayref($sth, {}, @values);
-\& }
-.Ve
-.PP
-\&\fICaveat emptor:\fR This caching can be useful in some applications,
-but it can also cause problems and should be used with care. Here
-is a contrived case where caching would cause a significant problem:
-.PP
-.Vb 3
-\& my $sth = $dbh\->prepare_cached(\*(AqSELECT * FROM foo WHERE bar=?\*(Aq);
-\& $sth\->execute(...);
-\& while (my $data = $sth\->fetchrow_hashref) {
-\&
-\& # later, in some other code called within the loop...
-\& my $sth2 = $dbh\->prepare_cached(\*(AqSELECT * FROM foo WHERE bar=?\*(Aq);
-\& $sth2\->execute(...);
-\& while (my $data2 = $sth2\->fetchrow_arrayref) {
-\& do_stuff(...);
-\& }
-\& }
-.Ve
-.PP
-In this example, since both handles are preparing the exact same statement,
-\&\f(CW$sth2\fR will not be its own statement handle, but a duplicate of \f(CW$sth\fR
-returned from the cache. The results will certainly not be what you expect.
-Typically the inner fetch loop will work normally, fetching all
-the records and terminating when there are no more, but now that \f(CW$sth\fR
-is the same as \f(CW$sth2\fR the outer fetch loop will also terminate.
-.PP
-You'll know if you run into this problem because \fIprepare_cached()\fR
-will generate a warning by default (when \f(CW$if_active\fR is false).
-.PP
-The cache used by \fIprepare_cached()\fR is keyed by both the statement
-and any attributes so you can also avoid this issue by doing something
-like:
-.PP
-.Vb 1
-\& $sth = $dbh\->prepare_cached("...", { dbi_dummy => _\|_FILE_\|_._\|_LINE_\|_ });
-.Ve
-.PP
-which will ensure that prepare_cached only returns statements cached
-by that line of code in that source file.
-.PP
-Also, to ensure the attributes passed are always the same, avoid passing
-references inline. For example, the Slice attribute is specified as a
-reference. Be sure to declare it external to the call to \fIprepare_cached()\fR, such
-that a new hash reference is not created on every call. See \*(L"connect_cached\*(R"
-for more details and examples.
-.PP
-If you'd like the cache to managed intelligently, you can tie the
-hashref returned by \f(CW\*(C`CachedKids\*(C'\fR to an appropriate caching module,
-such as Tie::Cache::LRU:
-.PP
-.Vb 3
-\& my $cache;
-\& tie %$cache, \*(AqTie::Cache::LRU\*(Aq, 500;
-\& $dbh\->{CachedKids} = $cache;
-.Ve
-.PP
-\fI\f(CI\*(C`commit\*(C'\fI\fR
-.IX Subsection "commit"
-.PP
-.Vb 1
-\& $rc = $dbh\->commit or die $dbh\->errstr;
-.Ve
-.PP
-Commit (make permanent) the most recent series of database changes
-if the database supports transactions and AutoCommit is off.
-.PP
-If \f(CW\*(C`AutoCommit\*(C'\fR is on, then calling
-\&\f(CW\*(C`commit\*(C'\fR will issue a \*(L"commit ineffective with AutoCommit\*(R" warning.
-.PP
-See also \*(L"Transactions\*(R" in the \*(L"\s-1FURTHER INFORMATION\*(R"\s0 section below.
-.PP
-\fI\f(CI\*(C`rollback\*(C'\fI\fR
-.IX Subsection "rollback"
-.PP
-.Vb 1
-\& $rc = $dbh\->rollback or die $dbh\->errstr;
-.Ve
-.PP
-Rollback (undo) the most recent series of uncommitted database
-changes if the database supports transactions and AutoCommit is off.
-.PP
-If \f(CW\*(C`AutoCommit\*(C'\fR is on, then calling
-\&\f(CW\*(C`rollback\*(C'\fR will issue a \*(L"rollback ineffective with AutoCommit\*(R" warning.
-.PP
-See also \*(L"Transactions\*(R" in the \*(L"\s-1FURTHER INFORMATION\*(R"\s0 section below.
-.PP
-\fI\f(CI\*(C`begin_work\*(C'\fI\fR
-.IX Subsection "begin_work"
-.PP
-.Vb 1
-\& $rc = $dbh\->begin_work or die $dbh\->errstr;
-.Ve
-.PP
-Enable transactions (by turning \f(CW\*(C`AutoCommit\*(C'\fR off) until the next call
-to \f(CW\*(C`commit\*(C'\fR or \f(CW\*(C`rollback\*(C'\fR. After the next \f(CW\*(C`commit\*(C'\fR or \f(CW\*(C`rollback\*(C'\fR,
-\&\f(CW\*(C`AutoCommit\*(C'\fR will automatically be turned on again.
-.PP
-If \f(CW\*(C`AutoCommit\*(C'\fR is already off when \f(CW\*(C`begin_work\*(C'\fR is called then
-it does nothing except return an error. If the driver does not support
-transactions then when \f(CW\*(C`begin_work\*(C'\fR attempts to set \f(CW\*(C`AutoCommit\*(C'\fR off
-the driver will trigger a fatal error.
-.PP
-See also \*(L"Transactions\*(R" in the \*(L"\s-1FURTHER INFORMATION\*(R"\s0 section below.
-.PP
-\fI\f(CI\*(C`disconnect\*(C'\fI\fR
-.IX Subsection "disconnect"
-.PP
-.Vb 1
-\& $rc = $dbh\->disconnect or warn $dbh\->errstr;
-.Ve
-.PP
-Disconnects the database from the database handle. \f(CW\*(C`disconnect\*(C'\fR is typically only used
-before exiting the program. The handle is of little use after disconnecting.
-.PP
-The transaction behaviour of the \f(CW\*(C`disconnect\*(C'\fR method is, sadly,
-undefined. Some database systems (such as Oracle and Ingres) will
-automatically commit any outstanding changes, but others (such as
-Informix) will rollback any outstanding changes. Applications not
-using \f(CW\*(C`AutoCommit\*(C'\fR should explicitly call \f(CW\*(C`commit\*(C'\fR or \f(CW\*(C`rollback\*(C'\fR before
-calling \f(CW\*(C`disconnect\*(C'\fR.
-.PP
-The database is automatically disconnected by the \f(CW\*(C`DESTROY\*(C'\fR method if
-still connected when there are no longer any references to the handle.
-The \f(CW\*(C`DESTROY\*(C'\fR method for each driver should implicitly call \f(CW\*(C`rollback\*(C'\fR to
-undo any uncommitted changes. This is vital behaviour to ensure that
-incomplete transactions don't get committed simply because Perl calls
-\&\f(CW\*(C`DESTROY\*(C'\fR on every object before exiting. Also, do not rely on the order
-of object destruction during \*(L"global destruction\*(R", as it is undefined.
-.PP
-Generally, if you want your changes to be committed or rolled back when
-you disconnect, then you should explicitly call \*(L"commit\*(R" or \*(L"rollback\*(R"
-before disconnecting.
-.PP
-If you disconnect from a database while you still have active
-statement handles (e.g., \s-1SELECT\s0 statement handles that may have
-more data to fetch), you will get a warning. The warning may indicate
-that a fetch loop terminated early, perhaps due to an uncaught error.
-To avoid the warning call the \f(CW\*(C`finish\*(C'\fR method on the active handles.
-.PP
-\fI\f(CI\*(C`ping\*(C'\fI\fR
-.IX Subsection "ping"
-.PP
-.Vb 1
-\& $rc = $dbh\->ping;
-.Ve
-.PP
-Attempts to determine, in a reasonably efficient way, if the database
-server is still running and the connection to it is still working.
-Individual drivers should implement this function in the most suitable
-manner for their database engine.
-.PP
-The current \fIdefault\fR implementation always returns true without
-actually doing anything. Actually, it returns "\f(CW\*(C`0 but true\*(C'\fR" which is
-true but zero. That way you can tell if the return value is genuine or
-just the default. Drivers should override this method with one that
-does the right thing for their type of database.
-.PP
-Few applications would have direct use for this method. See the specialized
-Apache::DBI module for one example usage.
-.PP
-\fI\f(CI\*(C`get_info\*(C'\fI\fR
-.IX Subsection "get_info"
-.PP
-.Vb 1
-\& $value = $dbh\->get_info( $info_type );
-.Ve
-.PP
-Returns information about the implementation, i.e. driver and data
-source capabilities, restrictions etc. It returns \f(CW\*(C`undef\*(C'\fR for
-unknown or unimplemented information types. For example:
-.PP
-.Vb 2
-\& $database_version = $dbh\->get_info( 18 ); # SQL_DBMS_VER
-\& $max_select_tables = $dbh\->get_info( 106 ); # SQL_MAXIMUM_TABLES_IN_SELECT
-.Ve
-.PP
-See \*(L"Standards Reference Information\*(R" for more detailed information
-about the information types and their meanings and possible return values.
-.PP
-The DBI::Const::GetInfoType module exports a \f(CW%GetInfoType\fR hash that
-can be used to map info type names to numbers. For example:
-.PP
-.Vb 1
-\& $database_version = $dbh\->get_info( $GetInfoType{SQL_DBMS_VER} );
-.Ve
-.PP
-The names are a merging of the \s-1ANSI\s0 and \s-1ODBC\s0 standards (which differ
-in some cases). See DBI::Const::GetInfoType for more details.
-.PP
-Because some \s-1DBI\s0 methods make use of \fIget_info()\fR, drivers are strongly
-encouraged to support \fIat least\fR the following very minimal set
-of information types to ensure the \s-1DBI\s0 itself works properly:
-.PP
-.Vb 7
-\& Type Name Example A Example B
-\& \-\-\-\- \-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\- \-\-\-\-\-\-\-\-\-\-\-\- \-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-
-\& 17 SQL_DBMS_NAME \*(AqACCESS\*(Aq \*(AqOracle\*(Aq
-\& 18 SQL_DBMS_VER \*(Aq03.50.0000\*(Aq \*(Aq08.01.0721 ...\*(Aq
-\& 29 SQL_IDENTIFIER_QUOTE_CHAR \*(Aq\`\*(Aq \*(Aq"\*(Aq
-\& 41 SQL_CATALOG_NAME_SEPARATOR \*(Aq.\*(Aq \*(Aq@\*(Aq
-\& 114 SQL_CATALOG_LOCATION 1 2
-.Ve
-.PP
-Values from 9000 to 9999 for get_info are officially reserved for use by Perl \s-1DBI.\s0
-Values in that range which have been assigned a meaning are defined here:
-.PP
-\&\f(CW9000\fR: true if a backslash character (\f(CW\*(C`\e\*(C'\fR) before placeholder-like text
-(e.g. \f(CW\*(C`?\*(C'\fR, \f(CW\*(C`:foo\*(C'\fR) will prevent it being treated as a placeholder by the driver.
-The backslash will be removed before the text is passed to the backend.
-.PP
-\fI\f(CI\*(C`table_info\*(C'\fI\fR
-.IX Subsection "table_info"
-.PP
-.Vb 2
-\& $sth = $dbh\->table_info( $catalog, $schema, $table, $type );
-\& $sth = $dbh\->table_info( $catalog, $schema, $table, $type, \e%attr );
-\&
-\& # then $sth\->fetchall_arrayref or $sth\->fetchall_hashref etc
-.Ve
-.PP
-Returns an active statement handle that can be used to fetch
-information about tables and views that exist in the database.
-.PP
-The arguments \f(CW$catalog\fR, \f(CW$schema\fR and \f(CW$table\fR may accept search patterns
-according to the database/driver, for example: \f(CW$table\fR = '%FOO%';
-Remember that the underscore character ('\f(CW\*(C`_\*(C'\fR') is a search pattern
-that means match any character, so 'FOO_%' is the same as 'FOO%'
-and 'FOO_BAR%' will match names like '\s-1FOO1BAR\s0'.
-.PP
-The value of \f(CW$type\fR is a comma-separated list of one or more types of
-tables to be returned in the result set. Each value may optionally be
-quoted, e.g.:
-.PP
-.Vb 2
-\& $type = "TABLE";
-\& $type = "\*(AqTABLE\*(Aq,\*(AqVIEW\*(Aq";
-.Ve
-.PP
-In addition the following special cases may also be supported by some drivers:
-.IP "\(bu" 4
-If the value of \f(CW$catalog\fR is '%' and \f(CW$schema\fR and \f(CW$table\fR name
-are empty strings, the result set contains a list of catalog names.
-For example:
-.Sp
-.Vb 1
-\& $sth = $dbh\->table_info(\*(Aq%\*(Aq, \*(Aq\*(Aq, \*(Aq\*(Aq);
-.Ve
-.IP "\(bu" 4
-If the value of \f(CW$schema\fR is '%' and \f(CW$catalog\fR and \f(CW$table\fR are empty
-strings, the result set contains a list of schema names.
-.IP "\(bu" 4
-If the value of \f(CW$type\fR is '%' and \f(CW$catalog\fR, \f(CW$schema\fR, and \f(CW$table\fR are all
-empty strings, the result set contains a list of table types.
-.PP
-If your driver doesn't support one or more of the selection filter
-parameters then you may get back more than you asked for and can
-do the filtering yourself.
-.PP
-This method can be expensive, and can return a large amount of data.
-(For example, small Oracle installation returns over 2000 rows.)
-So it's a good idea to use the filters to limit the data as much as possible.
-.PP
-The statement handle returned has at least the following fields in the
-order show below. Other fields, after these, may also be present.
-.PP
-\&\fB\s-1TABLE_CAT\s0\fR: Table catalog identifier. This field is \s-1NULL \s0(\f(CW\*(C`undef\*(C'\fR) if not
-applicable to the data source, which is usually the case. This field
-is empty if not applicable to the table.
-.PP
-\&\fB\s-1TABLE_SCHEM\s0\fR: The name of the schema containing the \s-1TABLE_NAME\s0 value.
-This field is \s-1NULL \s0(\f(CW\*(C`undef\*(C'\fR) if not applicable to data source, and
-empty if not applicable to the table.
-.PP
-\&\fB\s-1TABLE_NAME\s0\fR: Name of the table (or view, synonym, etc).
-.PP
-\&\fB\s-1TABLE_TYPE\s0\fR: One of the following: \*(L"\s-1TABLE\*(R", \*(L"VIEW\*(R", \*(L"SYSTEM TABLE\*(R",
-\&\*(L"GLOBAL TEMPORARY\*(R", \*(L"LOCAL TEMPORARY\*(R", \*(L"ALIAS\*(R", \*(L"SYNONYM\*(R"\s0 or a type
-identifier that is specific to the data
-source.
-.PP
-\&\fB\s-1REMARKS\s0\fR: A description of the table. May be \s-1NULL \s0(\f(CW\*(C`undef\*(C'\fR).
-.PP
-Note that \f(CW\*(C`table_info\*(C'\fR might not return records for all tables.
-Applications can use any valid table regardless of whether it's
-returned by \f(CW\*(C`table_info\*(C'\fR.
-.PP
-See also \*(L"tables\*(R", \*(L"Catalog Methods\*(R" and
-\&\*(L"Standards Reference Information\*(R".
-.PP
-\fI\f(CI\*(C`column_info\*(C'\fI\fR
-.IX Subsection "column_info"
-.PP
-.Vb 1
-\& $sth = $dbh\->column_info( $catalog, $schema, $table, $column );
-\&
-\& # then $sth\->fetchall_arrayref or $sth\->fetchall_hashref etc
-.Ve
-.PP
-Returns an active statement handle that can be used to fetch
-information about columns in specified tables.
-.PP
-The arguments \f(CW$schema\fR, \f(CW$table\fR and \f(CW$column\fR may accept search patterns
-according to the database/driver, for example: \f(CW$table\fR = '%FOO%';
-.PP
-Note: The support for the selection criteria is driver specific. If the
-driver doesn't support one or more of them then you may get back more
-than you asked for and can do the filtering yourself.
-.PP
-Note: If your driver does not support column_info an undef is
-returned. This is distinct from asking for something which does not
-exist in a driver which supports column_info as a valid statement
-handle to an empty result-set will be returned in this case.
-.PP
-If the arguments don't match any tables then you'll still get a statement
-handle, it'll just return no rows.
-.PP
-The statement handle returned has at least the following fields in the
-order shown below. Other fields, after these, may also be present.
-.PP
-\&\fB\s-1TABLE_CAT\s0\fR: The catalog identifier.
-This field is \s-1NULL \s0(\f(CW\*(C`undef\*(C'\fR) if not applicable to the data source,
-which is often the case. This field is empty if not applicable to the
-table.
-.PP
-\&\fB\s-1TABLE_SCHEM\s0\fR: The schema identifier.
-This field is \s-1NULL \s0(\f(CW\*(C`undef\*(C'\fR) if not applicable to the data source,
-and empty if not applicable to the table.
-.PP
-\&\fB\s-1TABLE_NAME\s0\fR: The table identifier.
-Note: A driver may provide column metadata not only for base tables, but
-also for derived objects like \s-1SYNONYMS\s0 etc.
-.PP
-\&\fB\s-1COLUMN_NAME\s0\fR: The column identifier.
-.PP
-\&\fB\s-1DATA_TYPE\s0\fR: The concise data type code.
-.PP
-\&\fB\s-1TYPE_NAME\s0\fR: A data source dependent data type name.
-.PP
-\&\fB\s-1COLUMN_SIZE\s0\fR: The column size.
-This is the maximum length in characters for character data types,
-the number of digits or bits for numeric data types or the length
-in the representation of temporal types.
-See the relevant specifications for detailed information.
-.PP
-\&\fB\s-1BUFFER_LENGTH\s0\fR: The length in bytes of transferred data.
-.PP
-\&\fB\s-1DECIMAL_DIGITS\s0\fR: The total number of significant digits to the right of
-the decimal point.
-.PP
-\&\fB\s-1NUM_PREC_RADIX\s0\fR: The radix for numeric precision.
-The value is 10 or 2 for numeric data types and \s-1NULL \s0(\f(CW\*(C`undef\*(C'\fR) if not
-applicable.
-.PP
-\&\fB\s-1NULLABLE\s0\fR: Indicates if a column can accept NULLs.
-The following values are defined:
-.PP
-.Vb 3
-\& SQL_NO_NULLS 0
-\& SQL_NULLABLE 1
-\& SQL_NULLABLE_UNKNOWN 2
-.Ve
-.PP
-\&\fB\s-1REMARKS\s0\fR: A description of the column.
-.PP
-\&\fB\s-1COLUMN_DEF\s0\fR: The default value of the column, in a format that can be used
-directly in an \s-1SQL\s0 statement.
-.PP
-Note that this may be an expression and not simply the text used for the
-default value in the original \s-1CREATE TABLE\s0 statement. For example, given:
-.PP
-.Vb 2
-\& col1 char(30) default current_user \-\- a \*(Aqfunction\*(Aq
-\& col2 char(30) default \*(Aqstring\*(Aq \-\- a string literal
-.Ve
-.PP
-where \*(L"current_user\*(R" is the name of a function, the corresponding \f(CW\*(C`COLUMN_DEF\*(C'\fR
-values would be:
-.PP
-.Vb 5
-\& Database col1 col2
-\& \-\-\-\-\-\-\-\- \-\-\-\- \-\-\-\-
-\& Oracle: current_user \*(Aqstring\*(Aq
-\& Postgres: "current_user"() \*(Aqstring\*(Aq::text
-\& MS SQL: (user_name()) (\*(Aqstring\*(Aq)
-.Ve
-.PP
-\&\fB\s-1SQL_DATA_TYPE\s0\fR: The \s-1SQL\s0 data type.
-.PP
-\&\fB\s-1SQL_DATETIME_SUB\s0\fR: The subtype code for datetime and interval data types.
-.PP
-\&\fB\s-1CHAR_OCTET_LENGTH\s0\fR: The maximum length in bytes of a character or binary
-data type column.
-.PP
-\&\fB\s-1ORDINAL_POSITION\s0\fR: The column sequence number (starting with 1).
-.PP
-\&\fB\s-1IS_NULLABLE\s0\fR: Indicates if the column can accept NULLs.
-Possible values are: '\s-1NO\s0', '\s-1YES\s0' and ''.
-.PP
-\&\s-1SQL/CLI\s0 defines the following additional columns:
-.PP
-.Vb 10
-\& CHAR_SET_CAT
-\& CHAR_SET_SCHEM
-\& CHAR_SET_NAME
-\& COLLATION_CAT
-\& COLLATION_SCHEM
-\& COLLATION_NAME
-\& UDT_CAT
-\& UDT_SCHEM
-\& UDT_NAME
-\& DOMAIN_CAT
-\& DOMAIN_SCHEM
-\& DOMAIN_NAME
-\& SCOPE_CAT
-\& SCOPE_SCHEM
-\& SCOPE_NAME
-\& MAX_CARDINALITY
-\& DTD_IDENTIFIER
-\& IS_SELF_REF
-.Ve
-.PP
-Drivers capable of supplying any of those values should do so in
-the corresponding column and supply undef values for the others.
-.PP
-Drivers wishing to provide extra database/driver specific information
-should do so in extra columns beyond all those listed above, and
-use lowercase field names with the driver-specific prefix (i.e.,
-\&'ora_...'). Applications accessing such fields should do so by name
-and not by column number.
-.PP
-The result set is ordered by \s-1TABLE_CAT, TABLE_SCHEM, TABLE_NAME\s0
-and \s-1ORDINAL_POSITION.\s0
-.PP
-Note: There is some overlap with statement handle attributes (in perl) and
-SQLDescribeCol (in \s-1ODBC\s0). However, SQLColumns provides more metadata.
-.PP
-See also \*(L"Catalog Methods\*(R" and \*(L"Standards Reference Information\*(R".
-.PP
-\fI\f(CI\*(C`primary_key_info\*(C'\fI\fR
-.IX Subsection "primary_key_info"
-.PP
-.Vb 1
-\& $sth = $dbh\->primary_key_info( $catalog, $schema, $table );
-\&
-\& # then $sth\->fetchall_arrayref or $sth\->fetchall_hashref etc
-.Ve
-.PP
-Returns an active statement handle that can be used to fetch information
-about columns that make up the primary key for a table.
-The arguments don't accept search patterns (unlike \fItable_info()\fR).
-.PP
-The statement handle will return one row per column, ordered by
-\&\s-1TABLE_CAT, TABLE_SCHEM, TABLE_NAME,\s0 and \s-1KEY_SEQ.\s0
-If there is no primary key then the statement handle will fetch no rows.
-.PP
-Note: The support for the selection criteria, such as \f(CW$catalog\fR, is
-driver specific. If the driver doesn't support catalogs and/or
-schemas, it may ignore these criteria.
-.PP
-The statement handle returned has at least the following fields in the
-order shown below. Other fields, after these, may also be present.
-.PP
-\&\fB\s-1TABLE_CAT\s0\fR: The catalog identifier.
-This field is \s-1NULL \s0(\f(CW\*(C`undef\*(C'\fR) if not applicable to the data source,
-which is often the case. This field is empty if not applicable to the
-table.
-.PP
-\&\fB\s-1TABLE_SCHEM\s0\fR: The schema identifier.
-This field is \s-1NULL \s0(\f(CW\*(C`undef\*(C'\fR) if not applicable to the data source,
-and empty if not applicable to the table.
-.PP
-\&\fB\s-1TABLE_NAME\s0\fR: The table identifier.
-.PP
-\&\fB\s-1COLUMN_NAME\s0\fR: The column identifier.
-.PP
-\&\fB\s-1KEY_SEQ\s0\fR: The column sequence number (starting with 1).
-Note: This field is named \fB\s-1ORDINAL_POSITION\s0\fR in \s-1SQL/CLI.\s0
-.PP
-\&\fB\s-1PK_NAME\s0\fR: The primary key constraint identifier.
-This field is \s-1NULL \s0(\f(CW\*(C`undef\*(C'\fR) if not applicable to the data source.
-.PP
-See also \*(L"Catalog Methods\*(R" and \*(L"Standards Reference Information\*(R".
-.PP
-\fI\f(CI\*(C`primary_key\*(C'\fI\fR
-.IX Subsection "primary_key"
-.PP
-.Vb 1
-\& @key_column_names = $dbh\->primary_key( $catalog, $schema, $table );
-.Ve
-.PP
-Simple interface to the \fIprimary_key_info()\fR method. Returns a list of
-the column names that comprise the primary key of the specified table.
-The list is in primary key column sequence order.
-If there is no primary key then an empty list is returned.
-.PP
-\fI\f(CI\*(C`foreign_key_info\*(C'\fI\fR
-.IX Subsection "foreign_key_info"
-.PP
-.Vb 2
-\& $sth = $dbh\->foreign_key_info( $pk_catalog, $pk_schema, $pk_table
-\& , $fk_catalog, $fk_schema, $fk_table );
-\&
-\& $sth = $dbh\->foreign_key_info( $pk_catalog, $pk_schema, $pk_table
-\& , $fk_catalog, $fk_schema, $fk_table
-\& , \e%attr );
-\&
-\& # then $sth\->fetchall_arrayref or $sth\->fetchall_hashref etc
-.Ve
-.PP
-Returns an active statement handle that can be used to fetch information
-about foreign keys in and/or referencing the specified table(s).
-The arguments don't accept search patterns (unlike \fItable_info()\fR).
-.PP
-\&\f(CW$pk_catalog\fR, \f(CW$pk_schema\fR, \f(CW$pk_table\fR
-identify the primary (unique) key table (\fB\s-1PKT\s0\fR).
-.PP
-\&\f(CW$fk_catalog\fR, \f(CW$fk_schema\fR, \f(CW$fk_table\fR
-identify the foreign key table (\fB\s-1FKT\s0\fR).
-.PP
-If both \fB\s-1PKT\s0\fR and \fB\s-1FKT\s0\fR are given, the function returns the foreign key, if
-any, in table \fB\s-1FKT\s0\fR that refers to the primary (unique) key of table \fB\s-1PKT\s0\fR.
-(Note: In \s-1SQL/CLI,\s0 the result is implementation-defined.)
-.PP
-If only \fB\s-1PKT\s0\fR is given, then the result set contains the primary key
-of that table and all foreign keys that refer to it.
-.PP
-If only \fB\s-1FKT\s0\fR is given, then the result set contains all foreign keys
-in that table and the primary keys to which they refer.
-(Note: In \s-1SQL/CLI,\s0 the result includes unique keys too.)
-.PP
-For example:
-.PP
-.Vb 3
-\& $sth = $dbh\->foreign_key_info( undef, $user, \*(Aqmaster\*(Aq);
-\& $sth = $dbh\->foreign_key_info( undef, undef, undef , undef, $user, \*(Aqdetail\*(Aq);
-\& $sth = $dbh\->foreign_key_info( undef, $user, \*(Aqmaster\*(Aq, undef, $user, \*(Aqdetail\*(Aq);
-\&
-\& # then $sth\->fetchall_arrayref or $sth\->fetchall_hashref etc
-.Ve
-.PP
-Note: The support for the selection criteria, such as \f(CW$catalog\fR, is
-driver specific. If the driver doesn't support catalogs and/or
-schemas, it may ignore these criteria.
-.PP
-The statement handle returned has the following fields in the order shown below.
-Because \s-1ODBC\s0 never includes unique keys, they define different columns in the
-result set than \s-1SQL/CLI. SQL/CLI\s0 column names are shown in parentheses.
-.PP
-\&\fB\s-1PKTABLE_CAT \s0( \s-1UK_TABLE_CAT \s0)\fR:
-The primary (unique) key table catalog identifier.
-This field is \s-1NULL \s0(\f(CW\*(C`undef\*(C'\fR) if not applicable to the data source,
-which is often the case. This field is empty if not applicable to the
-table.
-.PP
-\&\fB\s-1PKTABLE_SCHEM \s0( \s-1UK_TABLE_SCHEM \s0)\fR:
-The primary (unique) key table schema identifier.
-This field is \s-1NULL \s0(\f(CW\*(C`undef\*(C'\fR) if not applicable to the data source,
-and empty if not applicable to the table.
-.PP
-\&\fB\s-1PKTABLE_NAME \s0( \s-1UK_TABLE_NAME \s0)\fR:
-The primary (unique) key table identifier.
-.PP
-\&\fB\s-1PKCOLUMN_NAME \s0(\s-1UK_COLUMN_NAME \s0)\fR:
-The primary (unique) key column identifier.
-.PP
-\&\fB\s-1FKTABLE_CAT \s0( \s-1FK_TABLE_CAT \s0)\fR:
-The foreign key table catalog identifier.
-This field is \s-1NULL \s0(\f(CW\*(C`undef\*(C'\fR) if not applicable to the data source,
-which is often the case. This field is empty if not applicable to the
-table.
-.PP
-\&\fB\s-1FKTABLE_SCHEM \s0( \s-1FK_TABLE_SCHEM \s0)\fR:
-The foreign key table schema identifier.
-This field is \s-1NULL \s0(\f(CW\*(C`undef\*(C'\fR) if not applicable to the data source,
-and empty if not applicable to the table.
-.PP
-\&\fB\s-1FKTABLE_NAME \s0( \s-1FK_TABLE_NAME \s0)\fR:
-The foreign key table identifier.
-.PP
-\&\fB\s-1FKCOLUMN_NAME \s0( \s-1FK_COLUMN_NAME \s0)\fR:
-The foreign key column identifier.
-.PP
-\&\fB\s-1KEY_SEQ \s0( \s-1ORDINAL_POSITION \s0)\fR:
-The column sequence number (starting with 1).
-.PP
-\&\fB\s-1UPDATE_RULE \s0( \s-1UPDATE_RULE \s0)\fR:
-The referential action for the \s-1UPDATE\s0 rule.
-The following codes are defined:
-.PP
-.Vb 5
-\& CASCADE 0
-\& RESTRICT 1
-\& SET NULL 2
-\& NO ACTION 3
-\& SET DEFAULT 4
-.Ve
-.PP
-\&\fB\s-1DELETE_RULE \s0( \s-1DELETE_RULE \s0)\fR:
-The referential action for the \s-1DELETE\s0 rule.
-The codes are the same as for \s-1UPDATE_RULE.\s0
-.PP
-\&\fB\s-1FK_NAME \s0( \s-1FK_NAME \s0)\fR:
-The foreign key name.
-.PP
-\&\fB\s-1PK_NAME \s0( \s-1UK_NAME \s0)\fR:
-The primary (unique) key name.
-.PP
-\&\fB\s-1DEFERRABILITY \s0( \s-1DEFERABILITY \s0)\fR:
-The deferrability of the foreign key constraint.
-The following codes are defined:
-.PP
-.Vb 3
-\& INITIALLY DEFERRED 5
-\& INITIALLY IMMEDIATE 6
-\& NOT DEFERRABLE 7
-.Ve
-.PP
-\&\fB ( \s-1UNIQUE_OR_PRIMARY \s0)\fR:
-This column is necessary if a driver includes all candidate (i.e. primary and
-alternate) keys in the result set (as specified by \s-1SQL/CLI\s0).
-The value of this column is \s-1UNIQUE\s0 if the foreign key references an alternate
-key and \s-1PRIMARY\s0 if the foreign key references a primary key, or it
-may be undefined if the driver doesn't have access to the information.
-.PP
-See also \*(L"Catalog Methods\*(R" and \*(L"Standards Reference Information\*(R".
-.PP
-\fI\f(CI\*(C`statistics_info\*(C'\fI\fR
-.IX Subsection "statistics_info"
-.PP
-\&\fBWarning:\fR This method is experimental and may change.
-.PP
-.Vb 1
-\& $sth = $dbh\->statistics_info( $catalog, $schema, $table, $unique_only, $quick );
-\&
-\& # then $sth\->fetchall_arrayref or $sth\->fetchall_hashref etc
-.Ve
-.PP
-Returns an active statement handle that can be used to fetch statistical
-information about a table and its indexes.
-.PP
-The arguments don't accept search patterns (unlike \*(L"table_info\*(R").
-.PP
-If the boolean argument \f(CW$unique_only\fR is true, only \s-1UNIQUE\s0 indexes will be
-returned in the result set, otherwise all indexes will be returned.
-.PP
-If the boolean argument \f(CW$quick\fR is set, the actual statistical information
-columns (\s-1CARDINALITY\s0 and \s-1PAGES\s0) will only be returned if they are readily
-available from the server, and might not be current. Some databases may
-return stale statistics or no statistics at all with this flag set.
-.PP
-The statement handle will return at most one row per column name per index,
-plus at most one row for the entire table itself, ordered by \s-1NON_UNIQUE, TYPE,
-INDEX_QUALIFIER, INDEX_NAME,\s0 and \s-1ORDINAL_POSITION.\s0
-.PP
-Note: The support for the selection criteria, such as \f(CW$catalog\fR, is
-driver specific. If the driver doesn't support catalogs and/or
-schemas, it may ignore these criteria.
-.PP
-The statement handle returned has at least the following fields in the
-order shown below. Other fields, after these, may also be present.
-.PP
-\&\fB\s-1TABLE_CAT\s0\fR: The catalog identifier.
-This field is \s-1NULL \s0(\f(CW\*(C`undef\*(C'\fR) if not applicable to the data source,
-which is often the case. This field is empty if not applicable to the
-table.
-.PP
-\&\fB\s-1TABLE_SCHEM\s0\fR: The schema identifier.
-This field is \s-1NULL \s0(\f(CW\*(C`undef\*(C'\fR) if not applicable to the data source,
-and empty if not applicable to the table.
-.PP
-\&\fB\s-1TABLE_NAME\s0\fR: The table identifier.
-.PP
-\&\fB\s-1NON_UNIQUE\s0\fR: Unique index indicator.
-Returns 0 for unique indexes, 1 for non-unique indexes
-.PP
-\&\fB\s-1INDEX_QUALIFIER\s0\fR: Index qualifier identifier.
-The identifier that is used to qualify the index name when doing a
-\&\f(CW\*(C`DROP INDEX\*(C'\fR; \s-1NULL \s0(\f(CW\*(C`undef\*(C'\fR) is returned if an index qualifier is not
-supported by the data source.
-If a non-NULL (defined) value is returned in this column, it must be used
-to qualify the index name on a \f(CW\*(C`DROP INDEX\*(C'\fR statement; otherwise,
-the \s-1TABLE_SCHEM\s0 should be used to qualify the index name.
-.PP
-\&\fB\s-1INDEX_NAME\s0\fR: The index identifier.
-.PP
-\&\fB\s-1TYPE\s0\fR: The type of information being returned. Can be any of the
-following values: 'table', 'btree', 'clustered', 'content', 'hashed',
-or 'other'.
-.PP
-In the case that this field is 'table', all fields
-other than \s-1TABLE_CAT, TABLE_SCHEM, TABLE_NAME, TYPE,
-CARDINALITY,\s0 and \s-1PAGES\s0 will be \s-1NULL \s0(\f(CW\*(C`undef\*(C'\fR).
-.PP
-\&\fB\s-1ORDINAL_POSITION\s0\fR: Column sequence number (starting with 1).
-.PP
-\&\fB\s-1COLUMN_NAME\s0\fR: The column identifier.
-.PP
-\&\fB\s-1ASC_OR_DESC\s0\fR: Column sort sequence.
-\&\f(CW\*(C`A\*(C'\fR for Ascending, \f(CW\*(C`D\*(C'\fR for Descending, or \s-1NULL \s0(\f(CW\*(C`undef\*(C'\fR) if
-not supported for this index.
-.PP
-\&\fB\s-1CARDINALITY\s0\fR: Cardinality of the table or index.
-For indexes, this is the number of unique values in the index.
-For tables, this is the number of rows in the table.
-If not supported, the value will be \s-1NULL \s0(\f(CW\*(C`undef\*(C'\fR).
-.PP
-\&\fB\s-1PAGES\s0\fR: Number of storage pages used by this table or index.
-If not supported, the value will be \s-1NULL \s0(\f(CW\*(C`undef\*(C'\fR).
-.PP
-\&\fB\s-1FILTER_CONDITION\s0\fR: The index filter condition as a string.
-If the index is not a filtered index, or it cannot be determined
-whether the index is a filtered index, this value is \s-1NULL \s0(\f(CW\*(C`undef\*(C'\fR).
-If the index is a filtered index, but the filter condition
-cannot be determined, this value is the empty string \f(CW\*(Aq\*(Aq\fR.
-Otherwise it will be the literal filter condition as a string,
-such as \f(CW\*(C`SALARY <= 4500\*(C'\fR.
-.PP
-See also \*(L"Catalog Methods\*(R" and \*(L"Standards Reference Information\*(R".
-.PP
-\fI\f(CI\*(C`tables\*(C'\fI\fR
-.IX Subsection "tables"
-.PP
-.Vb 2
-\& @names = $dbh\->tables( $catalog, $schema, $table, $type );
-\& @names = $dbh\->tables; # deprecated
-.Ve
-.PP
-Simple interface to \fItable_info()\fR. Returns a list of matching
-table names, possibly including a catalog/schema prefix.
-.PP
-See \*(L"table_info\*(R" for a description of the parameters.
-.PP
-If \f(CW\*(C`$dbh\->get_info(29)\*(C'\fR returns true (29 is \s-1SQL_IDENTIFIER_QUOTE_CHAR\s0)
-then the table names are constructed and quoted by \*(L"quote_identifier\*(R"
-to ensure they are usable even if they contain whitespace or reserved
-words etc. This means that the table names returned will include
-quote characters.
-.PP
-\fI\f(CI\*(C`type_info_all\*(C'\fI\fR
-.IX Subsection "type_info_all"
-.PP
-.Vb 1
-\& $type_info_all = $dbh\->type_info_all;
-.Ve
-.PP
-Returns a reference to an array which holds information about each data
-type variant supported by the database and driver. The array and its
-contents should be treated as read-only.
-.PP
-The first item is a reference to an 'index' hash of \f(CW\*(C`Name =\*(C'\fR> \f(CW\*(C`Index\*(C'\fR pairs.
-The items following that are references to arrays, one per supported data
-type variant. The leading index hash defines the names and order of the
-fields within the arrays that follow it.
-For example:
-.PP
-.Vb 10
-\& $type_info_all = [
-\& { TYPE_NAME => 0,
-\& DATA_TYPE => 1,
-\& COLUMN_SIZE => 2, # was PRECISION originally
-\& LITERAL_PREFIX => 3,
-\& LITERAL_SUFFIX => 4,
-\& CREATE_PARAMS => 5,
-\& NULLABLE => 6,
-\& CASE_SENSITIVE => 7,
-\& SEARCHABLE => 8,
-\& UNSIGNED_ATTRIBUTE=> 9,
-\& FIXED_PREC_SCALE => 10, # was MONEY originally
-\& AUTO_UNIQUE_VALUE => 11, # was AUTO_INCREMENT originally
-\& LOCAL_TYPE_NAME => 12,
-\& MINIMUM_SCALE => 13,
-\& MAXIMUM_SCALE => 14,
-\& SQL_DATA_TYPE => 15,
-\& SQL_DATETIME_SUB => 16,
-\& NUM_PREC_RADIX => 17,
-\& INTERVAL_PRECISION=> 18,
-\& },
-\& [ \*(AqVARCHAR\*(Aq, SQL_VARCHAR,
-\& undef, "\*(Aq","\*(Aq", undef,0, 1,1,0,0,0,undef,1,255, undef
-\& ],
-\& [ \*(AqINTEGER\*(Aq, SQL_INTEGER,
-\& undef, "", "", undef,0, 0,1,0,0,0,undef,0, 0, 10
-\& ],
-\& ];
-.Ve
-.PP
-More than one row may have the same value in the \f(CW\*(C`DATA_TYPE\*(C'\fR
-field if there are different ways to spell the type name and/or there
-are variants of the type with different attributes (e.g., with and
-without \f(CW\*(C`AUTO_UNIQUE_VALUE\*(C'\fR set, with and without \f(CW\*(C`UNSIGNED_ATTRIBUTE\*(C'\fR, etc).
-.PP
-The rows are ordered by \f(CW\*(C`DATA_TYPE\*(C'\fR first and then by how closely each
-type maps to the corresponding \s-1ODBC SQL\s0 data type, closest first.
-.PP
-The meaning of the fields is described in the documentation for
-the \*(L"type_info\*(R" method.
-.PP
-An 'index' hash is provided so you don't need to rely on index
-values defined above. However, using \s-1DBD::ODBC\s0 with some old \s-1ODBC\s0
-drivers may return older names, shown as comments in the example above.
-Another issue with the index hash is that the lettercase of the
-keys is not defined. It is usually uppercase, as show here, but
-drivers may return names with any lettercase.
-.PP
-Drivers are also free to return extra driver-specific columns of
-information \- though it's recommended that they start at column
-index 50 to leave room for expansion of the \s-1DBI/ODBC\s0 specification.
-.PP
-The \fItype_info_all()\fR method is not normally used directly.
-The \*(L"type_info\*(R" method provides a more usable and useful interface
-to the data.
-.PP
-\fI\f(CI\*(C`type_info\*(C'\fI\fR
-.IX Subsection "type_info"
-.PP
-.Vb 1
-\& @type_info = $dbh\->type_info($data_type);
-.Ve
-.PP
-Returns a list of hash references holding information about one or more
-variants of \f(CW$data_type\fR. The list is ordered by \f(CW\*(C`DATA_TYPE\*(C'\fR first and
-then by how closely each type maps to the corresponding \s-1ODBC SQL\s0 data
-type, closest first. If called in a scalar context then only the first
-(best) element is returned.
-.PP
-If \f(CW$data_type\fR is undefined or \f(CW\*(C`SQL_ALL_TYPES\*(C'\fR, then the list will
-contain hashes for all data type variants supported by the database and driver.
-.PP
-If \f(CW$data_type\fR is an array reference then \f(CW\*(C`type_info\*(C'\fR returns the
-information for the \fIfirst\fR type in the array that has any matches.
-.PP
-The keys of the hash follow the same letter case conventions as the
-rest of the \s-1DBI \s0(see \*(L"Naming Conventions and Name Space\*(R"). The
-following uppercase items should always exist, though may be undef:
-.IP "\s-1TYPE_NAME \s0(string)" 4
-.IX Item "TYPE_NAME (string)"
-Data type name for use in \s-1CREATE TABLE\s0 statements etc.
-.IP "\s-1DATA_TYPE \s0(integer)" 4
-.IX Item "DATA_TYPE (integer)"
-\&\s-1SQL\s0 data type number.
-.IP "\s-1COLUMN_SIZE \s0(integer)" 4
-.IX Item "COLUMN_SIZE (integer)"
-For numeric types, this is either the total number of digits (if the
-\&\s-1NUM_PREC_RADIX\s0 value is 10) or the total number of bits allowed in the
-column (if \s-1NUM_PREC_RADIX\s0 is 2).
-.Sp
-For string types, this is the maximum size of the string in characters.
-.Sp
-For date and interval types, this is the maximum number of characters
-needed to display the value.
-.IP "\s-1LITERAL_PREFIX \s0(string)" 4
-.IX Item "LITERAL_PREFIX (string)"
-Characters used to prefix a literal. A typical prefix is "\f(CW\*(C`\*(Aq\*(C'\fR\*(L" for characters,
-or possibly \*(R"\f(CW\*(C`0x\*(C'\fR" for binary values passed as hexadecimal. \s-1NULL \s0(\f(CW\*(C`undef\*(C'\fR) is
-returned for data types for which this is not applicable.
-.IP "\s-1LITERAL_SUFFIX \s0(string)" 4
-.IX Item "LITERAL_SUFFIX (string)"
-Characters used to suffix a literal. Typically "\f(CW\*(C`\*(Aq\*(C'\fR" for characters.
-\&\s-1NULL \s0(\f(CW\*(C`undef\*(C'\fR) is returned for data types where this is not applicable.
-.IP "\s-1CREATE_PARAMS \s0(string)" 4
-.IX Item "CREATE_PARAMS (string)"
-Parameter names for data type definition. For example, \f(CW\*(C`CREATE_PARAMS\*(C'\fR for a
-\&\f(CW\*(C`DECIMAL\*(C'\fR would be "\f(CW\*(C`precision,scale\*(C'\fR" if the \s-1DECIMAL\s0 type should be
-declared as \f(CW\*(C`DECIMAL(\*(C'\fR\fIprecision,scale\fR\f(CW\*(C`)\*(C'\fR where \fIprecision\fR and \fIscale\fR
-are integer values. For a \f(CW\*(C`VARCHAR\*(C'\fR it would be "\f(CW\*(C`max length\*(C'\fR".
-\&\s-1NULL \s0(\f(CW\*(C`undef\*(C'\fR) is returned for data types for which this is not applicable.
-.IP "\s-1NULLABLE \s0(integer)" 4
-.IX Item "NULLABLE (integer)"
-Indicates whether the data type accepts a \s-1NULL\s0 value:
-\&\f(CW0\fR or an empty string = no, \f(CW1\fR = yes, \f(CW2\fR = unknown.
-.IP "\s-1CASE_SENSITIVE \s0(boolean)" 4
-.IX Item "CASE_SENSITIVE (boolean)"
-Indicates whether the data type is case sensitive in collations and
-comparisons.
-.IP "\s-1SEARCHABLE \s0(integer)" 4
-.IX Item "SEARCHABLE (integer)"
-Indicates how the data type can be used in a \s-1WHERE\s0 clause, as
-follows:
-.Sp
-.Vb 4
-\& 0 \- Cannot be used in a WHERE clause
-\& 1 \- Only with a LIKE predicate
-\& 2 \- All comparison operators except LIKE
-\& 3 \- Can be used in a WHERE clause with any comparison operator
-.Ve
-.IP "\s-1UNSIGNED_ATTRIBUTE \s0(boolean)" 4
-.IX Item "UNSIGNED_ATTRIBUTE (boolean)"
-Indicates whether the data type is unsigned. \s-1NULL \s0(\f(CW\*(C`undef\*(C'\fR) is returned
-for data types for which this is not applicable.
-.IP "\s-1FIXED_PREC_SCALE \s0(boolean)" 4
-.IX Item "FIXED_PREC_SCALE (boolean)"
-Indicates whether the data type always has the same precision and scale
-(such as a money type). \s-1NULL \s0(\f(CW\*(C`undef\*(C'\fR) is returned for data types
-for which
-this is not applicable.
-.IP "\s-1AUTO_UNIQUE_VALUE \s0(boolean)" 4
-.IX Item "AUTO_UNIQUE_VALUE (boolean)"
-Indicates whether a column of this data type is automatically set to a
-unique value whenever a new row is inserted. \s-1NULL \s0(\f(CW\*(C`undef\*(C'\fR) is returned
-for data types for which this is not applicable.
-.IP "\s-1LOCAL_TYPE_NAME \s0(string)" 4
-.IX Item "LOCAL_TYPE_NAME (string)"
-Localized version of the \f(CW\*(C`TYPE_NAME\*(C'\fR for use in dialog with users.
-\&\s-1NULL \s0(\f(CW\*(C`undef\*(C'\fR) is returned if a localized name is not available (in which
-case \f(CW\*(C`TYPE_NAME\*(C'\fR should be used).
-.IP "\s-1MINIMUM_SCALE \s0(integer)" 4
-.IX Item "MINIMUM_SCALE (integer)"
-The minimum scale of the data type. If a data type has a fixed scale,
-then \f(CW\*(C`MAXIMUM_SCALE\*(C'\fR holds the same value. \s-1NULL \s0(\f(CW\*(C`undef\*(C'\fR) is returned for
-data types for which this is not applicable.
-.IP "\s-1MAXIMUM_SCALE \s0(integer)" 4
-.IX Item "MAXIMUM_SCALE (integer)"
-The maximum scale of the data type. If a data type has a fixed scale,
-then \f(CW\*(C`MINIMUM_SCALE\*(C'\fR holds the same value. \s-1NULL \s0(\f(CW\*(C`undef\*(C'\fR) is returned for
-data types for which this is not applicable.
-.IP "\s-1SQL_DATA_TYPE \s0(integer)" 4
-.IX Item "SQL_DATA_TYPE (integer)"
-This column is the same as the \f(CW\*(C`DATA_TYPE\*(C'\fR column, except for interval
-and datetime data types. For interval and datetime data types, the
-\&\f(CW\*(C`SQL_DATA_TYPE\*(C'\fR field will return \f(CW\*(C`SQL_INTERVAL\*(C'\fR or \f(CW\*(C`SQL_DATETIME\*(C'\fR, and the
-\&\f(CW\*(C`SQL_DATETIME_SUB\*(C'\fR field below will return the subcode for the specific
-interval or datetime data type. If this field is \s-1NULL,\s0 then the driver
-does not support or report on interval or datetime subtypes.
-.IP "\s-1SQL_DATETIME_SUB \s0(integer)" 4
-.IX Item "SQL_DATETIME_SUB (integer)"
-For interval or datetime data types, where the \f(CW\*(C`SQL_DATA_TYPE\*(C'\fR
-field above is \f(CW\*(C`SQL_INTERVAL\*(C'\fR or \f(CW\*(C`SQL_DATETIME\*(C'\fR, this field will
-hold the \fIsubcode\fR for the specific interval or datetime data type.
-Otherwise it will be \s-1NULL \s0(\f(CW\*(C`undef\*(C'\fR).
-.Sp
-Although not mentioned explicitly in the standards, it seems there
-is a simple relationship between these values:
-.Sp
-.Vb 1
-\& DATA_TYPE == (10 * SQL_DATA_TYPE) + SQL_DATETIME_SUB
-.Ve
-.IP "\s-1NUM_PREC_RADIX \s0(integer)" 4
-.IX Item "NUM_PREC_RADIX (integer)"
-The radix value of the data type. For approximate numeric types,
-\&\f(CW\*(C`NUM_PREC_RADIX\*(C'\fR
-contains the value 2 and \f(CW\*(C`COLUMN_SIZE\*(C'\fR holds the number of bits. For
-exact numeric types, \f(CW\*(C`NUM_PREC_RADIX\*(C'\fR contains the value 10 and \f(CW\*(C`COLUMN_SIZE\*(C'\fR holds
-the number of decimal digits. \s-1NULL \s0(\f(CW\*(C`undef\*(C'\fR) is returned either for data types
-for which this is not applicable or if the driver cannot report this information.
-.IP "\s-1INTERVAL_PRECISION \s0(integer)" 4
-.IX Item "INTERVAL_PRECISION (integer)"
-The interval leading precision for interval types. \s-1NULL\s0 is returned
-either for data types for which this is not applicable or if the driver
-cannot report this information.
-.PP
-For example, to find the type name for the fields in a select statement
-you can do:
-.PP
-.Vb 1
-\& @names = map { scalar $dbh\->type_info($_)\->{TYPE_NAME} } @{ $sth\->{TYPE} }
-.Ve
-.PP
-Since \s-1DBI\s0 and \s-1ODBC\s0 drivers vary in how they map their types into the
-\&\s-1ISO\s0 standard types you may need to search for more than one type.
-Here's an example looking for a usable type to store a date:
-.PP
-.Vb 1
-\& $my_date_type = $dbh\->type_info( [ SQL_DATE, SQL_TIMESTAMP ] );
-.Ve
-.PP
-Similarly, to more reliably find a type to store small integers, you could
-use a list starting with \f(CW\*(C`SQL_SMALLINT\*(C'\fR, \f(CW\*(C`SQL_INTEGER\*(C'\fR, \f(CW\*(C`SQL_DECIMAL\*(C'\fR, etc.
-.PP
-See also \*(L"Standards Reference Information\*(R".
-.PP
-\fI\f(CI\*(C`quote\*(C'\fI\fR
-.IX Subsection "quote"
-.PP
-.Vb 2
-\& $sql = $dbh\->quote($value);
-\& $sql = $dbh\->quote($value, $data_type);
-.Ve
-.PP
-Quote a string literal for use as a literal value in an \s-1SQL\s0 statement,
-by escaping any special characters (such as quotation marks)
-contained within the string and adding the required type of outer
-quotation marks.
-.PP
-.Vb 2
-\& $sql = sprintf "SELECT foo FROM bar WHERE baz = %s",
-\& $dbh\->quote("Don\*(Aqt");
-.Ve
-.PP
-For most database types, at least those that conform to \s-1SQL\s0 standards, quote
-would return \f(CW\*(AqDon\*(Aq\*(Aqt\*(Aq\fR (including the outer quotation marks). For others it
-may return something like \f(CW\*(AqDon\e\*(Aqt\*(Aq\fR
-.PP
-An undefined \f(CW$value\fR value will be returned as the string \f(CW\*(C`NULL\*(C'\fR (without
-single quotation marks) to match how NULLs are represented in \s-1SQL.\s0
-.PP
-If \f(CW$data_type\fR is supplied, it is used to try to determine the required
-quoting behaviour by using the information returned by \*(L"type_info\*(R".
-As a special case, the standard numeric types are optimized to return
-\&\f(CW$value\fR without calling \f(CW\*(C`type_info\*(C'\fR.
-.PP
-Quote will probably \fInot\fR be able to deal with all possible input
-(such as binary data or data containing newlines), and is not related in
-any way with escaping or quoting shell meta-characters.
-.PP
-It is valid for the \fIquote()\fR method to return an \s-1SQL\s0 expression that
-evaluates to the desired string. For example:
-.PP
-.Vb 1
-\& $quoted = $dbh\->quote("one\entwo\e0three")
-.Ve
-.PP
-may return something like:
-.PP
-.Vb 1
-\& CONCAT(\*(Aqone\*(Aq, CHAR(12), \*(Aqtwo\*(Aq, CHAR(0), \*(Aqthree\*(Aq)
-.Ve
-.PP
-The \fIquote()\fR method should \fInot\fR be used with \*(L"Placeholders and
-Bind Values\*(R".
-.PP
-\fI\f(CI\*(C`quote_identifier\*(C'\fI\fR
-.IX Subsection "quote_identifier"
-.PP
-.Vb 2
-\& $sql = $dbh\->quote_identifier( $name );
-\& $sql = $dbh\->quote_identifier( $catalog, $schema, $table, \e%attr );
-.Ve
-.PP
-Quote an identifier (table name etc.) for use in an \s-1SQL\s0 statement,
-by escaping any special characters (such as double quotation marks)
-it contains and adding the required type of outer quotation marks.
-.PP
-Undefined names are ignored and the remainder are quoted and then
-joined together, typically with a dot (\f(CW\*(C`.\*(C'\fR) character. For example:
-.PP
-.Vb 1
-\& $id = $dbh\->quote_identifier( undef, \*(AqHer schema\*(Aq, \*(AqMy table\*(Aq );
-.Ve
-.PP
-would, for most database types, return \f(CW"Her schema"."My table"\fR
-(including all the double quotation marks).
-.PP
-If three names are supplied then the first is assumed to be a
-catalog name and special rules may be applied based on what \*(L"get_info\*(R"
-returns for \s-1SQL_CATALOG_NAME_SEPARATOR \s0(41) and \s-1SQL_CATALOG_LOCATION \s0(114).
-For example, for Oracle:
-.PP
-.Vb 1
-\& $id = $dbh\->quote_identifier( \*(Aqlink\*(Aq, \*(Aqschema\*(Aq, \*(Aqtable\*(Aq );
-.Ve
-.PP
-would return \f(CW"schema"."table"@"link"\fR.
-.PP
-\fI\f(CI\*(C`take_imp_data\*(C'\fI\fR
-.IX Subsection "take_imp_data"
-.PP
-.Vb 1
-\& $imp_data = $dbh\->take_imp_data;
-.Ve
-.PP
-Leaves the \f(CW$dbh\fR in an almost dead, zombie-like, state and returns
-a binary string of raw implementation data from the driver which
-describes the current database connection. Effectively it detaches
-the underlying database \s-1API\s0 connection data from the \s-1DBI\s0 handle.
-After calling \fItake_imp_data()\fR, all other methods except \f(CW\*(C`DESTROY\*(C'\fR
-will generate a warning and return undef.
-.PP
-Why would you want to do this? You don't, forget I even mentioned it.
-Unless, that is, you're implementing something advanced like a
-multi-threaded connection pool. See DBI::Pool.
-.PP
-The returned \f(CW$imp_data\fR can be passed as a \f(CW\*(C`dbi_imp_data\*(C'\fR attribute
-to a later \fIconnect()\fR call, even in a separate thread in the same
-process, where the driver can use it to 'adopt' the existing
-connection that the implementation data was taken from.
-.PP
-Some things to keep in mind...
-.PP
-\&\fB*\fR the \f(CW$imp_data\fR holds the only reference to the underlying
-database \s-1API\s0 connection data. That connection is still 'live' and
-won't be cleaned up properly unless the \f(CW$imp_data\fR is used to create
-a new \f(CW$dbh\fR which is then allowed to \fIdisconnect()\fR normally.
-.PP
-\&\fB*\fR using the same \f(CW$imp_data\fR to create more than one other new
-\&\f(CW$dbh\fR at a time may well lead to unpleasant problems. Don't do that.
-.PP
-Any child statement handles are effectively destroyed when \fItake_imp_data()\fR is
-called.
-.PP
-The \f(CW\*(C`take_imp_data\*(C'\fR method was added in \s-1DBI 1.36\s0 but wasn't useful till 1.49.
-.SS "Database Handle Attributes"
-.IX Subsection "Database Handle Attributes"
-This section describes attributes specific to database handles.
-.PP
-Changes to these database handle attributes do not affect any other
-existing or future database handles.
-.PP
-Attempting to set or get the value of an unknown attribute generates a warning,
-except for private driver-specific attributes (which all have names
-starting with a lowercase letter).
-.PP
-Example:
-.PP
-.Vb 2
-\& $h\->{AutoCommit} = ...; # set/write
-\& ... = $h\->{AutoCommit}; # get/read
-.Ve
-.PP
-\fI\f(CI\*(C`AutoCommit\*(C'\fI\fR
-.IX Subsection "AutoCommit"
-.PP
-Type: boolean
-.PP
-If true, then database changes cannot be rolled-back (undone). If false,
-then database changes automatically occur within a \*(L"transaction\*(R", which
-must either be committed or rolled back using the \f(CW\*(C`commit\*(C'\fR or \f(CW\*(C`rollback\*(C'\fR
-methods.
-.PP
-Drivers should always default to \f(CW\*(C`AutoCommit\*(C'\fR mode (an unfortunate
-choice largely forced on the \s-1DBI\s0 by \s-1ODBC\s0 and \s-1JDBC\s0 conventions.)
-.PP
-Attempting to set \f(CW\*(C`AutoCommit\*(C'\fR to an unsupported value is a fatal error.
-This is an important feature of the \s-1DBI.\s0 Applications that need
-full transaction behaviour can set \f(CW\*(C`$dbh\->{AutoCommit} = 0\*(C'\fR (or
-set \f(CW\*(C`AutoCommit\*(C'\fR to 0 via \*(L"connect\*(R")
-without having to check that the value was assigned successfully.
-.PP
-For the purposes of this description, we can divide databases into three
-categories:
-.PP
-.Vb 3
-\& Databases which don\*(Aqt support transactions at all.
-\& Databases in which a transaction is always active.
-\& Databases in which a transaction must be explicitly started (C<\*(AqBEGIN WORK\*(Aq>).
-.Ve
-.PP
-\&\fB* Databases which don't support transactions at all\fR
-.PP
-For these databases, attempting to turn \f(CW\*(C`AutoCommit\*(C'\fR off is a fatal error.
-\&\f(CW\*(C`commit\*(C'\fR and \f(CW\*(C`rollback\*(C'\fR both issue warnings about being ineffective while
-\&\f(CW\*(C`AutoCommit\*(C'\fR is in effect.
-.PP
-\&\fB* Databases in which a transaction is always active\fR
-.PP
-These are typically mainstream commercial relational databases with
-\&\*(L"\s-1ANSI\s0 standard\*(R" transaction behaviour.
-If \f(CW\*(C`AutoCommit\*(C'\fR is off, then changes to the database won't have any
-lasting effect unless \*(L"commit\*(R" is called (but see also
-\&\*(L"disconnect\*(R"). If \*(L"rollback\*(R" is called then any changes since the
-last commit are undone.
-.PP
-If \f(CW\*(C`AutoCommit\*(C'\fR is on, then the effect is the same as if the \s-1DBI\s0
-called \f(CW\*(C`commit\*(C'\fR automatically after every successful database
-operation. So calling \f(CW\*(C`commit\*(C'\fR or \f(CW\*(C`rollback\*(C'\fR explicitly while
-\&\f(CW\*(C`AutoCommit\*(C'\fR is on would be ineffective because the changes would
-have already been committed.
-.PP
-Changing \f(CW\*(C`AutoCommit\*(C'\fR from off to on will trigger a \*(L"commit\*(R".
-.PP
-For databases which don't support a specific auto-commit mode, the
-driver has to commit each statement automatically using an explicit
-\&\f(CW\*(C`COMMIT\*(C'\fR after it completes successfully (and roll it back using an
-explicit \f(CW\*(C`ROLLBACK\*(C'\fR if it fails). The error information reported to the
-application will correspond to the statement which was executed, unless
-it succeeded and the commit or rollback failed.
-.PP
-\&\fB* Databases in which a transaction must be explicitly started\fR
-.PP
-For these databases, the intention is to have them act like databases in
-which a transaction is always active (as described above).
-.PP
-To do this, the driver will automatically begin an explicit transaction
-when \f(CW\*(C`AutoCommit\*(C'\fR is turned off, or after a \*(L"commit\*(R" or
-\&\*(L"rollback\*(R" (or when the application issues the next database
-operation after one of those events).
-.PP
-In this way, the application does not have to treat these databases
-as a special case.
-.PP
-See \*(L"commit\*(R", \*(L"disconnect\*(R" and \*(L"Transactions\*(R" for other important
-notes about transactions.
-.PP
-\fI\f(CI\*(C`Driver\*(C'\fI\fR
-.IX Subsection "Driver"
-.PP
-Type: handle
-.PP
-Holds the handle of the parent driver. The only recommended use for this
-is to find the name of the driver using:
-.PP
-.Vb 1
-\& $dbh\->{Driver}\->{Name}
-.Ve
-.PP
-\fI\f(CI\*(C`Name\*(C'\fI\fR
-.IX Subsection "Name"
-.PP
-Type: string
-.PP
-Holds the \*(L"name\*(R" of the database. Usually (and recommended to be) the
-same as the "\f(CW\*(C`dbi:DriverName:...\*(C'\fR\*(L" string used to connect to the database,
-but with the leading \*(R"\f(CW\*(C`dbi:DriverName:\*(C'\fR" removed.
-.PP
-\fI\f(CI\*(C`Statement\*(C'\fI\fR
-.IX Subsection "Statement"
-.PP
-Type: string, read-only
-.PP
-Returns the statement string passed to the most recent \*(L"prepare\*(R" or
-\&\*(L"do\*(R" method called in this database handle, even if that method
-failed. This is especially useful where \f(CW\*(C`RaiseError\*(C'\fR is enabled and
-the exception handler checks $@ and sees that a 'prepare' method call
-failed.
-.PP
-\fI\f(CI\*(C`RowCacheSize\*(C'\fI\fR
-.IX Subsection "RowCacheSize"
-.PP
-Type: integer
-.PP
-A hint to the driver indicating the size of the local row cache that the
-application would like the driver to use for future \f(CW\*(C`SELECT\*(C'\fR statements.
-If a row cache is not implemented, then setting \f(CW\*(C`RowCacheSize\*(C'\fR is ignored
-and getting the value returns \f(CW\*(C`undef\*(C'\fR.
-.PP
-Some \f(CW\*(C`RowCacheSize\*(C'\fR values have special meaning, as follows:
-.PP
-.Vb 4
-\& 0 \- Automatically determine a reasonable cache size for each C<SELECT>
-\& 1 \- Disable the local row cache
-\& >1 \- Cache this many rows
-\& <0 \- Cache as many rows that will fit into this much memory for each C<SELECT>.
-.Ve
-.PP
-Note that large cache sizes may require a very large amount of memory
-(\fIcached rows * maximum size of row\fR). Also, a large cache will cause
-a longer delay not only for the first fetch, but also whenever the
-cache needs refilling.
-.PP
-See also the \*(L"RowsInCache\*(R" statement handle attribute.
-.PP
-\fI\f(CI\*(C`Username\*(C'\fI\fR
-.IX Subsection "Username"
-.PP
-Type: string
-.PP
-Returns the username used to connect to the database.
-.SH "DBI STATEMENT HANDLE OBJECTS"
-.IX Header "DBI STATEMENT HANDLE OBJECTS"
-This section lists the methods and attributes associated with \s-1DBI\s0
-statement handles.
-.SS "Statement Handle Methods"
-.IX Subsection "Statement Handle Methods"
-The \s-1DBI\s0 defines the following methods for use on \s-1DBI\s0 statement handles:
-.PP
-\fI\f(CI\*(C`bind_param\*(C'\fI\fR
-.IX Subsection "bind_param"
-.PP
-.Vb 3
-\& $sth\->bind_param($p_num, $bind_value)
-\& $sth\->bind_param($p_num, $bind_value, \e%attr)
-\& $sth\->bind_param($p_num, $bind_value, $bind_type)
-.Ve
-.PP
-The \f(CW\*(C`bind_param\*(C'\fR method takes a copy of \f(CW$bind_value\fR and associates it
-(binds it) with a placeholder, identified by \f(CW$p_num\fR, embedded in
-the prepared statement. Placeholders are indicated with question
-mark character (\f(CW\*(C`?\*(C'\fR). For example:
-.PP
-.Vb 5
-\& $dbh\->{RaiseError} = 1; # save having to check each method call
-\& $sth = $dbh\->prepare("SELECT name, age FROM people WHERE name LIKE ?");
-\& $sth\->bind_param(1, "John%"); # placeholders are numbered from 1
-\& $sth\->execute;
-\& DBI::dump_results($sth);
-.Ve
-.PP
-See \*(L"Placeholders and Bind Values\*(R" for more information.
-.PP
-\&\fBData Types for Placeholders\fR
-.PP
-The \f(CW\*(C`\e%attr\*(C'\fR parameter can be used to hint at the data type the
-placeholder should have. This is rarely needed. Typically, the driver is only
-interested in knowing if the placeholder should be bound as a number or a string.
-.PP
-.Vb 1
-\& $sth\->bind_param(1, $value, { TYPE => SQL_INTEGER });
-.Ve
-.PP
-As a short-cut for the common case, the data type can be passed
-directly, in place of the \f(CW\*(C`\e%attr\*(C'\fR hash reference. This example is
-equivalent to the one above:
-.PP
-.Vb 1
-\& $sth\->bind_param(1, $value, SQL_INTEGER);
-.Ve
-.PP
-The \f(CW\*(C`TYPE\*(C'\fR value indicates the standard (non-driver-specific) type for
-this parameter. To specify the driver-specific type, the driver may
-support a driver-specific attribute, such as \f(CW\*(C`{ ora_type => 97 }\*(C'\fR.
-.PP
-The \s-1SQL_INTEGER\s0 and other related constants can be imported using
-.PP
-.Vb 1
-\& use DBI qw(:sql_types);
-.Ve
-.PP
-See \*(L"\s-1DBI\s0 Constants\*(R" for more information.
-.PP
-The data type is 'sticky' in that bind values passed to \fIexecute()\fR are bound
-with the data type specified by earlier \fIbind_param()\fR calls, if any.
-Portable applications should not rely on being able to change the data type
-after the first \f(CW\*(C`bind_param\*(C'\fR call.
-.PP
-Perl only has string and number scalar data types. All database types
-that aren't numbers are bound as strings and must be in a format the
-database will understand except where the \fIbind_param()\fR \s-1TYPE\s0 attribute
-specifies a type that implies a particular format. For example, given:
-.PP
-.Vb 1
-\& $sth\->bind_param(1, $value, SQL_DATETIME);
-.Ve
-.PP
-the driver should expect \f(CW$value\fR to be in the \s-1ODBC\s0 standard \s-1SQL_DATETIME\s0
-format, which is '\s-1YYYY\-MM\-DD HH:MM:SS\s0'. Similarly for \s-1SQL_DATE, SQL_TIME\s0 etc.
-.PP
-As an alternative to specifying the data type in the \f(CW\*(C`bind_param\*(C'\fR call,
-you can let the driver pass the value as the default type (\f(CW\*(C`VARCHAR\*(C'\fR).
-You can then use an \s-1SQL\s0 function to convert the type within the statement.
-For example:
-.PP
-.Vb 1
-\& INSERT INTO price(code, price) VALUES (?, CONVERT(MONEY,?))
-.Ve
-.PP
-The \f(CW\*(C`CONVERT\*(C'\fR function used here is just an example. The actual function
-and syntax will vary between different databases and is non-portable.
-.PP
-See also \*(L"Placeholders and Bind Values\*(R" for more information.
-.PP
-\fI\f(CI\*(C`bind_param_inout\*(C'\fI\fR
-.IX Subsection "bind_param_inout"
-.PP
-.Vb 3
-\& $rc = $sth\->bind_param_inout($p_num, \e$bind_value, $max_len) or die $sth\->errstr;
-\& $rv = $sth\->bind_param_inout($p_num, \e$bind_value, $max_len, \e%attr) or ...
-\& $rv = $sth\->bind_param_inout($p_num, \e$bind_value, $max_len, $bind_type) or ...
-.Ve
-.PP
-This method acts like \*(L"bind_param\*(R", but also enables values to be
-updated by the statement. The statement is typically
-a call to a stored procedure. The \f(CW$bind_value\fR must be passed as a
-reference to the actual value to be used.
-.PP
-Note that unlike \*(L"bind_param\*(R", the \f(CW$bind_value\fR variable is not
-copied when \f(CW\*(C`bind_param_inout\*(C'\fR is called. Instead, the value in the
-variable is read at the time \*(L"execute\*(R" is called.
-.PP
-The additional \f(CW$max_len\fR parameter specifies the minimum amount of
-memory to allocate to \f(CW$bind_value\fR for the new value. If the value
-returned from the database is too
-big to fit, then the execution should fail. If unsure what value to use,
-pick a generous length, i.e., a length larger than the longest value that would ever be
-returned. The only cost of using a larger value than needed is wasted memory.
-.PP
-Undefined values or \f(CW\*(C`undef\*(C'\fR are used to indicate null values.
-See also \*(L"Placeholders and Bind Values\*(R" for more information.
-.PP
-\fI\f(CI\*(C`bind_param_array\*(C'\fI\fR
-.IX Subsection "bind_param_array"
-.PP
-.Vb 3
-\& $rc = $sth\->bind_param_array($p_num, $array_ref_or_value)
-\& $rc = $sth\->bind_param_array($p_num, $array_ref_or_value, \e%attr)
-\& $rc = $sth\->bind_param_array($p_num, $array_ref_or_value, $bind_type)
-.Ve
-.PP
-The \f(CW\*(C`bind_param_array\*(C'\fR method is used to bind an array of values
-to a placeholder embedded in the prepared statement which is to be executed
-with \*(L"execute_array\*(R". For example:
-.PP
-.Vb 6
-\& $dbh\->{RaiseError} = 1; # save having to check each method call
-\& $sth = $dbh\->prepare("INSERT INTO staff (first_name, last_name, dept) VALUES(?, ?, ?)");
-\& $sth\->bind_param_array(1, [ \*(AqJohn\*(Aq, \*(AqMary\*(Aq, \*(AqTim\*(Aq ]);
-\& $sth\->bind_param_array(2, [ \*(AqBooth\*(Aq, \*(AqTodd\*(Aq, \*(AqRobinson\*(Aq ]);
-\& $sth\->bind_param_array(3, "SALES"); # scalar will be reused for each row
-\& $sth\->execute_array( { ArrayTupleStatus => \emy @tuple_status } );
-.Ve
-.PP
-The \f(CW%attr\fR ($bind_type) argument is the same as defined for \*(L"bind_param\*(R".
-Refer to \*(L"bind_param\*(R" for general details on using placeholders.
-.PP
-(Note that \fIbind_param_array()\fR can \fInot\fR be used to expand a
-placeholder into a list of values for a statement like \*(L"\s-1SELECT\s0 foo
-\&\s-1WHERE\s0 bar \s-1IN \s0(?)\*(R". A placeholder can only ever represent one value
-per execution.)
-.PP
-Scalar values, including \f(CW\*(C`undef\*(C'\fR, may also be bound by
-\&\f(CW\*(C`bind_param_array\*(C'\fR. In which case the same value will be used for each
-\&\*(L"execute\*(R" call. Driver-specific implementations may behave
-differently, e.g., when binding to a stored procedure call, some
-databases may permit mixing scalars and arrays as arguments.
-.PP
-The default implementation provided by \s-1DBI \s0(for drivers that have
-not implemented array binding) is to iteratively call \*(L"execute\*(R" for
-each parameter tuple provided in the bound arrays. Drivers may
-provide more optimized implementations using whatever bulk operation
-support the database \s-1API\s0 provides. The default driver behaviour should
-match the default \s-1DBI\s0 behaviour, but always consult your driver
-documentation as there may be driver specific issues to consider.
-.PP
-Note that the default implementation currently only supports non-data
-returning statements (\s-1INSERT, UPDATE,\s0 but not \s-1SELECT\s0). Also,
-\&\f(CW\*(C`bind_param_array\*(C'\fR and \*(L"bind_param\*(R" cannot be mixed in the same
-statement execution, and \f(CW\*(C`bind_param_array\*(C'\fR must be used with
-\&\*(L"execute_array\*(R"; using \f(CW\*(C`bind_param_array\*(C'\fR will have no effect
-for \*(L"execute\*(R".
-.PP
-The \f(CW\*(C`bind_param_array\*(C'\fR method was added in \s-1DBI 1.22.\s0
-.PP
-\fI\f(CI\*(C`execute\*(C'\fI\fR
-.IX Subsection "execute"
-.PP
-.Vb 2
-\& $rv = $sth\->execute or die $sth\->errstr;
-\& $rv = $sth\->execute(@bind_values) or die $sth\->errstr;
-.Ve
-.PP
-Perform whatever processing is necessary to execute the prepared
-statement. An \f(CW\*(C`undef\*(C'\fR is returned if an error occurs. A successful
-\&\f(CW\*(C`execute\*(C'\fR always returns true regardless of the number of rows affected,
-even if it's zero (see below). It is always important to check the
-return status of \f(CW\*(C`execute\*(C'\fR (and most other \s-1DBI\s0 methods) for errors
-if you're not using \*(L"RaiseError\*(R".
-.PP
-For a \fInon\fR\-\f(CW\*(C`SELECT\*(C'\fR statement, \f(CW\*(C`execute\*(C'\fR returns the number of rows
-affected, if known. If no rows were affected, then \f(CW\*(C`execute\*(C'\fR returns
-"\f(CW0E0\fR", which Perl will treat as 0 but will regard as true. Note that it
-is \fInot\fR an error for no rows to be affected by a statement. If the
-number of rows affected is not known, then \f(CW\*(C`execute\*(C'\fR returns \-1.
-.PP
-For \f(CW\*(C`SELECT\*(C'\fR statements, execute simply \*(L"starts\*(R" the query within the
-database engine. Use one of the fetch methods to retrieve the data after
-calling \f(CW\*(C`execute\*(C'\fR. The \f(CW\*(C`execute\*(C'\fR method does \fInot\fR return the number of
-rows that will be returned by the query (because most databases can't
-tell in advance), it simply returns a true value.
-.PP
-You can tell if the statement was a \f(CW\*(C`SELECT\*(C'\fR statement by checking if
-\&\f(CW\*(C`$sth\->{NUM_OF_FIELDS}\*(C'\fR is greater than zero after calling \f(CW\*(C`execute\*(C'\fR.
-.PP
-If any arguments are given, then \f(CW\*(C`execute\*(C'\fR will effectively call
-\&\*(L"bind_param\*(R" for each value before executing the statement. Values
-bound in this way are usually treated as \f(CW\*(C`SQL_VARCHAR\*(C'\fR types unless
-the driver can determine the correct type (which is rare), or unless
-\&\f(CW\*(C`bind_param\*(C'\fR (or \f(CW\*(C`bind_param_inout\*(C'\fR) has already been used to
-specify the type.
-.PP
-Note that passing \f(CW\*(C`execute\*(C'\fR an empty array is the same as passing no arguments
-at all, which will execute the statement with previously bound values.
-That's probably not what you want.
-.PP
-If \fIexecute()\fR is called on a statement handle that's still active
-($sth\->{Active} is true) then it should effectively call \fIfinish()\fR
-to tidy up the previous execution results before starting this new
-execution.
-.PP
-\fI\f(CI\*(C`execute_array\*(C'\fI\fR
-.IX Subsection "execute_array"
-.PP
-.Vb 2
-\& $tuples = $sth\->execute_array(\e%attr) or die $sth\->errstr;
-\& $tuples = $sth\->execute_array(\e%attr, @bind_values) or die $sth\->errstr;
-\&
-\& ($tuples, $rows) = $sth\->execute_array(\e%attr) or die $sth\->errstr;
-\& ($tuples, $rows) = $sth\->execute_array(\e%attr, @bind_values) or die $sth\->errstr;
-.Ve
-.PP
-Execute the prepared statement once for each parameter tuple
-(group of values) provided either in the \f(CW@bind_values\fR, or by prior
-calls to \*(L"bind_param_array\*(R", or via a reference passed in \e%attr.
-.PP
-When called in scalar context the \fIexecute_array()\fR method returns the
-number of tuples executed, or \f(CW\*(C`undef\*(C'\fR if an error occurred. Like
-\&\fIexecute()\fR, a successful \fIexecute_array()\fR always returns true regardless
-of the number of tuples executed, even if it's zero. If there were any
-errors the ArrayTupleStatus array can be used to discover which tuples
-failed and with what errors.
-.PP
-When called in list context the \fIexecute_array()\fR method returns two scalars;
-\&\f(CW$tuples\fR is the same as calling \fIexecute_array()\fR in scalar context and \f(CW$rows\fR is
-the number of rows affected for each tuple, if available or
-\&\-1 if the driver cannot determine this. \s-1NOTE,\s0 some drivers cannot determine
-the number of rows affected per tuple but can provide the number of rows
-affected for the batch.
-If you are doing an update operation the returned rows affected may not be what
-you expect if, for instance, one or more of the tuples affected the same row
-multiple times. Some drivers may not yet support list context, in which case
-\&\f(CW$rows\fR will be undef, or may not be able to provide the number of rows affected
-when performing this batch operation, in which case \f(CW$rows\fR will be \-1.
-.PP
-Bind values for the tuples to be executed may be supplied row-wise
-by an \f(CW\*(C`ArrayTupleFetch\*(C'\fR attribute, or else column-wise in the
-\&\f(CW@bind_values\fR argument, or else column-wise by prior calls to
-\&\*(L"bind_param_array\*(R".
-.PP
-Where column-wise binding is used (via the \f(CW@bind_values\fR argument
-or calls to \fIbind_param_array()\fR) the maximum number of elements in
-any one of the bound value arrays determines the number of tuples
-executed. Placeholders with fewer values in their parameter arrays
-are treated as if padded with undef (\s-1NULL\s0) values.
-.PP
-If a scalar value is bound, instead of an array reference, it is
-treated as a \fIvariable\fR length array with all elements having the
-same value. It does not influence the number of tuples executed,
-so if all bound arrays have zero elements then zero tuples will
-be executed. If \fIall\fR bound values are scalars then one tuple
-will be executed, making \fIexecute_array()\fR act just like \fIexecute()\fR.
-.PP
-The \f(CW\*(C`ArrayTupleFetch\*(C'\fR attribute can be used to specify a reference
-to a subroutine that will be called to provide the bind values for
-each tuple execution. The subroutine should return an reference to
-an array which contains the appropriate number of bind values, or
-return an undef if there is no more data to execute.
-.PP
-As a convenience, the \f(CW\*(C`ArrayTupleFetch\*(C'\fR attribute can also be
-used to specify a statement handle. In which case the \fIfetchrow_arrayref()\fR
-method will be called on the given statement handle in order to
-provide the bind values for each tuple execution.
-.PP
-The values specified via \fIbind_param_array()\fR or the \f(CW@bind_values\fR
-parameter may be either scalars, or arrayrefs. If any \f(CW@bind_values\fR
-are given, then \f(CW\*(C`execute_array\*(C'\fR will effectively call \*(L"bind_param_array\*(R"
-for each value before executing the statement. Values bound in
-this way are usually treated as \f(CW\*(C`SQL_VARCHAR\*(C'\fR types unless the
-driver can determine the correct type (which is rare), or unless
-\&\f(CW\*(C`bind_param\*(C'\fR, \f(CW\*(C`bind_param_inout\*(C'\fR, \f(CW\*(C`bind_param_array\*(C'\fR, or
-\&\f(CW\*(C`bind_param_inout_array\*(C'\fR has already been used to specify the type.
-See \*(L"bind_param_array\*(R" for details.
-.PP
-The \f(CW\*(C`ArrayTupleStatus\*(C'\fR attribute can be used to specify a
-reference to an array which will receive the execute status of each
-executed parameter tuple. Note the \f(CW\*(C`ArrayTupleStatus\*(C'\fR attribute was
-mandatory until \s-1DBI 1.38.\s0
-.PP
-For tuples which are successfully executed, the element at the same
-ordinal position in the status array is the resulting rowcount (or \-1
-if unknown).
-If the execution of a tuple causes an error, then the corresponding
-status array element will be set to a reference to an array containing
-\&\*(L"err\*(R", \*(L"errstr\*(R" and \*(L"state\*(R" set by the failed execution.
-.PP
-If \fBany\fR tuple execution returns an error, \f(CW\*(C`execute_array\*(C'\fR will
-return \f(CW\*(C`undef\*(C'\fR. In that case, the application should inspect the
-status array to determine which parameter tuples failed.
-Some databases may not continue executing tuples beyond the first
-failure. In this case the status array will either hold fewer
-elements, or the elements beyond the failure will be undef.
-.PP
-If all parameter tuples are successfully executed, \f(CW\*(C`execute_array\*(C'\fR
-returns the number tuples executed. If no tuples were executed,
-then \fIexecute_array()\fR returns "\f(CW0E0\fR", just like \fIexecute()\fR does,
-which Perl will treat as 0 but will regard as true.
-.PP
-For example:
-.PP
-.Vb 10
-\& $sth = $dbh\->prepare("INSERT INTO staff (first_name, last_name) VALUES (?, ?)");
-\& my $tuples = $sth\->execute_array(
-\& { ArrayTupleStatus => \emy @tuple_status },
-\& \e@first_names,
-\& \e@last_names,
-\& );
-\& if ($tuples) {
-\& print "Successfully inserted $tuples records\en";
-\& }
-\& else {
-\& for my $tuple (0..@last_names\-1) {
-\& my $status = $tuple_status[$tuple];
-\& $status = [0, "Skipped"] unless defined $status;
-\& next unless ref $status;
-\& printf "Failed to insert (%s, %s): %s\en",
-\& $first_names[$tuple], $last_names[$tuple], $status\->[1];
-\& }
-\& }
-.Ve
-.PP
-Support for data returning statements such as \s-1SELECT\s0 is driver-specific
-and subject to change. At present, the default implementation
-provided by \s-1DBI\s0 only supports non-data returning statements.
-.PP
-Transaction semantics when using array binding are driver and
-database specific. If \f(CW\*(C`AutoCommit\*(C'\fR is on, the default \s-1DBI\s0
-implementation will cause each parameter tuple to be individually
-committed (or rolled back in the event of an error). If \f(CW\*(C`AutoCommit\*(C'\fR
-is off, the application is responsible for explicitly committing
-the entire set of bound parameter tuples. Note that different
-drivers and databases may have different behaviours when some
-parameter tuples cause failures. In some cases, the driver or
-database may automatically rollback the effect of all prior parameter
-tuples that succeeded in the transaction; other drivers or databases
-may retain the effect of prior successfully executed parameter
-tuples. Be sure to check your driver and database for its specific
-behaviour.
-.PP
-Note that, in general, performance will usually be better with
-\&\f(CW\*(C`AutoCommit\*(C'\fR turned off, and using explicit \f(CW\*(C`commit\*(C'\fR after each
-\&\f(CW\*(C`execute_array\*(C'\fR call.
-.PP
-The \f(CW\*(C`execute_array\*(C'\fR method was added in \s-1DBI 1.22,\s0 and ArrayTupleFetch
-was added in 1.36.
-.PP
-\fI\f(CI\*(C`execute_for_fetch\*(C'\fI\fR
-.IX Subsection "execute_for_fetch"
-.PP
-.Vb 2
-\& $tuples = $sth\->execute_for_fetch($fetch_tuple_sub);
-\& $tuples = $sth\->execute_for_fetch($fetch_tuple_sub, \e@tuple_status);
-\&
-\& ($tuples, $rows) = $sth\->execute_for_fetch($fetch_tuple_sub);
-\& ($tuples, $rows) = $sth\->execute_for_fetch($fetch_tuple_sub, \e@tuple_status);
-.Ve
-.PP
-The \fIexecute_for_fetch()\fR method is used to perform bulk operations and
-although it is most often used via the \fIexecute_array()\fR method you can
-use it directly. The main difference between execute_array and
-execute_for_fetch is the former does column or row-wise binding and
-the latter uses row-wise binding.
-.PP
-The fetch subroutine, referenced by \f(CW$fetch_tuple_sub\fR, is expected
-to return a reference to an array (known as a 'tuple') or undef.
-.PP
-The \fIexecute_for_fetch()\fR method calls \f(CW$fetch_tuple_sub\fR, without any
-parameters, until it returns a false value. Each tuple returned is
-used to provide bind values for an \f(CW$sth\fR\->execute(@$tuple) call.
-.PP
-In scalar context \fIexecute_for_fetch()\fR returns \f(CW\*(C`undef\*(C'\fR if there were any
-errors and the number of tuples executed otherwise. Like \fIexecute()\fR and
-\&\fIexecute_array()\fR a zero is returned as \*(L"0E0\*(R" so \fIexecute_for_fetch()\fR is
-only false on error. If there were any errors the \f(CW@tuple_status\fR array
-can be used to discover which tuples failed and with what errors.
-.PP
-When called in list context \fIexecute_for_fetch()\fR returns two scalars;
-\&\f(CW$tuples\fR is the same as calling \fIexecute_for_fetch()\fR in scalar context and \f(CW$rows\fR is
-the sum of the number of rows affected for each tuple, if available or \-1
-if the driver cannot determine this.
-If you are doing an update operation the returned rows affected may not be what
-you expect if, for instance, one or more of the tuples affected the same row
-multiple times. Some drivers may not yet support list context, in which case
-\&\f(CW$rows\fR will be undef, or may not be able to provide the number of rows affected
-when performing this batch operation, in which case \f(CW$rows\fR will be \-1.
-.PP
-If \e@tuple_status is passed then the execute_for_fetch method uses
-it to return status information. The tuple_status array holds one
-element per tuple. If the corresponding \fIexecute()\fR did not fail then
-the element holds the return value from \fIexecute()\fR, which is typically
-a row count. If the \fIexecute()\fR did fail then the element holds a
-reference to an array containing ($sth\->err, \f(CW$sth\fR\->errstr, \f(CW$sth\fR\->state).
-.PP
-If the driver detects an error that it knows means no further tuples can be
-executed then it may return, with an error status, even though \f(CW$fetch_tuple_sub\fR
-may still have more tuples to be executed.
-.PP
-Although each tuple returned by \f(CW$fetch_tuple_sub\fR is effectively used
-to call \f(CW$sth\fR\->execute(@$tuple_array_ref) the exact timing may vary.
-Drivers are free to accumulate sets of tuples to pass to the
-database server in bulk group operations for more efficient execution.
-However, the \f(CW$fetch_tuple_sub\fR is specifically allowed to return
-the same array reference each time (which is what \fIfetchrow_arrayref()\fR
-usually does).
-.PP
-For example:
-.PP
-.Vb 2
-\& my $sel = $dbh1\->prepare("select foo, bar from table1");
-\& $sel\->execute;
-\&
-\& my $ins = $dbh2\->prepare("insert into table2 (foo, bar) values (?,?)");
-\& my $fetch_tuple_sub = sub { $sel\->fetchrow_arrayref };
-\&
-\& my @tuple_status;
-\& $rc = $ins\->execute_for_fetch($fetch_tuple_sub, \e@tuple_status);
-\& my @errors = grep { ref $_ } @tuple_status;
-.Ve
-.PP
-Similarly, if you already have an array containing the data rows
-to be processed you'd use a subroutine to shift off and return
-each array ref in turn:
-.PP
-.Vb 1
-\& $ins\->execute_for_fetch( sub { shift @array_of_arrays }, \e@tuple_status);
-.Ve
-.PP
-The \f(CW\*(C`execute_for_fetch\*(C'\fR method was added in \s-1DBI 1.38.\s0
-.PP
-\fI\f(CI\*(C`fetchrow_arrayref\*(C'\fI\fR
-.IX Subsection "fetchrow_arrayref"
-.PP
-.Vb 2
-\& $ary_ref = $sth\->fetchrow_arrayref;
-\& $ary_ref = $sth\->fetch; # alias
-.Ve
-.PP
-Fetches the next row of data and returns a reference to an array
-holding the field values. Null fields are returned as \f(CW\*(C`undef\*(C'\fR
-values in the array.
-This is the fastest way to fetch data, particularly if used with
-\&\f(CW\*(C`$sth\->bind_columns\*(C'\fR.
-.PP
-If there are no more rows or if an error occurs, then \f(CW\*(C`fetchrow_arrayref\*(C'\fR
-returns an \f(CW\*(C`undef\*(C'\fR. You should check \f(CW\*(C`$sth\->err\*(C'\fR afterwards (or use the
-\&\f(CW\*(C`RaiseError\*(C'\fR attribute) to discover if the \f(CW\*(C`undef\*(C'\fR returned was due to an
-error.
-.PP
-Note that the same array reference is returned for each fetch, so don't
-store the reference and then use it after a later fetch. Also, the
-elements of the array are also reused for each row, so take care if you
-want to take a reference to an element. See also \*(L"bind_columns\*(R".
-.PP
-\fI\f(CI\*(C`fetchrow_array\*(C'\fI\fR
-.IX Subsection "fetchrow_array"
-.PP
-.Vb 1
-\& @ary = $sth\->fetchrow_array;
-.Ve
-.PP
-An alternative to \f(CW\*(C`fetchrow_arrayref\*(C'\fR. Fetches the next row of data
-and returns it as a list containing the field values. Null fields
-are returned as \f(CW\*(C`undef\*(C'\fR values in the list.
-.PP
-If there are no more rows or if an error occurs, then \f(CW\*(C`fetchrow_array\*(C'\fR
-returns an empty list. You should check \f(CW\*(C`$sth\->err\*(C'\fR afterwards (or use
-the \f(CW\*(C`RaiseError\*(C'\fR attribute) to discover if the empty list returned was
-due to an error.
-.PP
-If called in a scalar context for a statement handle that has more
-than one column, it is undefined whether the driver will return
-the value of the first column or the last. So don't do that.
-Also, in a scalar context, an \f(CW\*(C`undef\*(C'\fR is returned if there are no
-more rows or if an error occurred. That \f(CW\*(C`undef\*(C'\fR can't be distinguished
-from an \f(CW\*(C`undef\*(C'\fR returned because the first field value was \s-1NULL.\s0
-For these reasons you should exercise some caution if you use
-\&\f(CW\*(C`fetchrow_array\*(C'\fR in a scalar context.
-.PP
-\fI\f(CI\*(C`fetchrow_hashref\*(C'\fI\fR
-.IX Subsection "fetchrow_hashref"
-.PP
-.Vb 2
-\& $hash_ref = $sth\->fetchrow_hashref;
-\& $hash_ref = $sth\->fetchrow_hashref($name);
-.Ve
-.PP
-An alternative to \f(CW\*(C`fetchrow_arrayref\*(C'\fR. Fetches the next row of data
-and returns it as a reference to a hash containing field name and field
-value pairs. Null fields are returned as \f(CW\*(C`undef\*(C'\fR values in the hash.
-.PP
-If there are no more rows or if an error occurs, then \f(CW\*(C`fetchrow_hashref\*(C'\fR
-returns an \f(CW\*(C`undef\*(C'\fR. You should check \f(CW\*(C`$sth\->err\*(C'\fR afterwards (or use the
-\&\f(CW\*(C`RaiseError\*(C'\fR attribute) to discover if the \f(CW\*(C`undef\*(C'\fR returned was due to an
-error.
-.PP
-The optional \f(CW$name\fR parameter specifies the name of the statement handle
-attribute. For historical reasons it defaults to "\f(CW\*(C`NAME\*(C'\fR\*(L", however using
-either \*(R"\f(CW\*(C`NAME_lc\*(C'\fR\*(L" or \*(R"\f(CW\*(C`NAME_uc\*(C'\fR" is recommended for portability.
-.PP
-The keys of the hash are the same names returned by \f(CW\*(C`$sth\->{$name}\*(C'\fR. If
-more than one field has the same name, there will only be one entry in the
-returned hash for those fields, so statements like "\f(CW\*(C`select foo, foo from bar\*(C'\fR"
-will return only a single key from \f(CW\*(C`fetchrow_hashref\*(C'\fR. In these cases use
-column aliases or \f(CW\*(C`fetchrow_arrayref\*(C'\fR. Note that it is the database server
-(and not the \s-1DBD\s0 implementation) which provides the \fIname\fR for fields
-containing functions like "\f(CWcount(*)\fR\*(L" or \*(R"\f(CW\*(C`max(c_foo)\*(C'\fR" and they may clash
-with existing column names (most databases don't care about duplicate column
-names in a result-set). If you want these to return as unique names that are
-the same across databases, use \fIaliases\fR, as in "\f(CW\*(C`select count(*) as cnt\*(C'\fR\*(L"
-or \*(R"\f(CW\*(C`select max(c_foo) mx_foo, ...\*(C'\fR" depending on the syntax your database
-supports.
-.PP
-Because of the extra work \f(CW\*(C`fetchrow_hashref\*(C'\fR and Perl have to perform, it
-is not as efficient as \f(CW\*(C`fetchrow_arrayref\*(C'\fR or \f(CW\*(C`fetchrow_array\*(C'\fR.
-.PP
-By default a reference to a new hash is returned for each row.
-It is likely that a future version of the \s-1DBI\s0 will support an
-attribute which will enable the same hash to be reused for each
-row. This will give a significant performance boost, but it won't
-be enabled by default because of the risk of breaking old code.
-.PP
-\fI\f(CI\*(C`fetchall_arrayref\*(C'\fI\fR
-.IX Subsection "fetchall_arrayref"
-.PP
-.Vb 3
-\& $tbl_ary_ref = $sth\->fetchall_arrayref;
-\& $tbl_ary_ref = $sth\->fetchall_arrayref( $slice );
-\& $tbl_ary_ref = $sth\->fetchall_arrayref( $slice, $max_rows );
-.Ve
-.PP
-The \f(CW\*(C`fetchall_arrayref\*(C'\fR method can be used to fetch all the data to be
-returned from a prepared and executed statement handle. It returns a
-reference to an array that contains one reference per row.
-.PP
-If called on an \fIinactive\fR statement handle, \f(CW\*(C`fetchall_arrayref\*(C'\fR returns undef.
-.PP
-If there are no rows left to return from an \fIactive\fR statement handle, \f(CW\*(C`fetchall_arrayref\*(C'\fR returns a reference
-to an empty array. If an error occurs, \f(CW\*(C`fetchall_arrayref\*(C'\fR returns the
-data fetched thus far, which may be none. You should check \f(CW\*(C`$sth\->err\*(C'\fR
-afterwards (or use the \f(CW\*(C`RaiseError\*(C'\fR attribute) to discover if the data is
-complete or was truncated due to an error.
-.PP
-If \f(CW$slice\fR is an array reference, \f(CW\*(C`fetchall_arrayref\*(C'\fR uses \*(L"fetchrow_arrayref\*(R"
-to fetch each row as an array ref. If the \f(CW$slice\fR array is not empty
-then it is used as a slice to select individual columns by perl array
-index number (starting at 0, unlike column and parameter numbers which
-start at 1).
-.PP
-With no parameters, or if \f(CW$slice\fR is undefined, \f(CW\*(C`fetchall_arrayref\*(C'\fR
-acts as if passed an empty array ref.
-.PP
-For example, to fetch just the first column of every row:
-.PP
-.Vb 1
-\& $tbl_ary_ref = $sth\->fetchall_arrayref([0]);
-.Ve
-.PP
-To fetch the second to last and last column of every row:
-.PP
-.Vb 1
-\& $tbl_ary_ref = $sth\->fetchall_arrayref([\-2,\-1]);
-.Ve
-.PP
-Those two examples both return a reference to an array of array refs.
-.PP
-If \f(CW$slice\fR is a hash reference, \f(CW\*(C`fetchall_arrayref\*(C'\fR fetches each row as a hash
-reference. If the \f(CW$slice\fR hash is empty then the keys in the hashes have
-whatever name lettercase is returned by default. (See \*(L"FetchHashKeyName\*(R"
-attribute.) If the \f(CW$slice\fR hash is \fInot\fR empty, then it is used as a slice to
-select individual columns by name. The values of the hash should be set to 1.
-The key names of the returned hashes match the letter case of the names in the
-parameter hash, regardless of the \*(L"FetchHashKeyName\*(R" attribute.
-.PP
-For example, to fetch all fields of every row as a hash ref:
-.PP
-.Vb 1
-\& $tbl_ary_ref = $sth\->fetchall_arrayref({});
-.Ve
-.PP
-To fetch only the fields called \*(L"foo\*(R" and \*(L"bar\*(R" of every row as a hash ref
-(with keys named \*(L"foo\*(R" and \*(L"\s-1BAR\*(R",\s0 regardless of the original capitalization):
-.PP
-.Vb 1
-\& $tbl_ary_ref = $sth\->fetchall_arrayref({ foo=>1, BAR=>1 });
-.Ve
-.PP
-Those two examples both return a reference to an array of hash refs.
-.PP
-If \f(CW$slice\fR is a \fIreference to a hash reference\fR, that hash is used to select
-and rename columns. The keys are 0\-based column index numbers and the values
-are the corresponding keys for the returned row hashes.
-.PP
-For example, to fetch only the first and second columns of every row as a hash
-ref (with keys named \*(L"k\*(R" and \*(L"v\*(R" regardless of their original names):
-.PP
-.Vb 1
-\& $tbl_ary_ref = $sth\->fetchall_arrayref( \e{ 0 => \*(Aqk\*(Aq, 1 => \*(Aqv\*(Aq } );
-.Ve
-.PP
-If \f(CW$max_rows\fR is defined and greater than or equal to zero then it
-is used to limit the number of rows fetched before returning.
-\&\fIfetchall_arrayref()\fR can then be called again to fetch more rows.
-This is especially useful when you need the better performance of
-\&\fIfetchall_arrayref()\fR but don't have enough memory to fetch and return
-all the rows in one go.
-.PP
-Here's an example (assumes RaiseError is enabled):
-.PP
-.Vb 6
-\& my $rows = []; # cache for batches of rows
-\& while( my $row = ( shift(@$rows) || # get row from cache, or reload cache:
-\& shift(@{$rows=$sth\->fetchall_arrayref(undef,10_000)||[]}) )
-\& ) {
-\& ...
-\& }
-.Ve
-.PP
-That \fImight\fR be the fastest way to fetch and process lots of rows using the \s-1DBI,\s0
-but it depends on the relative cost of method calls vs memory allocation.
-.PP
-A standard \f(CW\*(C`while\*(C'\fR loop with column binding is often faster because
-the cost of allocating memory for the batch of rows is greater than
-the saving by reducing method calls. It's possible that the \s-1DBI\s0 may
-provide a way to reuse the memory of a previous batch in future, which
-would then shift the balance back towards \fIfetchall_arrayref()\fR.
-.PP
-\fI\f(CI\*(C`fetchall_hashref\*(C'\fI\fR
-.IX Subsection "fetchall_hashref"
-.PP
-.Vb 1
-\& $hash_ref = $sth\->fetchall_hashref($key_field);
-.Ve
-.PP
-The \f(CW\*(C`fetchall_hashref\*(C'\fR method can be used to fetch all the data to be
-returned from a prepared and executed statement handle. It returns a reference
-to a hash containing a key for each distinct value of the \f(CW$key_field\fR column
-that was fetched. For each key the corresponding value is a reference to a hash
-containing all the selected columns and their values, as returned by
-\&\f(CW\*(C`fetchrow_hashref()\*(C'\fR.
-.PP
-If there are no rows to return, \f(CW\*(C`fetchall_hashref\*(C'\fR returns a reference
-to an empty hash. If an error occurs, \f(CW\*(C`fetchall_hashref\*(C'\fR returns the
-data fetched thus far, which may be none. You should check
-\&\f(CW\*(C`$sth\->err\*(C'\fR afterwards (or use the \f(CW\*(C`RaiseError\*(C'\fR attribute) to
-discover if the data is complete or was truncated due to an error.
-.PP
-The \f(CW$key_field\fR parameter provides the name of the field that holds the
-value to be used for the key for the returned hash. For example:
-.PP
-.Vb 5
-\& $dbh\->{FetchHashKeyName} = \*(AqNAME_lc\*(Aq;
-\& $sth = $dbh\->prepare("SELECT FOO, BAR, ID, NAME, BAZ FROM TABLE");
-\& $sth\->execute;
-\& $hash_ref = $sth\->fetchall_hashref(\*(Aqid\*(Aq);
-\& print "Name for id 42 is $hash_ref\->{42}\->{name}\en";
-.Ve
-.PP
-The \f(CW$key_field\fR parameter can also be specified as an integer column
-number (counting from 1). If \f(CW$key_field\fR doesn't match any column in
-the statement, as a name first then as a number, then an error is
-returned.
-.PP
-For queries returning more than one 'key' column, you can specify
-multiple column names by passing \f(CW$key_field\fR as a reference to an
-array containing one or more key column names (or index numbers).
-For example:
-.PP
-.Vb 4
-\& $sth = $dbh\->prepare("SELECT foo, bar, baz FROM table");
-\& $sth\->execute;
-\& $hash_ref = $sth\->fetchall_hashref( [ qw(foo bar) ] );
-\& print "For foo 42 and bar 38, baz is $hash_ref\->{42}\->{38}\->{baz}\en";
-.Ve
-.PP
-The \fIfetchall_hashref()\fR method is normally used only where the key
-fields values for each row are unique. If multiple rows are returned
-with the same values for the key fields then later rows overwrite
-earlier ones.
-.PP
-\fI\f(CI\*(C`finish\*(C'\fI\fR
-.IX Subsection "finish"
-.PP
-.Vb 1
-\& $rc = $sth\->finish;
-.Ve
-.PP
-Indicate that no more data will be fetched from this statement handle
-before it is either executed again or destroyed. You almost certainly
-do \fInot\fR need to call this method.
-.PP
-Adding calls to \f(CW\*(C`finish\*(C'\fR after loop that fetches all rows is a common mistake,
-don't do it, it can mask genuine problems like uncaught fetch errors.
-.PP
-When all the data has been fetched from a \f(CW\*(C`SELECT\*(C'\fR statement, the driver will
-automatically call \f(CW\*(C`finish\*(C'\fR for you. So you should \fInot\fR call it explicitly
-\&\fIexcept\fR when you know that you've not fetched all the data from a statement
-handle \fIand\fR the handle won't be destroyed soon.
-.PP
-The most common example is when you only want to fetch just one row,
-but in that case the \f(CW\*(C`selectrow_*\*(C'\fR methods are usually better anyway.
-.PP
-Consider a query like:
-.PP
-.Vb 1
-\& SELECT foo FROM table WHERE bar=? ORDER BY baz
-.Ve
-.PP
-on a very large table. When executed, the database server will have to use
-temporary buffer space to store the sorted rows. If, after executing
-the handle and selecting just a few rows, the handle won't be re-executed for
-some time and won't be destroyed, the \f(CW\*(C`finish\*(C'\fR method can be used to tell
-the server that the buffer space can be freed.
-.PP
-Calling \f(CW\*(C`finish\*(C'\fR resets the \*(L"Active\*(R" attribute for the statement. It
-may also make some statement handle attributes (such as \f(CW\*(C`NAME\*(C'\fR and \f(CW\*(C`TYPE\*(C'\fR)
-unavailable if they have not already been accessed (and thus cached).
-.PP
-The \f(CW\*(C`finish\*(C'\fR method does not affect the transaction status of the
-database connection. It has nothing to do with transactions. It's mostly an
-internal \*(L"housekeeping\*(R" method that is rarely needed.
-See also \*(L"disconnect\*(R" and the \*(L"Active\*(R" attribute.
-.PP
-The \f(CW\*(C`finish\*(C'\fR method should have been called \f(CW\*(C`discard_pending_rows\*(C'\fR.
-.PP
-\fI\f(CI\*(C`rows\*(C'\fI\fR
-.IX Subsection "rows"
-.PP
-.Vb 1
-\& $rv = $sth\->rows;
-.Ve
-.PP
-Returns the number of rows affected by the last row affecting command,
-or \-1 if the number of rows is not known or not available.
-.PP
-Generally, you can only rely on a row count after a \fInon\fR\-\f(CW\*(C`SELECT\*(C'\fR
-\&\f(CW\*(C`execute\*(C'\fR (for some specific operations like \f(CW\*(C`UPDATE\*(C'\fR and \f(CW\*(C`DELETE\*(C'\fR), or
-after fetching all the rows of a \f(CW\*(C`SELECT\*(C'\fR statement.
-.PP
-For \f(CW\*(C`SELECT\*(C'\fR statements, it is generally not possible to know how many
-rows will be returned except by fetching them all. Some drivers will
-return the number of rows the application has fetched so far, but
-others may return \-1 until all rows have been fetched. So use of the
-\&\f(CW\*(C`rows\*(C'\fR method or \f(CW$DBI::rows\fR with \f(CW\*(C`SELECT\*(C'\fR statements is not
-recommended.
-.PP
-One alternative method to get a row count for a \f(CW\*(C`SELECT\*(C'\fR is to execute a
-\&\*(L"\s-1SELECT COUNT\s0(*) \s-1FROM ...\*(R" SQL\s0 statement with the same \*(L"...\*(R" as your
-query and then fetch the row count from that.
-.PP
-\fI\f(CI\*(C`bind_col\*(C'\fI\fR
-.IX Subsection "bind_col"
-.PP
-.Vb 3
-\& $rc = $sth\->bind_col($column_number, \e$var_to_bind);
-\& $rc = $sth\->bind_col($column_number, \e$var_to_bind, \e%attr );
-\& $rc = $sth\->bind_col($column_number, \e$var_to_bind, $bind_type );
-.Ve
-.PP
-Binds a Perl variable and/or some attributes to an output column
-(field) of a \f(CW\*(C`SELECT\*(C'\fR statement. Column numbers count up from 1.
-You do not need to bind output columns in order to fetch data.
-For maximum portability between drivers, \fIbind_col()\fR should be called
-after \fIexecute()\fR and not before.
-See also \*(L"bind_columns\*(R" for an example.
-.PP
-The binding is performed at a low level using Perl aliasing.
-Whenever a row is fetched from the database \f(CW$var_to_bind\fR appears
-to be automatically updated simply because it now refers to the same
-memory location as the corresponding column value. This makes using
-bound variables very efficient.
-Binding a tied variable doesn't work, currently.
-.PP
-The \*(L"bind_param\*(R" method
-performs a similar, but opposite, function for input variables.
-.PP
-\&\fBData Types for Column Binding\fR
-.PP
-The \f(CW\*(C`\e%attr\*(C'\fR parameter can be used to hint at the data type
-formatting the column should have. For example, you can use:
-.PP
-.Vb 1
-\& $sth\->bind_col(1, undef, { TYPE => SQL_DATETIME });
-.Ve
-.PP
-to specify that you'd like the column (which presumably is some
-kind of datetime type) to be returned in the standard format for
-\&\s-1SQL_DATETIME,\s0 which is '\s-1YYYY\-MM\-DD HH:MM:SS\s0', rather than the
-native formatting the database would normally use.
-.PP
-There's no \f(CW$var_to_bind\fR in that example to emphasize the point
-that \fIbind_col()\fR works on the underlying column and not just
-a particular bound variable.
-.PP
-As a short-cut for the common case, the data type can be passed
-directly, in place of the \f(CW\*(C`\e%attr\*(C'\fR hash reference. This example is
-equivalent to the one above:
-.PP
-.Vb 1
-\& $sth\->bind_col(1, undef, SQL_DATETIME);
-.Ve
-.PP
-The \f(CW\*(C`TYPE\*(C'\fR value indicates the standard (non-driver-specific) type for
-this parameter. To specify the driver-specific type, the driver may
-support a driver-specific attribute, such as \f(CW\*(C`{ ora_type => 97 }\*(C'\fR.
-.PP
-The \s-1SQL_DATETIME\s0 and other related constants can be imported using
-.PP
-.Vb 1
-\& use DBI qw(:sql_types);
-.Ve
-.PP
-See \*(L"\s-1DBI\s0 Constants\*(R" for more information.
-.PP
-Few drivers support specifying a data type via a \f(CW\*(C`bind_col\*(C'\fR call
-(most will simply ignore the data type). Fewer still allow the data
-type to be altered once set. If you do set a column type the type
-should remain sticky through further calls to bind_col for the same
-column if the type is not overridden (this is important for instance
-when you are using a slice in fetchall_arrayref).
-.PP
-The \s-1TYPE\s0 attribute for \fIbind_col()\fR was first specified in \s-1DBI 1.41.\s0
-.PP
-From \s-1DBI 1.611,\s0 drivers can use the \f(CW\*(C`TYPE\*(C'\fR attribute to attempt to
-cast the bound scalar to a perl type which more closely matches
-\&\f(CW\*(C`TYPE\*(C'\fR. At present \s-1DBI\s0 supports \f(CW\*(C`SQL_INTEGER\*(C'\fR, \f(CW\*(C`SQL_DOUBLE\*(C'\fR and
-\&\f(CW\*(C`SQL_NUMERIC\*(C'\fR. See \*(L"sql_type_cast\*(R" for details of how types are
-cast.
-.PP
-\&\fBOther attributes for Column Binding\fR
-.PP
-The \f(CW\*(C`\e%attr\*(C'\fR parameter may also contain the following attributes:
-.ie n .IP """StrictlyTyped""" 4
-.el .IP "\f(CWStrictlyTyped\fR" 4
-.IX Item "StrictlyTyped"
-If a \f(CW\*(C`TYPE\*(C'\fR attribute is passed to bind_col, then the driver will
-attempt to change the bound perl scalar to match the type more
-closely. If the bound value cannot be cast to the requested \f(CW\*(C`TYPE\*(C'\fR
-then by default it is left untouched and no error is generated. If you
-specify \f(CW\*(C`StrictlyTyped\*(C'\fR as 1 and the cast fails, this will generate
-an error.
-.Sp
-This attribute was first added in \s-1DBI 1.611.\s0 When 1.611 was released
-few drivers actually supported this attribute but DBD::Oracle and
-\&\s-1DBD::ODBC\s0 should from versions 1.24.
-.ie n .IP """DiscardString""" 4
-.el .IP "\f(CWDiscardString\fR" 4
-.IX Item "DiscardString"
-When the \f(CW\*(C`TYPE\*(C'\fR attribute is passed to \*(L"bind_col\*(R" and the driver
-successfully casts the bound perl scalar to a non-string type
-then if \f(CW\*(C`DiscardString\*(C'\fR is set to 1, the string portion of the
-scalar will be discarded. By default, \f(CW\*(C`DiscardString\*(C'\fR is not set.
-.Sp
-This attribute was first added in \s-1DBI 1.611.\s0 When 1.611 was released
-few drivers actually supported this attribute but DBD::Oracle and
-\&\s-1DBD::ODBC\s0 should from versions 1.24.
-.PP
-\fI\f(CI\*(C`bind_columns\*(C'\fI\fR
-.IX Subsection "bind_columns"
-.PP
-.Vb 1
-\& $rc = $sth\->bind_columns(@list_of_refs_to_vars_to_bind);
-.Ve
-.PP
-Calls \*(L"bind_col\*(R" for each column of the \f(CW\*(C`SELECT\*(C'\fR statement.
-.PP
-The list of references should have the same number of elements as the number of
-columns in the \f(CW\*(C`SELECT\*(C'\fR statement. If it doesn't then \f(CW\*(C`bind_columns\*(C'\fR will
-bind the elements given, up to the number of columns, and then return an error.
-.PP
-For maximum portability between drivers, \fIbind_columns()\fR should be called
-after \fIexecute()\fR and not before.
-.PP
-For example:
-.PP
-.Vb 4
-\& $dbh\->{RaiseError} = 1; # do this, or check every call for errors
-\& $sth = $dbh\->prepare(q{ SELECT region, sales FROM sales_by_region });
-\& $sth\->execute;
-\& my ($region, $sales);
-\&
-\& # Bind Perl variables to columns:
-\& $rv = $sth\->bind_columns(\e$region, \e$sales);
-\&
-\& # you can also use Perl\*(Aqs \e(...) syntax (see perlref docs):
-\& # $sth\->bind_columns(\e($region, $sales));
-\&
-\& # Column binding is the most efficient way to fetch data
-\& while ($sth\->fetch) {
-\& print "$region: $sales\en";
-\& }
-.Ve
-.PP
-For compatibility with old scripts, the first parameter will be
-ignored if it is \f(CW\*(C`undef\*(C'\fR or a hash reference.
-.PP
-Here's a more fancy example that binds columns to the values \fIinside\fR
-a hash (thanks to H.Merijn Brand):
-.PP
-.Vb 6
-\& $sth\->execute;
-\& my %row;
-\& $sth\->bind_columns( \e( @row{ @{$sth\->{NAME_lc} } } ));
-\& while ($sth\->fetch) {
-\& print "$row{region}: $row{sales}\en";
-\& }
-.Ve
-.PP
-\fI\f(CI\*(C`dump_results\*(C'\fI\fR
-.IX Subsection "dump_results"
-.PP
-.Vb 1
-\& $rows = $sth\->dump_results($maxlen, $lsep, $fsep, $fh);
-.Ve
-.PP
-Fetches all the rows from \f(CW$sth\fR, calls \f(CW\*(C`DBI::neat_list\*(C'\fR for each row, and
-prints the results to \f(CW$fh\fR (defaults to \f(CW\*(C`STDOUT\*(C'\fR) separated by \f(CW$lsep\fR
-(default \f(CW"\en"\fR). \f(CW$fsep\fR defaults to \f(CW", "\fR and \f(CW$maxlen\fR defaults to 35.
-.PP
-This method is designed as a handy utility for prototyping and
-testing queries. Since it uses \*(L"neat_list\*(R" to
-format and edit the string for reading by humans, it is not recommended
-for data transfer applications.
-.SS "Statement Handle Attributes"
-.IX Subsection "Statement Handle Attributes"
-This section describes attributes specific to statement handles. Most
-of these attributes are read-only.
-.PP
-Changes to these statement handle attributes do not affect any other
-existing or future statement handles.
-.PP
-Attempting to set or get the value of an unknown attribute generates a warning,
-except for private driver specific attributes (which all have names
-starting with a lowercase letter).
-.PP
-Example:
-.PP
-.Vb 1
-\& ... = $h\->{NUM_OF_FIELDS}; # get/read
-.Ve
-.PP
-Some drivers cannot provide valid values for some or all of these
-attributes until after \f(CW\*(C`$sth\->execute\*(C'\fR has been successfully
-called. Typically the attribute will be \f(CW\*(C`undef\*(C'\fR in these situations.
-.PP
-Some attributes, like \s-1NAME,\s0 are not appropriate to some types of
-statement, like \s-1SELECT.\s0 Typically the attribute will be \f(CW\*(C`undef\*(C'\fR
-in these situations.
-.PP
-For drivers which support stored procedures and multiple result sets
-(see \*(L"more_results\*(R") these attributes relate to the \fIcurrent\fR result set.
-.PP
-See also \*(L"finish\*(R" to learn more about the effect it
-may have on some attributes.
-.PP
-\fI\f(CI\*(C`NUM_OF_FIELDS\*(C'\fI\fR
-.IX Subsection "NUM_OF_FIELDS"
-.PP
-Type: integer, read-only
-.PP
-Number of fields (columns) in the data the prepared statement may return.
-Statements that don't return rows of data, like \f(CW\*(C`DELETE\*(C'\fR and \f(CW\*(C`CREATE\*(C'\fR
-set \f(CW\*(C`NUM_OF_FIELDS\*(C'\fR to 0 (though it may be undef in some drivers).
-.PP
-\fI\f(CI\*(C`NUM_OF_PARAMS\*(C'\fI\fR
-.IX Subsection "NUM_OF_PARAMS"
-.PP
-Type: integer, read-only
-.PP
-The number of parameters (placeholders) in the prepared statement.
-See \s-1SUBSTITUTION VARIABLES\s0 below for more details.
-.PP
-\fI\f(CI\*(C`NAME\*(C'\fI\fR
-.IX Subsection "NAME"
-.PP
-Type: array-ref, read-only
-.PP
-Returns a reference to an array of field names for each column. The
-names may contain spaces but should not be truncated or have any
-trailing space. Note that the names have the letter case (upper, lower
-or mixed) as returned by the driver being used. Portable applications
-should use \*(L"NAME_lc\*(R" or \*(L"NAME_uc\*(R".
-.PP
-.Vb 1
-\& print "First column name: $sth\->{NAME}\->[0]\en";
-.Ve
-.PP
-Also note that the name returned for (aggregate) functions like \f(CWcount(*)\fR
-or \f(CW\*(C`max(c_foo)\*(C'\fR is determined by the database server and not by \f(CW\*(C`DBI\*(C'\fR or
-the \f(CW\*(C`DBD\*(C'\fR backend.
-.PP
-\fI\f(CI\*(C`NAME_lc\*(C'\fI\fR
-.IX Subsection "NAME_lc"
-.PP
-Type: array-ref, read-only
-.PP
-Like \f(CW\*(C`/NAME\*(C'\fR but always returns lowercase names.
-.PP
-\fI\f(CI\*(C`NAME_uc\*(C'\fI\fR
-.IX Subsection "NAME_uc"
-.PP
-Type: array-ref, read-only
-.PP
-Like \f(CW\*(C`/NAME\*(C'\fR but always returns uppercase names.
-.PP
-\fI\f(CI\*(C`NAME_hash\*(C'\fI\fR
-.IX Subsection "NAME_hash"
-.PP
-Type: hash-ref, read-only
-.PP
-\fI\f(CI\*(C`NAME_lc_hash\*(C'\fI\fR
-.IX Subsection "NAME_lc_hash"
-.PP
-Type: hash-ref, read-only
-.PP
-\fI\f(CI\*(C`NAME_uc_hash\*(C'\fI\fR
-.IX Subsection "NAME_uc_hash"
-.PP
-Type: hash-ref, read-only
-.PP
-The \f(CW\*(C`NAME_hash\*(C'\fR, \f(CW\*(C`NAME_lc_hash\*(C'\fR, and \f(CW\*(C`NAME_uc_hash\*(C'\fR attributes
-return column name information as a reference to a hash.
-.PP
-The keys of the hash are the names of the columns. The letter case of
-the keys corresponds to the letter case returned by the \f(CW\*(C`NAME\*(C'\fR,
-\&\f(CW\*(C`NAME_lc\*(C'\fR, and \f(CW\*(C`NAME_uc\*(C'\fR attributes respectively (as described above).
-.PP
-The value of each hash entry is the perl index number of the
-corresponding column (counting from 0). For example:
-.PP
-.Vb 4
-\& $sth = $dbh\->prepare("select Id, Name from table");
-\& $sth\->execute;
-\& @row = $sth\->fetchrow_array;
-\& print "Name $row[ $sth\->{NAME_lc_hash}{name} ]\en";
-.Ve
-.PP
-\fI\f(CI\*(C`TYPE\*(C'\fI\fR
-.IX Subsection "TYPE"
-.PP
-Type: array-ref, read-only
-.PP
-Returns a reference to an array of integer values for each
-column. The value indicates the data type of the corresponding column.
-.PP
-The values correspond to the international standards (\s-1ANSI X3.135\s0
-and \s-1ISO/IEC 9075\s0) which, in general terms, means \s-1ODBC.\s0 Driver-specific
-types that don't exactly match standard types should generally return
-the same values as an \s-1ODBC\s0 driver supplied by the makers of the
-database. That might include private type numbers in ranges the vendor
-has officially registered with the \s-1ISO\s0 working group:
-.PP
-.Vb 1
-\& ftp://sqlstandards.org/SC32/SQL_Registry/
-.Ve
-.PP
-Where there's no vendor-supplied \s-1ODBC\s0 driver to be compatible with,
-the \s-1DBI\s0 driver can use type numbers in the range that is now
-officially reserved for use by the \s-1DBI: \-9999\s0 to \-9000.
-.PP
-All possible values for \f(CW\*(C`TYPE\*(C'\fR should have at least one entry in the
-output of the \f(CW\*(C`type_info_all\*(C'\fR method (see \*(L"type_info_all\*(R").
-.PP
-\fI\f(CI\*(C`PRECISION\*(C'\fI\fR
-.IX Subsection "PRECISION"
-.PP
-Type: array-ref, read-only
-.PP
-Returns a reference to an array of integer values for each column.
-.PP
-For numeric columns, the value is the maximum number of digits
-(without considering a sign character or decimal point). Note that
-the \*(L"display size\*(R" for floating point types (\s-1REAL, FLOAT, DOUBLE\s0)
-can be up to 7 characters greater than the precision (for the
-sign + decimal point + the letter E + a sign + 2 or 3 digits).
-.PP
-For any character type column the value is the \s-1OCTET_LENGTH,\s0
-in other words the number of bytes, not characters.
-.PP
-(More recent standards refer to this as \s-1COLUMN_SIZE\s0 but we stick
-with \s-1PRECISION\s0 for backwards compatibility.)
-.PP
-\fI\f(CI\*(C`SCALE\*(C'\fI\fR
-.IX Subsection "SCALE"
-.PP
-Type: array-ref, read-only
-.PP
-Returns a reference to an array of integer values for each column.
-\&\s-1NULL \s0(\f(CW\*(C`undef\*(C'\fR) values indicate columns where scale is not applicable.
-.PP
-\fI\f(CI\*(C`NULLABLE\*(C'\fI\fR
-.IX Subsection "NULLABLE"
-.PP
-Type: array-ref, read-only
-.PP
-Returns a reference to an array indicating the possibility of each
-column returning a null. Possible values are \f(CW0\fR
-(or an empty string) = no, \f(CW1\fR = yes, \f(CW2\fR = unknown.
-.PP
-.Vb 1
-\& print "First column may return NULL\en" if $sth\->{NULLABLE}\->[0];
-.Ve
-.PP
-\fI\f(CI\*(C`CursorName\*(C'\fI\fR
-.IX Subsection "CursorName"
-.PP
-Type: string, read-only
-.PP
-Returns the name of the cursor associated with the statement handle, if
-available. If not available or if the database driver does not support the
-\&\f(CW"where current of ..."\fR \s-1SQL\s0 syntax, then it returns \f(CW\*(C`undef\*(C'\fR.
-.PP
-\fI\f(CI\*(C`Database\*(C'\fI\fR
-.IX Subsection "Database"
-.PP
-Type: dbh, read-only
-.PP
-Returns the parent \f(CW$dbh\fR of the statement handle.
-.PP
-\fI\f(CI\*(C`Statement\*(C'\fI\fR
-.IX Subsection "Statement"
-.PP
-Type: string, read-only
-.PP
-Returns the statement string passed to the \*(L"prepare\*(R" method.
-.PP
-\fI\f(CI\*(C`ParamValues\*(C'\fI\fR
-.IX Subsection "ParamValues"
-.PP
-Type: hash ref, read-only
-.PP
-Returns a reference to a hash containing the values currently bound
-to placeholders. The keys of the hash are the 'names' of the
-placeholders, typically integers starting at 1. Returns undef if
-not supported by the driver.
-.PP
-See \*(L"ShowErrorStatement\*(R" for an example of how this is used.
-.PP
-* Keys:
-.PP
-If the driver supports \f(CW\*(C`ParamValues\*(C'\fR but no values have been bound
-yet then the driver should return a hash with placeholders names
-in the keys but all the values undef, but some drivers may return
-a ref to an empty hash because they can't pre-determine the names.
-.PP
-It is possible that the keys in the hash returned by \f(CW\*(C`ParamValues\*(C'\fR
-are not exactly the same as those implied by the prepared statement.
-For example, DBD::Oracle translates '\f(CW\*(C`?\*(C'\fR' placeholders into '\f(CW\*(C`:pN\*(C'\fR'
-where N is a sequence number starting at 1.
-.PP
-* Values:
-.PP
-It is possible that the values in the hash returned by \f(CW\*(C`ParamValues\*(C'\fR
-are not \fIexactly\fR the same as those passed to \fIbind_param()\fR or \fIexecute()\fR.
-The driver may have slightly modified values in some way based on the
-\&\s-1TYPE\s0 the value was bound with. For example a floating point value
-bound as an \s-1SQL_INTEGER\s0 type may be returned as an integer.
-The values returned by \f(CW\*(C`ParamValues\*(C'\fR can be passed to another
-\&\fIbind_param()\fR method with the same \s-1TYPE\s0 and will be seen by the
-database as the same value. See also \*(L"ParamTypes\*(R" below.
-.PP
-The \f(CW\*(C`ParamValues\*(C'\fR attribute was added in \s-1DBI 1.28.\s0
-.PP
-\fI\f(CI\*(C`ParamTypes\*(C'\fI\fR
-.IX Subsection "ParamTypes"
-.PP
-Type: hash ref, read-only
-.PP
-Returns a reference to a hash containing the type information
-currently bound to placeholders.
-Returns undef if not supported by the driver.
-.PP
-* Keys:
-.PP
-See \*(L"ParamValues\*(R" above.
-.PP
-* Values:
-.PP
-The hash values are hashrefs of type information in the same form as that
-passed to the various \fIbind_param()\fR methods (See \*(L"bind_param\*(R" for the format
-and values).
-.PP
-It is possible that the values in the hash returned by \f(CW\*(C`ParamTypes\*(C'\fR
-are not exactly the same as those passed to \fIbind_param()\fR or \fIexecute()\fR.
-Param attributes specified using the abbreviated form, like this:
-.PP
-.Vb 1
-\& $sth\->bind_param(1, SQL_INTEGER);
-.Ve
-.PP
-are returned in the expanded form, as if called like this:
-.PP
-.Vb 1
-\& $sth\->bind_param(1, { TYPE => SQL_INTEGER });
-.Ve
-.PP
-The driver may have modified the type information in some way based
-on the bound values, other hints provided by the \fIprepare()\fR'd
-\&\s-1SQL\s0 statement, or alternate type mappings required by the driver or target
-database system. The driver may also add private keys (with names beginning
-with the drivers reserved prefix, e.g., odbc_xxx).
-.PP
-* Example:
-.PP
-The keys and values in the returned hash can be passed to the various
-\&\fIbind_param()\fR methods to effectively reproduce a previous param binding.
-For example:
-.PP
-.Vb 7
-\& # assuming $sth1 is a previously prepared statement handle
-\& my $sth2 = $dbh\->prepare( $sth1\->{Statement} );
-\& my $ParamValues = $sth1\->{ParamValues} || {};
-\& my $ParamTypes = $sth1\->{ParamTypes} || {};
-\& $sth2\->bind_param($_, $ParamValues\->{$_}, $ParamTypes\->{$_})
-\& for keys %{ {%$ParamValues, %$ParamTypes} };
-\& $sth2\->execute();
-.Ve
-.PP
-The \f(CW\*(C`ParamTypes\*(C'\fR attribute was added in \s-1DBI 1.49.\s0 Implementation
-is the responsibility of individual drivers; the \s-1DBI\s0 layer default
-implementation simply returns undef.
-.PP
-\fI\f(CI\*(C`ParamArrays\*(C'\fI\fR
-.IX Subsection "ParamArrays"
-.PP
-Type: hash ref, read-only
-.PP
-Returns a reference to a hash containing the values currently bound to
-placeholders with \*(L"execute_array\*(R" or \*(L"bind_param_array\*(R". The
-keys of the hash are the 'names' of the placeholders, typically
-integers starting at 1. Returns undef if not supported by the driver
-or no arrays of parameters are bound.
-.PP
-Each key value is an array reference containing a list of the bound
-parameters for that column.
-.PP
-For example:
-.PP
-.Vb 8
-\& $sth = $dbh\->prepare("INSERT INTO staff (id, name) values (?,?)");
-\& $sth\->execute_array({},[1,2], [\*(Aqfred\*(Aq,\*(Aqdave\*(Aq]);
-\& if ($sth\->{ParamArrays}) {
-\& foreach $param (keys %{$sth\->{ParamArrays}}) {
-\& printf "Parameters for %s : %s\en", $param,
-\& join(",", @{$sth\->{ParamArrays}\->{$param}});
-\& }
-\& }
-.Ve
-.PP
-It is possible that the values in the hash returned by \f(CW\*(C`ParamArrays\*(C'\fR
-are not \fIexactly\fR the same as those passed to \*(L"bind_param_array\*(R" or
-\&\*(L"execute_array\*(R". The driver may have slightly modified values in some
-way based on the \s-1TYPE\s0 the value was bound with. For example a floating
-point value bound as an \s-1SQL_INTEGER\s0 type may be returned as an
-integer.
-.PP
-It is also possible that the keys in the hash returned by
-\&\f(CW\*(C`ParamArrays\*(C'\fR are not exactly the same as those implied by the
-prepared statement. For example, DBD::Oracle translates '\f(CW\*(C`?\*(C'\fR'
-placeholders into '\f(CW\*(C`:pN\*(C'\fR' where N is a sequence number starting at 1.
-.PP
-\fI\f(CI\*(C`RowsInCache\*(C'\fI\fR
-.IX Subsection "RowsInCache"
-.PP
-Type: integer, read-only
-.PP
-If the driver supports a local row cache for \f(CW\*(C`SELECT\*(C'\fR statements, then
-this attribute holds the number of un-fetched rows in the cache. If the
-driver doesn't, then it returns \f(CW\*(C`undef\*(C'\fR. Note that some drivers pre-fetch
-rows on execute, whereas others wait till the first fetch.
-.PP
-See also the \*(L"RowCacheSize\*(R" database handle attribute.
-.SH "FURTHER INFORMATION"
-.IX Header "FURTHER INFORMATION"
-.SS "Catalog Methods"
-.IX Subsection "Catalog Methods"
-An application can retrieve metadata information from the \s-1DBMS\s0 by issuing
-appropriate queries on the views of the Information Schema. Unfortunately,
-\&\f(CW\*(C`INFORMATION_SCHEMA\*(C'\fR views are seldom supported by the \s-1DBMS.\s0
-Special methods (catalog methods) are available to return result sets
-for a small but important portion of that metadata:
-.PP
-.Vb 5
-\& column_info
-\& foreign_key_info
-\& primary_key_info
-\& table_info
-\& statistics_info
-.Ve
-.PP
-All catalog methods accept arguments in order to restrict the result sets.
-Passing \f(CW\*(C`undef\*(C'\fR to an optional argument does not constrain the search for
-that argument.
-However, an empty string ('') is treated as a regular search criteria
-and will only match an empty value.
-.PP
-\&\fBNote\fR: \s-1SQL/CLI\s0 and \s-1ODBC\s0 differ in the handling of empty strings. An
-empty string will not restrict the result set in \s-1SQL/CLI.\s0
-.PP
-Most arguments in the catalog methods accept only \fIordinary values\fR, e.g.
-the arguments of \f(CW\*(C`primary_key_info()\*(C'\fR.
-Such arguments are treated as a literal string, i.e. the case is significant
-and quote characters are taken literally.
-.PP
-Some arguments in the catalog methods accept \fIsearch patterns\fR (strings
-containing '_' and/or '%'), e.g. the \f(CW$table\fR argument of \f(CW\*(C`column_info()\*(C'\fR.
-Passing '%' is equivalent to leaving the argument \f(CW\*(C`undef\*(C'\fR.
-.PP
-\&\fBCaveat\fR: The underscore ('_') is valid and often used in \s-1SQL\s0 identifiers.
-Passing such a value to a search pattern argument may return more rows than
-expected!
-To include pattern characters as literals, they must be preceded by an
-escape character which can be achieved with
-.PP
-.Vb 2
-\& $esc = $dbh\->get_info( 14 ); # SQL_SEARCH_PATTERN_ESCAPE
-\& $search_pattern =~ s/([_%])/$esc$1/g;
-.Ve
-.PP
-The \s-1ODBC\s0 and \s-1SQL/CLI\s0 specifications define a way to change the default
-behaviour described above: All arguments (except \fIlist value arguments\fR)
-are treated as \fIidentifier\fR if the \f(CW\*(C`SQL_ATTR_METADATA_ID\*(C'\fR attribute is
-set to \f(CW\*(C`SQL_TRUE\*(C'\fR.
-\&\fIQuoted identifiers\fR are very similar to \fIordinary values\fR, i.e. their
-body (the string within the quotes) is interpreted literally.
-\&\fIUnquoted identifiers\fR are compared in \s-1UPPERCASE.\s0
-.PP
-The \s-1DBI \s0(currently) does not support the \f(CW\*(C`SQL_ATTR_METADATA_ID\*(C'\fR attribute,
-i.e. it behaves like an \s-1ODBC\s0 driver where \f(CW\*(C`SQL_ATTR_METADATA_ID\*(C'\fR is set to
-\&\f(CW\*(C`SQL_FALSE\*(C'\fR.
-.SS "Transactions"
-.IX Subsection "Transactions"
-Transactions are a fundamental part of any robust database system. They
-protect against errors and database corruption by ensuring that sets of
-related changes to the database take place in atomic (indivisible,
-all-or-nothing) units.
-.PP
-This section applies to databases that support transactions and where
-\&\f(CW\*(C`AutoCommit\*(C'\fR is off. See \*(L"AutoCommit\*(R" for details of using \f(CW\*(C`AutoCommit\*(C'\fR
-with various types of databases.
-.PP
-The recommended way to implement robust transactions in Perl
-applications is to enable \*(L"RaiseError\*(R" and catch the error that's 'thrown' as
-an exception. For example, using Try::Tiny:
-.PP
-.Vb 10
-\& use Try::Tiny;
-\& $dbh\->{AutoCommit} = 0; # enable transactions, if possible
-\& $dbh\->{RaiseError} = 1;
-\& try {
-\& foo(...) # do lots of work here
-\& bar(...) # including inserts
-\& baz(...) # and updates
-\& $dbh\->commit; # commit the changes if we get this far
-\& } catch {
-\& warn "Transaction aborted because $_"; # Try::Tiny copies $@ into $_
-\& # now rollback to undo the incomplete changes
-\& # but do it in an eval{} as it may also fail
-\& eval { $dbh\->rollback };
-\& # add other application on\-error\-clean\-up code here
-\& };
-.Ve
-.PP
-If the \f(CW\*(C`RaiseError\*(C'\fR attribute is not set, then \s-1DBI\s0 calls would need to be
-manually checked for errors, typically like this:
-.PP
-.Vb 1
-\& $h\->method(@args) or die $h\->errstr;
-.Ve
-.PP
-With \f(CW\*(C`RaiseError\*(C'\fR set, the \s-1DBI\s0 will automatically \f(CW\*(C`die\*(C'\fR if any \s-1DBI\s0 method
-call on that handle (or a child handle) fails, so you don't have to
-test the return value of each method call. See \*(L"RaiseError\*(R" for more
-details.
-.PP
-A major advantage of the \f(CW\*(C`eval\*(C'\fR approach is that the transaction will be
-properly rolled back if \fIany\fR code (not just \s-1DBI\s0 calls) in the inner
-application dies for any reason. The major advantage of using the
-\&\f(CW\*(C`$h\->{RaiseError}\*(C'\fR attribute is that all \s-1DBI\s0 calls will be checked
-automatically. Both techniques are strongly recommended.
-.PP
-After calling \f(CW\*(C`commit\*(C'\fR or \f(CW\*(C`rollback\*(C'\fR many drivers will not let you
-fetch from a previously active \f(CW\*(C`SELECT\*(C'\fR statement handle that's a child
-of the same database handle. A typical way round this is to connect the
-the database twice and use one connection for \f(CW\*(C`SELECT\*(C'\fR statements.
-.PP
-See \*(L"AutoCommit\*(R" and \*(L"disconnect\*(R" for other important information
-about transactions.
-.SS "Handling \s-1BLOB / LONG /\s0 Memo Fields"
-.IX Subsection "Handling BLOB / LONG / Memo Fields"
-Many databases support \*(L"blob\*(R" (binary large objects), \*(L"long\*(R", or similar
-datatypes for holding very long strings or large amounts of binary
-data in a single field. Some databases support variable length long
-values over 2,000,000,000 bytes in length.
-.PP
-Since values of that size can't usually be held in memory, and because
-databases can't usually know in advance the length of the longest long
-that will be returned from a \f(CW\*(C`SELECT\*(C'\fR statement (unlike other data
-types), some special handling is required.
-.PP
-In this situation, the value of the \f(CW\*(C`$h\->{LongReadLen}\*(C'\fR
-attribute is used to determine how much buffer space to allocate
-when fetching such fields. The \f(CW\*(C`$h\->{LongTruncOk}\*(C'\fR attribute
-is used to determine how to behave if a fetched value can't fit
-into the buffer.
-.PP
-See the description of \*(L"LongReadLen\*(R" for more information.
-.PP
-When trying to insert long or binary values, placeholders should be used
-since there are often limits on the maximum size of an \f(CW\*(C`INSERT\*(C'\fR
-statement and the \*(L"quote\*(R" method generally can't cope with binary
-data. See \*(L"Placeholders and Bind Values\*(R".
-.SS "Simple Examples"
-.IX Subsection "Simple Examples"
-Here's a complete example program to select and fetch some data:
-.PP
-.Vb 3
-\& my $data_source = "dbi::DriverName:db_name";
-\& my $dbh = DBI\->connect($data_source, $user, $password)
-\& or die "Can\*(Aqt connect to $data_source: $DBI::errstr";
-\&
-\& my $sth = $dbh\->prepare( q{
-\& SELECT name, phone
-\& FROM mytelbook
-\& }) or die "Can\*(Aqt prepare statement: $DBI::errstr";
-\&
-\& my $rc = $sth\->execute
-\& or die "Can\*(Aqt execute statement: $DBI::errstr";
-\&
-\& print "Query will return $sth\->{NUM_OF_FIELDS} fields.\en\en";
-\& print "Field names: @{ $sth\->{NAME} }\en";
-\&
-\& while (($name, $phone) = $sth\->fetchrow_array) {
-\& print "$name: $phone\en";
-\& }
-\& # check for problems which may have terminated the fetch early
-\& die $sth\->errstr if $sth\->err;
-\&
-\& $dbh\->disconnect;
-.Ve
-.PP
-Here's a complete example program to insert some data from a file.
-(This example uses \f(CW\*(C`RaiseError\*(C'\fR to avoid needing to check each call).
-.PP
-.Vb 3
-\& my $dbh = DBI\->connect("dbi:DriverName:db_name", $user, $password, {
-\& RaiseError => 1, AutoCommit => 0
-\& });
-\&
-\& my $sth = $dbh\->prepare( q{
-\& INSERT INTO table (name, phone) VALUES (?, ?)
-\& });
-\&
-\& open FH, "<phone.csv" or die "Unable to open phone.csv: $!";
-\& while (<FH>) {
-\& chomp;
-\& my ($name, $phone) = split /,/;
-\& $sth\->execute($name, $phone);
-\& }
-\& close FH;
-\&
-\& $dbh\->commit;
-\& $dbh\->disconnect;
-.Ve
-.PP
-Here's how to convert fetched NULLs (undefined values) into empty strings:
-.PP
-.Vb 5
-\& while($row = $sth\->fetchrow_arrayref) {
-\& # this is a fast and simple way to deal with nulls:
-\& foreach (@$row) { $_ = \*(Aq\*(Aq unless defined }
-\& print "@$row\en";
-\& }
-.Ve
-.PP
-The \f(CW\*(C`q{...}\*(C'\fR style quoting used in these examples avoids clashing with
-quotes that may be used in the \s-1SQL\s0 statement. Use the double-quote like
-\&\f(CW\*(C`qq{...}\*(C'\fR operator if you want to interpolate variables into the string.
-See \*(L"Quote and Quote-like Operators\*(R" in perlop for more details.
-.SS "Threads and Thread Safety"
-.IX Subsection "Threads and Thread Safety"
-Perl 5.7 and later support a new threading model called iThreads.
-(The old \*(L"5.005 style\*(R" threads are not supported by the \s-1DBI.\s0)
-.PP
-In the iThreads model each thread has its own copy of the perl
-interpreter. When a new thread is created the original perl
-interpreter is 'cloned' to create a new copy for the new thread.
-.PP
-If the \s-1DBI\s0 and drivers are loaded and handles created before the
-thread is created then it will get a cloned copy of the \s-1DBI,\s0 the
-drivers and the handles.
-.PP
-However, the internal pointer data within the handles will refer
-to the \s-1DBI\s0 and drivers in the original interpreter. Using those
-handles in the new interpreter thread is not safe, so the \s-1DBI\s0 detects
-this and croaks on any method call using handles that don't belong
-to the current thread (except for \s-1DESTROY\s0).
-.PP
-Because of this (possibly temporary) restriction, newly created
-threads must make their own connections to the database. Handles
-can't be shared across threads.
-.PP
-But \s-1BEWARE,\s0 some underlying database APIs (the code the \s-1DBD\s0 driver
-uses to talk to the database, often supplied by the database vendor)
-are not thread safe. If it's not thread safe, then allowing more
-than one thread to enter the code at the same time may cause
-subtle/serious problems. In some cases allowing more than
-one thread to enter the code, even if \fInot\fR at the same time,
-can cause problems. You have been warned.
-.PP
-Using \s-1DBI\s0 with perl threads is not yet recommended for production
-environments. For more information see
-<http://www.perlmonks.org/index.pl?node_id=288022>
-.PP
-Note: There is a bug in perl 5.8.2 when configured with threads
-and debugging enabled (bug #24463) which causes a \s-1DBI\s0 test to fail.
-.SS "Signal Handling and Canceling Operations"
-.IX Subsection "Signal Handling and Canceling Operations"
-[The following only applies to systems with unix-like signal handling.
-I'd welcome additions for other systems, especially Windows.]
-.PP
-The first thing to say is that signal handling in Perl versions less
-than 5.8 is \fInot\fR safe. There is always a small risk of Perl
-crashing and/or core dumping when, or after, handling a signal
-because the signal could arrive and be handled while internal data
-structures are being changed. If the signal handling code
-used those same internal data structures it could cause all manner
-of subtle and not-so-subtle problems. The risk was reduced with
-5.4.4 but was still present in all perls up through 5.8.0.
-.PP
-Beginning in perl 5.8.0 perl implements 'safe' signal handling if
-your system has the \s-1POSIX\s0 \fIsigaction()\fR routine. Now when a signal
-is delivered perl just makes a note of it but does \fInot\fR run the
-\&\f(CW%SIG\fR handler. The handling is 'deferred' until a 'safe' moment.
-.PP
-Although this change made signal handling safe, it also lead to
-a problem with signals being deferred for longer than you'd like.
-If a signal arrived while executing a system call, such as waiting
-for data on a network connection, the signal is noted and then the
-system call that was executing returns with an \s-1EINTR\s0 error code
-to indicate that it was interrupted. All fine so far.
-.PP
-The problem comes when the code that made the system call sees the
-\&\s-1EINTR\s0 code and decides it's going to call it again. Perl doesn't
-do that, but database code sometimes does. If that happens then the
-signal handler doesn't get called until later. Maybe much later.
-.PP
-Fortunately there are ways around this which we'll discuss below.
-Unfortunately they make signals unsafe again.
-.PP
-The two most common uses of signals in relation to the \s-1DBI\s0 are for
-canceling operations when the user types Ctrl-C (interrupt), and for
-implementing a timeout using \f(CW\*(C`alarm()\*(C'\fR and \f(CW$SIG{ALRM}\fR.
-.IP "Cancel" 4
-.IX Item "Cancel"
-The \s-1DBI\s0 provides a \f(CW\*(C`cancel\*(C'\fR method for statement handles. The
-\&\f(CW\*(C`cancel\*(C'\fR method should abort the current operation and is designed
-to be called from a signal handler. For example:
-.Sp
-.Vb 1
-\& $SIG{INT} = sub { $sth\->cancel };
-.Ve
-.Sp
-However, few drivers implement this (the \s-1DBI\s0 provides a default
-method that just returns \f(CW\*(C`undef\*(C'\fR) and, even if implemented, there
-is still a possibility that the statement handle, and even the
-parent database handle, will not be usable afterwards.
-.Sp
-If \f(CW\*(C`cancel\*(C'\fR returns true, then it has successfully
-invoked the database engine's own cancel function. If it returns false,
-then \f(CW\*(C`cancel\*(C'\fR failed. If it returns \f(CW\*(C`undef\*(C'\fR, then the database
-driver does not have cancel implemented \- very few do.
-.IP "Timeout" 4
-.IX Item "Timeout"
-The traditional way to implement a timeout is to set \f(CW$SIG{ALRM}\fR
-to refer to some code that will be executed when an \s-1ALRM\s0 signal
-arrives and then to call alarm($seconds) to schedule an \s-1ALRM\s0 signal
-to be delivered \f(CW$seconds\fR in the future. For example:
-.Sp
-.Vb 10
-\& my $failed;
-\& eval {
-\& local $SIG{ALRM} = sub { die "TIMEOUT\en" }; # N.B. \en required
-\& eval {
-\& alarm($seconds);
-\& ... code to execute with timeout here (which may die) ...
-\& 1;
-\& } or $failed = 1;
-\& # outer eval catches alarm that might fire JUST before this alarm(0)
-\& alarm(0); # cancel alarm (if code ran fast)
-\& die "$@" if $failed;
-\& 1;
-\& } or $failed = 1;
-\& if ( $failed ) {
-\& if ( defined $@ and $@ eq "TIMEOUT\en" ) { ... }
-\& else { ... } # some other error
-\& }
-.Ve
-.Sp
-The first (outer) eval is used to avoid the unlikely but possible
-chance that the \*(L"code to execute\*(R" dies and the alarm fires before it
-is cancelled. Without the outer eval, if this happened your program
-will die if you have no \s-1ALRM\s0 handler or a non-local alarm handler
-will be called.
-.Sp
-Unfortunately, as described above, this won't always work as expected,
-depending on your perl version and the underlying database code.
-.Sp
-With Oracle for instance (DBD::Oracle), if the system which hosts
-the database is down the \s-1DBI\-\s0>\fIconnect()\fR call will hang for several
-minutes before returning an error.
-.PP
-The solution on these systems is to use the \f(CW\*(C`POSIX::sigaction()\*(C'\fR
-routine to gain low level access to how the signal handler is installed.
-.PP
-The code would look something like this (for the DBD-Oracle \fIconnect()\fR):
-.PP
-.Vb 1
-\& use POSIX qw(:signal_h);
-\&
-\& my $mask = POSIX::SigSet\->new( SIGALRM ); # signals to mask in the handler
-\& my $action = POSIX::SigAction\->new(
-\& sub { die "connect timeout\en" }, # the handler code ref
-\& $mask,
-\& # not using (perl 5.8.2 and later) \*(Aqsafe\*(Aq switch or sa_flags
-\& );
-\& my $oldaction = POSIX::SigAction\->new();
-\& sigaction( SIGALRM, $action, $oldaction );
-\& my $dbh;
-\& my $failed;
-\& eval {
-\& eval {
-\& alarm(5); # seconds before time out
-\& $dbh = DBI\->connect("dbi:Oracle:$dsn" ... );
-\& 1;
-\& } or $failed = 1;
-\& alarm(0); # cancel alarm (if connect worked fast)
-\& die "$@\en" if $failed; # connect died
-\& 1;
-\& } or $failed = 1;
-\& sigaction( SIGALRM, $oldaction ); # restore original signal handler
-\& if ( $failed ) {
-\& if ( defined $@ and $@ eq "connect timeout\en" ) {...}
-\& else { # connect died }
-\& }
-.Ve
-.PP
-See previous example for the reasoning around the double eval.
-.PP
-Similar techniques can be used for canceling statement execution.
-.PP
-Unfortunately, this solution is somewhat messy, and it does \fInot\fR work with
-perl versions less than perl 5.8 where \f(CW\*(C`POSIX::sigaction()\*(C'\fR appears to be broken.
-.PP
-For a cleaner implementation that works across perl versions, see Lincoln Baxter's
-Sys::SigAction module at Sys::SigAction.
-The documentation for Sys::SigAction includes an longer discussion
-of this problem, and a DBD::Oracle test script.
-.PP
-Be sure to read all the signal handling sections of the perlipc manual.
-.PP
-And finally, two more points to keep firmly in mind. Firstly,
-remember that what we've done here is essentially revert to old
-style \fIunsafe\fR handling of these signals. So do as little as
-possible in the handler. Ideally just \fIdie()\fR. Secondly, the handles
-in use at the time the signal is handled may not be safe to use
-afterwards.
-.SS "Subclassing the \s-1DBI\s0"
-.IX Subsection "Subclassing the DBI"
-\&\s-1DBI\s0 can be subclassed and extended just like any other object
-oriented module. Before we talk about how to do that, it's important
-to be clear about the various \s-1DBI\s0 classes and how they work together.
-.PP
-By default \f(CW\*(C`$dbh = DBI\->connect(...)\*(C'\fR returns a \f(CW$dbh\fR blessed
-into the \f(CW\*(C`DBI::db\*(C'\fR class. And the \f(CW\*(C`$dbh\->prepare\*(C'\fR method
-returns an \f(CW$sth\fR blessed into the \f(CW\*(C`DBI::st\*(C'\fR class (actually it
-simply changes the last four characters of the calling handle class
-to be \f(CW\*(C`::st\*(C'\fR).
-.PP
-The leading '\f(CW\*(C`DBI\*(C'\fR' is known as the 'root class' and the extra
-\&'\f(CW\*(C`::db\*(C'\fR' or '\f(CW\*(C`::st\*(C'\fR' are the 'handle type suffixes'. If you want
-to subclass the \s-1DBI\s0 you'll need to put your overriding methods into
-the appropriate classes. For example, if you want to use a root class
-of \f(CW\*(C`MySubDBI\*(C'\fR and override the \fIdo()\fR, \fIprepare()\fR and \fIexecute()\fR methods,
-then your \fIdo()\fR and \fIprepare()\fR methods should be in the \f(CW\*(C`MySubDBI::db\*(C'\fR
-class and the \fIexecute()\fR method should be in the \f(CW\*(C`MySubDBI::st\*(C'\fR class.
-.PP
-To setup the inheritance hierarchy the \f(CW@ISA\fR variable in \f(CW\*(C`MySubDBI::db\*(C'\fR
-should include \f(CW\*(C`DBI::db\*(C'\fR and the \f(CW@ISA\fR variable in \f(CW\*(C`MySubDBI::st\*(C'\fR
-should include \f(CW\*(C`DBI::st\*(C'\fR. The \f(CW\*(C`MySubDBI\*(C'\fR root class itself isn't
-currently used for anything visible and so, apart from setting \f(CW@ISA\fR
-to include \f(CW\*(C`DBI\*(C'\fR, it can be left empty.
-.PP
-So, having put your overriding methods into the right classes, and
-setup the inheritance hierarchy, how do you get the \s-1DBI\s0 to use them?
-You have two choices, either a static method call using the name
-of your subclass:
-.PP
-.Vb 1
-\& $dbh = MySubDBI\->connect(...);
-.Ve
-.PP
-or specifying a \f(CW\*(C`RootClass\*(C'\fR attribute:
-.PP
-.Vb 1
-\& $dbh = DBI\->connect(..., { RootClass => \*(AqMySubDBI\*(Aq });
-.Ve
-.PP
-If both forms are used then the attribute takes precedence.
-.PP
-The only differences between the two are that using an explicit
-RootClass attribute will a) make the \s-1DBI\s0 automatically attempt to load
-a module by that name if the class doesn't exist, and b) won't call
-your \fIMySubDBI::connect()\fR method, if you have one.
-.PP
-When subclassing is being used then, after a successful new
-connect, the \s-1DBI\-\s0>connect method automatically calls:
-.PP
-.Vb 1
-\& $dbh\->connected($dsn, $user, $pass, \e%attr);
-.Ve
-.PP
-The default method does nothing. The call is made just to simplify
-any post-connection setup that your subclass may want to perform.
-The parameters are the same as passed to \s-1DBI\-\s0>connect.
-If your subclass supplies a connected method, it should be part of the
-MySubDBI::db package.
-.PP
-One more thing to note: you must let the \s-1DBI\s0 do the handle creation. If you
-want to override the \fIconnect()\fR method in your *::dr class then it must still
-call SUPER::connect to get a \f(CW$dbh\fR to work with. Similarly, an overridden
-\&\fIprepare()\fR method in *::db must still call SUPER::prepare to get a \f(CW$sth\fR.
-If you try to create your own handles using \fIbless()\fR then you'll find the \s-1DBI\s0
-will reject them with an \*(L"is not a \s-1DBI\s0 handle (has no magic)\*(R" error.
-.PP
-Here's a brief example of a \s-1DBI\s0 subclass. A more thorough example
-can be found in \fIt/subclass.t\fR in the \s-1DBI\s0 distribution.
-.PP
-.Vb 1
-\& package MySubDBI;
-\&
-\& use strict;
-\&
-\& use DBI;
-\& use vars qw(@ISA);
-\& @ISA = qw(DBI);
-\&
-\& package MySubDBI::db;
-\& use vars qw(@ISA);
-\& @ISA = qw(DBI::db);
-\&
-\& sub prepare {
-\& my ($dbh, @args) = @_;
-\& my $sth = $dbh\->SUPER::prepare(@args)
-\& or return;
-\& $sth\->{private_mysubdbi_info} = { foo => \*(Aqbar\*(Aq };
-\& return $sth;
-\& }
-\&
-\& package MySubDBI::st;
-\& use vars qw(@ISA);
-\& @ISA = qw(DBI::st);
-\&
-\& sub fetch {
-\& my ($sth, @args) = @_;
-\& my $row = $sth\->SUPER::fetch(@args)
-\& or return;
-\& do_something_magical_with_row_data($row)
-\& or return $sth\->set_err(1234, "The magic failed", undef, "fetch");
-\& return $row;
-\& }
-.Ve
-.PP
-When calling a SUPER::method that returns a handle, be careful to
-check the return value before trying to do other things with it in
-your overridden method. This is especially important if you want to
-set a hash attribute on the handle, as Perl's autovivification will
-bite you by (in)conveniently creating an unblessed hashref, which your
-method will then return with usually baffling results later on like
-the error \*(L"dbih_getcom handle \s-1HASH\s0(0xa4451a8) is not a \s-1DBI\s0 handle (has
-no magic\*(R". It's best to check right after the call and return undef
-immediately on error, just like \s-1DBI\s0 would and just like the example
-above.
-.PP
-If your method needs to record an error it should call the \fIset_err()\fR
-method with the error code and error string, as shown in the example
-above. The error code and error string will be recorded in the
-handle and available via \f(CW\*(C`$h\->err\*(C'\fR and \f(CW$DBI::errstr\fR etc.
-The \fIset_err()\fR method always returns an undef or empty list as
-appropriate. Since your method should nearly always return an undef
-or empty list as soon as an error is detected it's handy to simply
-return what \fIset_err()\fR returns, as shown in the example above.
-.PP
-If the handle has \f(CW\*(C`RaiseError\*(C'\fR, \f(CW\*(C`PrintError\*(C'\fR, or \f(CW\*(C`HandleError\*(C'\fR
-etc. set then the \fIset_err()\fR method will honour them. This means
-that if \f(CW\*(C`RaiseError\*(C'\fR is set then \fIset_err()\fR won't return in the
-normal way but will 'throw an exception' that can be caught with
-an \f(CW\*(C`eval\*(C'\fR block.
-.PP
-You can stash private data into \s-1DBI\s0 handles
-via \f(CW\*(C`$h\->{private_..._*}\*(C'\fR. See the entry under \*(L"\s-1ATTRIBUTES
-COMMON TO ALL HANDLES\*(R"\s0 for info and important caveats.
-.SS "Memory Leaks"
-.IX Subsection "Memory Leaks"
-When tracking down memory leaks using tools like Devel::Leak
-you'll find that some \s-1DBI\s0 internals are reported as 'leaking' memory.
-This is very unlikely to be a real leak. The \s-1DBI\s0 has various caches to improve
-performance and the apparrent leaks are simply the normal operation of these
-caches.
-.PP
-The most frequent sources of the apparrent leaks are \*(L"ChildHandles\*(R",
-\&\*(L"prepare_cached\*(R" and \*(L"connect_cached\*(R".
-.PP
-For example http://stackoverflow.com/questions/13338308/perl\-dbi\-memory\-leak
-.PP
-Given how widely the \s-1DBI\s0 is used, you can rest assured that if a new release of
-the \s-1DBI\s0 did have a real leak it would be discovered, reported, and fixed
-immediately. The leak you're looking for is probably elsewhere. Good luck!
-.SH "TRACING"
-.IX Header "TRACING"
-The \s-1DBI\s0 has a powerful tracing mechanism built in. It enables you
-to see what's going on 'behind the scenes', both within the \s-1DBI\s0 and
-the drivers you're using.
-.SS "Trace Settings"
-.IX Subsection "Trace Settings"
-Which details are written to the trace output is controlled by a
-combination of a \fItrace level\fR, an integer from 0 to 15, and a set
-of \fItrace flags\fR that are either on or off. Together these are known
-as the \fItrace settings\fR and are stored together in a single integer.
-For normal use you only need to set the trace level, and generally
-only to a value between 1 and 4.
-.PP
-Each handle has its own trace settings, and so does the \s-1DBI.\s0
-When you call a method the \s-1DBI\s0 merges the handles settings into its
-own for the duration of the call: the trace flags of the handle are
-\&\s-1OR\s0'd into the trace flags of the \s-1DBI,\s0 and if the handle has a higher
-trace level then the \s-1DBI\s0 trace level is raised to match it.
-The previous \s-1DBI\s0 trace settings are restored when the called method
-returns.
-.SS "Trace Levels"
-.IX Subsection "Trace Levels"
-Trace \fIlevels\fR are as follows:
-.PP
-.Vb 8
-\& 0 \- Trace disabled.
-\& 1 \- Trace top\-level DBI method calls returning with results or errors.
-\& 2 \- As above, adding tracing of top\-level method entry with parameters.
-\& 3 \- As above, adding some high\-level information from the driver
-\& and some internal information from the DBI.
-\& 4 \- As above, adding more detailed information from the driver.
-\& This is the first level to trace all the rows being fetched.
-\& 5 to 15 \- As above but with more and more internal information.
-.Ve
-.PP
-Trace level 1 is best for a simple overview of what's happening.
-Trace levels 2 thru 4 a good choice for general purpose tracing.
-Levels 5 and above are best reserved for investigating a specific
-problem, when you need to see \*(L"inside\*(R" the driver and \s-1DBI.\s0
-.PP
-The trace output is detailed and typically very useful. Much of the
-trace output is formatted using the \*(L"neat\*(R" function, so strings
-in the trace output may be edited and truncated by that function.
-.SS "Trace Flags"
-.IX Subsection "Trace Flags"
-Trace \fIflags\fR are used to enable tracing of specific activities
-within the \s-1DBI\s0 and drivers. The \s-1DBI\s0 defines some trace flags and
-drivers can define others. \s-1DBI\s0 trace flag names begin with a capital
-letter and driver specific names begin with a lowercase letter, as
-usual.
-.PP
-Currently the \s-1DBI\s0 defines these trace flags:
-.PP
-.Vb 10
-\& ALL \- turn on all DBI and driver flags (not recommended)
-\& SQL \- trace SQL statements executed
-\& (not yet implemented in DBI but implemented in some DBDs)
-\& CON \- trace connection process
-\& ENC \- trace encoding (unicode translations etc)
-\& (not yet implemented in DBI but implemented in some DBDs)
-\& DBD \- trace only DBD messages
-\& (not implemented by all DBDs yet)
-\& TXN \- trace transactions
-\& (not implemented in all DBDs yet)
-.Ve
-.PP
-The \*(L"parse_trace_flags\*(R" and \*(L"parse_trace_flag\*(R" methods are used
-to convert trace flag names into the corresponding integer bit flags.
-.SS "Enabling Trace"
-.IX Subsection "Enabling Trace"
-The \f(CW\*(C`$h\->trace\*(C'\fR method sets the trace settings for a handle
-and \f(CW\*(C`DBI\->trace\*(C'\fR does the same for the \s-1DBI.\s0
-.PP
-In addition to the \*(L"trace\*(R" method, you can enable the same trace
-information, and direct the output to a file, by setting the
-\&\f(CW\*(C`DBI_TRACE\*(C'\fR environment variable before starting Perl.
-See \*(L"\s-1DBI_TRACE\*(R"\s0 for more information.
-.PP
-Finally, you can set, or get, the trace settings for a handle using
-the \f(CW\*(C`TraceLevel\*(C'\fR attribute.
-.PP
-All of those methods use \fIparse_trace_flags()\fR and so allow you set
-both the trace level and multiple trace flags by using a string
-containing the trace level and/or flag names separated by vertical
-bar ("\f(CW\*(C`|\*(C'\fR\*(L") or comma (\*(R"\f(CW\*(C`,\*(C'\fR") characters. For example:
-.PP
-.Vb 1
-\& local $h\->{TraceLevel} = "3|SQL|foo";
-.Ve
-.SS "Trace Output"
-.IX Subsection "Trace Output"
-Initially trace output is written to \f(CW\*(C`STDERR\*(C'\fR. Both the
-\&\f(CW\*(C`$h\->trace\*(C'\fR and \f(CW\*(C`DBI\->trace\*(C'\fR methods take an optional
-\&\f(CW$trace_file\fR parameter, which may be either the name of a file to be
-opened by \s-1DBI\s0 in append mode, or a reference to an existing writable
-(possibly layered) filehandle. If \f(CW$trace_file\fR is a filename,
-and can be opened in append mode, or \f(CW$trace_file\fR is a writable
-filehandle, then \fIall\fR trace output (currently including that from
-other handles) is redirected to that file. A warning is generated
-if \f(CW$trace_file\fR can't be opened or is not writable.
-.PP
-Further calls to \fItrace()\fR without \f(CW$trace_file\fR do not alter where
-the trace output is sent. If \f(CW$trace_file\fR is undefined, then
-trace output is sent to \f(CW\*(C`STDERR\*(C'\fR and, if the prior trace was opened with
-\&\f(CW$trace_file\fR as a filename, the previous trace file is closed; if \f(CW$trace_file\fR was
-a filehandle, the filehandle is \fBnot\fR closed.
-.PP
-\&\fB\s-1NOTE\s0\fR: If \f(CW$trace_file\fR is specified as a filehandle, the filehandle
-should not be closed until all \s-1DBI\s0 operations are completed, or the
-application has reset the trace file via another call to
-\&\f(CW\*(C`trace()\*(C'\fR that changes the trace file.
-.SS "Tracing to Layered Filehandles"
-.IX Subsection "Tracing to Layered Filehandles"
-\&\fB\s-1NOTE\s0\fR:
-.IP "\(bu" 4
-Tied filehandles are not currently supported, as
-tie operations are not available to the PerlIO
-methods used by the \s-1DBI.\s0
-.IP "\(bu" 4
-PerlIO layer support requires Perl version 5.8 or higher.
-.PP
-As of version 5.8, Perl provides the ability to layer various
-\&\*(L"disciplines\*(R" on an open filehandle via the PerlIO module.
-.PP
-A simple example of using PerlIO layers is to use a scalar as the output:
-.PP
-.Vb 3
-\& my $scalar = \*(Aq\*(Aq;
-\& open( my $fh, "+>:scalar", \e$scalar );
-\& $dbh\->trace( 2, $fh );
-.Ve
-.PP
-Now all trace output is simply appended to \f(CW$scalar\fR.
-.PP
-A more complex application of tracing to a layered filehandle is the
-use of a custom layer (\fIRefer to \fRPerlio::via \fIfor details
-on creating custom PerlIO layers.\fR). Consider an application with the
-following logger module:
-.PP
-.Vb 1
-\& package MyFancyLogger;
-\&
-\& sub new
-\& {
-\& my $self = {};
-\& my $fh;
-\& open $fh, \*(Aq>\*(Aq, \*(Aqfancylog.log\*(Aq;
-\& $self\->{_fh} = $fh;
-\& $self\->{_buf} = \*(Aq\*(Aq;
-\& return bless $self, shift;
-\& }
-\&
-\& sub log
-\& {
-\& my $self = shift;
-\& return unless exists $self\->{_fh};
-\& my $fh = $self\->{_fh};
-\& $self\->{_buf} .= shift;
-\& #
-\& # DBI feeds us pieces at a time, so accumulate a complete line
-\& # before outputing
-\& #
-\& print $fh "At ", scalar localtime(), \*(Aq:\*(Aq, $self\->{_buf}, "\en" and
-\& $self\->{_buf} = \*(Aq\*(Aq
-\& if $self\->{_buf}=~tr/\en//;
-\& }
-\&
-\& sub close {
-\& my $self = shift;
-\& return unless exists $self\->{_fh};
-\& my $fh = $self\->{_fh};
-\& print $fh "At ", scalar localtime(), \*(Aq:\*(Aq, $self\->{_buf}, "\en" and
-\& $self\->{_buf} = \*(Aq\*(Aq
-\& if $self\->{_buf};
-\& close $fh;
-\& delete $self\->{_fh};
-\& }
-\&
-\& 1;
-.Ve
-.PP
-To redirect \s-1DBI\s0 traces to this logger requires creating
-a package for the layer:
-.PP
-.Vb 1
-\& package PerlIO::via::MyFancyLogLayer;
-\&
-\& sub PUSHED
-\& {
-\& my ($class,$mode,$fh) = @_;
-\& my $logger;
-\& return bless \e$logger,$class;
-\& }
-\&
-\& sub OPEN {
-\& my ($self, $path, $mode, $fh) = @_;
-\& #
-\& # $path is actually our logger object
-\& #
-\& $$self = $path;
-\& return 1;
-\& }
-\&
-\& sub WRITE
-\& {
-\& my ($self, $buf, $fh) = @_;
-\& $$self\->log($buf);
-\& return length($buf);
-\& }
-\&
-\& sub CLOSE {
-\& my $self = shift;
-\& $$self\->close();
-\& return 0;
-\& }
-\&
-\& 1;
-.Ve
-.PP
-The application can then cause \s-1DBI\s0 traces to be routed to the
-logger using
-.PP
-.Vb 1
-\& use PerlIO::via::MyFancyLogLayer;
-\&
-\& open my $fh, \*(Aq>:via(MyFancyLogLayer)\*(Aq, MyFancyLogger\->new();
-\&
-\& $dbh\->trace(\*(AqSQL\*(Aq, $fh);
-.Ve
-.PP
-Now all trace output will be processed by MyFancyLogger's
-\&\fIlog()\fR method.
-.SS "Trace Content"
-.IX Subsection "Trace Content"
-Many of the values embedded in trace output are formatted using the \fIneat()\fR
-utility function. This means they may be quoted, sanitized, and possibly
-truncated if longer than \f(CW$DBI::neat_maxlen\fR. See \*(L"neat\*(R" for more details.
-.SS "Tracing Tips"
-.IX Subsection "Tracing Tips"
-You can add tracing to your own application code using the \*(L"trace_msg\*(R" method.
-.PP
-It can sometimes be handy to compare trace files from two different runs of the
-same script. However using a tool like \f(CW\*(C`diff\*(C'\fR on the original log output
-doesn't work well because the trace file is full of object addresses that may
-differ on each run.
-.PP
-The \s-1DBI\s0 includes a handy utility called dbilogstrip that can be used to
-\&'normalize' the log content. It can be used as a filter like this:
-.PP
-.Vb 3
-\& DBI_TRACE=2 perl yourscript.pl ...args1... 2>&1 | dbilogstrip > dbitrace1.log
-\& DBI_TRACE=2 perl yourscript.pl ...args2... 2>&1 | dbilogstrip > dbitrace2.log
-\& diff \-u dbitrace1.log dbitrace2.log
-.Ve
-.PP
-See dbilogstrip for more information.
-.SH "DBI ENVIRONMENT VARIABLES"
-.IX Header "DBI ENVIRONMENT VARIABLES"
-The \s-1DBI\s0 module recognizes a number of environment variables, but most of
-them should not be used most of the time.
-It is better to be explicit about what you are doing to avoid the need
-for environment variables, especially in a web serving system where web
-servers are stingy about which environment variables are available.
-.SS "\s-1DBI_DSN\s0"
-.IX Subsection "DBI_DSN"
-The \s-1DBI_DSN\s0 environment variable is used by \s-1DBI\-\s0>connect if you do not
-specify a data source when you issue the connect.
-It should have a format such as \*(L"dbi:Driver:databasename\*(R".
-.SS "\s-1DBI_DRIVER\s0"
-.IX Subsection "DBI_DRIVER"
-The \s-1DBI_DRIVER\s0 environment variable is used to fill in the database
-driver name in \s-1DBI\-\s0>connect if the data source string starts \*(L"dbi::\*(R"
-(thereby omitting the driver).
-If \s-1DBI_DSN\s0 omits the driver name, \s-1DBI_DRIVER\s0 can fill the gap.
-.SS "\s-1DBI_AUTOPROXY\s0"
-.IX Subsection "DBI_AUTOPROXY"
-The \s-1DBI_AUTOPROXY\s0 environment variable takes a string value that starts
-\&\*(L"dbi:Proxy:\*(R" and is typically followed by \*(L"hostname=...;port=...\*(R".
-It is used to alter the behaviour of \s-1DBI\-\s0>connect.
-For full details, see DBI::Proxy documentation.
-.SS "\s-1DBI_USER\s0"
-.IX Subsection "DBI_USER"
-The \s-1DBI_USER\s0 environment variable takes a string value that is used as
-the user name if the \s-1DBI\-\s0>connect call is given undef (as distinct from
-an empty string) as the username argument.
-Be wary of the security implications of using this.
-.SS "\s-1DBI_PASS\s0"
-.IX Subsection "DBI_PASS"
-The \s-1DBI_PASS\s0 environment variable takes a string value that is used as
-the password if the \s-1DBI\-\s0>connect call is given undef (as distinct from
-an empty string) as the password argument.
-Be extra wary of the security implications of using this.
-.SS "\s-1DBI_DBNAME \s0(obsolete)"
-.IX Subsection "DBI_DBNAME (obsolete)"
-The \s-1DBI_DBNAME\s0 environment variable takes a string value that is used only when the
-obsolescent style of \s-1DBI\-\s0>connect (with driver name as fourth parameter) is used, and
-when no value is provided for the first (database name) argument.
-.SS "\s-1DBI_TRACE\s0"
-.IX Subsection "DBI_TRACE"
-The \s-1DBI_TRACE\s0 environment variable specifies the global default
-trace settings for the \s-1DBI\s0 at startup. Can also be used to direct
-trace output to a file. When the \s-1DBI\s0 is loaded it does:
-.PP
-.Vb 1
-\& DBI\->trace(split /=/, $ENV{DBI_TRACE}, 2) if $ENV{DBI_TRACE};
-.Ve
-.PP
-So if \f(CW\*(C`DBI_TRACE\*(C'\fR contains an "\f(CW\*(C`=\*(C'\fR" character then what follows
-it is used as the name of the file to append the trace to.
-.PP
-output appended to that file. If the name begins with a number
-followed by an equal sign (\f(CW\*(C`=\*(C'\fR), then the number and the equal sign are
-stripped off from the name, and the number is used to set the trace
-level. For example:
-.PP
-.Vb 1
-\& DBI_TRACE=1=dbitrace.log perl your_test_script.pl
-.Ve
-.PP
-On Unix-like systems using a Bourne-like shell, you can do this easily
-on the command line:
-.PP
-.Vb 1
-\& DBI_TRACE=2 perl your_test_script.pl
-.Ve
-.PP
-See \*(L"\s-1TRACING\*(R"\s0 for more information.
-.SS "\s-1PERL_DBI_DEBUG \s0(obsolete)"
-.IX Subsection "PERL_DBI_DEBUG (obsolete)"
-An old variable that should no longer be used; equivalent to \s-1DBI_TRACE.\s0
-.SS "\s-1DBI_PROFILE\s0"
-.IX Subsection "DBI_PROFILE"
-The \s-1DBI_PROFILE\s0 environment variable can be used to enable profiling
-of \s-1DBI\s0 method calls. See DBI::Profile for more information.
-.SS "\s-1DBI_PUREPERL\s0"
-.IX Subsection "DBI_PUREPERL"
-The \s-1DBI_PUREPERL\s0 environment variable can be used to enable the
-use of DBI::PurePerl. See DBI::PurePerl for more information.
-.SH "WARNING AND ERROR MESSAGES"
-.IX Header "WARNING AND ERROR MESSAGES"
-.SS "Fatal Errors"
-.IX Subsection "Fatal Errors"
-.ie n .IP "Can't call method ""prepare"" without a package or object reference" 4
-.el .IP "Can't call method ``prepare'' without a package or object reference" 4
-.IX Item "Can't call method prepare without a package or object reference"
-The \f(CW$dbh\fR handle you're using to call \f(CW\*(C`prepare\*(C'\fR is probably undefined because
-the preceding \f(CW\*(C`connect\*(C'\fR failed. You should always check the return status of
-\&\s-1DBI\s0 methods, or use the \*(L"RaiseError\*(R" attribute.
-.ie n .IP "Can't call method ""execute"" without a package or object reference" 4
-.el .IP "Can't call method ``execute'' without a package or object reference" 4
-.IX Item "Can't call method execute without a package or object reference"
-The \f(CW$sth\fR handle you're using to call \f(CW\*(C`execute\*(C'\fR is probably undefined because
-the preceding \f(CW\*(C`prepare\*(C'\fR failed. You should always check the return status of
-\&\s-1DBI\s0 methods, or use the \*(L"RaiseError\*(R" attribute.
-.IP "\s-1DBI/DBD\s0 internal version mismatch" 4
-.IX Item "DBI/DBD internal version mismatch"
-The \s-1DBD\s0 driver module was built with a different version of \s-1DBI\s0 than
-the one currently being used. You should rebuild the \s-1DBD\s0 module under
-the current version of \s-1DBI.\s0
-.Sp
-(Some rare platforms require \*(L"static linking\*(R". On those platforms, there
-may be an old \s-1DBI\s0 or \s-1DBD\s0 driver version actually embedded in the Perl
-executable being used.)
-.IP "\s-1DBD\s0 driver has not implemented the AutoCommit attribute" 4
-.IX Item "DBD driver has not implemented the AutoCommit attribute"
-The \s-1DBD\s0 driver implementation is incomplete. Consult the author.
-.ie n .IP "Can't [sg]et %s\->{%s}: unrecognised attribute" 4
-.el .IP "Can't [sg]et \f(CW%s\fR\->{%s}: unrecognised attribute" 4
-.IX Item "Can't [sg]et %s->{%s}: unrecognised attribute"
-You attempted to set or get an unknown attribute of a handle. Make
-sure you have spelled the attribute name correctly; case is significant
-(e.g., \*(L"Autocommit\*(R" is not the same as \*(L"AutoCommit\*(R").
-.SH "Pure-Perl DBI"
-.IX Header "Pure-Perl DBI"
-A pure-perl emulation of the \s-1DBI\s0 is included in the distribution
-for people using pure-perl drivers who, for whatever reason, can't
-install the compiled \s-1DBI.\s0 See DBI::PurePerl.
-.SH "SEE ALSO"
-.IX Header "SEE ALSO"
-.SS "Driver and Database Documentation"
-.IX Subsection "Driver and Database Documentation"
-Refer to the documentation for the \s-1DBD\s0 driver that you are using.
-.PP
-Refer to the \s-1SQL\s0 Language Reference Manual for the database engine that you are using.
-.SS "\s-1ODBC\s0 and \s-1SQL/CLI\s0 Standards Reference Information"
-.IX Subsection "ODBC and SQL/CLI Standards Reference Information"
-More detailed information about the semantics of certain \s-1DBI\s0 methods
-that are based on \s-1ODBC\s0 and \s-1SQL/CLI\s0 standards is available on-line
-via microsoft.com, for \s-1ODBC,\s0 and www.jtc1sc32.org for the \s-1SQL/CLI\s0
-standard:
-.PP
-.Vb 9
-\& DBI method ODBC function SQL/CLI Working Draft
-\& \-\-\-\-\-\-\-\-\-\- \-\-\-\-\-\-\-\-\-\-\-\-\- \-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-\-
-\& column_info SQLColumns Page 124
-\& foreign_key_info SQLForeignKeys Page 163
-\& get_info SQLGetInfo Page 214
-\& primary_key_info SQLPrimaryKeys Page 254
-\& table_info SQLTables Page 294
-\& type_info SQLGetTypeInfo Page 239
-\& statistics_info SQLStatistics
-.Ve
-.PP
-To find documentation on the \s-1ODBC\s0 function you can use
-the \s-1MSDN\s0 search facility at:
-.PP
-.Vb 1
-\& http://msdn.microsoft.com/Search
-.Ve
-.PP
-and search for something like \f(CW"SQLColumns returns"\fR.
-.PP
-And for \s-1SQL/CLI\s0 standard information on SQLColumns you'd read page 124 of
-the (very large) \s-1SQL/CLI\s0 Working Draft available from:
-.PP
-.Vb 1
-\& http://jtc1sc32.org/doc/N0701\-0750/32N0744T.pdf
-.Ve
-.SS "Standards Reference Information"
-.IX Subsection "Standards Reference Information"
-A hyperlinked, browsable version of the \s-1BNF\s0 syntax for \s-1SQL92 \s0(plus
-Oracle 7 \s-1SQL\s0 and \s-1PL/SQL\s0) is available here:
-.PP
-.Vb 1
-\& http://cui.unige.ch/db\-research/Enseignement/analyseinfo/SQL92/BNFindex.html
-.Ve
-.PP
-You can find more information about \s-1SQL\s0 standards online by searching for the
-appropriate standard names and numbers. For example, searching for
-\&\*(L"\s-1ANSI/ISO/IEC\s0 International Standard (\s-1IS\s0) Database Language \s-1SQL \-\s0 Part 1:
-SQL/Framework\*(R" you'll find a copy at:
-.PP
-.Vb 1
-\& ftp://ftp.iks\-jena.de/mitarb/lutz/standards/sql/ansi\-iso\-9075\-1\-1999.pdf
-.Ve
-.SS "Books and Articles"
-.IX Subsection "Books and Articles"
-Programming the Perl \s-1DBI,\s0 by Alligator Descartes and Tim Bunce.
-<http://books.perl.org/book/154>
-.PP
-Programming Perl 3rd Ed. by Larry Wall, Tom Christiansen & Jon Orwant.
-<http://books.perl.org/book/134>
-.PP
-Learning Perl by Randal Schwartz.
-<http://books.perl.org/book/101>
-.PP
-Details of many other books related to perl can be found at <http://books.perl.org>
-.SS "Perl Modules"
-.IX Subsection "Perl Modules"
-Index of \s-1DBI\s0 related modules available from \s-1CPAN:\s0
-.PP
-.Vb 3
-\& L<https://metacpan.org/search?q=DBD%3A%3A>
-\& L<https://metacpan.org/search?q=DBIx%3A%3A>
-\& L<https://metacpan.org/search?q=DBI>
-.Ve
-.PP
-For a good comparison of RDBMS-OO mappers and some OO-RDBMS mappers
-(including Class::DBI, Alzabo, and DBIx::RecordSet in the former
-category and Tangram and \s-1SPOPS\s0 in the latter) see the Perl
-Object-Oriented Persistence project pages at:
-.PP
-.Vb 1
-\& http://poop.sourceforge.net
-.Ve
-.PP
-A similar page for Java toolkits can be found at:
-.PP
-.Vb 1
-\& http://c2.com/cgi\-bin/wiki?ObjectRelationalToolComparison
-.Ve
-.SS "Mailing List"
-.IX Subsection "Mailing List"
-The \fIdbi-users\fR mailing list is the primary means of communication among
-users of the \s-1DBI\s0 and its related modules. For details send email to:
-.PP
-.Vb 1
-\& L<dbi\-users\-help@perl.org>
-.Ve
-.PP
-There are typically between 700 and 900 messages per month. You have
-to subscribe in order to be able to post. However you can opt for a
-\&'post\-only' subscription.
-.PP
-Mailing list archives (of variable quality) are held at:
-.PP
-.Vb 3
-\& http://groups.google.com/groups?group=perl.dbi.users
-\& http://www.xray.mpe.mpg.de/mailing\-lists/dbi/
-\& http://www.mail\-archive.com/dbi\-users%40perl.org/
-.Ve
-.SS "Assorted Related Links"
-.IX Subsection "Assorted Related Links"
-The \s-1DBI \s0\*(L"Home Page\*(R":
-.PP
-.Vb 1
-\& http://dbi.perl.org/
-.Ve
-.PP
-Other \s-1DBI\s0 related links:
-.PP
-.Vb 2
-\& http://www.perlmonks.org/?node=DBI%20recipes
-\& http://www.perlmonks.org/?node=Speeding%20up%20the%20DBI
-.Ve
-.PP
-Other database related links:
-.PP
-.Vb 1
-\& http://www.connectionstrings.com/
-.Ve
-.PP
-Security, especially the \*(L"\s-1SQL\s0 Injection\*(R" attack:
-.PP
-.Vb 2
-\& http://bobby\-tables.com/
-\& http://online.securityfocus.com/infocus/1644
-.Ve
-.SS "\s-1FAQ\s0"
-.IX Subsection "FAQ"
-See <http://faq.dbi\-support.com/>
-.SH "AUTHORS"
-.IX Header "AUTHORS"
-\&\s-1DBI\s0 by Tim Bunce, <http://www.tim.bunce.name>
-.PP
-This pod text by Tim Bunce, J. Douglas Dunlop, Jonathan Leffler and others.
-Perl by Larry Wall and the \f(CW\*(C`perl5\-porters\*(C'\fR.
-.SH "COPYRIGHT"
-.IX Header "COPYRIGHT"
-The \s-1DBI\s0 module is Copyright (c) 1994\-2012 Tim Bunce. Ireland.
-All rights reserved.
-.PP
-You may distribute under the terms of either the \s-1GNU\s0 General Public
-License or the Artistic License, as specified in the Perl 5.10.0 \s-1README\s0 file.
-.SH "SUPPORT / WARRANTY"
-.IX Header "SUPPORT / WARRANTY"
-The \s-1DBI\s0 is free Open Source software. \s-1IT COMES WITHOUT WARRANTY OF ANY KIND.\s0
-.SS "Support"
-.IX Subsection "Support"
-My consulting company, Data Plan Services, offers annual and
-multi-annual support contracts for the \s-1DBI.\s0 These provide sustained
-support for \s-1DBI\s0 development, and sustained value for you in return.
-Contact me for details.
-.SS "Sponsor Enhancements"
-.IX Subsection "Sponsor Enhancements"
-If your company would benefit from a specific new \s-1DBI\s0 feature,
-please consider sponsoring its development. Work is performed
-rapidly, and usually on a fixed-price payment-on-delivery basis.
-Contact me for details.
-.PP
-Using such targeted financing allows you to contribute to \s-1DBI\s0
-development, and rapidly get something specific and valuable in return.
-.SH "ACKNOWLEDGEMENTS"
-.IX Header "ACKNOWLEDGEMENTS"
-I would like to acknowledge the valuable contributions of the many
-people I have worked with on the \s-1DBI\s0 project, especially in the early
-years (1992\-1994). In no particular order: Kevin Stock, Buzz Moschetti,
-Kurt Andersen, Ted Lemon, William Hails, Garth Kennedy, Michael Peppler,
-Neil S. Briscoe, Jeff Urlwin, David J. Hughes, Jeff Stander,
-Forrest D Whitcher, Larry Wall, Jeff Fried, Roy Johnson, Paul Hudson,
-Georg Rehfeld, Steve Sizemore, Ron Pool, Jon Meek, Tom Christiansen,
-Steve Baumgarten, Randal Schwartz, and a whole lot more.
-.PP
-Then, of course, there are the poor souls who have struggled through
-untold and undocumented obstacles to actually implement \s-1DBI\s0 drivers.
-Among their ranks are Jochen Wiedmann, Alligator Descartes, Jonathan
-Leffler, Jeff Urlwin, Michael Peppler, Henrik Tougaard, Edwin Pratomo,
-Davide Migliavacca, Jan Pazdziora, Peter Haworth, Edmund Mergl, Steve
-Williams, Thomas Lowery, and Phlip Plumlee. Without them, the \s-1DBI\s0 would
-not be the practical reality it is today. I'm also especially grateful
-to Alligator Descartes for starting work on the first edition of the
-\&\*(L"Programming the Perl \s-1DBI\*(R"\s0 book and letting me jump on board.
-.PP
-The \s-1DBI\s0 and DBD::Oracle were originally developed while I was Technical
-Director (\s-1CTO\s0) of the Paul Ingram Group in the \s-1UK. \s0 So I'd especially like
-to thank Paul for his generosity and vision in supporting this work for many years.
-.PP
-A couple of specific \s-1DBI\s0 features have been sponsored by enlightened companies:
-.PP
-The development of the \fIswap_inner_handle()\fR method was sponsored by BizRate.com (<http://BizRate.com>)
-.PP
-The development of DBD::Gofer and related modules was sponsored by
-Shopzilla.com (<http://Shopzilla.com>), where I currently work.
-.SH "CONTRIBUTING"
-.IX Header "CONTRIBUTING"
-As you can see above, many people have contributed to the \s-1DBI\s0 and
-drivers in many ways over many years.
-.PP
-If you'd like to help then see <http://dbi.perl.org/contributing>.
-.PP
-If you'd like the \s-1DBI\s0 to do something new or different then a good way
-to make that happen is to do it yourself and send me a patch to the
-source code that shows the changes. (But read \*(L"Speak before you patch\*(R"
-below.)
-.SS "Browsing the source code repository"
-.IX Subsection "Browsing the source code repository"
-Use https://github.com/perl5\-dbi/dbi
-.SS "How to create a patch using Git"
-.IX Subsection "How to create a patch using Git"
-The \s-1DBI\s0 source code is maintained using Git. To access the source
-you'll need to install a Git client. Then, to get the source code, do:
-.PP
-.Vb 1
-\& git clone https://github.com/perl5\-dbi/dbi.git DBI\-git
-.Ve
-.PP
-The source code will now be available in the new subdirectory \f(CW\*(C`DBI\-git\*(C'\fR.
-.PP
-When you want to synchronize later, issue the command
-.PP
-.Vb 1
-\& git pull \-\-all
-.Ve
-.PP
-Make your changes, test them, test them again until everything passes.
-If there are no tests for the new feature you added or a behaviour change,
-the change should include a new test. Then commit the changes. Either use
-.PP
-.Vb 1
-\& git gui
-.Ve
-.PP
-or
-.PP
-.Vb 1
-\& git commit \-a \-m \*(AqMessage to my changes\*(Aq
-.Ve
-.PP
-If you get any conflicts reported you'll need to fix them first.
-.PP
-Then generate the patch file to be mailed:
-.PP
-.Vb 1
-\& git format\-patch \-1 \-\-attach
-.Ve
-.PP
-which will create a file 0001\-*.patch (where * relates to the commit message).
-Read the patch file, as a sanity check, and then email it to dbi\-dev@perl.org.
-.PP
-If you have a github <https://github.com> account, you can also fork the
-repository, commit your changes to the forked repository and then do a
-pull request.
-.SS "How to create a patch without Git"
-.IX Subsection "How to create a patch without Git"
-Unpack a fresh copy of the distribution:
-.PP
-.Vb 2
-\& wget http://cpan.metacpan.org/authors/id/T/TI/TIMB/DBI\-1.627.tar.gz
-\& tar xfz DBI\-1.627.tar.gz
-.Ve
-.PP
-Rename the newly created top level directory:
-.PP
-.Vb 1
-\& mv DBI\-1.627 DBI\-1.627.your_foo
-.Ve
-.PP
-Edit the contents of \s-1DBI\-1.627\s0.your_foo/* till it does what you want.
-.PP
-Test your changes and then remove all temporary files:
-.PP
-.Vb 1
-\& make test && make distclean
-.Ve
-.PP
-Go back to the directory you originally unpacked the distribution:
-.PP
-.Vb 1
-\& cd ..
-.Ve
-.PP
-Unpack \fIanother\fR copy of the original distribution you started with:
-.PP
-.Vb 1
-\& tar xfz DBI\-1.627.tar.gz
-.Ve
-.PP
-Then create a patch file by performing a recursive \f(CW\*(C`diff\*(C'\fR on the two
-top level directories:
-.PP
-.Vb 1
-\& diff \-purd DBI\-1.627 DBI\-1.627.your_foo > DBI\-1.627.your_foo.patch
-.Ve
-.SS "Speak before you patch"
-.IX Subsection "Speak before you patch"
-For anything non-trivial or possibly controversial it's a good idea
-to discuss (on dbi\-dev@perl.org) the changes you propose before
-actually spending time working on them. Otherwise you run the risk
-of them being rejected because they don't fit into some larger plans
-you may not be aware of.
-.PP
-You can also reach the developers on \s-1IRC \s0(chat). If they are on-line,
-the most likely place to talk to them is the #dbi channel on irc.perl.org
-.SH "TRANSLATIONS"
-.IX Header "TRANSLATIONS"
-A German translation of this manual (possibly slightly out of date) is
-available, thanks to O'Reilly, at:
-.PP
-.Vb 1
-\& http://www.oreilly.de/catalog/perldbiger/
-.Ve
-.SH "TRAINING"
-.IX Header "TRAINING"
-References to \s-1DBI\s0 related training resources. No recommendation implied.
-.PP
-.Vb 2
-\& http://www.treepax.co.uk/
-\& http://www.keller.com/dbweb/
-.Ve
-.PP
-(If you offer professional \s-1DBI\s0 related training services,
-please send me your details so I can add them here.)
-.SH "OTHER RELATED WORK AND PERL MODULES"
-.IX Header "OTHER RELATED WORK AND PERL MODULES"
-.IP "Apache::DBI" 4
-.IX Item "Apache::DBI"
-To be used with the Apache daemon together with an embedded Perl
-interpreter like \f(CW\*(C`mod_perl\*(C'\fR. Establishes a database connection which
-remains open for the lifetime of the \s-1HTTP\s0 daemon. This way the \s-1CGI\s0
-connect and disconnect for every database access becomes superfluous.
-.IP "\s-1SQL\s0 Parser" 4
-.IX Item "SQL Parser"
-See also the SQL::Statement module, \s-1SQL\s0 parser and engine.
+++ /dev/null
-.\" Automatically generated by Pod::Man 2.28 (Pod::Simple 3.29)
-.\"
-.\" Standard preamble:
-.\" ========================================================================
-.de Sp \" Vertical space (when we can't use .PP)
-.if t .sp .5v
-.if n .sp
-..
-.de Vb \" Begin verbatim text
-.ft CW
-.nf
-.ne \\$1
-..
-.de Ve \" End verbatim text
-.ft R
-.fi
-..
-.\" Set up some character translations and predefined strings. \*(-- will
-.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
-.\" double quote, and \*(R" will give a right double quote. \*(C+ will
-.\" give a nicer C++. Capital omega is used to do unbreakable dashes and
-.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff,
-.\" nothing in troff, for use with C<>.
-.tr \(*W-
-.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
-.ie n \{\
-. ds -- \(*W-
-. ds PI pi
-. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
-. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch
-. ds L" ""
-. ds R" ""
-. ds C` ""
-. ds C' ""
-'br\}
-.el\{\
-. ds -- \|\(em\|
-. ds PI \(*p
-. ds L" ``
-. ds R" ''
-. ds C`
-. ds C'
-'br\}
-.\"
-.\" Escape single quotes in literal strings from groff's Unicode transform.
-.ie \n(.g .ds Aq \(aq
-.el .ds Aq '
-.\"
-.\" If the F register is turned on, we'll generate index entries on stderr for
-.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
-.\" entries marked with X<> in POD. Of course, you'll have to process the
-.\" output yourself in some meaningful fashion.
-.\"
-.\" Avoid warning from groff about undefined register 'F'.
-.de IX
-..
-.nr rF 0
-.if \n(.g .if rF .nr rF 1
-.if (\n(rF:(\n(.g==0)) \{
-. if \nF \{
-. de IX
-. tm Index:\\$1\t\\n%\t"\\$2"
-..
-. if !\nF==2 \{
-. nr % 0
-. nr F 2
-. \}
-. \}
-.\}
-.rr rF
-.\" ========================================================================
-.\"
-.IX Title "DBI::Const::GetInfo::ANSI 3pm"
-.TH DBI::Const::GetInfo::ANSI 3pm "2015-05-26" "perl v5.22.1" "User Contributed Perl Documentation"
-.\" For nroff, turn off justification. Always turn off hyphenation; it makes
-.\" way too many mistakes in technical documents.
-.if n .ad l
-.nh
-.SH "NAME"
-DBI::Const::GetInfo::ANSI \- ISO/IEC SQL/CLI Constants for GetInfo
-.SH "SYNOPSIS"
-.IX Header "SYNOPSIS"
-.Vb 1
-\& The API for this module is private and subject to change.
-.Ve
-.SH "DESCRIPTION"
-.IX Header "DESCRIPTION"
-Information requested by \fIGetInfo()\fR.
-.PP
-See: A.1 C header file \s-1SQLCLI.H,\s0 Page 316, 317.
-.PP
-The \s-1API\s0 for this module is private and subject to change.
-.SH "REFERENCES"
-.IX Header "REFERENCES"
-.Vb 2
-\& ISO/IEC FCD 9075\-3:200x Information technology \- Database Languages \-
-\& SQL \- Part 3: Call\-Level Interface (SQL/CLI)
-\&
-\& SC32 N00744 = WG3:VIE\-005 = H2\-2002\-007
-\&
-\& Date: 2002\-01\-15
-.Ve
-.ie n .SS "%ReturnTypes"
-.el .SS "\f(CW%ReturnTypes\fP"
-.IX Subsection "%ReturnTypes"
-See: Codes and data types for implementation information (Table 28), Page 85, 86.
-.PP
-Mapped to \s-1ODBC\s0 datatype names.
-.ie n .SS "%ReturnValues"
-.el .SS "\f(CW%ReturnValues\fP"
-.IX Subsection "%ReturnValues"
-See: A.1 C header file \s-1SQLCLI.H,\s0 Page 317, 318.
-.SH "TODO"
-.IX Header "TODO"
-Corrections, e.g.:
-.PP
-.Vb 1
-\& SQL_TRANSACTION_ISOLATION_OPTION vs. SQL_TRANSACTION_ISOLATION
-.Ve
+++ /dev/null
-.\" Automatically generated by Pod::Man 2.28 (Pod::Simple 3.29)
-.\"
-.\" Standard preamble:
-.\" ========================================================================
-.de Sp \" Vertical space (when we can't use .PP)
-.if t .sp .5v
-.if n .sp
-..
-.de Vb \" Begin verbatim text
-.ft CW
-.nf
-.ne \\$1
-..
-.de Ve \" End verbatim text
-.ft R
-.fi
-..
-.\" Set up some character translations and predefined strings. \*(-- will
-.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
-.\" double quote, and \*(R" will give a right double quote. \*(C+ will
-.\" give a nicer C++. Capital omega is used to do unbreakable dashes and
-.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff,
-.\" nothing in troff, for use with C<>.
-.tr \(*W-
-.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
-.ie n \{\
-. ds -- \(*W-
-. ds PI pi
-. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
-. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch
-. ds L" ""
-. ds R" ""
-. ds C` ""
-. ds C' ""
-'br\}
-.el\{\
-. ds -- \|\(em\|
-. ds PI \(*p
-. ds L" ``
-. ds R" ''
-. ds C`
-. ds C'
-'br\}
-.\"
-.\" Escape single quotes in literal strings from groff's Unicode transform.
-.ie \n(.g .ds Aq \(aq
-.el .ds Aq '
-.\"
-.\" If the F register is turned on, we'll generate index entries on stderr for
-.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
-.\" entries marked with X<> in POD. Of course, you'll have to process the
-.\" output yourself in some meaningful fashion.
-.\"
-.\" Avoid warning from groff about undefined register 'F'.
-.de IX
-..
-.nr rF 0
-.if \n(.g .if rF .nr rF 1
-.if (\n(rF:(\n(.g==0)) \{
-. if \nF \{
-. de IX
-. tm Index:\\$1\t\\n%\t"\\$2"
-..
-. if !\nF==2 \{
-. nr % 0
-. nr F 2
-. \}
-. \}
-.\}
-.rr rF
-.\" ========================================================================
-.\"
-.IX Title "DBI::Const::GetInfo::ODBC 3pm"
-.TH DBI::Const::GetInfo::ODBC 3pm "2015-05-26" "perl v5.22.1" "User Contributed Perl Documentation"
-.\" For nroff, turn off justification. Always turn off hyphenation; it makes
-.\" way too many mistakes in technical documents.
-.if n .ad l
-.nh
-.SH "NAME"
-DBI::Const::GetInfo::ODBC \- ODBC Constants for GetInfo
-.SH "SYNOPSIS"
-.IX Header "SYNOPSIS"
-.Vb 1
-\& The API for this module is private and subject to change.
-.Ve
-.SH "DESCRIPTION"
-.IX Header "DESCRIPTION"
-Information requested by \fIGetInfo()\fR.
-.PP
-The \s-1API\s0 for this module is private and subject to change.
-.SH "REFERENCES"
-.IX Header "REFERENCES"
-.Vb 2
-\& MDAC SDK 2.6
-\& ODBC version number (0x0351)
-\&
-\& sql.h
-\& sqlext.h
-.Ve
-.ie n .SS "%ReturnTypes"
-.el .SS "\f(CW%ReturnTypes\fP"
-.IX Subsection "%ReturnTypes"
-See: mk:@MSITStore:X:\edm\ecli\emdac\esdk26\eDocs\eodbc.chm::/htm/odbcsqlgetinfo.htm
-.PP
-.Vb 2
-\& => : alias
-\& => !!! : edited
-.Ve
-.ie n .SS "%ReturnValues"
-.el .SS "\f(CW%ReturnValues\fP"
-.IX Subsection "%ReturnValues"
-See: sql.h, sqlext.h
-Edited:
- \s-1SQL_TXN_ISOLATION_OPTION\s0
-.SH "TODO"
-.IX Header "TODO"
-.Vb 3
-\& Corrections?
-\& SQL_NULL_COLLATION: ODBC vs ANSI
-\& Unique values for $ReturnValues{...}?, e.g. SQL_FILE_USAGE
-.Ve
+++ /dev/null
-.\" Automatically generated by Pod::Man 2.28 (Pod::Simple 3.29)
-.\"
-.\" Standard preamble:
-.\" ========================================================================
-.de Sp \" Vertical space (when we can't use .PP)
-.if t .sp .5v
-.if n .sp
-..
-.de Vb \" Begin verbatim text
-.ft CW
-.nf
-.ne \\$1
-..
-.de Ve \" End verbatim text
-.ft R
-.fi
-..
-.\" Set up some character translations and predefined strings. \*(-- will
-.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
-.\" double quote, and \*(R" will give a right double quote. \*(C+ will
-.\" give a nicer C++. Capital omega is used to do unbreakable dashes and
-.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff,
-.\" nothing in troff, for use with C<>.
-.tr \(*W-
-.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
-.ie n \{\
-. ds -- \(*W-
-. ds PI pi
-. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
-. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch
-. ds L" ""
-. ds R" ""
-. ds C` ""
-. ds C' ""
-'br\}
-.el\{\
-. ds -- \|\(em\|
-. ds PI \(*p
-. ds L" ``
-. ds R" ''
-. ds C`
-. ds C'
-'br\}
-.\"
-.\" Escape single quotes in literal strings from groff's Unicode transform.
-.ie \n(.g .ds Aq \(aq
-.el .ds Aq '
-.\"
-.\" If the F register is turned on, we'll generate index entries on stderr for
-.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
-.\" entries marked with X<> in POD. Of course, you'll have to process the
-.\" output yourself in some meaningful fashion.
-.\"
-.\" Avoid warning from groff about undefined register 'F'.
-.de IX
-..
-.nr rF 0
-.if \n(.g .if rF .nr rF 1
-.if (\n(rF:(\n(.g==0)) \{
-. if \nF \{
-. de IX
-. tm Index:\\$1\t\\n%\t"\\$2"
-..
-. if !\nF==2 \{
-. nr % 0
-. nr F 2
-. \}
-. \}
-.\}
-.rr rF
-.\" ========================================================================
-.\"
-.IX Title "DBI::Const::GetInfoReturn 3pm"
-.TH DBI::Const::GetInfoReturn 3pm "2013-06-24" "perl v5.22.1" "User Contributed Perl Documentation"
-.\" For nroff, turn off justification. Always turn off hyphenation; it makes
-.\" way too many mistakes in technical documents.
-.if n .ad l
-.nh
-.SH "NAME"
-DBI::Const::GetInfoReturn \- Data and functions for describing GetInfo results
-.SH "SYNOPSIS"
-.IX Header "SYNOPSIS"
-The interface to this module is undocumented and liable to change.
-.SH "DESCRIPTION"
-.IX Header "DESCRIPTION"
-Data and functions for describing GetInfo results
+++ /dev/null
-.\" Automatically generated by Pod::Man 2.28 (Pod::Simple 3.29)
-.\"
-.\" Standard preamble:
-.\" ========================================================================
-.de Sp \" Vertical space (when we can't use .PP)
-.if t .sp .5v
-.if n .sp
-..
-.de Vb \" Begin verbatim text
-.ft CW
-.nf
-.ne \\$1
-..
-.de Ve \" End verbatim text
-.ft R
-.fi
-..
-.\" Set up some character translations and predefined strings. \*(-- will
-.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
-.\" double quote, and \*(R" will give a right double quote. \*(C+ will
-.\" give a nicer C++. Capital omega is used to do unbreakable dashes and
-.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff,
-.\" nothing in troff, for use with C<>.
-.tr \(*W-
-.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
-.ie n \{\
-. ds -- \(*W-
-. ds PI pi
-. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
-. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch
-. ds L" ""
-. ds R" ""
-. ds C` ""
-. ds C' ""
-'br\}
-.el\{\
-. ds -- \|\(em\|
-. ds PI \(*p
-. ds L" ``
-. ds R" ''
-. ds C`
-. ds C'
-'br\}
-.\"
-.\" Escape single quotes in literal strings from groff's Unicode transform.
-.ie \n(.g .ds Aq \(aq
-.el .ds Aq '
-.\"
-.\" If the F register is turned on, we'll generate index entries on stderr for
-.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
-.\" entries marked with X<> in POD. Of course, you'll have to process the
-.\" output yourself in some meaningful fashion.
-.\"
-.\" Avoid warning from groff about undefined register 'F'.
-.de IX
-..
-.nr rF 0
-.if \n(.g .if rF .nr rF 1
-.if (\n(rF:(\n(.g==0)) \{
-. if \nF \{
-. de IX
-. tm Index:\\$1\t\\n%\t"\\$2"
-..
-. if !\nF==2 \{
-. nr % 0
-. nr F 2
-. \}
-. \}
-.\}
-.rr rF
-.\" ========================================================================
-.\"
-.IX Title "DBI::Const::GetInfoType 3pm"
-.TH DBI::Const::GetInfoType 3pm "2013-06-24" "perl v5.22.1" "User Contributed Perl Documentation"
-.\" For nroff, turn off justification. Always turn off hyphenation; it makes
-.\" way too many mistakes in technical documents.
-.if n .ad l
-.nh
-.SH "NAME"
-DBI::Const::GetInfoType \- Data describing GetInfo type codes
-.SH "SYNOPSIS"
-.IX Header "SYNOPSIS"
-.Vb 1
-\& use DBI::Const::GetInfoType;
-.Ve
-.SH "DESCRIPTION"
-.IX Header "DESCRIPTION"
-Imports a \f(CW%GetInfoType\fR hash which maps names for GetInfo Type Codes
-into their corresponding numeric values. For example:
-.PP
-.Vb 1
-\& $database_version = $dbh\->get_info( $GetInfoType{SQL_DBMS_VER} );
-.Ve
-.PP
-The interface to this module is new and nothing beyond what is
-written here is guaranteed.
+++ /dev/null
-.\" Automatically generated by Pod::Man 2.28 (Pod::Simple 3.29)
-.\"
-.\" Standard preamble:
-.\" ========================================================================
-.de Sp \" Vertical space (when we can't use .PP)
-.if t .sp .5v
-.if n .sp
-..
-.de Vb \" Begin verbatim text
-.ft CW
-.nf
-.ne \\$1
-..
-.de Ve \" End verbatim text
-.ft R
-.fi
-..
-.\" Set up some character translations and predefined strings. \*(-- will
-.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
-.\" double quote, and \*(R" will give a right double quote. \*(C+ will
-.\" give a nicer C++. Capital omega is used to do unbreakable dashes and
-.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff,
-.\" nothing in troff, for use with C<>.
-.tr \(*W-
-.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
-.ie n \{\
-. ds -- \(*W-
-. ds PI pi
-. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
-. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch
-. ds L" ""
-. ds R" ""
-. ds C` ""
-. ds C' ""
-'br\}
-.el\{\
-. ds -- \|\(em\|
-. ds PI \(*p
-. ds L" ``
-. ds R" ''
-. ds C`
-. ds C'
-'br\}
-.\"
-.\" Escape single quotes in literal strings from groff's Unicode transform.
-.ie \n(.g .ds Aq \(aq
-.el .ds Aq '
-.\"
-.\" If the F register is turned on, we'll generate index entries on stderr for
-.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
-.\" entries marked with X<> in POD. Of course, you'll have to process the
-.\" output yourself in some meaningful fashion.
-.\"
-.\" Avoid warning from groff about undefined register 'F'.
-.de IX
-..
-.nr rF 0
-.if \n(.g .if rF .nr rF 1
-.if (\n(rF:(\n(.g==0)) \{
-. if \nF \{
-. de IX
-. tm Index:\\$1\t\\n%\t"\\$2"
-..
-. if !\nF==2 \{
-. nr % 0
-. nr F 2
-. \}
-. \}
-.\}
-.rr rF
-.\" ========================================================================
-.\"
-.IX Title "DBI::DBD 3pm"
-.TH DBI::DBD 3pm "2016-04-21" "perl v5.22.1" "User Contributed Perl Documentation"
-.\" For nroff, turn off justification. Always turn off hyphenation; it makes
-.\" way too many mistakes in technical documents.
-.if n .ad l
-.nh
-.SH "NAME"
-DBI::DBD \- Perl DBI Database Driver Writer's Guide
-.SH "SYNOPSIS"
-.IX Header "SYNOPSIS"
-.Vb 1
-\& perldoc DBI::DBD
-.Ve
-.SS "Version and volatility"
-.IX Subsection "Version and volatility"
-This document is \fIstill\fR a minimal draft which is in need of further work.
-.PP
-Please read the \fB\s-1DBI\s0\fR documentation first and fully. Then look at the
-implementation of some high-profile and regularly maintained drivers like
-DBD::Oracle, \s-1DBD::ODBC,\s0 DBD::Pg etc. (Those are no no particular order.)
-.PP
-Then reread the \fB\s-1DBI\s0\fR specification and the code of those drivers again as
-you're reading this. It'll help. Where this document and the driver code
-differ it's likely that the driver code is more correct, especially if multiple
-drivers do the same thing.
-.PP
-This document is a patchwork of contributions from various authors.
-More contributions (preferably as patches) are very welcome.
-.SH "DESCRIPTION"
-.IX Header "DESCRIPTION"
-This document is primarily intended to help people writing new
-database drivers for the Perl Database Interface (Perl \s-1DBI\s0).
-It may also help others interested in discovering why the internals of
-a \fB\s-1DBD\s0\fR driver are written the way they are.
-.PP
-This is a guide. Few (if any) of the statements in it are completely
-authoritative under all possible circumstances. This means you will
-need to use judgement in applying the guidelines in this document.
-If in \fIany\fR doubt at all, please do contact the \fIdbi-dev\fR mailing list
-(details given below) where Tim Bunce and other driver authors can help.
-.SH "CREATING A NEW DRIVER"
-.IX Header "CREATING A NEW DRIVER"
-The first rule for creating a new database driver for the Perl \s-1DBI\s0 is
-very simple: \fB\s-1DON\s0'T!\fR
-.PP
-There is usually a driver already available for the database you want
-to use, almost regardless of which database you choose. Very often, the
-database will provide an \s-1ODBC\s0 driver interface, so you can often use
-\&\fB\s-1DBD::ODBC\s0\fR to access the database. This is typically less convenient
-on a Unix box than on a Microsoft Windows box, but there are numerous
-options for \s-1ODBC\s0 driver managers on Unix too, and very often the \s-1ODBC\s0
-driver is provided by the database supplier.
-.PP
-Before deciding that you need to write a driver, do your homework to
-ensure that you are not wasting your energies.
-.PP
-[As of December 2002, the consensus is that if you need an \s-1ODBC\s0 driver
-manager on Unix, then the unixODBC driver (available from
-<http://www.unixodbc.org/>) is the way to go.]
-.PP
-The second rule for creating a new database driver for the Perl \s-1DBI\s0 is
-also very simple: \fBDon't \*(-- get someone else to do it for you!\fR
-.PP
-Nevertheless, there are occasions when it is necessary to write a new
-driver, often to use a proprietary language or \s-1API\s0 to access the
-database more swiftly, or more comprehensively, than an \s-1ODBC\s0 driver can.
-Then you should read this document very carefully, but with a suitably
-sceptical eye.
-.PP
-If there is something in here that does not make any sense, question it.
-You might be right that the information is bogus, but don't come to that
-conclusion too quickly.
-.SS "URLs and mailing lists"
-.IX Subsection "URLs and mailing lists"
-The primary web-site for locating \fB\s-1DBI\s0\fR software and information is
-.PP
-.Vb 1
-\& http://dbi.perl.org/
-.Ve
-.PP
-There are two main and one auxiliary mailing lists for people working
-with \fB\s-1DBI\s0\fR. The primary lists are \fIdbi\-users@perl.org\fR for general users
-of \fB\s-1DBI\s0\fR and \fB\s-1DBD\s0\fR drivers, and \fIdbi\-dev@perl.org\fR mainly for \fB\s-1DBD\s0\fR driver
-writers (don't join the \fIdbi-dev\fR list unless you have a good reason).
-The auxiliary list is \fIdbi\-announce@perl.org\fR for announcing new
-releases of \fB\s-1DBI\s0\fR or \fB\s-1DBD\s0\fR drivers.
-.PP
-You can join these lists by accessing the web-site <http://dbi.perl.org/>.
-The lists are closed so you cannot send email to any of the lists
-unless you join the list first.
-.PP
-You should also consider monitoring the \fIcomp.lang.perl.*\fR newsgroups,
-especially \fIcomp.lang.perl.modules\fR.
-.SS "The Cheetah book"
-.IX Subsection "The Cheetah book"
-The definitive book on Perl \s-1DBI\s0 is the Cheetah book, so called because
-of the picture on the cover. Its proper title is '\fIProgramming the
-Perl \s-1DBI:\s0 Database programming with Perl\fR' by Alligator Descartes
-and Tim Bunce, published by O'Reilly Associates, February 2000, \s-1ISBN
-1\-56592\-699\-4.\s0 Buy it now if you have not already done so, and read it.
-.SS "Locating drivers"
-.IX Subsection "Locating drivers"
-Before writing a new driver, it is in your interests to find out
-whether there already is a driver for your database. If there is such
-a driver, it would be much easier to make use of it than to write your
-own!
-.PP
-The primary web-site for locating Perl software is
-<http://search.cpan.org/>. You should look under the various
-modules listings for the software you are after. For example:
-.PP
-.Vb 1
-\& http://search.cpan.org/modlist/Database_Interfaces
-.Ve
-.PP
-Follow the \fB\s-1DBD::\s0\fR and \fBDBIx::\fR links at the top to see those subsets.
-.PP
-See the \fB\s-1DBI\s0\fR docs for information on \fB\s-1DBI\s0\fR web sites and mailing lists.
-.SS "Registering a new driver"
-.IX Subsection "Registering a new driver"
-Before going through any official registration process, you will need
-to establish that there is no driver already in the works. You'll do
-that by asking the \fB\s-1DBI\s0\fR mailing lists whether there is such a driver
-available, or whether anybody is working on one.
-.PP
-When you get the go ahead, you will need to establish the name of the
-driver and a prefix for the driver. Typically, the name is based on the
-name of the database software it uses, and the prefix is a contraction
-of that. Hence, \fBDBD::Oracle\fR has the name \fIOracle\fR and the prefix
-\&'\fIora_\fR'. The prefix must be lowercase and contain no underscores other
-than the one at the end.
-.PP
-This information will be recorded in the \fB\s-1DBI\s0\fR module. Apart from
-documentation purposes, registration is a prerequisite for
-installing private methods.
-.PP
-If you are writing a driver which will not be distributed on \s-1CPAN,\s0 then
-you should choose a prefix beginning with '\fIx_\fR', to avoid potential
-prefix collisions with drivers registered in the future. Thus, if you
-wrote a non-CPAN distributed driver called \fBDBD::CustomDB\fR, the prefix
-might be '\fIx_cdb_\fR'.
-.PP
-This document assumes you are writing a driver called \fBDBD::Driver\fR, and
-that the prefix '\fIdrv_\fR' is assigned to the driver.
-.SS "Two styles of database driver"
-.IX Subsection "Two styles of database driver"
-There are two distinct styles of database driver that can be written to
-work with the Perl \s-1DBI.\s0
-.PP
-Your driver can be written in pure Perl, requiring no C compiler.
-When feasible, this is the best solution, but most databases are not
-written in such a way that this can be done. Some examples of pure
-Perl drivers are \fBDBD::File\fR and \fB\s-1DBD::CSV\s0\fR.
-.PP
-Alternatively, and most commonly, your driver will need to use some C
-code to gain access to the database. This will be classified as a C/XS
-driver.
-.SS "What code will you write?"
-.IX Subsection "What code will you write?"
-There are a number of files that need to be written for either a pure
-Perl driver or a C/XS driver. There are no extra files needed only by
-a pure Perl driver, but there are several extra files needed only by a
-C/XS driver.
-.PP
-\fIFiles common to pure Perl and C/XS drivers\fR
-.IX Subsection "Files common to pure Perl and C/XS drivers"
-.PP
-Assuming that your driver is called \fBDBD::Driver\fR, these files are:
-.IP "\(bu" 4
-\&\fIMakefile.PL\fR
-.IP "\(bu" 4
-\&\fI\s-1META\s0.yml\fR
-.IP "\(bu" 4
-\&\fI\s-1README\s0\fR
-.IP "\(bu" 4
-\&\fI\s-1MANIFEST\s0\fR
-.IP "\(bu" 4
-\&\fIDriver.pm\fR
-.IP "\(bu" 4
-\&\fIlib/Bundle/DBD/Driver.pm\fR
-.IP "\(bu" 4
-\&\fIlib/DBD/Driver/Summary.pm\fR
-.IP "\(bu" 4
-\&\fIt/*.t\fR
-.PP
-The first four files are mandatory. \fIMakefile.PL\fR is used to control
-how the driver is built and installed. The \fI\s-1README\s0\fR file tells people
-who download the file about how to build the module and any prerequisite
-software that must be installed. The \fI\s-1MANIFEST\s0\fR file is used by the
-standard Perl module distribution mechanism. It lists all the source
-files that need to be distributed with your module. \fIDriver.pm\fR is what
-is loaded by the \fB\s-1DBI\s0\fR code; it contains the methods peculiar to your
-driver.
-.PP
-Although the \fI\s-1META\s0.yml\fR file is not \fBrequired\fR you are advised to
-create one. Of particular importance are the \fIbuild_requires\fR and
-\&\fIconfigure_requires\fR attributes which newer \s-1CPAN\s0 modules understand.
-You use these to tell the \s-1CPAN\s0 module (and \s-1CPANPLUS\s0) that your build
-and configure mechanisms require \s-1DBI.\s0 The best reference for \s-1META\s0.yml
-(at the time of writing) is
-<http://module\-build.sourceforge.net/META\-spec\-v1.4.html>. You can find
-a reasonable example of a \fI\s-1META\s0.yml\fR in \s-1DBD::ODBC.\s0
-.PP
-The \fIlib/Bundle/DBD/Driver.pm\fR file allows you to specify other Perl
-modules on which yours depends in a format that allows someone to type a
-simple command and ensure that all the pre-requisites are in place as
-well as building your driver.
-.PP
-The \fIlib/DBD/Driver/Summary.pm\fR file contains (an updated version of) the
-information that was included \- or that would have been included \- in
-the appendices of the Cheetah book as a summary of the abilities of your
-driver and the associated database.
-.PP
-The files in the \fIt\fR subdirectory are unit tests for your driver.
-You should write your tests as stringently as possible, while taking
-into account the diversity of installations that you can encounter:
-.IP "\(bu" 4
-Your tests should not casually modify operational databases.
-.IP "\(bu" 4
-You should never damage existing tables in a database.
-.IP "\(bu" 4
-You should code your tests to use a constrained name space within the
-database. For example, the tables (and all other named objects) that are
-created could all begin with '\fIdbd_drv_\fR'.
-.IP "\(bu" 4
-At the end of a test run, there should be no testing objects left behind
-in the database.
-.IP "\(bu" 4
-If you create any databases, you should remove them.
-.IP "\(bu" 4
-If your database supports temporary tables that are automatically
-removed at the end of a session, then exploit them as often as possible.
-.IP "\(bu" 4
-Try to make your tests independent of each other. If you have a
-test \fIt/t11dowhat.t\fR that depends upon the successful running
-of \fIt/t10thingamy.t\fR, people cannot run the single test case
-\&\fIt/t11dowhat.t\fR. Further, running \fIt/t11dowhat.t\fR twice in a row is
-likely to fail (at least, if \fIt/t11dowhat.t\fR modifies the database at
-all) because the database at the start of the second run is not what you
-saw at the start of the first run.
-.IP "\(bu" 4
-Document in your \fI\s-1README\s0\fR file what you do, and what privileges people
-need to do it.
-.IP "\(bu" 4
-You can, and probably should, sequence your tests by including a test
-number before an abbreviated version of the test name; the tests are run
-in the order in which the names are expanded by shell-style globbing.
-.IP "\(bu" 4
-It is in your interests to ensure that your tests work as widely
-as possible.
-.PP
-Many drivers also install sub-modules \fBDBD::Driver::SubModule\fR
-for any of a variety of different reasons, such as to support
-the metadata methods (see the discussion of \*(L"\s-1METADATA METHODS\*(R"\s0
-below). Such sub-modules are conventionally stored in the directory
-\&\fIlib/DBD/Driver\fR. The module itself would usually be in a file
-\&\fISubModule.pm\fR. All such sub-modules should themselves be version
-stamped (see the discussions far below).
-.PP
-\fIExtra files needed by C/XS drivers\fR
-.IX Subsection "Extra files needed by C/XS drivers"
-.PP
-The software for a C/XS driver will typically contain at least four
-extra files that are not relevant to a pure Perl driver.
-.IP "\(bu" 4
-\&\fIDriver.xs\fR
-.IP "\(bu" 4
-\&\fIDriver.h\fR
-.IP "\(bu" 4
-\&\fIdbdimp.h\fR
-.IP "\(bu" 4
-\&\fIdbdimp.c\fR
-.PP
-The \fIDriver.xs\fR file is used to generate C code that Perl can call to gain
-access to the C functions you write that will, in turn, call down onto
-your database software.
-.PP
-The \fIDriver.h\fR header is a stylized header that ensures you can access the
-necessary Perl and \fB\s-1DBI\s0\fR macros, types, and function declarations.
-.PP
-The \fIdbdimp.h\fR is used to specify which functions have been implemented by
-your driver.
-.PP
-The \fIdbdimp.c\fR file is where you write the C code that does the real work
-of translating between Perl-ish data types and what the database expects
-to use and return.
-.PP
-There are some (mainly small, but very important) differences between
-the contents of \fIMakefile.PL\fR and \fIDriver.pm\fR for pure Perl and C/XS
-drivers, so those files are described both in the section on creating a
-pure Perl driver and in the section on creating a C/XS driver.
-.PP
-Obviously, you can add extra source code files to the list.
-.SS "Requirements on a driver and driver writer"
-.IX Subsection "Requirements on a driver and driver writer"
-To be remotely useful, your driver must be implemented in a format that
-allows it to be distributed via \s-1CPAN,\s0 the Comprehensive Perl Archive
-Network (<http://www.cpan.org/> and <http://search.cpan.org>).
-Of course, it is easier if you do not have to meet this criterion, but
-you will not be able to ask for much help if you do not do so, and
-no-one is likely to want to install your module if they have to learn a
-new installation mechanism.
-.SH "CREATING A PURE PERL DRIVER"
-.IX Header "CREATING A PURE PERL DRIVER"
-Writing a pure Perl driver is surprisingly simple. However, there are
-some problems you should be aware of. The best option is of course
-picking up an existing driver and carefully modifying one method
-after the other.
-.PP
-Also look carefully at \fBDBD::AnyData\fR and \fBDBD::Template\fR.
-.PP
-As an example we take a look at the \fBDBD::File\fR driver, a driver for
-accessing plain files as tables, which is part of the \fB\s-1DBD::CSV\s0\fR package.
-.PP
-The minimal set of files we have to implement are \fIMakefile.PL\fR,
-\&\fI\s-1README\s0\fR, \fI\s-1MANIFEST\s0\fR and \fIDriver.pm\fR.
-.SS "Pure Perl version of Makefile.PL"
-.IX Subsection "Pure Perl version of Makefile.PL"
-You typically start with writing \fIMakefile.PL\fR, a Makefile
-generator. The contents of this file are described in detail in
-the ExtUtils::MakeMaker man pages. It is definitely a good idea
-if you start reading them. At least you should know about the
-variables \fI\s-1CONFIGURE\s0\fR, \fI\s-1DEFINED\s0\fR, \fI\s-1PM\s0\fR, \fI\s-1DIR\s0\fR, \fI\s-1EXE_FILES\s0\fR,
-\&\fI\s-1INC\s0\fR, \fI\s-1LIBS\s0\fR, \fI\s-1LINKTYPE\s0\fR, \fI\s-1NAME\s0\fR, \fI\s-1OPTIMIZE\s0\fR, \fI\s-1PL_FILES\s0\fR,
-\&\fI\s-1VERSION\s0\fR, \fI\s-1VERSION_FROM\s0\fR, \fIclean\fR, \fIdepend\fR, \fIrealclean\fR from
-the ExtUtils::MakeMaker man page: these are used in almost any
-\&\fIMakefile.PL\fR.
-.PP
-Additionally read the section on \fIOverriding MakeMaker Methods\fR and the
-descriptions of the \fIdistcheck\fR, \fIdisttest\fR and \fIdist\fR targets: They
-will definitely be useful for you.
-.PP
-Of special importance for \fB\s-1DBI\s0\fR drivers is the \fIpostamble\fR method from
-the ExtUtils::MM_Unix man page.
-.PP
-For Emacs users, I recommend the \fIlibscan\fR method, which removes
-Emacs backup files (file names which end with a tilde '~') from lists of
-files.
-.PP
-Now an example, I use the word \f(CW\*(C`Driver\*(C'\fR wherever you should insert
-your driver's name:
-.PP
-.Vb 1
-\& # \-*\- perl \-*\-
-\&
-\& use ExtUtils::MakeMaker;
-\&
-\& WriteMakefile(
-\& dbd_edit_mm_attribs( {
-\& \*(AqNAME\*(Aq => \*(AqDBD::Driver\*(Aq,
-\& \*(AqVERSION_FROM\*(Aq => \*(AqDriver.pm\*(Aq,
-\& \*(AqINC\*(Aq => \*(Aq\*(Aq,
-\& \*(Aqdist\*(Aq => { \*(AqSUFFIX\*(Aq => \*(Aq.gz\*(Aq,
-\& \*(AqCOMPRESS\*(Aq => \*(Aqgzip \-9f\*(Aq },
-\& \*(Aqrealclean\*(Aq => { FILES => \*(Aq*.xsi\*(Aq },
-\& \*(AqPREREQ_PM\*(Aq => \*(Aq1.03\*(Aq,
-\& \*(AqCONFIGURE\*(Aq => sub {
-\& eval {require DBI::DBD;};
-\& if ($@) {
-\& warn $@;
-\& exit 0;
-\& }
-\& my $dbi_arch_dir = dbd_dbi_arch_dir();
-\& if (exists($opts{INC})) {
-\& return {INC => "$opts{INC} \-I$dbi_arch_dir"};
-\& } else {
-\& return {INC => "\-I$dbi_arch_dir"};
-\& }
-\& }
-\& },
-\& { create_pp_tests => 1})
-\& );
-\&
-\& package MY;
-\& sub postamble { return main::dbd_postamble(@_); }
-\& sub libscan {
-\& my ($self, $path) = @_;
-\& ($path =~ m/\e~$/) ? undef : $path;
-\& }
-.Ve
-.PP
-Note the calls to \f(CW\*(C`dbd_edit_mm_attribs()\*(C'\fR and \f(CW\*(C`dbd_postamble()\*(C'\fR.
-.PP
-The second hash reference in the call to \f(CW\*(C`dbd_edit_mm_attribs()\*(C'\fR
-(containing \f(CW\*(C`create_pp_tests()\*(C'\fR) is optional; you should not use it
-unless your driver is a pure Perl driver (that is, it does not use C and
-\&\s-1XS\s0 code). Therefore, the call to \f(CW\*(C`dbd_edit_mm_attribs()\*(C'\fR is not
-relevant for C/XS drivers and may be omitted; simply use the (single)
-hash reference containing \s-1NAME\s0 etc as the only argument to \f(CW\*(C`WriteMakefile()\*(C'\fR.
-.PP
-Note that the \f(CW\*(C`dbd_edit_mm_attribs()\*(C'\fR code will fail if you do not have a
-\&\fIt\fR sub-directory containing at least one test case.
-.PP
-\&\fI\s-1PREREQ_PM\s0\fR tells MakeMaker that \s-1DBI \s0(version 1.03 in this case) is
-required for this module. This will issue a warning that \s-1DBI 1.03\s0 is
-missing if someone attempts to install your \s-1DBD\s0 without \s-1DBI 1.03.\s0 See
-\&\fI\s-1CONFIGURE\s0\fR below for why this does not work reliably in stopping cpan
-testers failing your module if \s-1DBI\s0 is not installed.
-.PP
-\&\fI\s-1CONFIGURE\s0\fR is a subroutine called by MakeMaker during
-\&\f(CW\*(C`WriteMakefile\*(C'\fR. By putting the \f(CW\*(C`require DBI::DBD\*(C'\fR in this section
-we can attempt to load \s-1DBI::DBD\s0 but if it is missing we exit with
-success. As we exit successfully without creating a Makefile when
-\&\s-1DBI::DBD\s0 is missing cpan testers will not report a failure. This may
-seem at odds with \fI\s-1PREREQ_PM\s0\fR but \fI\s-1PREREQ_PM\s0\fR does not cause
-\&\f(CW\*(C`WriteMakefile\*(C'\fR to fail (unless you also specify \s-1PREREQ_FATAL\s0 which
-is strongly discouraged by MakeMaker) so \f(CW\*(C`WriteMakefile\*(C'\fR would
-continue to call \f(CW\*(C`dbd_dbi_arch_dir\*(C'\fR and fail.
-.PP
-All drivers must use \f(CW\*(C`dbd_postamble()\*(C'\fR or risk running into problems.
-.PP
-Note the specification of \fI\s-1VERSION_FROM\s0\fR; the named file
-(\fIDriver.pm\fR) will be scanned for the first line that looks like an
-assignment to \fI\f(CI$VERSION\fI\fR, and the subsequent text will be used to
-determine the version number. Note the commentary in
-ExtUtils::MakeMaker on the subject of correctly formatted version
-numbers.
-.PP
-If your driver depends upon external software (it usually will), you
-will need to add code to ensure that your environment is workable
-before the call to \f(CW\*(C`WriteMakefile()\*(C'\fR. If you need to check for the
-existence of an external library and perhaps modify \fI\s-1INC\s0\fR to include
-the paths to where the external library header files are located and
-you cannot find the library or header files make sure you output a
-message saying they cannot be found but \f(CW\*(C`exit 0\*(C'\fR (success) \fBbefore\fR
-calling \f(CW\*(C`WriteMakefile\*(C'\fR or \s-1CPAN\s0 testers will fail your module if the
-external library is not found.
-.PP
-A full-fledged \fIMakefile.PL\fR can be quite large (for example, the
-files for \fBDBD::Oracle\fR and \fBDBD::Informix\fR are both over 1000 lines
-long, and the Informix one uses \- and creates \- auxiliary modules
-too).
-.PP
-See also ExtUtils::MakeMaker and ExtUtils::MM_Unix. Consider using
-CPAN::MakeMaker in place of \fIExtUtils::MakeMaker\fR.
-.SS "\s-1README\s0"
-.IX Subsection "README"
-The \s-1README\s0 file should describe what the driver is for, the
-pre-requisites for the build process, the actual build process, how to
-report errors, and who to report them to.
-.PP
-Users will find ways of breaking the driver build and test process
-which you would never even have dreamed to be possible in your worst
-nightmares. Therefore, you need to write this document defensively,
-precisely and concisely.
-.PP
-As always, use the \fI\s-1README\s0\fR from one of the established drivers as a basis
-for your own; the version in \fBDBD::Informix\fR is worth a look as it has
-been quite successful in heading off problems.
-.IP "\(bu" 4
-Note that users will have versions of Perl and \fB\s-1DBI\s0\fR that are both older
-and newer than you expected, but this will seldom cause much trouble.
-When it does, it will be because you are using features of \fB\s-1DBI\s0\fR that are
-not supported in the version they are using.
-.IP "\(bu" 4
-Note that users will have versions of the database software that are
-both older and newer than you expected. You will save yourself time in
-the long run if you can identify the range of versions which have been
-tested and warn about versions which are not known to be \s-1OK.\s0
-.IP "\(bu" 4
-Note that many people trying to install your driver will not be experts
-in the database software.
-.IP "\(bu" 4
-Note that many people trying to install your driver will not be experts
-in C or Perl.
-.SS "\s-1MANIFEST\s0"
-.IX Subsection "MANIFEST"
-The \fI\s-1MANIFEST\s0\fR will be used by the Makefile's dist target to build the
-distribution tar file that is uploaded to \s-1CPAN.\s0 It should list every
-file that you want to include in your distribution, one per line.
-.SS "lib/Bundle/DBD/Driver.pm"
-.IX Subsection "lib/Bundle/DBD/Driver.pm"
-The \s-1CPAN\s0 module provides an extremely powerful bundle mechanism that
-allows you to specify pre-requisites for your driver.
-.PP
-The primary pre-requisite is \fBBundle::DBI\fR; you may want or need to add
-some more. With the bundle set up correctly, the user can type:
-.PP
-.Vb 1
-\& perl \-MCPAN \-e \*(Aqinstall Bundle::DBD::Driver\*(Aq
-.Ve
-.PP
-and Perl will download, compile, test and install all the Perl modules
-needed to build your driver.
-.PP
-The prerequisite modules are listed in the \f(CW\*(C`CONTENTS\*(C'\fR section, with the
-official name of the module followed by a dash and an informal name or
-description.
-.IP "\(bu" 4
-Listing \fBBundle::DBI\fR as the main pre-requisite simplifies life.
-.IP "\(bu" 4
-Don't forget to list your driver.
-.IP "\(bu" 4
-Note that unless the \s-1DBMS\s0 is itself a Perl module, you cannot list it as
-a pre-requisite in this file.
-.IP "\(bu" 4
-You should keep the version of the bundle the same as the version of
-your driver.
-.IP "\(bu" 4
-You should add configuration management, copyright, and licencing
-information at the top.
-.PP
-A suitable skeleton for this file is shown below.
-.PP
-.Vb 1
-\& package Bundle::DBD::Driver;
-\&
-\& $VERSION = \*(Aq0.01\*(Aq;
-\&
-\& 1;
-\&
-\& _\|_END_\|_
-\&
-\& =head1 NAME
-\&
-\& Bundle::DBD::Driver \- A bundle to install all DBD::Driver related modules
-\&
-\& =head1 SYNOPSIS
-\&
-\& C<perl \-MCPAN \-e \*(Aqinstall Bundle::DBD::Driver\*(Aq>
-\&
-\& =head1 CONTENTS
-\&
-\& Bundle::DBI \- Bundle for DBI by TIMB (Tim Bunce)
-\&
-\& DBD::Driver \- DBD::Driver by YOU (Your Name)
-\&
-\& =head1 DESCRIPTION
-\&
-\& This bundle includes all the modules used by the Perl Database
-\& Interface (DBI) driver for Driver (DBD::Driver), assuming the
-\& use of DBI version 1.13 or later, created by Tim Bunce.
-\&
-\& If you\*(Aqve not previously used the CPAN module to install any
-\& bundles, you will be interrogated during its setup phase.
-\& But when you\*(Aqve done it once, it remembers what you told it.
-\& You could start by running:
-\&
-\& C<perl \-MCPAN \-e \*(Aqinstall Bundle::CPAN\*(Aq>
-\&
-\& =head1 SEE ALSO
-\&
-\& Bundle::DBI
-\&
-\& =head1 AUTHOR
-\&
-\& Your Name E<lt>F<you@yourdomain.com>E<gt>
-\&
-\& =head1 THANKS
-\&
-\& This bundle was created by ripping off Bundle::libnet created by
-\& Graham Barr E<lt>F<gbarr@ti.com>E<gt>, and radically simplified
-\& with some information from Jochen Wiedmann E<lt>F<joe@ispsoft.de>E<gt>.
-\& The template was then included in the DBI::DBD documentation by
-\& Jonathan Leffler E<lt>F<jleffler@informix.com>E<gt>.
-\&
-\& =cut
-.Ve
-.SS "lib/DBD/Driver/Summary.pm"
-.IX Subsection "lib/DBD/Driver/Summary.pm"
-There is no substitute for taking the summary file from a driver that
-was documented in the Perl book (such as \fBDBD::Oracle\fR or \fBDBD::Informix\fR or
-\&\fB\s-1DBD::ODBC\s0\fR, to name but three), and adapting it to describe the
-facilities available via \fBDBD::Driver\fR when accessing the Driver database.
-.SS "Pure Perl version of Driver.pm"
-.IX Subsection "Pure Perl version of Driver.pm"
-The \fIDriver.pm\fR file defines the Perl module \fBDBD::Driver\fR for your driver.
-It will define a package \fBDBD::Driver\fR along with some version information,
-some variable definitions, and a function \f(CW\*(C`driver()\*(C'\fR which will have a more
-or less standard structure.
-.PP
-It will also define three sub-packages of \fBDBD::Driver\fR:
-.IP "DBD::Driver::dr" 4
-.IX Item "DBD::Driver::dr"
-with methods \f(CW\*(C`connect()\*(C'\fR, \f(CW\*(C`data_sources()\*(C'\fR and \f(CW\*(C`disconnect_all()\*(C'\fR;
-.IP "DBD::Driver::db" 4
-.IX Item "DBD::Driver::db"
-with methods such as \f(CW\*(C`prepare()\*(C'\fR;
-.IP "DBD::Driver::st" 4
-.IX Item "DBD::Driver::st"
-with methods such as \f(CW\*(C`execute()\*(C'\fR and \f(CW\*(C`fetch()\*(C'\fR.
-.PP
-The \fIDriver.pm\fR file will also contain the documentation specific to
-\&\fBDBD::Driver\fR in the format used by perldoc.
-.PP
-In a pure Perl driver, the \fIDriver.pm\fR file is the core of the
-implementation. You will need to provide all the key methods needed by \fB\s-1DBI\s0\fR.
-.PP
-Now let's take a closer look at an excerpt of \fIFile.pm\fR as an example.
-We ignore things that are common to any module (even non-DBI modules)
-or really specific to the \fBDBD::File\fR package.
-.PP
-\fIThe DBD::Driver package\fR
-.IX Subsection "The DBD::Driver package"
-.PP
-The header
-.IX Subsection "The header"
-.PP
-.Vb 1
-\& package DBD::File;
-\&
-\& use strict;
-\& use vars qw($VERSION $drh);
-\&
-\& $VERSION = "1.23.00" # Version number of DBD::File
-.Ve
-.PP
-This is where the version number of your driver is specified, and is
-where \fIMakefile.PL\fR looks for this information. Please ensure that any
-other modules added with your driver are also version stamped so that
-\&\s-1CPAN\s0 does not get confused.
-.PP
-It is recommended that you use a two-part (1.23) or three-part (1.23.45)
-version number. Also consider the \s-1CPAN\s0 system, which gets confused and
-considers version 1.10 to precede version 1.9, so that using a raw \s-1CVS,
-RCS\s0 or \s-1SCCS\s0 version number is probably not appropriate (despite being
-very common).
-.PP
-For Subversion you could use:
-.PP
-.Vb 1
-\& $VERSION = "12.012346";
-.Ve
-.PP
-(use lots of leading zeros on the second portion so if you move the code to a
-shared repository like svn.perl.org the much larger revision numbers won't
-cause a problem, at least not for a few years). For \s-1RCS\s0 or \s-1CVS\s0 you can use:
-.PP
-.Vb 1
-\& $VERSION = "11.22";
-.Ve
-.PP
-which pads out the fractional part with leading zeros so all is well
-(so long as you don't go past x.99)
-.PP
-.Vb 1
-\& $drh = undef; # holds driver handle once initialized
-.Ve
-.PP
-This is where the driver handle will be stored, once created.
-Note that you may assume there is only one handle for your driver.
-.PP
-The driver constructor
-.IX Subsection "The driver constructor"
-.PP
-The \f(CW\*(C`driver()\*(C'\fR method is the driver handle constructor. Note that
-the \f(CW\*(C`driver()\*(C'\fR method is in the \fBDBD::Driver\fR package, not in
-one of the sub-packages \fBDBD::Driver::dr\fR, \fBDBD::Driver::db\fR, or
-\&\fBDBD::Driver::db\fR.
-.PP
-.Vb 4
-\& sub driver
-\& {
-\& return $drh if $drh; # already created \- return same one
-\& my ($class, $attr) = @_;
-\&
-\& $class .= "::dr";
-\&
-\& DBD::Driver::db\->install_method(\*(Aqdrv_example_dbh_method\*(Aq);
-\& DBD::Driver::st\->install_method(\*(Aqdrv_example_sth_method\*(Aq);
-\&
-\& # not a \*(Aqmy\*(Aq since we use it above to prevent multiple drivers
-\& $drh = DBI::_new_drh($class, {
-\& \*(AqName\*(Aq => \*(AqFile\*(Aq,
-\& \*(AqVersion\*(Aq => $VERSION,
-\& \*(AqAttribution\*(Aq => \*(AqDBD::File by Jochen Wiedmann\*(Aq,
-\& })
-\& or return undef;
-\&
-\& return $drh;
-\& }
-.Ve
-.PP
-This is a reasonable example of how \fB\s-1DBI\s0\fR implements its handles. There
-are three kinds: \fBdriver handles\fR (typically stored in \fI\f(CI$drh\fI\fR; from
-now on called \fIdrh\fR or \fI\f(CI$drh\fI\fR), \fBdatabase handles\fR (from now on
-called \fIdbh\fR or \fI\f(CI$dbh\fI\fR) and \fBstatement handles\fR (from now on called
-\&\fIsth\fR or \fI\f(CI$sth\fI\fR).
-.PP
-The prototype of \f(CW\*(C`DBI::_new_drh()\*(C'\fR is
-.PP
-.Vb 1
-\& $drh = DBI::_new_drh($class, $public_attrs, $private_attrs);
-.Ve
-.PP
-with the following arguments:
-.ie n .IP "\fI\fI$class\fI\fR" 4
-.el .IP "\fI\f(CI$class\fI\fR" 4
-.IX Item "$class"
-is typically the class for your driver, (for example, \*(L"DBD::File::dr\*(R"),
-passed as the first argument to the \f(CW\*(C`driver()\*(C'\fR method.
-.ie n .IP "\fI\fI$public_attrs\fI\fR" 4
-.el .IP "\fI\f(CI$public_attrs\fI\fR" 4
-.IX Item "$public_attrs"
-is a hash ref to attributes like \fIName\fR, \fIVersion\fR, and \fIAttribution\fR.
-These are processed and used by \fB\s-1DBI\s0\fR. You had better not make any
-assumptions about them nor should you add private attributes here.
-.ie n .IP "\fI\fI$private_attrs\fI\fR" 4
-.el .IP "\fI\f(CI$private_attrs\fI\fR" 4
-.IX Item "$private_attrs"
-This is another (optional) hash ref with your private attributes.
-\&\fB\s-1DBI\s0\fR will store them and otherwise leave them alone.
-.PP
-The \f(CW\*(C`DBI::_new_drh()\*(C'\fR method and the \f(CW\*(C`driver()\*(C'\fR method both return \f(CW\*(C`undef\*(C'\fR
-for failure (in which case you must look at \fI\f(CI$DBI::err\fI\fR and \fI\f(CI$DBI::errstr\fI\fR
-for the failure information, because you have no driver handle to use).
-.PP
-Using \fIinstall_method()\fR to expose driver-private methods
-.IX Subsection "Using install_method() to expose driver-private methods"
-.PP
-.Vb 1
-\& DBD::Foo::db\->install_method($method_name, \e%attr);
-.Ve
-.PP
-Installs the driver-private method named by \f(CW$method_name\fR into the
-\&\s-1DBI\s0 method dispatcher so it can be called directly, avoiding the
-need to use the \fIfunc()\fR method.
-.PP
-It is called as a static method on the driver class to which the
-method belongs. The method name must begin with the corresponding
-registered driver-private prefix. For example, for DBD::Oracle
-\&\f(CW$method_name\fR must being with '\f(CW\*(C`ora_\*(C'\fR', and for DBD::AnyData it
-must begin with '\f(CW\*(C`ad_\*(C'\fR'.
-.PP
-The \f(CW\*(C`\e%attr\*(C'\fR attributes can be used to provide fine control over how the \s-1DBI\s0
-dispatcher handles the dispatching of the method. However it's undocumented
-at the moment. See the IMA_* #define's in \s-1DBI\s0.xs and the O=>0x000x values in
-the initialization of \f(CW%DBI::DBI_methods\fR in \s-1DBI\s0.pm. (Volunteers to polish up
-and document the interface are very welcome to get in touch via dbi\-dev@perl.org).
-.PP
-Methods installed using install_method default to the standard error
-handling behaviour for \s-1DBI\s0 methods: clearing err and errstr before
-calling the method, and checking for errors to trigger RaiseError
-etc. on return. This differs from the default behaviour of \fIfunc()\fR.
-.PP
-Note for driver authors: The DBD::Foo::xx\->install_method call won't
-work until the class-hierarchy has been setup. Normally the \s-1DBI\s0
-looks after that just after the driver is loaded. This means
-\&\fIinstall_method()\fR can't be called at the time the driver is loaded
-unless the class-hierarchy is set up first. The way to do that is
-to call the \fIsetup_driver()\fR method:
-.PP
-.Vb 1
-\& DBI\->setup_driver(\*(AqDBD::Foo\*(Aq);
-.Ve
-.PP
-before using \fIinstall_method()\fR.
-.PP
-The \s-1CLONE\s0 special subroutine
-.IX Subsection "The CLONE special subroutine"
-.PP
-Also needed here, in the \fBDBD::Driver\fR package, is a \f(CW\*(C`CLONE()\*(C'\fR method
-that will be called by perl when an interpreter is cloned. All your
-\&\f(CW\*(C`CLONE()\*(C'\fR method needs to do, currently, is clear the cached \fI\f(CI$drh\fI\fR so
-the new interpreter won't start using the cached \fI\f(CI$drh\fI\fR from the old
-interpreter:
-.PP
-.Vb 3
-\& sub CLONE {
-\& undef $drh;
-\& }
-.Ve
-.PP
-See <http://search.cpan.org/dist/perl/pod/perlmod.pod#Making_your_module_threadsafe>
-for details.
-.PP
-\fIThe DBD::Driver::dr package\fR
-.IX Subsection "The DBD::Driver::dr package"
-.PP
-The next lines of code look as follows:
-.PP
-.Vb 1
-\& package DBD::Driver::dr; # ====== DRIVER ======
-\&
-\& $DBD::Driver::dr::imp_data_size = 0;
-.Ve
-.PP
-Note that no \fI\f(CI@ISA\fI\fR is needed here, or for the other \fBDBD::Driver::*\fR
-classes, because the \fB\s-1DBI\s0\fR takes care of that for you when the driver is
-loaded.
-.PP
-.Vb 2
-\& *FIX ME* Explain what the imp_data_size is, so that implementors aren\*(Aqt
-\& practicing cargo\-cult programming.
-.Ve
-.PP
-The database handle constructor
-.IX Subsection "The database handle constructor"
-.PP
-The database handle constructor is the driver's (hence the changed
-namespace) \f(CW\*(C`connect()\*(C'\fR method:
-.PP
-.Vb 3
-\& sub connect
-\& {
-\& my ($drh, $dr_dsn, $user, $auth, $attr) = @_;
-\&
-\& # Some database specific verifications, default settings
-\& # and the like can go here. This should only include
-\& # syntax checks or similar stuff where it\*(Aqs legal to
-\& # \*(Aqdie\*(Aq in case of errors.
-\& # For example, many database packages requires specific
-\& # environment variables to be set; this could be where you
-\& # validate that they are set, or default them if they are not set.
-\&
-\& my $driver_prefix = "drv_"; # the assigned prefix for this driver
-\&
-\& # Process attributes from the DSN; we assume ODBC syntax
-\& # here, that is, the DSN looks like var1=val1;...;varN=valN
-\& foreach my $var ( split /;/, $dr_dsn ) {
-\& my ($attr_name, $attr_value) = split \*(Aq=\*(Aq, $var, 2;
-\& return $drh\->set_err($DBI::stderr, "Can\*(Aqt parse DSN part \*(Aq$var\*(Aq")
-\& unless defined $attr_value;
-\&
-\& # add driver prefix to attribute name if it doesn\*(Aqt have it already
-\& $attr_name = $driver_prefix.$attr_name
-\& unless $attr_name =~ /^$driver_prefix/o;
-\&
-\& # Store attribute into %$attr, replacing any existing value.
-\& # The DBI will STORE() these into $dbh after we\*(Aqve connected
-\& $attr\->{$attr_name} = $attr_value;
-\& }
-\&
-\& # Get the attributes we\*(Aqll use to connect.
-\& # We use delete here because these no need to STORE them
-\& my $db = delete $attr\->{drv_database} || delete $attr\->{drv_db}
-\& or return $drh\->set_err($DBI::stderr, "No database name given in DSN \*(Aq$dr_dsn\*(Aq");
-\& my $host = delete $attr\->{drv_host} || \*(Aqlocalhost\*(Aq;
-\& my $port = delete $attr\->{drv_port} || 123456;
-\&
-\& # Assume you can attach to your database via drv_connect:
-\& my $connection = drv_connect($db, $host, $port, $user, $auth)
-\& or return $drh\->set_err($DBI::stderr, "Can\*(Aqt connect to $dr_dsn: ...");
-\&
-\& # create a \*(Aqblank\*(Aq dbh (call superclass constructor)
-\& my ($outer, $dbh) = DBI::_new_dbh($drh, { Name => $dr_dsn });
-\&
-\& $dbh\->STORE(\*(AqActive\*(Aq, 1 );
-\& $dbh\->{drv_connection} = $connection;
-\&
-\& return $outer;
-\& }
-.Ve
-.PP
-This is mostly the same as in the \fIdriver handle constructor\fR above.
-The arguments are described in \s-1DBI\s0.
-.PP
-The constructor \f(CW\*(C`DBI::_new_dbh()\*(C'\fR is called, returning a database handle.
-The constructor's prototype is:
-.PP
-.Vb 1
-\& ($outer, $inner) = DBI::_new_dbh($drh, $public_attr, $private_attr);
-.Ve
-.PP
-with similar arguments to those in the \fIdriver handle constructor\fR,
-except that the \fI\f(CI$class\fI\fR is replaced by \fI\f(CI$drh\fI\fR. The \fIName\fR attribute
-is a standard \fB\s-1DBI\s0\fR attribute (see \*(L"Database Handle Attributes\*(R" in \s-1DBI\s0).
-.PP
-In scalar context, only the outer handle is returned.
-.PP
-Note the use of the \f(CW\*(C`STORE()\*(C'\fR method for setting the \fIdbh\fR attributes.
-That's because within the driver code, the handle object you have is
-the 'inner' handle of a tied hash, not the outer handle that the
-users of your driver have.
-.PP
-Because you have the inner handle, tie magic doesn't get invoked
-when you get or set values in the hash. This is often very handy for
-speed when you want to get or set simple non-special driver-specific
-attributes.
-.PP
-However, some attribute values, such as those handled by the \fB\s-1DBI\s0\fR like
-\&\fIPrintError\fR, don't actually exist in the hash and must be read via
-\&\f(CW\*(C`$h\->FETCH($attrib)\*(C'\fR and set via \f(CW\*(C`$h\->STORE($attrib, $value)\*(C'\fR.
-If in any doubt, use these methods.
-.PP
-The \fIdata_sources()\fR method
-.IX Subsection "The data_sources() method"
-.PP
-The \f(CW\*(C`data_sources()\*(C'\fR method must populate and return a list of valid data
-sources, prefixed with the "\fIdbi:Driver\fR" incantation that allows them to
-be used in the first argument of the \f(CW\*(C`DBI\->connect()\*(C'\fR method.
-An example of this might be scanning the \fI\f(CI$HOME\fI/.odbcini\fR file on Unix
-for \s-1ODBC\s0 data sources (DSNs).
-.PP
-As a trivial example, consider a fixed list of data sources:
-.PP
-.Vb 11
-\& sub data_sources
-\& {
-\& my($drh, $attr) = @_;
-\& my(@list) = ();
-\& # You need more sophisticated code than this to set @list...
-\& push @list, "dbi:Driver:abc";
-\& push @list, "dbi:Driver:def";
-\& push @list, "dbi:Driver:ghi";
-\& # End of code to set @list
-\& return @list;
-\& }
-.Ve
-.PP
-The \fIdisconnect_all()\fR method
-.IX Subsection "The disconnect_all() method"
-.PP
-If you need to release any resources when the driver is unloaded, you
-can provide a disconnect_all method.
-.PP
-Other driver handle methods
-.IX Subsection "Other driver handle methods"
-.PP
-If you need any other driver handle methods, they can follow here.
-.PP
-Error handling
-.IX Subsection "Error handling"
-.PP
-It is quite likely that something fails in the connect method.
-With \fBDBD::File\fR for example, you might catch an error when setting the
-current directory to something not existent by using the
-(driver-specific) \fIf_dir\fR attribute.
-.PP
-To report an error, you use the \f(CW\*(C`set_err()\*(C'\fR method:
-.PP
-.Vb 1
-\& $h\->set_err($err, $errmsg, $state);
-.Ve
-.PP
-This will ensure that the error is recorded correctly and that
-\&\fIRaiseError\fR and \fIPrintError\fR etc are handled correctly.
-.PP
-Typically you'll always use the method instance, aka your method's first
-argument.
-.PP
-As \f(CW\*(C`set_err()\*(C'\fR always returns \f(CW\*(C`undef\*(C'\fR your error handling code can
-usually be simplified to something like this:
-.PP
-.Vb 1
-\& return $h\->set_err($err, $errmsg, $state) if ...;
-.Ve
-.PP
-\fIThe DBD::Driver::db package\fR
-.IX Subsection "The DBD::Driver::db package"
-.PP
-.Vb 1
-\& package DBD::Driver::db; # ====== DATABASE ======
-\&
-\& $DBD::Driver::db::imp_data_size = 0;
-.Ve
-.PP
-The statement handle constructor
-.IX Subsection "The statement handle constructor"
-.PP
-There's nothing much new in the statement handle constructor, which
-is the \f(CW\*(C`prepare()\*(C'\fR method:
-.PP
-.Vb 3
-\& sub prepare
-\& {
-\& my ($dbh, $statement, @attribs) = @_;
-\&
-\& # create a \*(Aqblank\*(Aq sth
-\& my ($outer, $sth) = DBI::_new_sth($dbh, { Statement => $statement });
-\&
-\& $sth\->STORE(\*(AqNUM_OF_PARAMS\*(Aq, ($statement =~ tr/?//));
-\&
-\& $sth\->{drv_params} = [];
-\&
-\& return $outer;
-\& }
-.Ve
-.PP
-This is still the same \*(-- check the arguments and call the super class
-constructor \f(CW\*(C`DBI::_new_sth()\*(C'\fR. Again, in scalar context, only the outer
-handle is returned. The \fIStatement\fR attribute should be cached as
-shown.
-.PP
-Note the prefix \fIdrv_\fR in the attribute names: it is required that
-all your private attributes use a lowercase prefix unique to your driver.
-As mentioned earlier in this document, the \fB\s-1DBI\s0\fR contains a registry of
-known driver prefixes and may one day warn about unknown attributes
-that don't have a registered prefix.
-.PP
-Note that we parse the statement here in order to set the attribute
-\&\fI\s-1NUM_OF_PARAMS\s0\fR. The technique illustrated is not very reliable; it can
-be confused by question marks appearing in quoted strings, delimited
-identifiers or in \s-1SQL\s0 comments that are part of the \s-1SQL\s0 statement. We
-could set \fI\s-1NUM_OF_PARAMS\s0\fR in the \f(CW\*(C`execute()\*(C'\fR method instead because
-the \fB\s-1DBI\s0\fR specification explicitly allows a driver to defer this, but then
-the user could not call \f(CW\*(C`bind_param()\*(C'\fR.
-.PP
-Transaction handling
-.IX Subsection "Transaction handling"
-.PP
-Pure Perl drivers will rarely support transactions. Thus your \f(CW\*(C`commit()\*(C'\fR
-and \f(CW\*(C`rollback()\*(C'\fR methods will typically be quite simple:
-.PP
-.Vb 8
-\& sub commit
-\& {
-\& my ($dbh) = @_;
-\& if ($dbh\->FETCH(\*(AqWarn\*(Aq)) {
-\& warn("Commit ineffective while AutoCommit is on");
-\& }
-\& 0;
-\& }
-\&
-\& sub rollback {
-\& my ($dbh) = @_;
-\& if ($dbh\->FETCH(\*(AqWarn\*(Aq)) {
-\& warn("Rollback ineffective while AutoCommit is on");
-\& }
-\& 0;
-\& }
-.Ve
-.PP
-Or even simpler, just use the default methods provided by the \fB\s-1DBI\s0\fR that
-do nothing except return \f(CW\*(C`undef\*(C'\fR.
-.PP
-The \fB\s-1DBI\s0\fR's default \f(CW\*(C`begin_work()\*(C'\fR method can be used by inheritance.
-.PP
-The \s-1\fISTORE\s0()\fR and \s-1\fIFETCH\s0()\fR methods
-.IX Subsection "The STORE() and FETCH() methods"
-.PP
-These methods (that we have already used, see above) are called for
-you, whenever the user does a:
-.PP
-.Vb 1
-\& $dbh\->{$attr} = $val;
-.Ve
-.PP
-or, respectively,
-.PP
-.Vb 1
-\& $val = $dbh\->{$attr};
-.Ve
-.PP
-See perltie for details on tied hash refs to understand why these
-methods are required.
-.PP
-The \fB\s-1DBI\s0\fR will handle most attributes for you, in particular attributes
-like \fIRaiseError\fR or \fIPrintError\fR. All you have to do is handle your
-driver's private attributes and any attributes, like \fIAutoCommit\fR and
-\&\fIChopBlanks\fR, that the \fB\s-1DBI\s0\fR can't handle for you.
-.PP
-A good example might look like this:
-.PP
-.Vb 10
-\& sub STORE
-\& {
-\& my ($dbh, $attr, $val) = @_;
-\& if ($attr eq \*(AqAutoCommit\*(Aq) {
-\& # AutoCommit is currently the only standard attribute we have
-\& # to consider.
-\& if (!$val) { die "Can\*(Aqt disable AutoCommit"; }
-\& return 1;
-\& }
-\& if ($attr =~ m/^drv_/) {
-\& # Handle only our private attributes here
-\& # Note that we could trigger arbitrary actions.
-\& # Ideally we should warn about unknown attributes.
-\& $dbh\->{$attr} = $val; # Yes, we are allowed to do this,
-\& return 1; # but only for our private attributes
-\& }
-\& # Else pass up to DBI to handle for us
-\& $dbh\->SUPER::STORE($attr, $val);
-\& }
-\&
-\& sub FETCH
-\& {
-\& my ($dbh, $attr) = @_;
-\& if ($attr eq \*(AqAutoCommit\*(Aq) { return 1; }
-\& if ($attr =~ m/^drv_/) {
-\& # Handle only our private attributes here
-\& # Note that we could trigger arbitrary actions.
-\& return $dbh\->{$attr}; # Yes, we are allowed to do this,
-\& # but only for our private attributes
-\& }
-\& # Else pass up to DBI to handle
-\& $dbh\->SUPER::FETCH($attr);
-\& }
-.Ve
-.PP
-The \fB\s-1DBI\s0\fR will actually store and fetch driver-specific attributes (with all
-lowercase names) without warning or error, so there's actually no need to
-implement driver-specific any code in your \f(CW\*(C`FETCH()\*(C'\fR and \f(CW\*(C`STORE()\*(C'\fR
-methods unless you need extra logic/checks, beyond getting or setting
-the value.
-.PP
-Unless your driver documentation indicates otherwise, the return value of
-the \f(CW\*(C`STORE()\*(C'\fR method is unspecified and the caller shouldn't use that value.
-.PP
-Other database handle methods
-.IX Subsection "Other database handle methods"
-.PP
-As with the driver package, other database handle methods may follow here.
-In particular you should consider a (possibly empty) \f(CW\*(C`disconnect()\*(C'\fR
-method and possibly a \f(CW\*(C`quote()\*(C'\fR method if \fB\s-1DBI\s0\fR's default isn't correct for
-you. You may also need the \f(CW\*(C`type_info_all()\*(C'\fR and \f(CW\*(C`get_info()\*(C'\fR methods,
-as described elsewhere in this document.
-.PP
-Where reasonable use \f(CW\*(C`$h\->SUPER::foo()\*(C'\fR to call the \fB\s-1DBI\s0\fR's method in
-some or all cases and just wrap your custom behavior around that.
-.PP
-If you want to use private trace flags you'll probably want to be
-able to set them by name. To do that you'll need to define a
-\&\f(CW\*(C`parse_trace_flag()\*(C'\fR method (note that's \*(L"parse_trace_flag\*(R", singular,
-not \*(L"parse_trace_flags\*(R", plural).
-.PP
-.Vb 9
-\& sub parse_trace_flag {
-\& my ($h, $name) = @_;
-\& return 0x01000000 if $name eq \*(Aqfoo\*(Aq;
-\& return 0x02000000 if $name eq \*(Aqbar\*(Aq;
-\& return 0x04000000 if $name eq \*(Aqbaz\*(Aq;
-\& return 0x08000000 if $name eq \*(Aqboo\*(Aq;
-\& return 0x10000000 if $name eq \*(Aqbop\*(Aq;
-\& return $h\->SUPER::parse_trace_flag($name);
-\& }
-.Ve
-.PP
-All private flag names must be lowercase, and all private flags
-must be in the top 8 of the 32 bits.
-.PP
-\fIThe DBD::Driver::st package\fR
-.IX Subsection "The DBD::Driver::st package"
-.PP
-This package follows the same pattern the others do:
-.PP
-.Vb 1
-\& package DBD::Driver::st;
-\&
-\& $DBD::Driver::st::imp_data_size = 0;
-.Ve
-.PP
-The \fIexecute()\fR and \fIbind_param()\fR methods
-.IX Subsection "The execute() and bind_param() methods"
-.PP
-This is perhaps the most difficult method because we have to consider
-parameter bindings here. In addition to that, there are a number of
-statement attributes which must be set for inherited \fB\s-1DBI\s0\fR methods to
-function correctly (see \*(L"Statement attributes\*(R" below).
-.PP
-We present a simplified implementation by using the \fIdrv_params\fR
-attribute from above:
-.PP
-.Vb 12
-\& sub bind_param
-\& {
-\& my ($sth, $pNum, $val, $attr) = @_;
-\& my $type = (ref $attr) ? $attr\->{TYPE} : $attr;
-\& if ($type) {
-\& my $dbh = $sth\->{Database};
-\& $val = $dbh\->quote($sth, $type);
-\& }
-\& my $params = $sth\->{drv_params};
-\& $params\->[$pNum\-1] = $val;
-\& 1;
-\& }
-\&
-\& sub execute
-\& {
-\& my ($sth, @bind_values) = @_;
-\&
-\& # start of by finishing any previous execution if still active
-\& $sth\->finish if $sth\->FETCH(\*(AqActive\*(Aq);
-\&
-\& my $params = (@bind_values) ?
-\& \e@bind_values : $sth\->{drv_params};
-\& my $numParam = $sth\->FETCH(\*(AqNUM_OF_PARAMS\*(Aq);
-\& return $sth\->set_err($DBI::stderr, "Wrong number of parameters")
-\& if @$params != $numParam;
-\& my $statement = $sth\->{\*(AqStatement\*(Aq};
-\& for (my $i = 0; $i < $numParam; $i++) {
-\& $statement =~ s/?/$params\->[$i]/; # XXX doesn\*(Aqt deal with quoting etc!
-\& }
-\& # Do anything ... we assume that an array ref of rows is
-\& # created and store it:
-\& $sth\->{\*(Aqdrv_data\*(Aq} = $data;
-\& $sth\->{\*(Aqdrv_rows\*(Aq} = @$data; # number of rows
-\& $sth\->STORE(\*(AqNUM_OF_FIELDS\*(Aq) = $numFields;
-\& $sth\->{Active} = 1;
-\& @$data || \*(Aq0E0\*(Aq;
-\& }
-.Ve
-.PP
-There are a number of things you should note here.
-.PP
-We initialize the \fI\s-1NUM_OF_FIELDS\s0\fR and \fIActive\fR attributes here,
-because they are essential for \f(CW\*(C`bind_columns()\*(C'\fR to work.
-.PP
-We use attribute \f(CW\*(C`$sth\->{Statement}\*(C'\fR which we created
-within \f(CW\*(C`prepare()\*(C'\fR. The attribute \f(CW\*(C`$sth\->{Database}\*(C'\fR, which is
-nothing else than the \fIdbh\fR, was automatically created by \fB\s-1DBI\s0\fR.
-.PP
-Finally, note that (as specified in the \fB\s-1DBI\s0\fR specification) we return the
-string \f(CW\*(Aq0E0\*(Aq\fR instead of the number 0, so that the result tests true but
-equal to zero.
-.PP
-.Vb 1
-\& $sth\->execute() or die $sth\->errstr;
-.Ve
-.PP
-The \fIexecute_array()\fR, \fIexecute_for_fetch()\fR and \fIbind_param_array()\fR methods
-.IX Subsection "The execute_array(), execute_for_fetch() and bind_param_array() methods"
-.PP
-In general, \s-1DBD\s0's only need to implement \f(CW\*(C`execute_for_fetch()\*(C'\fR and
-\&\f(CW\*(C`bind_param_array\*(C'\fR. \s-1DBI\s0's default \f(CW\*(C`execute_array()\*(C'\fR will invoke the
-\&\s-1DBD\s0's \f(CW\*(C`execute_for_fetch()\*(C'\fR as needed.
-.PP
-The following sequence describes the interaction between
-\&\s-1DBI \s0\f(CW\*(C`execute_array\*(C'\fR and a \s-1DBD\s0's \f(CW\*(C`execute_for_fetch\*(C'\fR:
-.IP "1." 4
-App calls \f(CW\*(C`$sth\->execute_array(\e%attrs, @array_of_arrays)\*(C'\fR
-.IP "2." 4
-If \f(CW@array_of_arrays\fR was specified, \s-1DBI\s0 processes \f(CW@array_of_arrays\fR by calling
-\&\s-1DBD\s0's \f(CW\*(C`bind_param_array()\*(C'\fR. Alternately, App may have directly called
-\&\f(CW\*(C`bind_param_array()\*(C'\fR
-.IP "3." 4
-\&\s-1DBD\s0 validates and binds each array
-.IP "4." 4
-\&\s-1DBI\s0 retrieves the validated param arrays from \s-1DBD\s0's ParamArray attribute
-.IP "5." 4
-\&\s-1DBI\s0 calls \s-1DBD\s0's \f(CW\*(C`execute_for_fetch($fetch_tuple_sub, \e@tuple_status)\*(C'\fR,
-where \f(CW&$fetch_tuple_sub\fR is a closure to iterate over the
-returned ParamArray values, and \f(CW\*(C`\e@tuple_status\*(C'\fR is an array to receive
-the disposition status of each tuple.
-.IP "6." 4
-\&\s-1DBD\s0 iteratively calls \f(CW&$fetch_tuple_sub\fR to retrieve parameter tuples
-to be added to its bulk database operation/request.
-.IP "7." 4
-when \s-1DBD\s0 reaches the limit of tuples it can handle in a single database
-operation/request, or the \f(CW&$fetch_tuple_sub\fR indicates no more
-tuples by returning undef, the \s-1DBD\s0 executes the bulk operation, and
-reports the disposition of each tuple in \e@tuple_status.
-.IP "8." 4
-\&\s-1DBD\s0 repeats steps 6 and 7 until all tuples are processed.
-.PP
-E.g., here's the essence of DBD::Oracle's execute_for_fetch:
-.PP
-.Vb 10
-\& while (1) {
-\& my @tuple_batch;
-\& for (my $i = 0; $i < $batch_size; $i++) {
-\& push @tuple_batch, [ @{$fetch_tuple_sub\->() || last} ];
-\& }
-\& last unless @tuple_batch;
-\& my $res = ora_execute_array($sth, \e@tuple_batch,
-\& scalar(@tuple_batch), $tuple_batch_status);
-\& push @$tuple_status, @$tuple_batch_status;
-\& }
-.Ve
-.PP
-Note that \s-1DBI\s0's default \fIexecute_array()\fR/\fIexecute_for_fetch()\fR implementation
-requires the use of positional (i.e., '?') placeholders. Drivers
-which \fBrequire\fR named placeholders must either emulate positional
-placeholders (e.g., see DBD::Oracle), or must implement their own
-\&\fIexecute_array()\fR/\fIexecute_for_fetch()\fR methods to properly sequence bound
-parameter arrays.
-.PP
-Fetching data
-.IX Subsection "Fetching data"
-.PP
-Only one method needs to be written for fetching data, \f(CW\*(C`fetchrow_arrayref()\*(C'\fR.
-The other methods, \f(CW\*(C`fetchrow_array()\*(C'\fR, \f(CW\*(C`fetchall_arrayref()\*(C'\fR, etc, as well
-as the database handle's \f(CW\*(C`select*\*(C'\fR methods are part of \fB\s-1DBI\s0\fR, and call
-\&\f(CW\*(C`fetchrow_arrayref()\*(C'\fR as necessary.
-.PP
-.Vb 10
-\& sub fetchrow_arrayref
-\& {
-\& my ($sth) = @_;
-\& my $data = $sth\->{drv_data};
-\& my $row = shift @$data;
-\& if (!$row) {
-\& $sth\->STORE(Active => 0); # mark as no longer active
-\& return undef;
-\& }
-\& if ($sth\->FETCH(\*(AqChopBlanks\*(Aq)) {
-\& map { $_ =~ s/\es+$//; } @$row;
-\& }
-\& return $sth\->_set_fbav($row);
-\& }
-\& *fetch = \e&fetchrow_arrayref; # required alias for fetchrow_arrayref
-.Ve
-.PP
-Note the use of the method \f(CW\*(C`_set_fbav()\*(C'\fR \*(-- this is required so that
-\&\f(CW\*(C`bind_col()\*(C'\fR and \f(CW\*(C`bind_columns()\*(C'\fR work.
-.PP
-If an error occurs which leaves the \fI\f(CI$sth\fI\fR in a state where remaining rows
-can't be fetched then \fIActive\fR should be turned off before the method returns.
-.PP
-The \f(CW\*(C`rows()\*(C'\fR method for this driver can be implemented like this:
-.PP
-.Vb 1
-\& sub rows { shift\->{drv_rows} }
-.Ve
-.PP
-because it knows in advance how many rows it has fetched.
-Alternatively you could delete that method and so fallback
-to the \fB\s-1DBI\s0\fR's own method which does the right thing based
-on the number of calls to \f(CW\*(C`_set_fbav()\*(C'\fR.
-.PP
-The more_results method
-.IX Subsection "The more_results method"
-.PP
-If your driver doesn't support multiple result sets, then don't even implement this method.
-.PP
-Otherwise, this method needs to get the statement handle ready to fetch results
-from the next result set, if there is one. Typically you'd start with:
-.PP
-.Vb 1
-\& $sth\->finish;
-.Ve
-.PP
-then you should delete all the attributes from the attribute cache that may no
-longer be relevant for the new result set:
-.PP
-.Vb 2
-\& delete $sth\->{$_}
-\& for qw(NAME TYPE PRECISION SCALE ...);
-.Ve
-.PP
-for drivers written in C use:
-.PP
-.Vb 6
-\& hv_delete((HV*)SvRV(sth), "NAME", 4, G_DISCARD);
-\& hv_delete((HV*)SvRV(sth), "NULLABLE", 8, G_DISCARD);
-\& hv_delete((HV*)SvRV(sth), "NUM_OF_FIELDS", 13, G_DISCARD);
-\& hv_delete((HV*)SvRV(sth), "PRECISION", 9, G_DISCARD);
-\& hv_delete((HV*)SvRV(sth), "SCALE", 5, G_DISCARD);
-\& hv_delete((HV*)SvRV(sth), "TYPE", 4, G_DISCARD);
-.Ve
-.PP
-Don't forget to also delete, or update, any driver-private attributes that may
-not be correct for the next resultset.
-.PP
-The \s-1NUM_OF_FIELDS\s0 attribute is a special case. It should be set using \s-1STORE:\s0
-.PP
-.Vb 2
-\& $sth\->STORE(NUM_OF_FIELDS => 0); /* for DBI <= 1.53 */
-\& $sth\->STORE(NUM_OF_FIELDS => $new_value);
-.Ve
-.PP
-for drivers written in C use this incantation:
-.PP
-.Vb 5
-\& /* Adjust NUM_OF_FIELDS \- which also adjusts the row buffer size */
-\& DBIc_NUM_FIELDS(imp_sth) = 0; /* for DBI <= 1.53 */
-\& DBIc_STATE(imp_xxh)\->set_attr_k(sth, sv_2mortal(newSVpvn("NUM_OF_FIELDS",13)), 0,
-\& sv_2mortal(newSViv(mysql_num_fields(imp_sth\->result)))
-\& );
-.Ve
-.PP
-For \s-1DBI\s0 versions prior to 1.54 you'll also need to explicitly adjust the
-number of elements in the row buffer array (\f(CW\*(C`DBIc_FIELDS_AV(imp_sth)\*(C'\fR)
-to match the new result set. Fill any new values with \fInewSV\fR\|(0) not &sv_undef.
-Alternatively you could free DBIc_FIELDS_AV(imp_sth) and set it to null,
-but that would mean \fIbind_columns()\fR wouldn't work across result sets.
-.PP
-Statement attributes
-.IX Subsection "Statement attributes"
-.PP
-The main difference between \fIdbh\fR and \fIsth\fR attributes is, that you
-should implement a lot of attributes here that are required by
-the \fB\s-1DBI\s0\fR, such as \fI\s-1NAME\s0\fR, \fI\s-1NULLABLE\s0\fR, \fI\s-1TYPE\s0\fR, etc. See
-\&\*(L"Statement Handle Attributes\*(R" in \s-1DBI\s0 for a complete list.
-.PP
-Pay attention to attributes which are marked as read only, such as
-\&\fI\s-1NUM_OF_PARAMS\s0\fR. These attributes can only be set the first time
-a statement is executed. If a statement is prepared, then executed
-multiple times, warnings may be generated.
-.PP
-You can protect against these warnings, and prevent the recalculation
-of attributes which might be expensive to calculate (such as the
-\&\fI\s-1NAME\s0\fR and \fINAME_*\fR attributes):
-.PP
-.Vb 3
-\& my $storedNumParams = $sth\->FETCH(\*(AqNUM_OF_PARAMS\*(Aq);
-\& if (!defined $storedNumParams or $storedNumFields < 0) {
-\& $sth\->STORE(\*(AqNUM_OF_PARAMS\*(Aq) = $numParams;
-\&
-\& # Set other useful attributes that only need to be set once
-\& # for a statement, like $sth\->{NAME} and $sth\->{TYPE}
-\& }
-.Ve
-.PP
-One particularly important attribute to set correctly (mentioned in
-\&\*(L"\s-1ATTRIBUTES COMMON TO ALL HANDLES\*(R"\s0 in \s-1DBI\s0 is \fIActive\fR. Many \fB\s-1DBI\s0\fR methods,
-including \f(CW\*(C`bind_columns()\*(C'\fR, depend on this attribute.
-.PP
-Besides that the \f(CW\*(C`STORE()\*(C'\fR and \f(CW\*(C`FETCH()\*(C'\fR methods are mainly the same
-as above for \fIdbh\fR's.
-.PP
-Other statement methods
-.IX Subsection "Other statement methods"
-.PP
-A trivial \f(CW\*(C`finish()\*(C'\fR method to discard stored data, reset any attributes
-(such as \fIActive\fR) and do \f(CW\*(C`$sth\->SUPER::finish()\*(C'\fR.
-.PP
-If you've defined a \f(CW\*(C`parse_trace_flag()\*(C'\fR method in \fB::db\fR you'll also want
-it in \fB::st\fR, so just alias it in:
-.PP
-.Vb 1
-\& *parse_trace_flag = \e&DBD::foo:db::parse_trace_flag;
-.Ve
-.PP
-And perhaps some other methods that are not part of the \fB\s-1DBI\s0\fR
-specification, in particular to make metadata available.
-Remember that they must have names that begin with your drivers
-registered prefix so they can be installed using \f(CW\*(C`install_method()\*(C'\fR.
-.PP
-If \f(CW\*(C`DESTROY()\*(C'\fR is called on a statement handle that's still active
-(\f(CW\*(C`$sth\->{Active}\*(C'\fR is true) then it should effectively call \f(CW\*(C`finish()\*(C'\fR.
-.PP
-.Vb 4
-\& sub DESTROY {
-\& my $sth = shift;
-\& $sth\->finish if $sth\->FETCH(\*(AqActive\*(Aq);
-\& }
-.Ve
-.SS "Tests"
-.IX Subsection "Tests"
-The test process should conform as closely as possibly to the Perl
-standard test harness.
-.PP
-In particular, most (all) of the tests should be run in the \fIt\fR sub-directory,
-and should simply produce an \f(CW\*(C`ok\*(C'\fR when run under \f(CW\*(C`make test\*(C'\fR.
-For details on how this is done, see the Camel book and the section in
-Chapter 7, \*(L"The Standard Perl Library\*(R" on Test::Harness.
-.PP
-The tests may need to adapt to the type of database which is being used
-for testing, and to the privileges of the user testing the driver. For
-example, the \fBDBD::Informix\fR test code has to adapt in a number of
-places to the type of database to which it is connected as different
-Informix databases have different capabilities: some of the tests are
-for databases without transaction logs; others are for databases with a
-transaction log; some versions of the server have support for blobs, or
-stored procedures, or user-defined data types, and others do not.
-.PP
-When a complete file of tests must be skipped, you can provide a reason
-in a pseudo-comment:
-.PP
-.Vb 5
-\& if ($no_transactions_available)
-\& {
-\& print "1..0 # Skip: No transactions available\en";
-\& exit 0;
-\& }
-.Ve
-.PP
-Consider downloading the \fBDBD::Informix\fR code and look at the code in
-\&\fIDBD/Informix/TestHarness.pm\fR which is used throughout the
-\&\fBDBD::Informix\fR tests in the \fIt\fR sub-directory.
-.SH "CREATING A C/XS DRIVER"
-.IX Header "CREATING A C/XS DRIVER"
-Please also see the section under \*(L"\s-1CREATING A PURE PERL DRIVER\*(R"\s0
-regarding the creation of the \fIMakefile.PL\fR.
-.PP
-Creating a new C/XS driver from scratch will always be a daunting task.
-You can and should greatly simplify your task by taking a good
-reference driver implementation and modifying that to match the
-database product for which you are writing a driver.
-.PP
-The de facto reference driver has been the one for \fBDBD::Oracle\fR written
-by Tim Bunce, who is also the author of the \fB\s-1DBI\s0\fR package. The \fBDBD::Oracle\fR
-module is a good example of a driver implemented around a C\-level \s-1API.\s0
-.PP
-Nowadays it it seems better to base on \fB\s-1DBD::ODBC\s0\fR, another driver
-maintained by Tim and Jeff Urlwin, because it offers a lot of metadata
-and seems to become the guideline for the future development. (Also as
-\&\fBDBD::Oracle\fR digs deeper into the Oracle 8 \s-1OCI\s0 interface it'll get even
-more hairy than it is now.)
-.PP
-The \fBDBD::Informix\fR driver is one driver implemented using embedded \s-1SQL\s0
-instead of a function-based \s-1API.
-\&\s0\fBDBD::Ingres\fR may also be worth a look.
-.SS "C/XS version of Driver.pm"
-.IX Subsection "C/XS version of Driver.pm"
-A lot of the code in the \fIDriver.pm\fR file is very similar to the code for pure Perl modules
-\&\- see above. However,
-there are also some subtle (and not so subtle) differences, including:
-.IP "\(bu" 8
-The variables \fI\f(CI$DBD::Driver::\fI{dr|db|st}::imp_data_size\fR are not defined
-here, but in the \s-1XS\s0 code, because they declare the size of certain
-C structures.
-.IP "\(bu" 8
-Some methods are typically moved to the \s-1XS\s0 code, in particular
-\&\f(CW\*(C`prepare()\*(C'\fR, \f(CW\*(C`execute()\*(C'\fR, \f(CW\*(C`disconnect()\*(C'\fR, \f(CW\*(C`disconnect_all()\*(C'\fR and the
-\&\f(CW\*(C`STORE()\*(C'\fR and \f(CW\*(C`FETCH()\*(C'\fR methods.
-.IP "\(bu" 8
-Other methods are still part of \fIDriver.pm\fR, but have callbacks to
-the \s-1XS\s0 code.
-.IP "\(bu" 8
-If the driver-specific parts of the \fIimp_drh_t\fR structure need to be
-formally initialized (which does not seem to be a common requirement),
-then you need to add a call to an appropriate \s-1XS\s0 function in the driver
-method of \f(CW\*(C`DBD::Driver::driver()\*(C'\fR, and you define the corresponding function
-in \fIDriver.xs\fR, and you define the C code in \fIdbdimp.c\fR and the prototype in
-\&\fIdbdimp.h\fR.
-.Sp
-For example, \fBDBD::Informix\fR has such a requirement, and adds the
-following call after the call to \f(CW\*(C`_new_drh()\*(C'\fR in \fIInformix.pm\fR:
-.Sp
-.Vb 1
-\& DBD::Informix::dr::driver_init($drh);
-.Ve
-.Sp
-and the following code in \fIInformix.xs\fR:
-.Sp
-.Vb 6
-\& # Initialize the DBD::Informix driver data structure
-\& void
-\& driver_init(drh)
-\& SV *drh
-\& CODE:
-\& ST(0) = dbd_ix_dr_driver_init(drh) ? &sv_yes : &sv_no;
-.Ve
-.Sp
-and the code in \fIdbdimp.h\fR declares:
-.Sp
-.Vb 1
-\& extern int dbd_ix_dr_driver_init(SV *drh);
-.Ve
-.Sp
-and the code in \fIdbdimp.ec\fR (equivalent to \fIdbdimp.c\fR) defines:
-.Sp
-.Vb 11
-\& /* Formally initialize the DBD::Informix driver structure */
-\& int
-\& dbd_ix_dr_driver(SV *drh)
-\& {
-\& D_imp_drh(drh);
-\& imp_drh\->n_connections = 0; /* No active connections */
-\& imp_drh\->current_connection = 0; /* No current connection */
-\& imp_drh\->multipleconnections = (ESQLC_VERSION >= 600) ? True : False;
-\& dbd_ix_link_newhead(&imp_drh\->head); /* Empty linked list of connections */
-\& return 1;
-\& }
-.Ve
-.Sp
-\&\fBDBD::Oracle\fR has a similar requirement but gets around it by checking
-whether the private data part of the driver handle is all zeroed out,
-rather than add extra functions.
-.PP
-Now let's take a closer look at an excerpt from \fIOracle.pm\fR (revised
-heavily to remove idiosyncrasies) as an example, ignoring things that
-were already discussed for pure Perl drivers.
-.PP
-\fIThe connect method\fR
-.IX Subsection "The connect method"
-.PP
-The connect method is the database handle constructor.
-You could write either of two versions of this method: either one which
-takes connection attributes (new code) and one which ignores them (old
-code only).
-.PP
-If you ignore the connection attributes, then you omit all mention of
-the \fI\f(CI$auth\fI\fR variable (which is a reference to a hash of attributes), and
-the \s-1XS\s0 system manages the differences for you.
-.PP
-.Vb 3
-\& sub connect
-\& {
-\& my ($drh, $dbname, $user, $auth, $attr) = @_;
-\&
-\& # Some database specific verifications, default settings
-\& # and the like following here. This should only include
-\& # syntax checks or similar stuff where it\*(Aqs legal to
-\& # \*(Aqdie\*(Aq in case of errors.
-\&
-\& my $dbh = DBI::_new_dbh($drh, {
-\& \*(AqName\*(Aq => $dbname,
-\& })
-\& or return undef;
-\&
-\& # Call the driver\-specific function _login in Driver.xs file which
-\& # calls the DBMS\-specific function(s) to connect to the database,
-\& # and populate internal handle data.
-\& DBD::Driver::db::_login($dbh, $dbname, $user, $auth, $attr)
-\& or return undef;
-\&
-\& $dbh;
-\& }
-.Ve
-.PP
-This is mostly the same as in the pure Perl case, the exception being
-the use of the private \f(CW\*(C`_login()\*(C'\fR callback, which is the function
-that will really connect to the database. It is implemented in
-\&\fIDriver.xst\fR (you should not implement it) and calls
-\&\f(CW\*(C`dbd_db_login6()\*(C'\fR or \f(CW\*(C`dbd_db_login6_sv\*(C'\fR from \fIdbdimp.c\fR. See below
-for details.
-.PP
-If your driver has driver-specific attributes which may be passed in the
-connect method and hence end up in \f(CW$attr\fR in \f(CW\*(C`dbd_db_login6\*(C'\fR then it
-is best to delete any you process so \s-1DBI\s0 does not send them again
-via \s-1STORE\s0 after connect. You can do this in C like this:
-.PP
-.Vb 2
-\& DBD_ATTRIB_DELETE(attr, "my_attribute_name",
-\& strlen("my_attribute_name"));
-.Ve
-.PP
-However, prior to \s-1DBI\s0 subversion version 11605 (and fixed post 1.607)
-\&\s-1DBD_ATTRIB_DELETE\s0 segfaulted so if you cannot guarantee the \s-1DBI\s0 version
-will be post 1.607 you need to use:
-.PP
-.Vb 2
-\& hv_delete((HV*)SvRV(attr), "my_attribute_name",
-\& strlen("my_attribute_name"), G_DISCARD);
-\&
-\& *FIX ME* Discuss removing attributes in Perl code.
-.Ve
-.PP
-\fIThe disconnect_all method\fR
-.IX Subsection "The disconnect_all method"
-.PP
-.Vb 1
-\& *FIX ME* T.B.S
-.Ve
-.PP
-\fIThe data_sources method\fR
-.IX Subsection "The data_sources method"
-.PP
-If your \f(CW\*(C`data_sources()\*(C'\fR method can be implemented in pure Perl, then do
-so because it is easier than doing it in \s-1XS\s0 code (see the section above
-for pure Perl drivers).
-.PP
-If your \f(CW\*(C`data_sources()\*(C'\fR method must call onto compiled functions, then
-you will need to define \fIdbd_dr_data_sources\fR in your \fIdbdimp.h\fR file, which
-will trigger \fIDriver.xst\fR (in \fB\s-1DBI\s0\fR v1.33 or greater) to generate the \s-1XS\s0
-code that calls your actual C function (see the discussion below for
-details) and you do not code anything in \fIDriver.pm\fR to handle it.
-.PP
-\fIThe prepare method\fR
-.IX Subsection "The prepare method"
-.PP
-The prepare method is the statement handle constructor, and most of it
-is not new. Like the \f(CW\*(C`connect()\*(C'\fR method, it now has a C callback:
-.PP
-.Vb 2
-\& package DBD::Driver::db; # ====== DATABASE ======
-\& use strict;
-\&
-\& sub prepare
-\& {
-\& my ($dbh, $statement, $attribs) = @_;
-\&
-\& # create a \*(Aqblank\*(Aq sth
-\& my $sth = DBI::_new_sth($dbh, {
-\& \*(AqStatement\*(Aq => $statement,
-\& })
-\& or return undef;
-\&
-\& # Call the driver\-specific function _prepare in Driver.xs file
-\& # which calls the DBMS\-specific function(s) to prepare a statement
-\& # and populate internal handle data.
-\& DBD::Driver::st::_prepare($sth, $statement, $attribs)
-\& or return undef;
-\& $sth;
-\& }
-.Ve
-.PP
-\fIThe execute method\fR
-.IX Subsection "The execute method"
-.PP
-.Vb 1
-\& *FIX ME* T.B.S
-.Ve
-.PP
-\fIThe fetchrow_arrayref method\fR
-.IX Subsection "The fetchrow_arrayref method"
-.PP
-.Vb 1
-\& *FIX ME* T.B.S
-.Ve
-.PP
-\fIOther methods?\fR
-.IX Subsection "Other methods?"
-.PP
-.Vb 1
-\& *FIX ME* T.B.S
-.Ve
-.SS "Driver.xs"
-.IX Subsection "Driver.xs"
-\&\fIDriver.xs\fR should look something like this:
-.PP
-.Vb 1
-\& #include "Driver.h"
-\&
-\& DBISTATE_DECLARE;
-\&
-\& INCLUDE: Driver.xsi
-\&
-\& MODULE = DBD::Driver PACKAGE = DBD::Driver::dr
-\&
-\& /* Non\-standard drh XS methods following here, if any. */
-\& /* If none (the usual case), omit the MODULE line above too. */
-\&
-\& MODULE = DBD::Driver PACKAGE = DBD::Driver::db
-\&
-\& /* Non\-standard dbh XS methods following here, if any. */
-\& /* Currently this includes things like _list_tables from */
-\& /* DBD::mSQL and DBD::mysql. */
-\&
-\& MODULE = DBD::Driver PACKAGE = DBD::Driver::st
-\&
-\& /* Non\-standard sth XS methods following here, if any. */
-\& /* In particular this includes things like _list_fields from */
-\& /* DBD::mSQL and DBD::mysql for accessing metadata. */
-.Ve
-.PP
-Note especially the include of \fIDriver.xsi\fR here: \fB\s-1DBI\s0\fR inserts stub
-functions for almost all private methods here which will typically do
-much work for you.
-.PP
-Wherever you really have to implement something, it will call a private
-function in \fIdbdimp.c\fR, and this is what you have to implement.
-.PP
-You need to set up an extra routine if your driver needs to export
-constants of its own, analogous to the \s-1SQL\s0 types available when you say:
-.PP
-.Vb 1
-\& use DBI qw(:sql_types);
-\&
-\& *FIX ME* T.B.S
-.Ve
-.SS "Driver.h"
-.IX Subsection "Driver.h"
-\&\fIDriver.h\fR is very simple and the operational contents should look like this:
-.PP
-.Vb 2
-\& #ifndef DRIVER_H_INCLUDED
-\& #define DRIVER_H_INCLUDED
-\&
-\& #define NEED_DBIXS_VERSION 93 /* 93 for DBI versions 1.00 to 1.51+ */
-\& #define PERL_NO_GET_CONTEXT /* if used require DBI 1.51+ */
-\&
-\& #include <DBIXS.h> /* installed by the DBI module */
-\&
-\& #include "dbdimp.h"
-\&
-\& #include "dbivport.h" /* see below */
-\&
-\& #include <dbd_xsh.h> /* installed by the DBI module */
-\&
-\& #endif /* DRIVER_H_INCLUDED */
-.Ve
-.PP
-The \fI\s-1DBIXS\s0.h\fR header defines most of the interesting information that
-the writer of a driver needs.
-.PP
-The file \fIdbd_xsh.h\fR header provides prototype declarations for the C
-functions that you might decide to implement. Note that you should
-normally only define one of \f(CW\*(C`dbd_db_login()\*(C'\fR, \f(CW\*(C`dbd_db_login6()\*(C'\fR or
-\&\f(CW\*(C`dbd_db_login6_sv\*(C'\fR unless you are intent on supporting really old
-versions of \fB\s-1DBI\s0\fR (prior to \fB\s-1DBI\s0\fR 1.06) as well as modern
-versions. The only standard, \fB\s-1DBI\s0\fR\-mandated functions that you need
-write are those specified in the \fIdbd_xsh.h\fR header. You might also
-add extra driver-specific functions in \fIDriver.xs\fR.
-.PP
-The \fIdbivport.h\fR file should be \fIcopied\fR from the latest \fB\s-1DBI\s0\fR release
-into your distribution each time you modify your driver. Its job is to
-allow you to enhance your code to work with the latest \fB\s-1DBI\s0\fR \s-1API\s0 while
-still allowing your driver to be compiled and used with older versions
-of the \fB\s-1DBI\s0\fR (for example, when the \f(CW\*(C`DBIh_SET_ERR_CHAR()\*(C'\fR macro was added
-to \fB\s-1DBI\s0\fR 1.41, an emulation of it was added to \fIdbivport.h\fR). This makes
-users happy and your life easier. Always read the notes in \fIdbivport.h\fR
-to check for any limitations in the emulation that you should be aware
-of.
-.PP
-With \fB\s-1DBI\s0\fR v1.51 or better I recommend that the driver defines
-\&\fI\s-1PERL_NO_GET_CONTEXT\s0\fR before \fI\s-1DBIXS\s0.h\fR is included. This can significantly
-improve efficiency when running under a thread enabled perl. (Remember that
-the standard perl in most Linux distributions is built with threads enabled.
-So is ActiveState perl for Windows, and perl built for Apache mod_perl2.)
-If you do this there are some things to keep in mind:
-.IP "\(bu" 4
-If \fI\s-1PERL_NO_GET_CONTEXT\s0\fR is defined, then every function that calls the Perl
-\&\s-1API\s0 will need to start out with a \f(CW\*(C`dTHX;\*(C'\fR declaration.
-.IP "\(bu" 4
-You'll know which functions need this, because the C compiler will
-complain that the undeclared identifier \f(CW\*(C`my_perl\*(C'\fR is used if \fIand only if\fR
-the perl you are using to develop and test your driver has threads enabled.
-.IP "\(bu" 4
-If you don't remember to test with a thread-enabled perl before making
-a release it's likely that you'll get failure reports from users who are.
-.IP "\(bu" 4
-For driver private functions it is possible to gain even more
-efficiency by replacing \f(CW\*(C`dTHX;\*(C'\fR with \f(CW\*(C`pTHX_\*(C'\fR prepended to the
-parameter list and then \f(CW\*(C`aTHX_\*(C'\fR prepended to the argument list where
-the function is called.
-.PP
-See \*(L"How multiple interpreters and concurrency are supported\*(R" in perlguts for
-additional information about \fI\s-1PERL_NO_GET_CONTEXT\s0\fR.
-.SS "Implementation header dbdimp.h"
-.IX Subsection "Implementation header dbdimp.h"
-This header file has two jobs:
-.PP
-First it defines data structures for your private part of the handles.
-Note that the \s-1DBI\s0 provides many common fields for you. For example
-the statement handle (imp_sth) already has a row_count field with an \s-1IV\s0 type
-that accessed via the DBIc_ROW_COUNT(imp_sth) macro. Using this is strongly
-recommended as it's built in to some \s-1DBI\s0 internals so the \s-1DBI\s0 can 'just work'
-in more cases and you'll have less driver-specific code to write.
-Study \s-1DBIXS\s0.h to see what's included with each type of handle.
-.PP
-Second it defines macros that rename the generic names like
-\&\f(CW\*(C`dbd_db_login()\*(C'\fR to database specific names like \f(CW\*(C`ora_db_login()\*(C'\fR. This
-avoids name clashes and enables use of different drivers when you work
-with a statically linked perl.
-.PP
-It also will have the important task of disabling \s-1XS\s0 methods that you
-don't want to implement.
-.PP
-Finally, the macros will also be used to select alternate
-implementations of some functions. For example, the \f(CW\*(C`dbd_db_login()\*(C'\fR
-function is not passed the attribute hash.
-.PP
-Since \fB\s-1DBI\s0\fR v1.06, if a \f(CW\*(C`dbd_db_login6()\*(C'\fR macro is defined (for a function
-with 6 arguments), it will be used instead with the attribute hash
-passed as the sixth argument.
-.PP
-Since \fB\s-1DBI\s0\fR post v1.607, if a \f(CW\*(C`dbd_db_login6_sv()\*(C'\fR macro is defined (for
-a function like dbd_db_login6 but with scalar pointers for the dbname,
-username and password), it will be used instead. This will allow your
-login6 function to see if there are any Unicode characters in the
-dbname.
-.PP
-Similarly defining dbd_db_do4_iv is preferred over dbd_db_do4, dbd_st_rows_iv
-over dbd_st_rows, and dbd_st_execute_iv over dbd_st_execute. The *_iv forms are
-declared to return the \s-1IV\s0 type instead of an int.
-.PP
-People used to just pick Oracle's \fIdbdimp.c\fR and use the same names,
-structures and types. I strongly recommend against that. At first glance
-this saves time, but your implementation will be less readable. It was
-just hell when I had to separate \fB\s-1DBI\s0\fR specific parts, Oracle specific
-parts, mSQL specific parts and mysql specific parts in \fBDBD::mysql\fR's
-\&\fIdbdimp.h\fR and \fIdbdimp.c\fR. (\fBDBD::mysql\fR was a port of \fBDBD::mSQL\fR
-which was based on \fBDBD::Oracle\fR.) [Seconded, based on the experience
-taking \fBDBD::Informix\fR apart, even though the version inherited in 1996
-was only based on \fBDBD::Oracle\fR.]
-.PP
-This part of the driver is \fIyour exclusive part\fR. Rewrite it from
-scratch, so it will be clean and short: in other words, a better piece
-of code. (Of course keep an eye on other people's work.)
-.PP
-.Vb 4
-\& struct imp_drh_st {
-\& dbih_drc_t com; /* MUST be first element in structure */
-\& /* Insert your driver handle attributes here */
-\& };
-\&
-\& struct imp_dbh_st {
-\& dbih_dbc_t com; /* MUST be first element in structure */
-\& /* Insert your database handle attributes here */
-\& };
-\&
-\& struct imp_sth_st {
-\& dbih_stc_t com; /* MUST be first element in structure */
-\& /* Insert your statement handle attributes here */
-\& };
-\&
-\& /* Rename functions for avoiding name clashes; prototypes are */
-\& /* in dbd_xsh.h */
-\& #define dbd_init drv_dr_init
-\& #define dbd_db_login6_sv drv_db_login_sv
-\& #define dbd_db_do drv_db_do
-\& ... many more here ...
-.Ve
-.PP
-These structures implement your private part of the handles.
-.PP
-You \fIhave\fR to use the name \f(CW\*(C`imp_dbh_{dr|db|st}\*(C'\fR and the first field
-\&\fImust\fR be of type \fIdbih_drc_t|_dbc_t|_stc_t\fR and \fImust\fR be called
-\&\f(CW\*(C`com\*(C'\fR.
-.PP
-You should never access these fields directly, except by using the
-\&\fI\fIDBIc_xxx()\fI\fR macros below.
-.SS "Implementation source dbdimp.c"
-.IX Subsection "Implementation source dbdimp.c"
-Conventionally, \fIdbdimp.c\fR is the main implementation file (but
-\&\fBDBD::Informix\fR calls the file \fIdbdimp.ec\fR). This section includes a
-short note on each function that is used in the \fIDriver.xsi\fR template
-and thus \fIhas\fR to be implemented.
-.PP
-Of course, you will probably also need to implement other support
-functions, which should usually be file static if they are placed in
-\&\fIdbdimp.c\fR. If they are placed in other files, you need to list those
-files in \fIMakefile.PL\fR (and \fI\s-1MANIFEST\s0\fR) to handle them correctly.
-.PP
-It is wise to adhere to a namespace convention for your functions to
-avoid conflicts. For example, for a driver with prefix \fIdrv_\fR, you
-might call externally visible functions \fIdbd_drv_xxxx\fR. You should also
-avoid non-constant global variables as much as possible to improve the
-support for threading.
-.PP
-Since Perl requires support for function prototypes (\s-1ANSI\s0 or \s-1ISO\s0 or
-Standard C), you should write your code using function prototypes too.
-.PP
-It is possible to use either the unmapped names such as \f(CW\*(C`dbd_init()\*(C'\fR or
-the mapped names such as \f(CW\*(C`dbd_ix_dr_init()\*(C'\fR in the \fIdbdimp.c\fR file.
-\&\fBDBD::Informix\fR uses the mapped names which makes it easier to identify
-where to look for linkage problems at runtime (which will report errors
-using the mapped names).
-.PP
-Most other drivers, and in particular \fBDBD::Oracle\fR, use the unmapped
-names in the source code which makes it a little easier to compare code
-between drivers and eases discussions on the \fIdbi-dev\fR mailing list.
-The majority of the code fragments here will use the unmapped names.
-.PP
-Ultimately, you should provide implementations for most of the
-functions listed in the \fIdbd_xsh.h\fR header. The exceptions are
-optional functions (such as \f(CW\*(C`dbd_st_rows()\*(C'\fR) and those functions with
-alternative signatures, such as \f(CW\*(C`dbd_db_login6_sv\*(C'\fR,
-\&\f(CW\*(C`dbd_db_login6()\*(C'\fR and \fI\fIdbd_db_login()\fI\fR. Then you should only
-implement one of the alternatives, and generally the newer one of the
-alternatives.
-.PP
-\fIThe dbd_init method\fR
-.IX Subsection "The dbd_init method"
-.PP
-.Vb 1
-\& #include "Driver.h"
-\&
-\& DBISTATE_DECLARE;
-\&
-\& void dbd_init(dbistate_t* dbistate)
-\& {
-\& DBISTATE_INIT; /* Initialize the DBI macros */
-\& }
-.Ve
-.PP
-The \f(CW\*(C`dbd_init()\*(C'\fR function will be called when your driver is first
-loaded; the bootstrap command in \f(CW\*(C`DBD::Driver::dr::driver()\*(C'\fR triggers this,
-and the call is generated in the \fI\s-1BOOT\s0\fR section of \fIDriver.xst\fR.
-These statements are needed to allow your driver to use the \fB\s-1DBI\s0\fR macros.
-They will include your private header file \fIdbdimp.h\fR in turn.
-Note that \fI\s-1DBISTATE_INIT\s0\fR requires the name of the argument to \f(CW\*(C`dbd_init()\*(C'\fR
-to be called \f(CW\*(C`dbistate()\*(C'\fR.
-.PP
-\fIThe dbd_drv_error method\fR
-.IX Subsection "The dbd_drv_error method"
-.PP
-You need a function to record errors so \fB\s-1DBI\s0\fR can access them properly.
-You can call it whatever you like, but we'll call it \f(CW\*(C`dbd_drv_error()\*(C'\fR
-here.
-.PP
-The argument list depends on your database software; different systems
-provide different ways to get at error information.
-.PP
-.Vb 2
-\& static void dbd_drv_error(SV *h, int rc, const char *what)
-\& {
-.Ve
-.PP
-Note that \fIh\fR is a generic handle, may it be a driver handle, a
-database or a statement handle.
-.PP
-.Vb 1
-\& D_imp_xxh(h);
-.Ve
-.PP
-This macro will declare and initialize a variable \fIimp_xxh\fR with
-a pointer to your private handle pointer. You may cast this to
-to \fIimp_drh_t\fR, \fIimp_dbh_t\fR or \fIimp_sth_t\fR.
-.PP
-To record the error correctly, equivalent to the \f(CW\*(C`set_err()\*(C'\fR method,
-use one of the \f(CW\*(C`DBIh_SET_ERR_CHAR(...)\*(C'\fR or \f(CW\*(C`DBIh_SET_ERR_SV(...)\*(C'\fR macros,
-which were added in \fB\s-1DBI\s0\fR 1.41:
-.PP
-.Vb 2
-\& DBIh_SET_ERR_SV(h, imp_xxh, err, errstr, state, method);
-\& DBIh_SET_ERR_CHAR(h, imp_xxh, err_c, err_i, errstr, state, method);
-.Ve
-.PP
-For \f(CW\*(C`DBIh_SET_ERR_SV\*(C'\fR the \fIerr\fR, \fIerrstr\fR, \fIstate\fR, and \fImethod\fR
-parameters are \f(CW\*(C`SV*\*(C'\fR (use &sv_undef instead of \s-1NULL\s0).
-.PP
-For \f(CW\*(C`DBIh_SET_ERR_CHAR\*(C'\fR the \fIerr_c\fR, \fIerrstr\fR, \fIstate\fR, \fImethod\fR
-parameters are \f(CW\*(C`char*\*(C'\fR.
-.PP
-The \fIerr_i\fR parameter is an \f(CW\*(C`IV\*(C'\fR that's used instead of \fIerr_c\fR if
-\&\fIerr_c\fR is \f(CW\*(C`Null\*(C'\fR.
-.PP
-The \fImethod\fR parameter can be ignored.
-.PP
-The \f(CW\*(C`DBIh_SET_ERR_CHAR\*(C'\fR macro is usually the simplest to use when you
-just have an integer error code and an error message string:
-.PP
-.Vb 1
-\& DBIh_SET_ERR_CHAR(h, imp_xxh, Nullch, rc, what, Nullch, Nullch);
-.Ve
-.PP
-As you can see, any parameters that aren't relevant to you can be \f(CW\*(C`Null\*(C'\fR.
-.PP
-To make drivers compatible with \fB\s-1DBI\s0\fR < 1.41 you should be using \fIdbivport.h\fR
-as described in \*(L"Driver.h\*(R" above.
-.PP
-The (obsolete) macros such as \f(CW\*(C`DBIh_EVENT2\*(C'\fR should be removed from drivers.
-.PP
-The names \f(CW\*(C`dbis\*(C'\fR and \f(CW\*(C`DBIS\*(C'\fR, which were used in previous versions of
-this document, should be replaced with the \f(CW\*(C`DBIc_DBISTATE(imp_xxh)\*(C'\fR macro.
-.PP
-The name \f(CW\*(C`DBILOGFP\*(C'\fR, which was also used in previous versions of this
-document, should be replaced by \f(CW\*(C`DBIc_LOGPIO(imp_xxh)\*(C'\fR.
-.PP
-Your code should not call the C \f(CW\*(C`<stdio.h>\*(C'\fR I/O functions; you
-should use \f(CW\*(C`PerlIO_printf()\*(C'\fR as shown:
-.PP
-.Vb 3
-\& if (DBIc_TRACE_LEVEL(imp_xxh) >= 2)
-\& PerlIO_printf(DBIc_LOGPIO(imp_xxh), "foobar %s: %s\en",
-\& foo, neatsvpv(errstr,0));
-.Ve
-.PP
-That's the first time we see how tracing works within a \fB\s-1DBI\s0\fR driver. Make
-use of this as often as you can, but don't output anything at a trace
-level less than 3. Levels 1 and 2 are reserved for the \fB\s-1DBI\s0\fR.
-.PP
-You can define up to 8 private trace flags using the top 8 bits
-of \f(CW\*(C`DBIc_TRACE_FLAGS(imp)\*(C'\fR, that is: \f(CW0xFF000000\fR. See the
-\&\f(CW\*(C`parse_trace_flag()\*(C'\fR method elsewhere in this document.
-.PP
-\fIThe dbd_dr_data_sources method\fR
-.IX Subsection "The dbd_dr_data_sources method"
-.PP
-This method is optional; the support for it was added in \fB\s-1DBI\s0\fR v1.33.
-.PP
-As noted in the discussion of \fIDriver.pm\fR, if the data sources
-can be determined by pure Perl code, do it that way. If, as in
-\&\fBDBD::Informix\fR, the information is obtained by a C function call, then
-you need to define a function that matches the prototype:
-.PP
-.Vb 1
-\& extern AV *dbd_dr_data_sources(SV *drh, imp_drh_t *imp_drh, SV *attrs);
-.Ve
-.PP
-An outline implementation for \fBDBD::Informix\fR follows, assuming that the
-\&\f(CW\*(C`sqgetdbs()\*(C'\fR function call shown will return up to 100 databases names,
-with the pointers to each name in the array dbsname and the name strings
-themselves being stores in dbsarea.
-.PP
-.Vb 7
-\& AV *dbd_dr_data_sources(SV *drh, imp_drh_t *imp_drh, SV *attr)
-\& {
-\& int ndbs;
-\& int i;
-\& char *dbsname[100];
-\& char dbsarea[10000];
-\& AV *av = Nullav;
-\&
-\& if (sqgetdbs(&ndbs, dbsname, 100, dbsarea, sizeof(dbsarea)) == 0)
-\& {
-\& av = NewAV();
-\& av_extend(av, (I32)ndbs);
-\& sv_2mortal((SV *)av);
-\& for (i = 0; i < ndbs; i++)
-\& av_store(av, i, newSVpvf("dbi:Informix:%s", dbsname[i]));
-\& }
-\& return(av);
-\& }
-.Ve
-.PP
-The actual \fBDBD::Informix\fR implementation has a number of extra lines of
-code, logs function entry and exit, reports the error from \f(CW\*(C`sqgetdbs()\*(C'\fR,
-and uses \f(CW\*(C`#define\*(C'\fR'd constants for the array sizes.
-.PP
-\fIThe dbd_db_login6 method\fR
-.IX Subsection "The dbd_db_login6 method"
-.PP
-.Vb 2
-\& int dbd_db_login6_sv(SV* dbh, imp_dbh_t* imp_dbh, SV* dbname,
-\& SV* user, SV* auth, SV *attr);
-\&
-\& or
-\&
-\& int dbd_db_login6(SV* dbh, imp_dbh_t* imp_dbh, char* dbname,
-\& char* user, char* auth, SV *attr);
-.Ve
-.PP
-This function will really connect to the database. The argument \fIdbh\fR
-is the database handle. \fIimp_dbh\fR is the pointer to the handles private
-data, as is \fIimp_xxx\fR in \f(CW\*(C`dbd_drv_error()\*(C'\fR above. The arguments
-\&\fIdbname\fR, \fIuser\fR, \fIauth\fR and \fIattr\fR correspond to the arguments of
-the driver handle's \f(CW\*(C`connect()\*(C'\fR method.
-.PP
-You will quite often use database specific attributes here, that are
-specified in the \s-1DSN. I\s0 recommend you parse the \s-1DSN \s0(using Perl) within
-the \f(CW\*(C`connect()\*(C'\fR method and pass the segments of the \s-1DSN\s0 via the
-attributes parameter through \f(CW\*(C`_login()\*(C'\fR to \f(CW\*(C`dbd_db_login6()\*(C'\fR.
-.PP
-Here's how you fetch them; as an example we use \fIhostname\fR attribute,
-which can be up to 12 characters long excluding null terminator:
-.PP
-.Vb 3
-\& SV** svp;
-\& STRLEN len;
-\& char* hostname;
-\&
-\& if ( (svp = DBD_ATTRIB_GET_SVP(attr, "drv_hostname", 12)) && SvTRUE(*svp)) {
-\& hostname = SvPV(*svp, len);
-\& DBD_ATTRIB_DELETE(attr, "drv_hostname", 12); /* avoid later STORE */
-\& } else {
-\& hostname = "localhost";
-\& }
-.Ve
-.PP
-If you handle any driver specific attributes in the dbd_db_login6
-method you probably want to delete them from \f(CW\*(C`attr\*(C'\fR (as above with
-\&\s-1DBD_ATTRIB_DELETE\s0). If you don't delete your handled attributes \s-1DBI\s0
-will call \f(CW\*(C`STORE\*(C'\fR for each attribute after the connect/login and this
-is at best redundant for attributes you have already processed.
-.PP
-\&\fBNote: Until revision 11605 (post \s-1DBI 1.607\s0), there was a problem with
-\&\s-1DBD_ATTRIBUTE_DELETE\s0 so unless you require a \s-1DBI\s0 version after 1.607
-you need to replace each \s-1DBD_ATTRIBUTE_DELETE\s0 call with:\fR
-.PP
-.Vb 1
-\& hv_delete((HV*)SvRV(attr), key, key_len, G_DISCARD)
-.Ve
-.PP
-Note that you can also obtain standard attributes such as \fIAutoCommit\fR and
-\&\fIChopBlanks\fR from the attributes parameter, using \f(CW\*(C`DBD_ATTRIB_GET_IV\*(C'\fR for
-integer attributes.
-.PP
-If, for example, your database does not support transactions but
-\&\fIAutoCommit\fR is set off (requesting transaction support), then you can
-emulate a 'failure to connect'.
-.PP
-Now you should really connect to the database. In general, if the
-connection fails, it is best to ensure that all allocated resources are
-released so that the handle does not need to be destroyed separately. If
-you are successful (and possibly even if you fail but you have allocated
-some resources), you should use the following macros:
-.PP
-.Vb 1
-\& DBIc_IMPSET_on(imp_dbh);
-.Ve
-.PP
-This indicates that the driver (implementor) has allocated resources in
-the \fIimp_dbh\fR structure and that the implementors private \f(CW\*(C`dbd_db_destroy()\*(C'\fR
-function should be called when the handle is destroyed.
-.PP
-.Vb 1
-\& DBIc_ACTIVE_on(imp_dbh);
-.Ve
-.PP
-This indicates that the handle has an active connection to the server
-and that the \f(CW\*(C`dbd_db_disconnect()\*(C'\fR function should be called before the
-handle is destroyed.
-.PP
-Note that if you do need to fail, you should report errors via the \fIdrh\fR
-or \fIimp_drh\fR rather than via \fIdbh\fR or \fIimp_dbh\fR because \fIimp_dbh\fR will be
-destroyed by the failure, so errors recorded in that handle will not be
-visible to \fB\s-1DBI\s0\fR, and hence not the user either.
-.PP
-Note too, that the function is passed \fIdbh\fR and \fIimp_dbh\fR, and there
-is a macro \f(CW\*(C`D_imp_drh_from_dbh\*(C'\fR which can recover the \fIimp_drh\fR from
-the \fIimp_dbh\fR. However, there is no \fB\s-1DBI\s0\fR macro to provide you with the
-\&\fIdrh\fR given either the \fIimp_dbh\fR or the \fIdbh\fR or the \fIimp_drh\fR (and
-there's no way to recover the \fIdbh\fR given just the \fIimp_dbh\fR).
-.PP
-This suggests that, despite the above notes about \f(CW\*(C`dbd_drv_error()\*(C'\fR
-taking an \f(CW\*(C`SV *\*(C'\fR, it may be better to have two error routines, one
-taking \fIimp_dbh\fR and one taking \fIimp_drh\fR instead. With care, you can
-factor most of the formatting code out so that these are small routines
-calling a common error formatter. See the code in \fBDBD::Informix\fR
-1.05.00 for more information.
-.PP
-The \f(CW\*(C`dbd_db_login6()\*(C'\fR function should return \fI\s-1TRUE\s0\fR for success,
-\&\fI\s-1FALSE\s0\fR otherwise.
-.PP
-Drivers implemented long ago may define the five-argument function
-\&\f(CW\*(C`dbd_db_login()\*(C'\fR instead of \f(CW\*(C`dbd_db_login6()\*(C'\fR. The missing argument is
-the attributes. There are ways to work around the missing attributes,
-but they are ungainly; it is much better to use the 6\-argument form.
-Even later drivers will use \f(CW\*(C`dbd_db_login6_sv()\*(C'\fR which provides the
-dbname, username and password as SVs.
-.PP
-\fIThe dbd_db_commit and dbd_db_rollback methods\fR
-.IX Subsection "The dbd_db_commit and dbd_db_rollback methods"
-.PP
-.Vb 2
-\& int dbd_db_commit(SV *dbh, imp_dbh_t *imp_dbh);
-\& int dbd_db_rollback(SV* dbh, imp_dbh_t* imp_dbh);
-.Ve
-.PP
-These are used for commit and rollback. They should return \fI\s-1TRUE\s0\fR for
-success, \fI\s-1FALSE\s0\fR for error.
-.PP
-The arguments \fIdbh\fR and \fIimp_dbh\fR are the same as for \f(CW\*(C`dbd_db_login6()\*(C'\fR
-above; I will omit describing them in what follows, as they appear
-always.
-.PP
-These functions should return \fI\s-1TRUE\s0\fR for success, \fI\s-1FALSE\s0\fR otherwise.
-.PP
-\fIThe dbd_db_disconnect method\fR
-.IX Subsection "The dbd_db_disconnect method"
-.PP
-This is your private part of the \f(CW\*(C`disconnect()\*(C'\fR method. Any \fIdbh\fR with
-the \fI\s-1ACTIVE\s0\fR flag on must be disconnected. (Note that you have to set
-it in \f(CW\*(C`dbd_db_connect()\*(C'\fR above.)
-.PP
-.Vb 1
-\& int dbd_db_disconnect(SV* dbh, imp_dbh_t* imp_dbh);
-.Ve
-.PP
-The database handle will return \fI\s-1TRUE\s0\fR for success, \fI\s-1FALSE\s0\fR otherwise.
-In any case it should do a:
-.PP
-.Vb 1
-\& DBIc_ACTIVE_off(imp_dbh);
-.Ve
-.PP
-before returning so \fB\s-1DBI\s0\fR knows that \f(CW\*(C`dbd_db_disconnect()\*(C'\fR was executed.
-.PP
-Note that there's nothing to stop a \fIdbh\fR being \fIdisconnected\fR while
-it still have active children. If your database \s-1API\s0 reacts badly to
-trying to use an \fIsth\fR in this situation then you'll need to add code
-like this to all \fIsth\fR methods:
-.PP
-.Vb 2
-\& if (!DBIc_ACTIVE(DBIc_PARENT_COM(imp_sth)))
-\& return 0;
-.Ve
-.PP
-Alternatively, you can add code to your driver to keep explicit track of
-the statement handles that exist for each database handle and arrange
-to destroy those handles before disconnecting from the database. There
-is code to do this in \fBDBD::Informix\fR. Similar comments apply to the
-driver handle keeping track of all the database handles.
-.PP
-Note that the code which destroys the subordinate handles should only
-release the associated database resources and mark the handles inactive;
-it does not attempt to free the actual handle structures.
-.PP
-This function should return \fI\s-1TRUE\s0\fR for success, \fI\s-1FALSE\s0\fR otherwise, but
-it is not clear what anything can do about a failure.
-.PP
-\fIThe dbd_db_discon_all method\fR
-.IX Subsection "The dbd_db_discon_all method"
-.PP
-.Vb 1
-\& int dbd_discon_all (SV *drh, imp_drh_t *imp_drh);
-.Ve
-.PP
-This function may be called at shutdown time. It should make
-best-efforts to disconnect all database handles \- if possible. Some
-databases don't support that, in which case you can do nothing
-but return 'success'.
-.PP
-This function should return \fI\s-1TRUE\s0\fR for success, \fI\s-1FALSE\s0\fR otherwise, but
-it is not clear what anything can do about a failure.
-.PP
-\fIThe dbd_db_destroy method\fR
-.IX Subsection "The dbd_db_destroy method"
-.PP
-This is your private part of the database handle destructor. Any \fIdbh\fR with
-the \fI\s-1IMPSET\s0\fR flag on must be destroyed, so that you can safely free
-resources. (Note that you have to set it in \f(CW\*(C`dbd_db_connect()\*(C'\fR above.)
-.PP
-.Vb 4
-\& void dbd_db_destroy(SV* dbh, imp_dbh_t* imp_dbh)
-\& {
-\& DBIc_IMPSET_off(imp_dbh);
-\& }
-.Ve
-.PP
-The \fB\s-1DBI\s0\fR \fIDriver.xst\fR code will have called \f(CW\*(C`dbd_db_disconnect()\*(C'\fR for you,
-if the handle is still 'active', before calling \f(CW\*(C`dbd_db_destroy()\*(C'\fR.
-.PP
-Before returning the function must switch \fI\s-1IMPSET\s0\fR to off, so \fB\s-1DBI\s0\fR knows
-that the destructor was called.
-.PP
-A \fB\s-1DBI\s0\fR handle doesn't keep references to its children. But children
-do keep references to their parents. So a database handle won't be
-\&\f(CW\*(C`DESTROY\*(C'\fR'd until all its children have been \f(CW\*(C`DESTROY\*(C'\fR'd.
-.PP
-\fIThe dbd_db_STORE_attrib method\fR
-.IX Subsection "The dbd_db_STORE_attrib method"
-.PP
-This function handles
-.PP
-.Vb 1
-\& $dbh\->{$key} = $value;
-.Ve
-.PP
-Its prototype is:
-.PP
-.Vb 2
-\& int dbd_db_STORE_attrib(SV* dbh, imp_dbh_t* imp_dbh, SV* keysv,
-\& SV* valuesv);
-.Ve
-.PP
-You do not handle all attributes; on the contrary, you should not handle
-\&\fB\s-1DBI\s0\fR attributes here: leave this to \fB\s-1DBI\s0\fR. (There are two exceptions,
-\&\fIAutoCommit\fR and \fIChopBlanks\fR, which you should care about.)
-.PP
-The return value is \fI\s-1TRUE\s0\fR if you have handled the attribute or \fI\s-1FALSE\s0\fR
-otherwise. If you are handling an attribute and something fails, you
-should call \f(CW\*(C`dbd_drv_error()\*(C'\fR, so \fB\s-1DBI\s0\fR can raise exceptions, if desired.
-If \f(CW\*(C`dbd_drv_error()\*(C'\fR returns, however, you have a problem: the user will
-never know about the error, because he typically will not check
-\&\f(CW\*(C`$dbh\->errstr()\*(C'\fR.
-.PP
-I cannot recommend a general way of going on, if \f(CW\*(C`dbd_drv_error()\*(C'\fR returns,
-but there are examples where even the \fB\s-1DBI\s0\fR specification expects that
-you \f(CW\*(C`croak()\*(C'\fR. (See the \fIAutoCommit\fR method in \s-1DBI\s0.)
-.PP
-If you have to store attributes, you should either use your private
-data structure \fIimp_xxx\fR, the handle hash (via \f(CW\*(C`(HV*)SvRV(dbh)\*(C'\fR), or use
-the private \fIimp_data\fR.
-.PP
-The first is best for internal C values like integers or pointers and
-where speed is important within the driver. The handle hash is best for
-values the user may want to get/set via driver-specific attributes.
-The private \fIimp_data\fR is an additional \f(CW\*(C`SV\*(C'\fR attached to the handle. You
-could think of it as an unnamed handle attribute. It's not normally used.
-.PP
-\fIThe dbd_db_FETCH_attrib method\fR
-.IX Subsection "The dbd_db_FETCH_attrib method"
-.PP
-This is the counterpart of \f(CW\*(C`dbd_db_STORE_attrib()\*(C'\fR, needed for:
-.PP
-.Vb 1
-\& $value = $dbh\->{$key};
-.Ve
-.PP
-Its prototype is:
-.PP
-.Vb 1
-\& SV* dbd_db_FETCH_attrib(SV* dbh, imp_dbh_t* imp_dbh, SV* keysv);
-.Ve
-.PP
-Unlike all previous methods this returns an \f(CW\*(C`SV\*(C'\fR with the value. Note
-that you should normally execute \f(CW\*(C`sv_2mortal()\*(C'\fR, if you return a nonconstant
-value. (Constant values are \f(CW&sv_undef\fR, \f(CW&sv_no\fR and \f(CW&sv_yes\fR.)
-.PP
-Note, that \fB\s-1DBI\s0\fR implements a caching algorithm for attribute values.
-If you think, that an attribute may be fetched, you store it in the
-\&\fIdbh\fR itself:
-.PP
-.Vb 2
-\& if (cacheit) /* cache value for later DBI \*(Aqquick\*(Aq fetch? */
-\& hv_store((HV*)SvRV(dbh), key, kl, cachesv, 0);
-.Ve
-.PP
-\fIThe dbd_st_prepare method\fR
-.IX Subsection "The dbd_st_prepare method"
-.PP
-This is the private part of the \f(CW\*(C`prepare()\*(C'\fR method. Note that you
-\&\fBmust not\fR really execute the statement here. You may, however,
-preparse and validate the statement, or do similar things.
-.PP
-.Vb 2
-\& int dbd_st_prepare(SV* sth, imp_sth_t* imp_sth, char* statement,
-\& SV* attribs);
-.Ve
-.PP
-A typical, simple, possibility is to do nothing and rely on the perl
-\&\f(CW\*(C`prepare()\*(C'\fR code that set the \fIStatement\fR attribute on the handle. This
-attribute can then be used by \f(CW\*(C`dbd_st_execute()\*(C'\fR.
-.PP
-If the driver supports placeholders then the \fI\s-1NUM_OF_PARAMS\s0\fR attribute
-must be set correctly by \f(CW\*(C`dbd_st_prepare()\*(C'\fR:
-.PP
-.Vb 1
-\& DBIc_NUM_PARAMS(imp_sth) = ...
-.Ve
-.PP
-If you can, you should also setup attributes like \fI\s-1NUM_OF_FIELDS\s0\fR, \fI\s-1NAME\s0\fR,
-etc. here, but \fB\s-1DBI\s0\fR doesn't require that \- they can be deferred until
-\&\fIexecute()\fR is called. However, if you do, document it.
-.PP
-In any case you should set the \fI\s-1IMPSET\s0\fR flag, as you did in
-\&\f(CW\*(C`dbd_db_connect()\*(C'\fR above:
-.PP
-.Vb 1
-\& DBIc_IMPSET_on(imp_sth);
-.Ve
-.PP
-\fIThe dbd_st_execute method\fR
-.IX Subsection "The dbd_st_execute method"
-.PP
-This is where a statement will really be executed.
-.PP
-.Vb 1
-\& int dbd_st_execute(SV* sth, imp_sth_t* imp_sth);
-.Ve
-.PP
-\&\f(CW\*(C`dbd_st_execute\*(C'\fR should return \-2 for any error, \-1 if the number of
-rows affected is unknown else it should be the number of affected
-(updated, inserted) rows.
-.PP
-Note that you must be aware a statement may be executed repeatedly.
-Also, you should not expect that \f(CW\*(C`finish()\*(C'\fR will be called between two
-executions, so you might need code, like the following, near the start
-of the function:
-.PP
-.Vb 2
-\& if (DBIc_ACTIVE(imp_sth))
-\& dbd_st_finish(h, imp_sth);
-.Ve
-.PP
-If your driver supports the binding of parameters (it should!), but the
-database doesn't, you must do it here. This can be done as follows:
-.PP
-.Vb 4
-\& SV *svp;
-\& char* statement = DBD_ATTRIB_GET_PV(h, "Statement", 9, svp, "");
-\& int numParam = DBIc_NUM_PARAMS(imp_sth);
-\& int i;
-\&
-\& for (i = 0; i < numParam; i++)
-\& {
-\& char* value = dbd_db_get_param(sth, imp_sth, i);
-\& /* It is your drivers task to implement dbd_db_get_param, */
-\& /* it must be setup as a counterpart of dbd_bind_ph. */
-\& /* Look for \*(Aq?\*(Aq and replace it with \*(Aqvalue\*(Aq. Difficult */
-\& /* task, note that you may have question marks inside */
-\& /* quotes and comments the like ... :\-( */
-\& /* See DBD::mysql for an example. (Don\*(Aqt look too deep into */
-\& /* the example, you will notice where I was lazy ...) */
-\& }
-.Ve
-.PP
-The next thing is to really execute the statement.
-.PP
-Note that you must set the attributes \fI\s-1NUM_OF_FIELDS\s0\fR, \fI\s-1NAME\s0\fR, etc
-when the statement is successfully executed if the driver has not
-already done so: they may be used even before a potential \f(CW\*(C`fetchrow()\*(C'\fR.
-In particular you have to tell \fB\s-1DBI\s0\fR the number of fields that the
-statement has, because it will be used by \fB\s-1DBI\s0\fR internally. Thus the
-function will typically ends with:
-.PP
-.Vb 4
-\& if (isSelectStatement) {
-\& DBIc_NUM_FIELDS(imp_sth) = numFields;
-\& DBIc_ACTIVE_on(imp_sth);
-\& }
-.Ve
-.PP
-It is important that the \fI\s-1ACTIVE\s0\fR flag only be set for \f(CW\*(C`SELECT\*(C'\fR
-statements (or any other statements that can return many
-values from the database using a cursor-like mechanism). See
-\&\f(CW\*(C`dbd_db_connect()\*(C'\fR above for more explanations.
-.PP
-There plans for a preparse function to be provided by \fB\s-1DBI\s0\fR, but this has
-not reached fruition yet.
-Meantime, if you want to know how ugly it can get, try looking at the
-\&\f(CW\*(C`dbd_ix_preparse()\*(C'\fR in \fBDBD::Informix\fR \fIdbdimp.ec\fR and the related
-functions in \fIiustoken.c\fR and \fIsqltoken.c\fR.
-.PP
-\fIThe dbd_st_fetch method\fR
-.IX Subsection "The dbd_st_fetch method"
-.PP
-This function fetches a row of data. The row is stored in in an array,
-of \f(CW\*(C`SV\*(C'\fR's that \fB\s-1DBI\s0\fR prepares for you. This has two advantages: it is fast
-(you even reuse the \f(CW\*(C`SV\*(C'\fR's, so they don't have to be created after the
-first \f(CW\*(C`fetchrow()\*(C'\fR), and it guarantees that \fB\s-1DBI\s0\fR handles \f(CW\*(C`bind_cols()\*(C'\fR for
-you.
-.PP
-What you do is the following:
-.PP
-.Vb 6
-\& AV* av;
-\& int numFields = DBIc_NUM_FIELDS(imp_sth); /* Correct, if NUM_FIELDS
-\& is constant for this statement. There are drivers where this is
-\& not the case! */
-\& int chopBlanks = DBIc_is(imp_sth, DBIcf_ChopBlanks);
-\& int i;
-\&
-\& if (!fetch_new_row_of_data(...)) {
-\& ... /* check for error or end\-of\-data */
-\& DBIc_ACTIVE_off(imp_sth); /* turn off Active flag automatically */
-\& return Nullav;
-\& }
-\& /* get the fbav (field buffer array value) for this row */
-\& /* it is very important to only call this after you know */
-\& /* that you have a row of data to return. */
-\& av = DBIc_DBISTATE(imp_sth)\->get_fbav(imp_sth);
-\& for (i = 0; i < numFields; i++) {
-\& SV* sv = fetch_a_field(..., i);
-\& if (chopBlanks && SvOK(sv) && type_is_blank_padded(field_type[i])) {
-\& /* Remove white space from end (only) of sv */
-\& }
-\& sv_setsv(AvARRAY(av)[i], sv); /* Note: (re)use! */
-\& }
-\& return av;
-.Ve
-.PP
-There's no need to use a \f(CW\*(C`fetch_a_field()\*(C'\fR function returning an \f(CW\*(C`SV*\*(C'\fR.
-It's more common to use your database \s-1API\s0 functions to fetch the
-data as character strings and use code like this:
-.PP
-.Vb 1
-\& sv_setpvn(AvARRAY(av)[i], char_ptr, char_count);
-.Ve
-.PP
-\&\f(CW\*(C`NULL\*(C'\fR values must be returned as \f(CW\*(C`undef\*(C'\fR. You can use code like this:
-.PP
-.Vb 1
-\& SvOK_off(AvARRAY(av)[i]);
-.Ve
-.PP
-The function returns the \f(CW\*(C`AV\*(C'\fR prepared by \fB\s-1DBI\s0\fR for success or \f(CW\*(C`Nullav\*(C'\fR
-otherwise.
-.PP
-.Vb 3
-\& *FIX ME* Discuss what happens when there\*(Aqs no more data to fetch.
-\& Are errors permitted if another fetch occurs after the first fetch
-\& that reports no more data. (Permitted, not required.)
-.Ve
-.PP
-If an error occurs which leaves the \fI\f(CI$sth\fI\fR in a state where remaining
-rows can't be fetched then \fIActive\fR should be turned off before the
-method returns.
-.PP
-\fIThe dbd_st_finish3 method\fR
-.IX Subsection "The dbd_st_finish3 method"
-.PP
-The \f(CW\*(C`$sth\->finish()\*(C'\fR method can be called if the user wishes to
-indicate that no more rows will be fetched even if the database has more
-rows to offer, and the \fB\s-1DBI\s0\fR code can call the function when handles are
-being destroyed. See the \fB\s-1DBI\s0\fR specification for more background details.
-.PP
-In both circumstances, the \fB\s-1DBI\s0\fR code ends up calling the
-\&\f(CW\*(C`dbd_st_finish3()\*(C'\fR method (if you provide a mapping for
-\&\f(CW\*(C`dbd_st_finish3()\*(C'\fR in \fIdbdimp.h\fR), or \f(CW\*(C`dbd_st_finish()\*(C'\fR otherwise.
-The difference is that \f(CW\*(C`dbd_st_finish3()\*(C'\fR takes a third argument which
-is an \f(CW\*(C`int\*(C'\fR with the value 1 if it is being called from a \f(CW\*(C`destroy()\*(C'\fR
-method and 0 otherwise.
-.PP
-Note that \fB\s-1DBI\s0\fR v1.32 and earlier test on \f(CW\*(C`dbd_db_finish3()\*(C'\fR to call
-\&\f(CW\*(C`dbd_st_finish3()\*(C'\fR; if you provide \f(CW\*(C`dbd_st_finish3()\*(C'\fR, either define
-\&\f(CW\*(C`dbd_db_finish3()\*(C'\fR too, or insist on \fB\s-1DBI\s0\fR v1.33 or later.
-.PP
-All it \fIneeds\fR to do is turn off the \fIActive\fR flag for the \fIsth\fR.
-It will only be called by \fIDriver.xst\fR code, if the driver has set \fI\s-1ACTIVE\s0\fR
-to on for the \fIsth\fR.
-.PP
-Outline example:
-.PP
-.Vb 8
-\& int dbd_st_finish3(SV* sth, imp_sth_t* imp_sth, int from_destroy) {
-\& if (DBIc_ACTIVE(imp_sth))
-\& {
-\& /* close cursor or equivalent action */
-\& DBIc_ACTIVE_off(imp_sth);
-\& }
-\& return 1;
-\& }
-.Ve
-.PP
-The from_destroy parameter is true if \f(CW\*(C`dbd_st_finish3()\*(C'\fR is being called
-from \f(CW\*(C`DESTROY()\*(C'\fR \- and so the statement is about to be destroyed.
-For many drivers there is no point in doing anything more than turning off
-the \fIActive\fR flag in this case.
-.PP
-The function returns \fI\s-1TRUE\s0\fR for success, \fI\s-1FALSE\s0\fR otherwise, but there isn't
-a lot anyone can do to recover if there is an error.
-.PP
-\fIThe dbd_st_destroy method\fR
-.IX Subsection "The dbd_st_destroy method"
-.PP
-This function is the private part of the statement handle destructor.
-.PP
-.Vb 4
-\& void dbd_st_destroy(SV* sth, imp_sth_t* imp_sth) {
-\& ... /* any clean\-up that\*(Aqs needed */
-\& DBIc_IMPSET_off(imp_sth); /* let DBI know we\*(Aqve done it */
-\& }
-.Ve
-.PP
-The \fB\s-1DBI\s0\fR \fIDriver.xst\fR code will call \f(CW\*(C`dbd_st_finish()\*(C'\fR for you, if the
-\&\fIsth\fR has the \fI\s-1ACTIVE\s0\fR flag set, before calling \f(CW\*(C`dbd_st_destroy()\*(C'\fR.
-.PP
-\fIThe dbd_st_STORE_attrib and dbd_st_FETCH_attrib methods\fR
-.IX Subsection "The dbd_st_STORE_attrib and dbd_st_FETCH_attrib methods"
-.PP
-These functions correspond to \f(CW\*(C`dbd_db_STORE()\*(C'\fR and \f(CW\*(C`dbd_db_FETCH()\*(C'\fR attrib
-above, except that they are for statement handles.
-See above.
-.PP
-.Vb 3
-\& int dbd_st_STORE_attrib(SV* sth, imp_sth_t* imp_sth, SV* keysv,
-\& SV* valuesv);
-\& SV* dbd_st_FETCH_attrib(SV* sth, imp_sth_t* imp_sth, SV* keysv);
-.Ve
-.PP
-\fIThe dbd_bind_ph method\fR
-.IX Subsection "The dbd_bind_ph method"
-.PP
-This function is internally used by the \f(CW\*(C`bind_param()\*(C'\fR method, the
-\&\f(CW\*(C`bind_param_inout()\*(C'\fR method and by the \fB\s-1DBI\s0\fR \fIDriver.xst\fR code if
-\&\f(CW\*(C`execute()\*(C'\fR is called with any bind parameters.
-.PP
-.Vb 3
-\& int dbd_bind_ph (SV *sth, imp_sth_t *imp_sth, SV *param,
-\& SV *value, IV sql_type, SV *attribs,
-\& int is_inout, IV maxlen);
-.Ve
-.PP
-The \fIparam\fR argument holds an \f(CW\*(C`IV\*(C'\fR with the parameter number (1, 2, ...).
-The \fIvalue\fR argument is the parameter value and \fIsql_type\fR is its type.
-.PP
-If your driver does not support \f(CW\*(C`bind_param_inout()\*(C'\fR then you should
-ignore \fImaxlen\fR and croak if \fIis_inout\fR is \fI\s-1TRUE\s0\fR.
-.PP
-If your driver \fIdoes\fR support \f(CW\*(C`bind_param_inout()\*(C'\fR then you should
-note that \fIvalue\fR is the \f(CW\*(C`SV\*(C'\fR \fIafter\fR dereferencing the reference
-passed to \f(CW\*(C`bind_param_inout()\*(C'\fR.
-.PP
-In drivers of simple databases the function will, for example, store
-the value in a parameter array and use it later in \f(CW\*(C`dbd_st_execute()\*(C'\fR.
-See the \fBDBD::mysql\fR driver for an example.
-.PP
-\fIImplementing bind_param_inout support\fR
-.IX Subsection "Implementing bind_param_inout support"
-.PP
-To provide support for parameters bound by reference rather than by
-value, the driver must do a number of things. First, and most
-importantly, it must note the references and stash them in its own
-driver structure. Secondly, when a value is bound to a column, the
-driver must discard any previous reference bound to the column. On
-each execute, the driver must evaluate the references and internally
-bind the values resulting from the references. This is only applicable
-if the user writes:
-.PP
-.Vb 1
-\& $sth\->execute;
-.Ve
-.PP
-If the user writes:
-.PP
-.Vb 1
-\& $sth\->execute(@values);
-.Ve
-.PP
-then \fB\s-1DBI\s0\fR automatically calls the binding code for each element of
-\&\fI\f(CI@values\fI\fR. These calls are indistinguishable from explicit user calls to
-\&\f(CW\*(C`bind_param()\*(C'\fR.
-.SS "C/XS version of Makefile.PL"
-.IX Subsection "C/XS version of Makefile.PL"
-The \fIMakefile.PL\fR file for a C/XS driver is similar to the code needed
-for a pure Perl driver, but there are a number of extra bits of
-information needed by the build system.
-.PP
-For example, the attributes list passed to \f(CW\*(C`WriteMakefile()\*(C'\fR needs
-to specify the object files that need to be compiled and built into
-the shared object (\s-1DLL\s0). This is often, but not necessarily, just
-\&\fIdbdimp.o\fR (unless that should be \fIdbdimp.obj\fR because you're building
-on \s-1MS\s0 Windows).
-.PP
-Note that you can reliably determine the extension of the object files
-from the \fI\f(CI$Config\fI{obj_ext}\fR values, and there are many other useful pieces
-of configuration information lurking in that hash.
-You get access to it with:
-.PP
-.Vb 1
-\& use Config;
-.Ve
-.SS "Methods which do not need to be written"
-.IX Subsection "Methods which do not need to be written"
-The \fB\s-1DBI\s0\fR code implements the majority of the methods which are accessed
-using the notation \f(CW\*(C`DBI\->function()\*(C'\fR, the only exceptions being
-\&\f(CW\*(C`DBI\->connect()\*(C'\fR and \f(CW\*(C`DBI\->data_sources()\*(C'\fR which require
-support from the driver.
-.PP
-The \fB\s-1DBI\s0\fR code implements the following documented driver, database and
-statement functions which do not need to be written by the \fB\s-1DBD\s0\fR driver
-writer.
-.ie n .IP "$dbh\->\fIdo()\fR" 4
-.el .IP "\f(CW$dbh\fR\->\fIdo()\fR" 4
-.IX Item "$dbh->do()"
-The default implementation of this function prepares, executes and
-destroys the statement. This can be replaced if there is a better
-way to implement this, such as \f(CW\*(C`EXECUTE IMMEDIATE\*(C'\fR which can
-sometimes be used if there are no parameters.
-.ie n .IP "$h\->\fIerrstr()\fR" 4
-.el .IP "\f(CW$h\fR\->\fIerrstr()\fR" 4
-.IX Item "$h->errstr()"
-.PD 0
-.ie n .IP "$h\->\fIerr()\fR" 4
-.el .IP "\f(CW$h\fR\->\fIerr()\fR" 4
-.IX Item "$h->err()"
-.ie n .IP "$h\->\fIstate()\fR" 4
-.el .IP "\f(CW$h\fR\->\fIstate()\fR" 4
-.IX Item "$h->state()"
-.ie n .IP "$h\->\fItrace()\fR" 4
-.el .IP "\f(CW$h\fR\->\fItrace()\fR" 4
-.IX Item "$h->trace()"
-.PD
-The \fB\s-1DBD\s0\fR driver does not need to worry about these routines at all.
-.ie n .IP "$h\->{ChopBlanks}" 4
-.el .IP "\f(CW$h\fR\->{ChopBlanks}" 4
-.IX Item "$h->{ChopBlanks}"
-This attribute needs to be honored during \f(CW\*(C`fetch()\*(C'\fR operations, but does
-not need to be handled by the attribute handling code.
-.ie n .IP "$h\->{RaiseError}" 4
-.el .IP "\f(CW$h\fR\->{RaiseError}" 4
-.IX Item "$h->{RaiseError}"
-The \fB\s-1DBD\s0\fR driver does not need to worry about this attribute at all.
-.ie n .IP "$h\->{PrintError}" 4
-.el .IP "\f(CW$h\fR\->{PrintError}" 4
-.IX Item "$h->{PrintError}"
-The \fB\s-1DBD\s0\fR driver does not need to worry about this attribute at all.
-.ie n .IP "$sth\->\fIbind_col()\fR" 4
-.el .IP "\f(CW$sth\fR\->\fIbind_col()\fR" 4
-.IX Item "$sth->bind_col()"
-Assuming the driver uses the \f(CW\*(C`DBIc_DBISTATE(imp_xxh)\->get_fbav()\*(C'\fR
-function (C drivers, see below), or the \f(CW\*(C`$sth\->_set_fbav($data)\*(C'\fR
-method (Perl drivers) the driver does not need to do anything about this
-routine.
-.ie n .IP "$sth\->\fIbind_columns()\fR" 4
-.el .IP "\f(CW$sth\fR\->\fIbind_columns()\fR" 4
-.IX Item "$sth->bind_columns()"
-Regardless of whether the driver uses
-\&\f(CW\*(C`DBIc_DBISTATE(imp_xxh)\->get_fbav()\*(C'\fR, the driver does not need
-to do anything about this routine as it simply iteratively calls
-\&\f(CW\*(C`$sth\->bind_col()\*(C'\fR.
-.PP
-The \fB\s-1DBI\s0\fR code implements a default implementation of the following
-functions which do not need to be written by the \fB\s-1DBD\s0\fR driver writer
-unless the default implementation is incorrect for the Driver.
-.ie n .IP "$dbh\->\fIquote()\fR" 4
-.el .IP "\f(CW$dbh\fR\->\fIquote()\fR" 4
-.IX Item "$dbh->quote()"
-This should only be written if the database does not accept the \s-1ANSI
-SQL\s0 standard for quoting strings, with the string enclosed in single
-quotes and any embedded single quotes replaced by two consecutive
-single quotes.
-.Sp
-For the two argument form of quote, you need to implement the
-\&\f(CW\*(C`type_info()\*(C'\fR method to provide the information that quote needs.
-.ie n .IP "$dbh\->\fIping()\fR" 4
-.el .IP "\f(CW$dbh\fR\->\fIping()\fR" 4
-.IX Item "$dbh->ping()"
-This should be implemented as a simple efficient way to determine
-whether the connection to the database is still alive. Typically
-code like this:
-.Sp
-.Vb 9
-\& sub ping {
-\& my $dbh = shift;
-\& $sth = $dbh\->prepare_cached(q{
-\& select * from A_TABLE_NAME where 1=0
-\& }) or return 0;
-\& $sth\->execute or return 0;
-\& $sth\->finish;
-\& return 1;
-\& }
-.Ve
-.Sp
-where \fIA_TABLE_NAME\fR is the name of a table that always exists (such as a
-database system catalogue).
-.ie n .IP "$drh\->default_user" 4
-.el .IP "\f(CW$drh\fR\->default_user" 4
-.IX Item "$drh->default_user"
-The default implementation of default_user will get the database
-username and password fields from \f(CW$ENV{DBI_USER}\fR and
-\&\f(CW$ENV{DBI_PASS}\fR. You can override this method. It is called as
-follows:
-.Sp
-.Vb 1
-\& ($user, $pass) = $drh\->default_user($user, $pass, $attr)
-.Ve
-.SH "METADATA METHODS"
-.IX Header "METADATA METHODS"
-The exposition above ignores the \fB\s-1DBI\s0\fR MetaData methods.
-The metadata methods are all associated with a database handle.
-.SS "Using DBI::DBD::Metadata"
-.IX Subsection "Using DBI::DBD::Metadata"
-The \fBDBI::DBD::Metadata\fR module is a good semi-automatic way for the
-developer of a \fB\s-1DBD\s0\fR module to write the \f(CW\*(C`get_info()\*(C'\fR and \f(CW\*(C`type_info()\*(C'\fR
-functions quickly and accurately.
-.PP
-\fIGenerating the get_info method\fR
-.IX Subsection "Generating the get_info method"
-.PP
-Prior to \fB\s-1DBI\s0\fR v1.33, this existed as the method \f(CW\*(C`write_getinfo_pm()\*(C'\fR
-in the \fB\s-1DBI::DBD\s0\fR module. From \fB\s-1DBI\s0\fR v1.33, it exists as the method
-\&\f(CW\*(C`write_getinfo_pm()\*(C'\fR in the \fBDBI::DBD::Metadata\fR module. This
-discussion assumes you have \fB\s-1DBI\s0\fR v1.33 or later.
-.PP
-You examine the documentation for \f(CW\*(C`write_getinfo_pm()\*(C'\fR using:
-.PP
-.Vb 1
-\& perldoc DBI::DBD::Metadata
-.Ve
-.PP
-To use it, you need a Perl \fB\s-1DBI\s0\fR driver for your database which implements
-the \f(CW\*(C`get_info()\*(C'\fR method. In practice, this means you need to install
-\&\fB\s-1DBD::ODBC\s0\fR, an \s-1ODBC\s0 driver manager, and an \s-1ODBC\s0 driver for your
-database.
-.PP
-With the pre-requisites in place, you might type:
-.PP
-.Vb 2
-\& perl \-MDBI::DBD::Metadata \-we \e
-\& "write_getinfo_pm (qw{ dbi:ODBC:foo_db username password Driver })"
-.Ve
-.PP
-The procedure writes to standard output the code that should be added to
-your \fIDriver.pm\fR file and the code that should be written to
-\&\fIlib/DBD/Driver/GetInfo.pm\fR.
-.PP
-You should review the output to ensure that it is sensible.
-.PP
-\fIGenerating the type_info method\fR
-.IX Subsection "Generating the type_info method"
-.PP
-Given the idea of the \f(CW\*(C`write_getinfo_pm()\*(C'\fR method, it was not hard
-to devise a parallel method, \f(CW\*(C`write_typeinfo_pm()\*(C'\fR, which does the
-analogous job for the \fB\s-1DBI\s0\fR \f(CW\*(C`type_info_all()\*(C'\fR metadata method. The
-\&\f(CW\*(C`write_typeinfo_pm()\*(C'\fR method was added to \fB\s-1DBI\s0\fR v1.33.
-.PP
-You examine the documentation for \f(CW\*(C`write_typeinfo_pm()\*(C'\fR using:
-.PP
-.Vb 1
-\& perldoc DBI::DBD::Metadata
-.Ve
-.PP
-The setup is exactly analogous to the mechanism described in
-\&\*(L"Generating the get_info method\*(R".
-.PP
-With the pre-requisites in place, you might type:
-.PP
-.Vb 2
-\& perl \-MDBI::DBD::Metadata \-we \e
-\& "write_typeinfo_pm (qw{ dbi:ODBC:foo_db username password Driver })"
-.Ve
-.PP
-The procedure writes to standard output the code that should be added to
-your \fIDriver.pm\fR file and the code that should be written to
-\&\fIlib/DBD/Driver/TypeInfo.pm\fR.
-.PP
-You should review the output to ensure that it is sensible.
-.SS "Writing DBD::Driver::db::get_info"
-.IX Subsection "Writing DBD::Driver::db::get_info"
-If you use the \fBDBI::DBD::Metadata\fR module, then the code you need is
-generated for you.
-.PP
-If you decide not to use the \fBDBI::DBD::Metadata\fR module, you
-should probably borrow the code from a driver that has done so (eg
-\&\fBDBD::Informix\fR from version 1.05 onwards) and crib the code from
-there, or look at the code that generates that module and follow
-that. The method in \fIDriver.pm\fR will be very simple; the method in
-\&\fIlib/DBD/Driver/GetInfo.pm\fR is not very much more complex unless your
-\&\s-1DBMS\s0 itself is much more complex.
-.PP
-Note that some of the \fB\s-1DBI\s0\fR utility methods rely on information from the
-\&\f(CW\*(C`get_info()\*(C'\fR method to perform their operations correctly. See, for
-example, the \f(CW\*(C`quote_identifier()\*(C'\fR and quote methods, discussed below.
-.SS "Writing DBD::Driver::db::type_info_all"
-.IX Subsection "Writing DBD::Driver::db::type_info_all"
-If you use the \f(CW\*(C`DBI::DBD::Metadata\*(C'\fR module, then the code you need is
-generated for you.
-.PP
-If you decide not to use the \f(CW\*(C`DBI::DBD::Metadata\*(C'\fR module, you
-should probably borrow the code from a driver that has done so (eg
-\&\f(CW\*(C`DBD::Informix\*(C'\fR from version 1.05 onwards) and crib the code from
-there, or look at the code that generates that module and follow
-that. The method in \fIDriver.pm\fR will be very simple; the method in
-\&\fIlib/DBD/Driver/TypeInfo.pm\fR is not very much more complex unless your
-\&\s-1DBMS\s0 itself is much more complex.
-.SS "Writing DBD::Driver::db::type_info"
-.IX Subsection "Writing DBD::Driver::db::type_info"
-The guidelines on writing this method are still not really clear.
-No sample implementation is available.
-.SS "Writing DBD::Driver::db::table_info"
-.IX Subsection "Writing DBD::Driver::db::table_info"
-.Vb 2
-\& *FIX ME* The guidelines on writing this method have not been written yet.
-\& No sample implementation is available.
-.Ve
-.SS "Writing DBD::Driver::db::column_info"
-.IX Subsection "Writing DBD::Driver::db::column_info"
-.Vb 2
-\& *FIX ME* The guidelines on writing this method have not been written yet.
-\& No sample implementation is available.
-.Ve
-.SS "Writing DBD::Driver::db::primary_key_info"
-.IX Subsection "Writing DBD::Driver::db::primary_key_info"
-.Vb 2
-\& *FIX ME* The guidelines on writing this method have not been written yet.
-\& No sample implementation is available.
-.Ve
-.SS "Writing DBD::Driver::db::primary_key"
-.IX Subsection "Writing DBD::Driver::db::primary_key"
-.Vb 2
-\& *FIX ME* The guidelines on writing this method have not been written yet.
-\& No sample implementation is available.
-.Ve
-.SS "Writing DBD::Driver::db::foreign_key_info"
-.IX Subsection "Writing DBD::Driver::db::foreign_key_info"
-.Vb 2
-\& *FIX ME* The guidelines on writing this method have not been written yet.
-\& No sample implementation is available.
-.Ve
-.SS "Writing DBD::Driver::db::tables"
-.IX Subsection "Writing DBD::Driver::db::tables"
-This method generates an array of names in a format suitable for being
-embedded in \s-1SQL\s0 statements in places where a table name is expected.
-.PP
-If your database hews close enough to the \s-1SQL\s0 standard or if you have
-implemented an appropriate \f(CW\*(C`table_info()\*(C'\fR function and and the appropriate
-\&\f(CW\*(C`quote_identifier()\*(C'\fR function, then the \fB\s-1DBI\s0\fR default version of this method
-will work for your driver too.
-.PP
-Otherwise, you have to write a function yourself, such as:
-.PP
-.Vb 12
-\& sub tables
-\& {
-\& my($dbh, $cat, $sch, $tab, $typ) = @_;
-\& my(@res);
-\& my($sth) = $dbh\->table_info($cat, $sch, $tab, $typ);
-\& my(@arr);
-\& while (@arr = $sth\->fetchrow_array)
-\& {
-\& push @res, $dbh\->quote_identifier($arr[0], $arr[1], $arr[2]);
-\& }
-\& return @res;
-\& }
-.Ve
-.PP
-See also the default implementation in \fI\s-1DBI\s0.pm\fR.
-.SS "Writing DBD::Driver::db::quote"
-.IX Subsection "Writing DBD::Driver::db::quote"
-This method takes a value and converts it into a string suitable for
-embedding in an \s-1SQL\s0 statement as a string literal.
-.PP
-If your \s-1DBMS\s0 accepts the \s-1SQL\s0 standard notation for strings (single
-quotes around the string as a whole with any embedded single quotes
-doubled up), then you do not need to write this method as \fB\s-1DBI\s0\fR provides a
-default method that does it for you.
-.PP
-If your \s-1DBMS\s0 uses an alternative notation or escape mechanism, then you
-need to provide an equivalent function. For example, suppose your \s-1DBMS\s0
-used C notation with double quotes around the string and backslashes
-escaping both double quotes and backslashes themselves. Then you might
-write the function as:
-.PP
-.Vb 6
-\& sub quote
-\& {
-\& my($dbh, $str) = @_;
-\& $str =~ s/["\e\e]/\e\e$&/gmo;
-\& return qq{"$str"};
-\& }
-.Ve
-.PP
-Handling newlines and other control characters is left as an exercise
-for the reader.
-.PP
-This sample method ignores the \fI\f(CI$data_type\fI\fR indicator which is the
-optional second argument to the method.
-.SS "Writing DBD::Driver::db::quote_identifier"
-.IX Subsection "Writing DBD::Driver::db::quote_identifier"
-This method is called to ensure that the name of the given table (or
-other database object) can be embedded into an \s-1SQL\s0 statement without
-danger of misinterpretation. The result string should be usable in the
-text of an \s-1SQL\s0 statement as the identifier for a table.
-.PP
-If your \s-1DBMS\s0 accepts the \s-1SQL\s0 standard notation for quoted identifiers
-(which uses double quotes around the identifier as a whole, with any
-embedded double quotes doubled up) and accepts \fI\*(L"schema\*(R".\*(L"identifier\*(R"\fR
-(and \fI\*(L"catalog\*(R".\*(L"schema\*(R".\*(L"identifier\*(R"\fR when a catalog is specified), then
-you do not need to write this method as \fB\s-1DBI\s0\fR provides a default method
-that does it for you.
-.PP
-In fact, even if your \s-1DBMS\s0 does not handle exactly that notation but
-you have implemented the \f(CW\*(C`get_info()\*(C'\fR method and it gives the correct
-responses, then it will work for you. If your database is fussier, then
-you need to implement your own version of the function.
-.PP
-For example, \fBDBD::Informix\fR has to deal with an environment variable
-\&\fI\s-1DELIMIDENT\s0\fR. If it is not set, then the \s-1DBMS\s0 treats names enclosed in
-double quotes as strings rather than names, which is usually a syntax
-error. Additionally, the catalog portion of the name is separated from
-the schema and table by a different delimiter (colon instead of dot),
-and the catalog portion is never enclosed in quotes. (Fortunately,
-valid strings for the catalog will never contain weird characters that
-might need to be escaped, unless you count dots, dashes, slashes and
-at-signs as weird.) Finally, an Informix database can contain objects
-that cannot be accessed because they were created by a user with the
-\&\fI\s-1DELIMIDENT\s0\fR environment variable set, but the current user does not
-have it set. By design choice, the \f(CW\*(C`quote_identifier()\*(C'\fR method encloses
-those identifiers in double quotes anyway, which generally triggers a
-syntax error, and the metadata methods which generate lists of tables
-etc omit those identifiers from the result sets.
-.PP
-.Vb 10
-\& sub quote_identifier
-\& {
-\& my($dbh, $cat, $sch, $obj) = @_;
-\& my($rv) = "";
-\& my($qq) = (defined $ENV{DELIMIDENT}) ? \*(Aq"\*(Aq : \*(Aq\*(Aq;
-\& $rv .= qq{$cat:} if (defined $cat);
-\& if (defined $sch)
-\& {
-\& if ($sch !~ m/^\ew+$/o)
-\& {
-\& $qq = \*(Aq"\*(Aq;
-\& $sch =~ s/$qq/$qq$qq/gm;
-\& }
-\& $rv .= qq{$qq$sch$qq.};
-\& }
-\& if (defined $obj)
-\& {
-\& if ($obj !~ m/^\ew+$/o)
-\& {
-\& $qq = \*(Aq"\*(Aq;
-\& $obj =~ s/$qq/$qq$qq/gm;
-\& }
-\& $rv .= qq{$qq$obj$qq};
-\& }
-\& return $rv;
-\& }
-.Ve
-.PP
-Handling newlines and other control characters is left as an exercise
-for the reader.
-.PP
-Note that there is an optional fourth parameter to this function which
-is a reference to a hash of attributes; this sample implementation
-ignores that.
-.PP
-This sample implementation also ignores the single-argument variant of
-the method.
-.SH "TRACING"
-.IX Header "TRACING"
-Tracing in \s-1DBI\s0 is controlled with a combination of a trace level and a
-set of flags which together are known as the trace settings. The trace
-settings are stored in a single integer and divided into levels and
-flags by a set of masks (\f(CW\*(C`DBIc_TRACE_LEVEL_MASK\*(C'\fR and
-\&\f(CW\*(C`DBIc_TRACE_FLAGS_MASK\*(C'\fR).
-.PP
-Each handle has it's own trace settings and so does the \s-1DBI.\s0 When you
-call a method the \s-1DBI\s0 merges the handles settings into its own for the
-duration of the call: the trace flags of the handle are \s-1OR\s0'd into the
-trace flags of the \s-1DBI,\s0 and if the handle has a higher trace level
-then the \s-1DBI\s0 trace level is raised to match it. The previous \s-1DBI\s0 trace
-settings are restored when the called method returns.
-.SS "Trace Level"
-.IX Subsection "Trace Level"
-The trace level is the first 4 bits of the trace settings (masked by
-\&\f(CW\*(C`DBIc_TRACE_FLAGS_MASK\*(C'\fR) and represents trace levels of 1 to 15. Do
-not output anything at trace levels less than 3 as they are reserved
-for \s-1DBI.\s0
-.PP
-For advice on what to output at each level see \*(L"Trace Levels\*(R" in
-\&\s-1DBI\s0.
-.PP
-To test for a trace level you can use the \f(CW\*(C`DBIc_TRACE_LEVEL\*(C'\fR macro
-like this:
-.PP
-.Vb 3
-\& if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) {
-\& PerlIO_printf(DBIc_LOGPIO(imp_xxh), "foobar");
-\& }
-.Ve
-.PP
-Also \fBnote\fR the use of PerlIO_printf which you should always use for
-tracing and never the C \f(CW\*(C`stdio.h\*(C'\fR I/O functions.
-.SS "Trace Flags"
-.IX Subsection "Trace Flags"
-Trace flags are used to enable tracing of specific activities within
-the \s-1DBI\s0 and drivers. The \s-1DBI\s0 defines some trace flags and drivers can
-define others. \s-1DBI\s0 trace flag names begin with a capital letter and
-driver specific names begin with a lowercase letter. For a list of \s-1DBI\s0
-defined trace flags see \*(L"Trace Flags\*(R" in \s-1DBI\s0.
-.PP
-If you want to use private trace flags you'll probably want to be able
-to set them by name. Drivers are expected to override the
-parse_trace_flag (note the singular) and check if \f(CW$trace_flag_name\fR is
-a driver specific trace flags and, if not, then call the DBIs default
-\&\fIparse_trace_flag()\fR. To do that you'll need to define a
-\&\fIparse_trace_flag()\fR method like this:
-.PP
-.Vb 9
-\& sub parse_trace_flag {
-\& my ($h, $name) = @_;
-\& return 0x01000000 if $name eq \*(Aqfoo\*(Aq;
-\& return 0x02000000 if $name eq \*(Aqbar\*(Aq;
-\& return 0x04000000 if $name eq \*(Aqbaz\*(Aq;
-\& return 0x08000000 if $name eq \*(Aqboo\*(Aq;
-\& return 0x10000000 if $name eq \*(Aqbop\*(Aq;
-\& return $h\->SUPER::parse_trace_flag($name);
-\& }
-.Ve
-.PP
-All private flag names must be lowercase, and all private flags must
-be in the top 8 of the 32 bits of \f(CW\*(C`DBIc_TRACE_FLAGS(imp)\*(C'\fR i.e.,
-0xFF000000.
-.PP
-If you've defined a \fIparse_trace_flag()\fR method in ::db you'll also want
-it in ::st, so just alias it in:
-.PP
-.Vb 1
-\& *parse_trace_flag = \e&DBD::foo:db::parse_trace_flag;
-.Ve
-.PP
-You may want to act on the current '\s-1SQL\s0' trace flag that \s-1DBI\s0 defines
-to output \s-1SQL\s0 prepared/executed as \s-1DBI\s0 currently does not do \s-1SQL\s0
-tracing.
-.SS "Trace Macros"
-.IX Subsection "Trace Macros"
-Access to the trace level and trace flags is via a set of macros.
-.PP
-.Vb 4
-\& DBIc_TRACE_SETTINGS(imp) returns the trace settings
-\& DBIc_TRACE_LEVEL(imp) returns the trace level
-\& DBIc_TRACE_FLAGS(imp) returns the trace flags
-\& DBIc_TRACE(imp, flags, flaglevel, level)
-\&
-\& e.g.,
-\&
-\& DBIc_TRACE(imp, 0, 0, 4)
-\& if level >= 4
-\&
-\& DBIc_TRACE(imp, DBDtf_FOO, 2, 4)
-\& if tracing DBDtf_FOO & level>=2 or level>=4
-\&
-\& DBIc_TRACE(imp, DBDtf_FOO, 2, 0)
-\& as above but never trace just due to level
-.Ve
-.SH "WRITING AN EMULATION LAYER FOR AN OLD PERL INTERFACE"
-.IX Header "WRITING AN EMULATION LAYER FOR AN OLD PERL INTERFACE"
-Study \fIOraperl.pm\fR (supplied with \fBDBD::Oracle\fR) and \fIIngperl.pm\fR (supplied
-with \fBDBD::Ingres\fR) and the corresponding \fIdbdimp.c\fR files for ideas.
-.PP
-Note that the emulation code sets \f(CW\*(C`$dbh\->{CompatMode} = 1;\*(C'\fR for each
-connection so that the internals of the driver can implement behaviour
-compatible with the old interface when dealing with those handles.
-.SS "Setting emulation perl variables"
-.IX Subsection "Setting emulation perl variables"
-For example, ingperl has a \fI\f(CI$sql_rowcount\fI\fR variable. Rather than try
-to manually update this in \fIIngperl.pm\fR it can be done faster in C code.
-In \f(CW\*(C`dbd_init()\*(C'\fR:
-.PP
-.Vb 1
-\& sql_rowcount = perl_get_sv("Ingperl::sql_rowcount", GV_ADDMULTI);
-.Ve
-.PP
-In the relevant places do:
-.PP
-.Vb 2
-\& if (DBIc_COMPAT(imp_sth)) /* only do this for compatibility mode handles */
-\& sv_setiv(sql_rowcount, the_row_count);
-.Ve
-.SH "OTHER MISCELLANEOUS INFORMATION"
-.IX Header "OTHER MISCELLANEOUS INFORMATION"
-.SS "The imp_xyz_t types"
-.IX Subsection "The imp_xyz_t types"
-Any handle has a corresponding C structure filled with private data.
-Some of this data is reserved for use by \fB\s-1DBI\s0\fR (except for using the
-DBIc macros below), some is for you. See the description of the
-\&\fIdbdimp.h\fR file above for examples. Most functions in \fIdbdimp.c\fR
-are passed both the handle \f(CW\*(C`xyz\*(C'\fR and a pointer to \f(CW\*(C`imp_xyz\*(C'\fR. In
-rare cases, however, you may use the following macros:
-.IP "D_imp_dbh(dbh)" 4
-.IX Item "D_imp_dbh(dbh)"
-Given a function argument \fIdbh\fR, declare a variable \fIimp_dbh\fR and
-initialize it with a pointer to the handles private data. Note: This
-must be a part of the function header, because it declares a variable.
-.IP "D_imp_sth(sth)" 4
-.IX Item "D_imp_sth(sth)"
-Likewise for statement handles.
-.IP "D_imp_xxx(h)" 4
-.IX Item "D_imp_xxx(h)"
-Given any handle, declare a variable \fIimp_xxx\fR and initialize it
-with a pointer to the handles private data. It is safe, for example,
-to cast \fIimp_xxx\fR to \f(CW\*(C`imp_dbh_t*\*(C'\fR, if \f(CW\*(C`DBIc_TYPE(imp_xxx) == DBIt_DB\*(C'\fR.
-(You can also call \f(CW\*(C`sv_derived_from(h, "DBI::db")\*(C'\fR, but that's much
-slower.)
-.IP "D_imp_dbh_from_sth" 4
-.IX Item "D_imp_dbh_from_sth"
-Given a \fIimp_sth\fR, declare a variable \fIimp_dbh\fR and initialize it with a
-pointer to the parent database handle's implementors structure.
-.SS "Using DBIc_IMPSET_on"
-.IX Subsection "Using DBIc_IMPSET_on"
-The driver code which initializes a handle should use \f(CW\*(C`DBIc_IMPSET_on()\*(C'\fR
-as soon as its state is such that the cleanup code must be called.
-When this happens is determined by your driver code.
-.PP
-\&\fBFailure to call this can lead to corruption of data structures.\fR
-.PP
-For example, \fBDBD::Informix\fR maintains a linked list of database
-handles in the driver, and within each handle, a linked list of
-statements. Once a statement is added to the linked list, it is crucial
-that it is cleaned up (removed from the list). When \fI\fIDBIc_IMPSET_on()\fI\fR
-was being called too late, it was able to cause all sorts of problems.
-.SS "Using \fIDBIc_is()\fP, \fIDBIc_has()\fP, \fIDBIc_on()\fP and \fIDBIc_off()\fP"
-.IX Subsection "Using DBIc_is(), DBIc_has(), DBIc_on() and DBIc_off()"
-Once upon a long time ago, the only way of handling the internal \fB\s-1DBI\s0\fR
-boolean flags/attributes was through macros such as:
-.PP
-.Vb 2
-\& DBIc_WARN DBIc_WARN_on DBIc_WARN_off
-\& DBIc_COMPAT DBIc_COMPAT_on DBIc_COMPAT_off
-.Ve
-.PP
-Each of these took an \fIimp_xxh\fR pointer as an argument.
-.PP
-Since then, new attributes have been added such as \fIChopBlanks\fR,
-\&\fIRaiseError\fR and \fIPrintError\fR, and these do not have the full set of
-macros. The approved method for handling these is now the four macros:
-.PP
-.Vb 5
-\& DBIc_is(imp, flag)
-\& DBIc_has(imp, flag) an alias for DBIc_is
-\& DBIc_on(imp, flag)
-\& DBIc_off(imp, flag)
-\& DBIc_set(imp, flag, on) set if on is true, else clear
-.Ve
-.PP
-Consequently, the \f(CW\*(C`DBIc_XXXXX\*(C'\fR family of macros is now mostly deprecated
-and new drivers should avoid using them, even though the older drivers
-will probably continue to do so for quite a while yet. However...
-.PP
-There is an \fIimportant exception\fR to that. The \fI\s-1ACTIVE\s0\fR and \fI\s-1IMPSET\s0\fR
-flags should be set via the \f(CW\*(C`DBIc_ACTIVE_on()\*(C'\fR and \f(CW\*(C`DBIc_IMPSET_on()\*(C'\fR macros,
-and unset via the \f(CW\*(C`DBIc_ACTIVE_off()\*(C'\fR and \f(CW\*(C`DBIc_IMPSET_off()\*(C'\fR macros.
-.SS "Using the \fIget_fbav()\fP method"
-.IX Subsection "Using the get_fbav() method"
-\&\fB\s-1THIS IS CRITICAL\s0 for C/XS drivers\fR.
-.PP
-The \f(CW\*(C`$sth\->bind_col()\*(C'\fR and \f(CW\*(C`$sth\->bind_columns()\*(C'\fR documented
-in the \fB\s-1DBI\s0\fR specification do not have to be implemented by the driver
-writer because \fB\s-1DBI\s0\fR takes care of the details for you.
-.PP
-However, the key to ensuring that bound columns work is to call the
-function \f(CW\*(C`DBIc_DBISTATE(imp_xxh)\->get_fbav()\*(C'\fR in the code which
-fetches a row of data.
-.PP
-This returns an \f(CW\*(C`AV\*(C'\fR, and each element of the \f(CW\*(C`AV\*(C'\fR contains the \f(CW\*(C`SV\*(C'\fR which
-should be set to contain the returned data.
-.PP
-The pure Perl equivalent is the \f(CW\*(C`$sth\->_set_fbav($data)\*(C'\fR method, as
-described in the part on pure Perl drivers.
-.SS "Casting strings to Perl types based on a \s-1SQL\s0 type"
-.IX Subsection "Casting strings to Perl types based on a SQL type"
-\&\s-1DBI\s0 from 1.611 (and \s-1DBIXS_REVISION 13606\s0) defines the
-sql_type_cast_svpv method which may be used to cast a string
-representation of a value to a more specific Perl type based on a \s-1SQL\s0
-type. You should consider using this method when processing bound
-column data as it provides some support for the \s-1TYPE\s0 bind_col
-attribute which is rarely used in drivers.
-.PP
-.Vb 1
-\& int sql_type_cast_svpv(pTHX_ SV *sv, int sql_type, U32 flags, void *v)
-.Ve
-.PP
-\&\f(CW\*(C`sv\*(C'\fR is what you would like cast, \f(CW\*(C`sql_type\*(C'\fR is one of the \s-1DBI\s0 defined
-\&\s-1SQL\s0 types (e.g., \f(CW\*(C`SQL_INTEGER\*(C'\fR) and \f(CW\*(C`flags\*(C'\fR is a bitmask as follows:
-.IP "DBIstcf_STRICT" 4
-.IX Item "DBIstcf_STRICT"
-If set this indicates you want an error state returned if the cast
-cannot be performed.
-.IP "DBIstcf_DISCARD_STRING" 4
-.IX Item "DBIstcf_DISCARD_STRING"
-If set and the pv portion of the \f(CW\*(C`sv\*(C'\fR is cast then this will cause
-sv's pv to be freed up.
-.PP
-sql_type_cast_svpv returns the following states:
-.PP
-.Vb 5
-\& \-2 sql_type is not handled \- sv not changed
-\& \-1 sv is undef, sv not changed
-\& 0 sv could not be cast cleanly and DBIstcf_STRICT was specified
-\& 1 sv could not be case cleanly and DBIstcf_STRICT was not specified
-\& 2 sv was cast ok
-.Ve
-.PP
-The current implementation of sql_type_cast_svpv supports
-\&\f(CW\*(C`SQL_INTEGER\*(C'\fR, \f(CW\*(C`SQL_DOUBLE\*(C'\fR and \f(CW\*(C`SQL_NUMERIC\*(C'\fR. \f(CW\*(C`SQL_INTEGER\*(C'\fR uses
-sv_2iv and hence may set \s-1IV, UV\s0 or \s-1NV\s0 depending on the
-number. \f(CW\*(C`SQL_DOUBLE\*(C'\fR uses sv_2nv so may set \s-1NV\s0 and \f(CW\*(C`SQL_NUMERIC\*(C'\fR
-will set \s-1IV\s0 or \s-1UV\s0 or \s-1NV.\s0
-.PP
-DBIstcf_STRICT should be implemented as the StrictlyTyped attribute
-and DBIstcf_DISCARD_STRING implemented as the DiscardString attribute
-to the bind_col method and both default to off.
-.PP
-See DBD::Oracle for an example of how this is used.
-.SH "SUBCLASSING DBI DRIVERS"
-.IX Header "SUBCLASSING DBI DRIVERS"
-This is definitely an open subject. It can be done, as demonstrated by
-the \fBDBD::File\fR driver, but it is not as simple as one might think.
-.PP
-(Note that this topic is different from subclassing the \fB\s-1DBI\s0\fR. For an
-example of that, see the \fIt/subclass.t\fR file supplied with the \fB\s-1DBI\s0\fR.)
-.PP
-The main problem is that the \fIdbh\fR's and \fIsth\fR's that your \f(CW\*(C`connect()\*(C'\fR and
-\&\f(CW\*(C`prepare()\*(C'\fR methods return are not instances of your \fBDBD::Driver::db\fR
-or \fBDBD::Driver::st\fR packages, they are not even derived from it.
-Instead they are instances of the \fBDBI::db\fR or \fBDBI::st\fR classes or
-a derived subclass. Thus, if you write a method \f(CW\*(C`mymethod()\*(C'\fR and do a
-.PP
-.Vb 1
-\& $dbh\->mymethod()
-.Ve
-.PP
-then the autoloader will search for that method in the package \fBDBI::db\fR.
-Of course you can instead to a
-.PP
-.Vb 1
-\& $dbh\->func(\*(Aqmymethod\*(Aq)
-.Ve
-.PP
-and that will indeed work, even if \f(CW\*(C`mymethod()\*(C'\fR is inherited, but not
-without additional work. Setting \fI\f(CI@ISA\fI\fR is not sufficient.
-.SS "Overwriting methods"
-.IX Subsection "Overwriting methods"
-The first problem is, that the \f(CW\*(C`connect()\*(C'\fR method has no idea of
-subclasses. For example, you cannot implement base class and subclass
-in the same file: The \f(CW\*(C`install_driver()\*(C'\fR method wants to do a
-.PP
-.Vb 1
-\& require DBD::Driver;
-.Ve
-.PP
-In particular, your subclass \fBhas\fR to be a separate driver, from
-the view of \fB\s-1DBI\s0\fR, and you cannot share driver handles.
-.PP
-Of course that's not much of a problem. You should even be able
-to inherit the base classes \f(CW\*(C`connect()\*(C'\fR method. But you cannot
-simply overwrite the method, unless you do something like this,
-quoted from \fB\s-1DBD::CSV\s0\fR:
-.PP
-.Vb 2
-\& sub connect ($$;$$$) {
-\& my ($drh, $dbname, $user, $auth, $attr) = @_;
-\&
-\& my $this = $drh\->DBD::File::dr::connect($dbname, $user, $auth, $attr);
-\& if (!exists($this\->{csv_tables})) {
-\& $this\->{csv_tables} = {};
-\& }
-\&
-\& $this;
-\& }
-.Ve
-.PP
-Note that we cannot do a
-.PP
-.Vb 1
-\& $drh\->SUPER::connect($dbname, $user, $auth, $attr);
-.Ve
-.PP
-as we would usually do in a an \s-1OO\s0 environment, because \fI\f(CI$drh\fI\fR is an instance
-of \fBDBI::dr\fR. And note, that the \f(CW\*(C`connect()\*(C'\fR method of \fBDBD::File\fR is
-able to handle subclass attributes. See the description of Pure Perl
-drivers above.
-.PP
-It is essential that you always call superclass method in the above
-manner. However, that should do.
-.SS "Attribute handling"
-.IX Subsection "Attribute handling"
-Fortunately the \fB\s-1DBI\s0\fR specifications allow a simple, but still
-performant way of handling attributes. The idea is based on the
-convention that any driver uses a prefix \fIdriver_\fR for its private
-methods. Thus it's always clear whether to pass attributes to the super
-class or not. For example, consider this \f(CW\*(C`STORE()\*(C'\fR method from the
-\&\fB\s-1DBD::CSV\s0\fR class:
-.PP
-.Vb 8
-\& sub STORE {
-\& my ($dbh, $attr, $val) = @_;
-\& if ($attr !~ /^driver_/) {
-\& return $dbh\->DBD::File::db::STORE($attr, $val);
-\& }
-\& if ($attr eq \*(Aqdriver_foo\*(Aq) {
-\& ...
-\& }
-.Ve
-.SH "AUTHORS"
-.IX Header "AUTHORS"
-Jonathan Leffler <jleffler@us.ibm.com> (previously <jleffler@informix.com>),
-Jochen Wiedmann <joe@ispsoft.de>,
-Steffen Goeldner <sgoeldner@cpan.org>,
-and Tim Bunce <dbi\-users@perl.org>.
+++ /dev/null
-.\" Automatically generated by Pod::Man 2.28 (Pod::Simple 3.29)
-.\"
-.\" Standard preamble:
-.\" ========================================================================
-.de Sp \" Vertical space (when we can't use .PP)
-.if t .sp .5v
-.if n .sp
-..
-.de Vb \" Begin verbatim text
-.ft CW
-.nf
-.ne \\$1
-..
-.de Ve \" End verbatim text
-.ft R
-.fi
-..
-.\" Set up some character translations and predefined strings. \*(-- will
-.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
-.\" double quote, and \*(R" will give a right double quote. \*(C+ will
-.\" give a nicer C++. Capital omega is used to do unbreakable dashes and
-.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff,
-.\" nothing in troff, for use with C<>.
-.tr \(*W-
-.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
-.ie n \{\
-. ds -- \(*W-
-. ds PI pi
-. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
-. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch
-. ds L" ""
-. ds R" ""
-. ds C` ""
-. ds C' ""
-'br\}
-.el\{\
-. ds -- \|\(em\|
-. ds PI \(*p
-. ds L" ``
-. ds R" ''
-. ds C`
-. ds C'
-'br\}
-.\"
-.\" Escape single quotes in literal strings from groff's Unicode transform.
-.ie \n(.g .ds Aq \(aq
-.el .ds Aq '
-.\"
-.\" If the F register is turned on, we'll generate index entries on stderr for
-.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
-.\" entries marked with X<> in POD. Of course, you'll have to process the
-.\" output yourself in some meaningful fashion.
-.\"
-.\" Avoid warning from groff about undefined register 'F'.
-.de IX
-..
-.nr rF 0
-.if \n(.g .if rF .nr rF 1
-.if (\n(rF:(\n(.g==0)) \{
-. if \nF \{
-. de IX
-. tm Index:\\$1\t\\n%\t"\\$2"
-..
-. if !\nF==2 \{
-. nr % 0
-. nr F 2
-. \}
-. \}
-.\}
-.rr rF
-.\" ========================================================================
-.\"
-.IX Title "DBI::DBD::Metadata 3pm"
-.TH DBI::DBD::Metadata 3pm "2015-05-26" "perl v5.22.1" "User Contributed Perl Documentation"
-.\" For nroff, turn off justification. Always turn off hyphenation; it makes
-.\" way too many mistakes in technical documents.
-.if n .ad l
-.nh
-.SH "NAME"
-DBI::DBD::Metadata \- Generate the code and data for some DBI metadata methods
-.SH "SYNOPSIS"
-.IX Header "SYNOPSIS"
-The idea is to extract metadata information from a good quality
-\&\s-1ODBC\s0 driver and use it to generate code and data to use in your own
-\&\s-1DBI\s0 driver for the same database.
-.PP
-To generate code to support the get_info method:
-.PP
-.Vb 1
-\& perl \-MDBI::DBD::Metadata \-e "write_getinfo_pm(\*(Aqdbi:ODBC:dsn\-name\*(Aq,\*(Aquser\*(Aq,\*(Aqpass\*(Aq,\*(AqDriver\*(Aq)"
-\&
-\& perl \-MDBI::DBD::Metadata \-e write_getinfo_pm dbi:ODBC:foo_db username password Driver
-.Ve
-.PP
-To generate code to support the type_info method:
-.PP
-.Vb 1
-\& perl \-MDBI::DBD::Metadata \-e "write_typeinfo_pm(\*(Aqdbi:ODBC:dsn\-name\*(Aq,\*(Aquser\*(Aq,\*(Aqpass\*(Aq,\*(AqDriver\*(Aq)"
-\&
-\& perl \-MDBI::DBD::Metadata \-e write_typeinfo_pm dbi:ODBC:dsn\-name user pass Driver
-.Ve
-.PP
-Where \f(CW\*(C`dbi:ODBC:dsn\-name\*(C'\fR is the connection to use to extract the
-data, and \f(CW\*(C`Driver\*(C'\fR is the name of the driver you want the code
-generated for (the driver name gets embedded into the output in
-numerous places).
-.SH "Generating a GetInfo package for a driver"
-.IX Header "Generating a GetInfo package for a driver"
-The \f(CW\*(C`write_getinfo_pm\*(C'\fR in the DBI::DBD::Metadata module generates a
-DBD::Driver::GetInfo package on standard output.
-.PP
-This method generates a DBD::Driver::GetInfo package from the data
-source you specified in the parameter list or in the environment
-variable \s-1DBI_DSN.\s0
-DBD::Driver::GetInfo should help a \s-1DBD\s0 author implement the \s-1DBI\s0
-\&\fIget_info()\fR method.
-Because you are just creating this package, it is very unlikely that
-DBD::Driver already provides a good implementation for \fIget_info()\fR.
-Thus you will probably connect via \s-1DBD::ODBC.\s0
-.PP
-Once you are sure that it is producing reasonably sane data, you should
-typically redirect the standard output to lib/DBD/Driver/GetInfo.pm, and
-then hand edit the result.
-Do not forget to update your Makefile.PL and \s-1MANIFEST\s0 to include this as
-an extra \s-1PM\s0 file that should be installed.
-.PP
-If you connect via \s-1DBD::ODBC,\s0 you should use version 0.38 or greater;
-.PP
-Please take a critical look at the data returned!
-\&\s-1ODBC\s0 drivers vary dramatically in their quality.
-.PP
-The generator assumes that most values are static and places these
-values directly in the \f(CW%info\fR hash.
-A few examples show the use of \s-1CODE\s0 references and the implementation
-via subroutines.
-It is very likely that you will have to write additional subroutines for
-values depending on the session state or server version, e.g.
-\&\s-1SQL_DBMS_VER.\s0
-.PP
-A possible implementation of \fIDBD::Driver::db::get_info()\fR may look like:
-.PP
-.Vb 7
-\& sub get_info {
-\& my($dbh, $info_type) = @_;
-\& require DBD::Driver::GetInfo;
-\& my $v = $DBD::Driver::GetInfo::info{int($info_type)};
-\& $v = $v\->($dbh) if ref $v eq \*(AqCODE\*(Aq;
-\& return $v;
-\& }
-.Ve
-.PP
-Please replace Driver (or \*(L"<foo>\*(R") with the name of your driver.
-Note that this stub function is generated for you by write_getinfo_pm
-function, but you must manually transfer the code to Driver.pm.
-.SH "Generating a TypeInfo package for a driver"
-.IX Header "Generating a TypeInfo package for a driver"
-The \f(CW\*(C`write_typeinfo_pm\*(C'\fR function in the DBI::DBD::Metadata module generates
-on standard output the data needed for a driver's type_info_all method.
-It also provides default implementations of the type_info_all
-method for inclusion in the driver's main implementation file.
-.PP
-The driver parameter is the name of the driver for which the methods
-will be generated; for the sake of examples, this will be \*(L"Driver\*(R".
-Typically, the dsn parameter will be of the form \*(L"dbi:ODBC:odbc_dsn\*(R",
-where the odbc_dsn is a \s-1DSN\s0 for one of the driver's databases.
-The user and pass parameters are the other optional connection
-parameters that will be provided to the \s-1DBI\s0 connect method.
-.PP
-Once you are sure that it is producing reasonably sane data, you should
-typically redirect the standard output to lib/DBD/Driver/TypeInfo.pm,
-and then hand edit the result if necessary.
-Do not forget to update your Makefile.PL and \s-1MANIFEST\s0 to include this as
-an extra \s-1PM\s0 file that should be installed.
-.PP
-Please take a critical look at the data returned!
-\&\s-1ODBC\s0 drivers vary dramatically in their quality.
-.PP
-The generator assumes that all the values are static and places these
-values directly in the \f(CW%info\fR hash.
-.PP
-A possible implementation of \fIDBD::Driver::type_info_all()\fR may look like:
-.PP
-.Vb 5
-\& sub type_info_all {
-\& my ($dbh) = @_;
-\& require DBD::Driver::TypeInfo;
-\& return [ @$DBD::Driver::TypeInfo::type_info_all ];
-\& }
-.Ve
-.PP
-Please replace Driver (or \*(L"<foo>\*(R") with the name of your driver.
-Note that this stub function is generated for you by the write_typeinfo_pm
-function, but you must manually transfer the code to Driver.pm.
-.SH "AUTHORS"
-.IX Header "AUTHORS"
-Jonathan Leffler <jleffler@us.ibm.com> (previously <jleffler@informix.com>),
-Jochen Wiedmann <joe@ispsoft.de>,
-Steffen Goeldner <sgoeldner@cpan.org>,
-and Tim Bunce <dbi\-users@perl.org>.
+++ /dev/null
-.\" Automatically generated by Pod::Man 2.28 (Pod::Simple 3.29)
-.\"
-.\" Standard preamble:
-.\" ========================================================================
-.de Sp \" Vertical space (when we can't use .PP)
-.if t .sp .5v
-.if n .sp
-..
-.de Vb \" Begin verbatim text
-.ft CW
-.nf
-.ne \\$1
-..
-.de Ve \" End verbatim text
-.ft R
-.fi
-..
-.\" Set up some character translations and predefined strings. \*(-- will
-.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
-.\" double quote, and \*(R" will give a right double quote. \*(C+ will
-.\" give a nicer C++. Capital omega is used to do unbreakable dashes and
-.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff,
-.\" nothing in troff, for use with C<>.
-.tr \(*W-
-.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
-.ie n \{\
-. ds -- \(*W-
-. ds PI pi
-. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
-. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch
-. ds L" ""
-. ds R" ""
-. ds C` ""
-. ds C' ""
-'br\}
-.el\{\
-. ds -- \|\(em\|
-. ds PI \(*p
-. ds L" ``
-. ds R" ''
-. ds C`
-. ds C'
-'br\}
-.\"
-.\" Escape single quotes in literal strings from groff's Unicode transform.
-.ie \n(.g .ds Aq \(aq
-.el .ds Aq '
-.\"
-.\" If the F register is turned on, we'll generate index entries on stderr for
-.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
-.\" entries marked with X<> in POD. Of course, you'll have to process the
-.\" output yourself in some meaningful fashion.
-.\"
-.\" Avoid warning from groff about undefined register 'F'.
-.de IX
-..
-.nr rF 0
-.if \n(.g .if rF .nr rF 1
-.if (\n(rF:(\n(.g==0)) \{
-. if \nF \{
-. de IX
-. tm Index:\\$1\t\\n%\t"\\$2"
-..
-. if !\nF==2 \{
-. nr % 0
-. nr F 2
-. \}
-. \}
-.\}
-.rr rF
-.\" ========================================================================
-.\"
-.IX Title "DBI::DBD::SqlEngine 3pm"
-.TH DBI::DBD::SqlEngine 3pm "2016-04-21" "perl v5.22.1" "User Contributed Perl Documentation"
-.\" For nroff, turn off justification. Always turn off hyphenation; it makes
-.\" way too many mistakes in technical documents.
-.if n .ad l
-.nh
-.SH "NAME"
-DBI::DBD::SqlEngine \- Base class for DBI drivers without their own SQL engine
-.SH "SYNOPSIS"
-.IX Header "SYNOPSIS"
-.Vb 1
-\& package DBD::myDriver;
-\&
-\& use base qw(DBI::DBD::SqlEngine);
-\&
-\& sub driver
-\& {
-\& ...
-\& my $drh = $proto\->SUPER::driver($attr);
-\& ...
-\& return $drh\->{class};
-\& }
-\&
-\& package DBD::myDriver::dr;
-\&
-\& @ISA = qw(DBI::DBD::SqlEngine::dr);
-\&
-\& sub data_sources { ... }
-\& ...
-\&
-\& package DBD::myDriver::db;
-\&
-\& @ISA = qw(DBI::DBD::SqlEngine::db);
-\&
-\& sub init_valid_attributes { ... }
-\& sub init_default_attributes { ... }
-\& sub set_versions { ... }
-\& sub validate_STORE_attr { my ($dbh, $attrib, $value) = @_; ... }
-\& sub validate_FETCH_attr { my ($dbh, $attrib) = @_; ... }
-\& sub get_myd_versions { ... }
-\& sub get_avail_tables { ... }
-\&
-\& package DBD::myDriver::st;
-\&
-\& @ISA = qw(DBI::DBD::SqlEngine::st);
-\&
-\& sub FETCH { ... }
-\& sub STORE { ... }
-\&
-\& package DBD::myDriver::Statement;
-\&
-\& @ISA = qw(DBI::DBD::SqlEngine::Statement);
-\&
-\& sub open_table { ... }
-\&
-\& package DBD::myDriver::Table;
-\&
-\& @ISA = qw(DBI::DBD::SqlEngine::Table);
-\&
-\& sub new { ... }
-.Ve
-.SH "DESCRIPTION"
-.IX Header "DESCRIPTION"
-DBI::DBD::SqlEngine abstracts the usage of \s-1SQL\s0 engines from the
-\&\s-1DBD. DBD\s0 authors can concentrate on the data retrieval they want to
-provide.
-.PP
-It is strongly recommended that you read DBD::File::Developers and
-DBD::File::Roadmap, because many of the DBD::File \s-1API\s0 is provided
-by DBI::DBD::SqlEngine.
-.PP
-Currently the \s-1API\s0 of DBI::DBD::SqlEngine is experimental and will
-likely change in the near future to provide the table meta data basics
-like DBD::File.
-.PP
-DBI::DBD::SqlEngine expects that any driver in inheritance chain has
-a \s-1DBI\s0 prefix.
-.SS "Metadata"
-.IX Subsection "Metadata"
-The following attributes are handled by \s-1DBI\s0 itself and not by
-DBI::DBD::SqlEngine, thus they all work as expected:
-.PP
-.Vb 10
-\& Active
-\& ActiveKids
-\& CachedKids
-\& CompatMode (Not used)
-\& InactiveDestroy
-\& AutoInactiveDestroy
-\& Kids
-\& PrintError
-\& RaiseError
-\& Warn (Not used)
-.Ve
-.PP
-\fIThe following \s-1DBI\s0 attributes are handled by DBI::DBD::SqlEngine:\fR
-.IX Subsection "The following DBI attributes are handled by DBI::DBD::SqlEngine:"
-.PP
-AutoCommit
-.IX Subsection "AutoCommit"
-.PP
-Always on.
-.PP
-ChopBlanks
-.IX Subsection "ChopBlanks"
-.PP
-Works.
-.PP
-\s-1NUM_OF_FIELDS\s0
-.IX Subsection "NUM_OF_FIELDS"
-.PP
-Valid after \f(CW\*(C`$sth\->execute\*(C'\fR.
-.PP
-\s-1NUM_OF_PARAMS\s0
-.IX Subsection "NUM_OF_PARAMS"
-.PP
-Valid after \f(CW\*(C`$sth\->prepare\*(C'\fR.
-.PP
-\s-1NAME\s0
-.IX Subsection "NAME"
-.PP
-Valid after \f(CW\*(C`$sth\->execute\*(C'\fR; probably undef for Non-Select statements.
-.PP
-\s-1NULLABLE\s0
-.IX Subsection "NULLABLE"
-.PP
-Not really working, always returns an array ref of ones, as \s-1DBD::CSV\s0
-does not verify input data. Valid after \f(CW\*(C`$sth\->execute\*(C'\fR; undef for
-non-select statements.
-.PP
-\fIThe following \s-1DBI\s0 attributes and methods are not supported:\fR
-.IX Subsection "The following DBI attributes and methods are not supported:"
-.IP "bind_param_inout" 4
-.IX Item "bind_param_inout"
-.PD 0
-.IP "CursorName" 4
-.IX Item "CursorName"
-.IP "LongReadLen" 4
-.IX Item "LongReadLen"
-.IP "LongTruncOk" 4
-.IX Item "LongTruncOk"
-.PD
-.PP
-\fIDBI::DBD::SqlEngine specific attributes\fR
-.IX Subsection "DBI::DBD::SqlEngine specific attributes"
-.PP
-In addition to the \s-1DBI\s0 attributes, you can use the following dbh
-attributes:
-.PP
-sql_engine_version
-.IX Subsection "sql_engine_version"
-.PP
-Contains the module version of this driver (\fBreadonly\fR)
-.PP
-sql_nano_version
-.IX Subsection "sql_nano_version"
-.PP
-Contains the module version of DBI::SQL::Nano (\fBreadonly\fR)
-.PP
-sql_statement_version
-.IX Subsection "sql_statement_version"
-.PP
-Contains the module version of SQL::Statement, if available (\fBreadonly\fR)
-.PP
-sql_handler
-.IX Subsection "sql_handler"
-.PP
-Contains the \s-1SQL\s0 Statement engine, either DBI::SQL::Nano or SQL::Statement
-(\fBreadonly\fR).
-.PP
-sql_parser_object
-.IX Subsection "sql_parser_object"
-.PP
-Contains an instantiated instance of SQL::Parser (\fBreadonly\fR).
-This is filled when used first time (only when used with SQL::Statement).
-.PP
-sql_sponge_driver
-.IX Subsection "sql_sponge_driver"
-.PP
-Contains an internally used DBD::Sponge handle (\fBreadonly\fR).
-.PP
-sql_valid_attrs
-.IX Subsection "sql_valid_attrs"
-.PP
-Contains the list of valid attributes for each DBI::DBD::SqlEngine based
-driver (\fBreadonly\fR).
-.PP
-sql_readonly_attrs
-.IX Subsection "sql_readonly_attrs"
-.PP
-Contains the list of those attributes which are readonly (\fBreadonly\fR).
-.PP
-sql_identifier_case
-.IX Subsection "sql_identifier_case"
-.PP
-Contains how DBI::DBD::SqlEngine deals with non-quoted \s-1SQL\s0 identifiers:
-.PP
-.Vb 5
-\& * SQL_IC_UPPER (1) means all identifiers are internally converted
-\& into upper\-cased pendants
-\& * SQL_IC_LOWER (2) means all identifiers are internally converted
-\& into lower\-cased pendants
-\& * SQL_IC_MIXED (4) means all identifiers are taken as they are
-.Ve
-.PP
-These conversions happen if (and only if) no existing identifier matches.
-Once existing identifier is used as known.
-.PP
-The \s-1SQL\s0 statement execution classes doesn't have to care, so don't expect
-\&\f(CW\*(C`sql_identifier_case\*(C'\fR affects column names in statements like
-.PP
-.Vb 1
-\& SELECT * FROM foo
-.Ve
-.PP
-sql_quoted_identifier_case
-.IX Subsection "sql_quoted_identifier_case"
-.PP
-Contains how DBI::DBD::SqlEngine deals with quoted \s-1SQL\s0 identifiers
-(\fBreadonly\fR). It's fixated to \s-1SQL_IC_SENSITIVE \\fIs0\fR\|(3), which is interpreted
-as \s-1SQL_IC_MIXED.\s0
-.PP
-sql_flags
-.IX Subsection "sql_flags"
-.PP
-Contains additional flags to instantiate an SQL::Parser. Because an
-SQL::Parser is instantiated only once, it's recommended to set this flag
-before any statement is executed.
-.PP
-sql_dialect
-.IX Subsection "sql_dialect"
-.PP
-Controls the dialect understood by SQL::Parser. Possible values (delivery
-state of SQL::Statement):
-.PP
-.Vb 3
-\& * ANSI
-\& * CSV
-\& * AnyData
-.Ve
-.PP
-Defaults to \*(L"\s-1CSV\*(R". \s0 Because an SQL::Parser is instantiated only once and
-SQL::Parser doesn't allow one to modify the dialect once instantiated,
-it's strongly recommended to set this flag before any statement is
-executed (best place is connect attribute hash).
-.PP
-sql_engine_in_gofer
-.IX Subsection "sql_engine_in_gofer"
-.PP
-This value has a true value in case of this driver is operated via
-DBD::Gofer. The impact of being operated via Gofer is a read-only
-driver (not read-only databases!), so you cannot modify any attributes
-later \- neither any table settings. \fBBut\fR you won't get an error in
-cases you modify table attributes, so please carefully watch
-\&\f(CW\*(C`sql_engine_in_gofer\*(C'\fR.
-.PP
-sql_meta
-.IX Subsection "sql_meta"
-.PP
-Private data area which contains information about the tables this
-module handles. Table meta data might not be available until the
-table has been accessed for the first time e.g., by issuing a select
-on it however it is possible to pre-initialize attributes for each table
-you use.
-.PP
-DBI::DBD::SqlEngine recognizes the (public) attributes \f(CW\*(C`col_names\*(C'\fR,
-\&\f(CW\*(C`table_name\*(C'\fR, \f(CW\*(C`readonly\*(C'\fR, \f(CW\*(C`sql_data_source\*(C'\fR and \f(CW\*(C`sql_identifier_case\*(C'\fR.
-Be very careful when modifying attributes you do not know, the consequence
-might be a destroyed or corrupted table.
-.PP
-While \f(CW\*(C`sql_meta\*(C'\fR is a private and readonly attribute (which means, you
-cannot modify it's values), derived drivers might provide restricted
-write access through another attribute. Well known accessors are
-\&\f(CW\*(C`csv_tables\*(C'\fR for \s-1DBD::CSV\s0, \f(CW\*(C`ad_tables\*(C'\fR for DBD::AnyData and
-\&\f(CW\*(C`dbm_tables\*(C'\fR for \s-1DBD::DBM\s0.
-.PP
-sql_table_source
-.IX Subsection "sql_table_source"
-.PP
-Controls the class which will be used for fetching available tables.
-.PP
-See \*(L"DBI::DBD::SqlEngine::TableSource\*(R" for details.
-.PP
-sql_data_source
-.IX Subsection "sql_data_source"
-.PP
-Contains the class name to be used for opening tables.
-.PP
-See \*(L"DBI::DBD::SqlEngine::DataSource\*(R" for details.
-.SS "Driver private methods"
-.IX Subsection "Driver private methods"
-\fIDefault \s-1DBI\s0 methods\fR
-.IX Subsection "Default DBI methods"
-.PP
-data_sources
-.IX Subsection "data_sources"
-.PP
-The \f(CW\*(C`data_sources\*(C'\fR method returns a list of subdirectories of the current
-directory in the form \*(L"dbi:CSV:f_dir=$dirname\*(R".
-.PP
-If you want to read the subdirectories of another directory, use
-.PP
-.Vb 2
-\& my ($drh) = DBI\->install_driver ("CSV");
-\& my (@list) = $drh\->data_sources (f_dir => "/usr/local/csv_data");
-.Ve
-.PP
-list_tables
-.IX Subsection "list_tables"
-.PP
-This method returns a list of file names inside \f(CW$dbh\fR\->{f_dir}.
-Example:
-.PP
-.Vb 2
-\& my ($dbh) = DBI\->connect ("dbi:CSV:f_dir=/usr/local/csv_data");
-\& my (@list) = $dbh\->func ("list_tables");
-.Ve
-.PP
-Note that the list includes all files contained in the directory, even
-those that have non-valid table names, from the view of \s-1SQL.\s0
-.PP
-\fIAdditional methods\fR
-.IX Subsection "Additional methods"
-.PP
-The following methods are only available via their documented name when
-DBI::DBD::SQlEngine is used directly. Because this is only reasonable for
-testing purposes, the real names must be used instead. Those names can be
-computed by replacing the \f(CW\*(C`sql_\*(C'\fR in the method name with the driver prefix.
-.PP
-sql_versions
-.IX Subsection "sql_versions"
-.PP
-Signature:
-.PP
-.Vb 5
-\& sub sql_versions (;$) {
-\& my ($table_name) = @_;
-\& $table_name ||= ".";
-\& ...
-\& }
-.Ve
-.PP
-Returns the versions of the driver, including the \s-1DBI\s0 version, the Perl
-version, DBI::PurePerl version (if DBI::PurePerl is active) and the version
-of the \s-1SQL\s0 engine in use.
-.PP
-.Vb 8
-\& my $dbh = DBI\->connect ("dbi:File:");
-\& my $sql_versions = $dbh\->func( "sql_versions" );
-\& print "$sql_versions\en";
-\& _\|_END_\|_
-\& # DBI::DBD::SqlEngine 0.05 using SQL::Statement 1.402
-\& # DBI 1.623
-\& # OS netbsd (6.99.12)
-\& # Perl 5.016002 (x86_64\-netbsd\-thread\-multi)
-.Ve
-.PP
-Called in list context, sql_versions will return an array containing each
-line as single entry.
-.PP
-Some drivers might use the optional (table name) argument and modify
-version information related to the table (e.g. \s-1DBD::DBM\s0 provides storage
-backend information for the requested table, when it has a table name).
-.PP
-sql_get_meta
-.IX Subsection "sql_get_meta"
-.PP
-Signature:
-.PP
-.Vb 5
-\& sub sql_get_meta ($$)
-\& {
-\& my ($table_name, $attrib) = @_;
-\& ...
-\& }
-.Ve
-.PP
-Returns the value of a meta attribute set for a specific table, if any.
-See sql_meta for the possible attributes.
-.PP
-A table name of \f(CW"."\fR (single dot) is interpreted as the default table.
-This will retrieve the appropriate attribute globally from the dbh.
-This has the same restrictions as \f(CW\*(C`$dbh\->{$attrib}\*(C'\fR.
-.PP
-sql_set_meta
-.IX Subsection "sql_set_meta"
-.PP
-Signature:
-.PP
-.Vb 5
-\& sub sql_set_meta ($$$)
-\& {
-\& my ($table_name, $attrib, $value) = @_;
-\& ...
-\& }
-.Ve
-.PP
-Sets the value of a meta attribute set for a specific table.
-See sql_meta for the possible attributes.
-.PP
-A table name of \f(CW"."\fR (single dot) is interpreted as the default table
-which will set the specified attribute globally for the dbh.
-This has the same restrictions as \f(CW\*(C`$dbh\->{$attrib} = $value\*(C'\fR.
-.PP
-sql_clear_meta
-.IX Subsection "sql_clear_meta"
-.PP
-Signature:
-.PP
-.Vb 5
-\& sub sql_clear_meta ($)
-\& {
-\& my ($table_name) = @_;
-\& ...
-\& }
-.Ve
-.PP
-Clears the table specific meta information in the private storage of the
-dbh.
-.SS "Extensibility"
-.IX Subsection "Extensibility"
-\fIDBI::DBD::SqlEngine::TableSource\fR
-.IX Subsection "DBI::DBD::SqlEngine::TableSource"
-.PP
-Provides data sources and table information on database driver and database
-handle level.
-.PP
-.Vb 1
-\& package DBI::DBD::SqlEngine::TableSource;
-\&
-\& sub data_sources ($;$)
-\& {
-\& my ( $class, $drh, $attrs ) = @_;
-\& ...
-\& }
-\&
-\& sub avail_tables
-\& {
-\& my ( $class, $drh ) = @_;
-\& ...
-\& }
-.Ve
-.PP
-The \f(CW\*(C`data_sources\*(C'\fR method is called when the user invokes any of the
-following:
-.PP
-.Vb 2
-\& @ary = DBI\->data_sources($driver);
-\& @ary = DBI\->data_sources($driver, \e%attr);
-\&
-\& @ary = $dbh\->data_sources();
-\& @ary = $dbh\->data_sources(\e%attr);
-.Ve
-.PP
-The \f(CW\*(C`avail_tables\*(C'\fR method is called when the user invokes any of the
-following:
-.PP
-.Vb 1
-\& @names = $dbh\->tables( $catalog, $schema, $table, $type );
-\&
-\& $sth = $dbh\->table_info( $catalog, $schema, $table, $type );
-\& $sth = $dbh\->table_info( $catalog, $schema, $table, $type, \e%attr );
-\&
-\& $dbh\->func( "list_tables" );
-.Ve
-.PP
-Every time where an \f(CW\*(C`\e%attr\*(C'\fR argument can be specified, this \f(CW\*(C`\e%attr\*(C'\fR
-object's \f(CW\*(C`sql_table_source\*(C'\fR attribute is preferred over the \f(CW$dbh\fR
-attribute or the driver default, eg.
-.PP
-.Vb 6
-\& @ary = DBI\->data_sources("dbi:CSV:", {
-\& f_dir => "/your/csv/tables",
-\& # note: this class doesn\*(Aqt comes with DBI
-\& sql_table_source => "DBD::File::Archive::Tar::TableSource",
-\& # scan tarballs instead of directories
-\& });
-.Ve
-.PP
-When you're going to implement such a DBD::File::Archive::Tar::TableSource
-class, remember to add correct attributes (including \f(CW\*(C`sql_table_source\*(C'\fR
-and \f(CW\*(C`sql_data_source\*(C'\fR) to the returned \s-1DSN\s0's.
-.PP
-\fIDBI::DBD::SqlEngine::DataSource\fR
-.IX Subsection "DBI::DBD::SqlEngine::DataSource"
-.PP
-Provides base functionality for dealing with tables. It is primarily
-designed for allowing transparent access to files on disk or already
-opened (file\-)streams (eg. for \s-1DBD::CSV\s0).
-.PP
-Derived classes shall be restricted to similar functionality, too (eg.
-opening streams from an archive, transparently compress/uncompress
-log files before parsing them,
-.PP
-.Vb 1
-\& package DBI::DBD::SqlEngine::DataSource;
-\&
-\& sub complete_table_name ($$;$)
-\& {
-\& my ( $self, $meta, $table, $respect_case ) = @_;
-\& ...
-\& }
-.Ve
-.PP
-The method \f(CW\*(C`complete_table_name\*(C'\fR is called when first setting up the
-\&\fImeta information\fR for a table:
-.PP
-.Vb 1
-\& "SELECT user.id, user.name, user.shell FROM user WHERE ..."
-.Ve
-.PP
-results in opening the table \f(CW\*(C`user\*(C'\fR. First step of the table open
-process is completing the name. Let's imagine you're having a \s-1DBD::CSV\s0
-handle with following settings:
-.PP
-.Vb 3
-\& $dbh\->{sql_identifier_case} = SQL_IC_LOWER;
-\& $dbh\->{f_ext} = \*(Aq.lst\*(Aq;
-\& $dbh\->{f_dir} = \*(Aq/data/web/adrmgr\*(Aq;
-.Ve
-.PP
-Those settings will result in looking for files matching
-\&\f(CW\*(C`[Uu][Ss][Ee][Rr](\e.lst)?$\*(C'\fR in \f(CW\*(C`/data/web/adrmgr/\*(C'\fR. The scanning of the
-directory \f(CW\*(C`/data/web/adrmgr/\*(C'\fR and the pattern match check will be done
-in \f(CW\*(C`DBD::File::DataSource::File\*(C'\fR by the \f(CW\*(C`complete_table_name\*(C'\fR method.
-.PP
-If you intend to provide other sources of data streams than files, in
-addition to provide an appropriate \f(CW\*(C`complete_table_name\*(C'\fR method, a method
-to open the resource is required:
-.PP
-.Vb 1
-\& package DBI::DBD::SqlEngine::DataSource;
-\&
-\& sub open_data ($)
-\& {
-\& my ( $self, $meta, $attrs, $flags ) = @_;
-\& ...
-\& }
-.Ve
-.PP
-After the method \f(CW\*(C`open_data\*(C'\fR has been run successfully, the table's meta
-information are in a state which allowes the table's data accessor methods
-will be able to fetch/store row information. Implementation details heavily
-depends on the table implementation, whereby the most famous is surely
-DBD::File::Table.
-.SH "SQL ENGINES"
-.IX Header "SQL ENGINES"
-DBI::DBD::SqlEngine currently supports two \s-1SQL\s0 engines:
-SQL::Statement and
-DBI::SQL::Nano::Statement_. DBI::SQL::Nano supports a
-\&\fIvery\fR limited subset of \s-1SQL\s0 statements, but it might be faster for some
-very simple tasks. SQL::Statement in contrast supports a much larger subset
-of \s-1ANSI SQL.\s0
-.PP
-To use SQL::Statement, you need at least version 1.401 of
-SQL::Statement and the environment variable \f(CW\*(C`DBI_SQL_NANO\*(C'\fR must not
-be set to a true value.
-.SH "SUPPORT"
-.IX Header "SUPPORT"
-You can find documentation for this module with the perldoc command.
-.PP
-.Vb 1
-\& perldoc DBI::DBD::SqlEngine
-.Ve
-.PP
-You can also look for information at:
-.IP "\(bu" 4
-\&\s-1RT: CPAN\s0's request tracker
-.Sp
-<http://rt.cpan.org/NoAuth/Bugs.html?Dist=DBI>
-<http://rt.cpan.org/NoAuth/Bugs.html?Dist=SQL\-Statement>
-.IP "\(bu" 4
-AnnoCPAN: Annotated \s-1CPAN\s0 documentation
-.Sp
-<http://annocpan.org/dist/DBI>
-<http://annocpan.org/dist/SQL\-Statement>
-.IP "\(bu" 4
-\&\s-1CPAN\s0 Ratings
-.Sp
-<http://cpanratings.perl.org/d/DBI>
-.IP "\(bu" 4
-Search \s-1CPAN\s0
-.Sp
-<http://search.cpan.org/dist/DBI/>
-.SS "Where can I go for more help?"
-.IX Subsection "Where can I go for more help?"
-For questions about installation or usage, please ask on the
-dbi\-dev@perl.org mailing list.
-.PP
-If you have a bug report, patch or suggestion, please open
-a new report ticket on \s-1CPAN,\s0 if there is not already one for
-the issue you want to report. Of course, you can mail any of the
-module maintainers, but it is less likely to be missed if
-it is reported on \s-1RT.\s0
-.PP
-Report tickets should contain a detailed description of the bug or
-enhancement request you want to report and at least an easy way to
-verify/reproduce the issue and any supplied fix. Patches are always
-welcome, too.
-.SH "ACKNOWLEDGEMENTS"
-.IX Header "ACKNOWLEDGEMENTS"
-Thanks to Tim Bunce, Martin Evans and H.Merijn Brand for their continued
-support while developing DBD::File, \s-1DBD::DBM\s0 and DBD::AnyData.
-Their support, hints and feedback helped to design and implement this
-module.
-.SH "AUTHOR"
-.IX Header "AUTHOR"
-This module is currently maintained by
-.PP
-H.Merijn Brand < h.m.brand at xs4all.nl > and
-Jens Rehsack < rehsack at googlemail.com >
-.PP
-The original authors are Jochen Wiedmann and Jeff Zucker.
-.SH "COPYRIGHT AND LICENSE"
-.IX Header "COPYRIGHT AND LICENSE"
-.Vb 3
-\& Copyright (C) 2009\-2013 by H.Merijn Brand & Jens Rehsack
-\& Copyright (C) 2004\-2009 by Jeff Zucker
-\& Copyright (C) 1998\-2004 by Jochen Wiedmann
-.Ve
-.PP
-All rights reserved.
-.PP
-You may freely distribute and/or modify this module under the terms of
-either the \s-1GNU\s0 General Public License (\s-1GPL\s0) or the Artistic License, as
-specified in the Perl \s-1README\s0 file.
-.SH "SEE ALSO"
-.IX Header "SEE ALSO"
-\&\s-1DBI\s0, DBD::File, DBD::AnyData and DBD::Sys.
+++ /dev/null
-.\" Automatically generated by Pod::Man 2.28 (Pod::Simple 3.29)
-.\"
-.\" Standard preamble:
-.\" ========================================================================
-.de Sp \" Vertical space (when we can't use .PP)
-.if t .sp .5v
-.if n .sp
-..
-.de Vb \" Begin verbatim text
-.ft CW
-.nf
-.ne \\$1
-..
-.de Ve \" End verbatim text
-.ft R
-.fi
-..
-.\" Set up some character translations and predefined strings. \*(-- will
-.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
-.\" double quote, and \*(R" will give a right double quote. \*(C+ will
-.\" give a nicer C++. Capital omega is used to do unbreakable dashes and
-.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff,
-.\" nothing in troff, for use with C<>.
-.tr \(*W-
-.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
-.ie n \{\
-. ds -- \(*W-
-. ds PI pi
-. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
-. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch
-. ds L" ""
-. ds R" ""
-. ds C` ""
-. ds C' ""
-'br\}
-.el\{\
-. ds -- \|\(em\|
-. ds PI \(*p
-. ds L" ``
-. ds R" ''
-. ds C`
-. ds C'
-'br\}
-.\"
-.\" Escape single quotes in literal strings from groff's Unicode transform.
-.ie \n(.g .ds Aq \(aq
-.el .ds Aq '
-.\"
-.\" If the F register is turned on, we'll generate index entries on stderr for
-.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
-.\" entries marked with X<> in POD. Of course, you'll have to process the
-.\" output yourself in some meaningful fashion.
-.\"
-.\" Avoid warning from groff about undefined register 'F'.
-.de IX
-..
-.nr rF 0
-.if \n(.g .if rF .nr rF 1
-.if (\n(rF:(\n(.g==0)) \{
-. if \nF \{
-. de IX
-. tm Index:\\$1\t\\n%\t"\\$2"
-..
-. if !\nF==2 \{
-. nr % 0
-. nr F 2
-. \}
-. \}
-.\}
-.rr rF
-.\" ========================================================================
-.\"
-.IX Title "DBI::DBD::SqlEngine::Developers 3pm"
-.TH DBI::DBD::SqlEngine::Developers 3pm "2016-04-21" "perl v5.22.1" "User Contributed Perl Documentation"
-.\" For nroff, turn off justification. Always turn off hyphenation; it makes
-.\" way too many mistakes in technical documents.
-.if n .ad l
-.nh
-.SH "NAME"
-DBI::DBD::SqlEngine::Developers \- Developers documentation for DBI::DBD::SqlEngine
-.SH "SYNOPSIS"
-.IX Header "SYNOPSIS"
-.Vb 1
-\& package DBD::myDriver;
-\&
-\& use base qw(DBI::DBD::SqlEngine);
-\&
-\& sub driver
-\& {
-\& ...
-\& my $drh = $proto\->SUPER::driver($attr);
-\& ...
-\& return $drh\->{class};
-\& }
-\&
-\& sub CLONE { ... }
-\&
-\& package DBD::myDriver::dr;
-\&
-\& @ISA = qw(DBI::DBD::SqlEngine::dr);
-\&
-\& sub data_sources { ... }
-\& ...
-\&
-\& package DBD::myDriver::db;
-\&
-\& @ISA = qw(DBI::DBD::SqlEngine::db);
-\&
-\& sub init_valid_attributes { ... }
-\& sub init_default_attributes { ... }
-\& sub set_versions { ... }
-\& sub validate_STORE_attr { my ($dbh, $attrib, $value) = @_; ... }
-\& sub validate_FETCH_attr { my ($dbh, $attrib) = @_; ... }
-\& sub get_myd_versions { ... }
-\& sub get_avail_tables { ... }
-\&
-\& package DBD::myDriver::st;
-\&
-\& @ISA = qw(DBI::DBD::SqlEngine::st);
-\&
-\& sub FETCH { ... }
-\& sub STORE { ... }
-\&
-\& package DBD::myDriver::Statement;
-\&
-\& @ISA = qw(DBI::DBD::SqlEngine::Statement);
-\&
-\& sub open_table { ... }
-\&
-\& package DBD::myDriver::Table;
-\&
-\& @ISA = qw(DBI::DBD::SqlEngine::Table);
-\&
-\& my %reset_on_modify = (
-\& myd_abc => "myd_foo",
-\& myd_mno => "myd_bar",
-\& );
-\& _\|_PACKAGE_\|_\->register_reset_on_modify( \e%reset_on_modify );
-\& my %compat_map = (
-\& abc => \*(Aqfoo_abc\*(Aq,
-\& xyz => \*(Aqfoo_xyz\*(Aq,
-\& );
-\& _\|_PACKAGE_\|_\->register_compat_map( \e%compat_map );
-\&
-\& sub bootstrap_table_meta { ... }
-\& sub init_table_meta { ... }
-\& sub table_meta_attr_changed { ... }
-\& sub open_data { ... }
-\&
-\& sub new { ... }
-\&
-\& sub fetch_row { ... }
-\& sub push_row { ... }
-\& sub push_names { ... }
-\& sub seek { ... }
-\& sub truncate { ... }
-\& sub drop { ... }
-\&
-\& # optimize the SQL engine by add one or more of
-\& sub update_current_row { ... }
-\& # or
-\& sub update_specific_row { ... }
-\& # or
-\& sub update_one_row { ... }
-\& # or
-\& sub insert_new_row { ... }
-\& # or
-\& sub delete_current_row { ... }
-\& # or
-\& sub delete_one_row { ... }
-.Ve
-.SH "DESCRIPTION"
-.IX Header "DESCRIPTION"
-This document describes the interface of DBI::DBD::SqlEngine for \s-1DBD\s0
-developers who write DBI::DBD::SqlEngine based \s-1DBI\s0 drivers. It supplements
-\&\s-1DBI::DBD\s0 and DBI::DBD::SqlEngine::HowTo, which you should read first.
-.SH "CLASSES"
-.IX Header "CLASSES"
-Each \s-1DBI\s0 driver must provide a package global \f(CW\*(C`driver\*(C'\fR method and
-three \s-1DBI\s0 related classes:
-.IP "DBI::DBD::SqlEngine::dr" 4
-.IX Item "DBI::DBD::SqlEngine::dr"
-Driver package, contains the methods \s-1DBI\s0 calls indirectly via \s-1DBI\s0
-interface:
-.Sp
-.Vb 1
-\& DBI\->connect (\*(AqDBI:DBM:\*(Aq, undef, undef, {})
-\&
-\& # invokes
-\& package DBD::DBM::dr;
-\& @DBD::DBM::dr::ISA = qw(DBI::DBD::SqlEngine::dr);
-\&
-\& sub connect ($$;$$$)
-\& {
-\& ...
-\& }
-.Ve
-.Sp
-Similar for \f(CW\*(C`data_sources ()\*(C'\fR and \f(CW\*(C`disconnect_all()\*(C'\fR.
-.Sp
-Pure Perl \s-1DBI\s0 drivers derived from DBI::DBD::SqlEngine usually don't need to
-override any of the methods provided through the DBD::XXX::dr package.
-However if you need additional initialization not fitting in
-\&\f(CW\*(C`init_valid_attributes()\*(C'\fR and \f(CW\*(C`init_default_attributes()\*(C'\fR of you're ::db
-class, the connect method might be the final place to be modified.
-.IP "DBI::DBD::SqlEngine::db" 4
-.IX Item "DBI::DBD::SqlEngine::db"
-Contains the methods which are called through \s-1DBI\s0 database handles
-(\f(CW$dbh\fR). e.g.,
-.Sp
-.Vb 3
-\& $sth = $dbh\->prepare ("select * from foo");
-\& # returns the f_encoding setting for table foo
-\& $dbh\->csv_get_meta ("foo", "f_encoding");
-.Ve
-.Sp
-DBI::DBD::SqlEngine provides the typical methods required here. Developers who
-write \s-1DBI\s0 drivers based on DBI::DBD::SqlEngine need to override the methods
-\&\f(CW\*(C`set_versions\*(C'\fR and \f(CW\*(C`init_valid_attributes\*(C'\fR.
-.IP "DBI::DBD::SqlEngine::TieMeta;" 4
-.IX Item "DBI::DBD::SqlEngine::TieMeta;"
-Provides the tie-magic for \f(CW\*(C`$dbh\->{$drv_pfx . "_meta"}\*(C'\fR. Routes
-\&\f(CW\*(C`STORE\*(C'\fR through \f(CW\*(C`$drv\->set_sql_engine_meta()\*(C'\fR and \f(CW\*(C`FETCH\*(C'\fR through
-\&\f(CW\*(C`$drv\->get_sql_engine_meta()\*(C'\fR. \f(CW\*(C`DELETE\*(C'\fR is not supported, you have
-to execute a \f(CW\*(C`DROP TABLE\*(C'\fR statement, where applicable.
-.IP "DBI::DBD::SqlEngine::TieTables;" 4
-.IX Item "DBI::DBD::SqlEngine::TieTables;"
-Provides the tie-magic for tables in \f(CW\*(C`$dbh\->{$drv_pfx . "_meta"}\*(C'\fR.
-Routes \f(CW\*(C`STORE\*(C'\fR though \f(CW\*(C`$tblClass\->set_table_meta_attr()\*(C'\fR and \f(CW\*(C`FETCH\*(C'\fR
-though \f(CW\*(C`$tblClass\->get_table_meta_attr()\*(C'\fR. \f(CW\*(C`DELETE\*(C'\fR removes an
-attribute from the \fImeta object\fR retrieved by
-\&\f(CW\*(C`$tblClass\->get_table_meta()\*(C'\fR.
-.IP "DBI::DBD::SqlEngine::st" 4
-.IX Item "DBI::DBD::SqlEngine::st"
-Contains the methods to deal with prepared statement handles. e.g.,
-.Sp
-.Vb 1
-\& $sth\->execute () or die $sth\->errstr;
-.Ve
-.IP "DBI::DBD::SqlEngine::TableSource;" 4
-.IX Item "DBI::DBD::SqlEngine::TableSource;"
-Base class for 3rd party table sources:
-.Sp
-.Vb 1
-\& $dbh\->{sql_table_source} = "DBD::Foo::TableSource";
-.Ve
-.IP "DBI::DBD::SqlEngine::DataSource;" 4
-.IX Item "DBI::DBD::SqlEngine::DataSource;"
-Base class for 3rd party data sources:
-.Sp
-.Vb 1
-\& $dbh\->{sql_data_source} = "DBD::Foo::DataSource";
-.Ve
-.IP "DBI::DBD::SqlEngine::Statement;" 4
-.IX Item "DBI::DBD::SqlEngine::Statement;"
-Base class for derived drivers statement engine. Implements \f(CW\*(C`open_table\*(C'\fR.
-.IP "DBI::DBD::SqlEngine::Table;" 4
-.IX Item "DBI::DBD::SqlEngine::Table;"
-Contains tailoring between \s-1SQL\s0 engine's requirements and
-\&\f(CW\*(C`DBI::DBD::SqlEngine\*(C'\fR magic for finding the right tables and storage.
-Builds bridges between \f(CW\*(C`sql_meta\*(C'\fR handling of \f(CW\*(C`DBI::DBD::SqlEngine::db\*(C'\fR,
-table initialization for \s-1SQL\s0 engines and \fImeta object\fR's attribute
-management for derived drivers.
-.SS "DBI::DBD::SqlEngine"
-.IX Subsection "DBI::DBD::SqlEngine"
-This is the main package containing the routines to initialize
-DBI::DBD::SqlEngine based \s-1DBI\s0 drivers. Primarily the
-\&\f(CW\*(C`DBI::DBD::SqlEngine::driver\*(C'\fR method is invoked, either directly
-from \s-1DBI\s0 when the driver is initialized or from the derived class.
-.PP
-.Vb 1
-\& package DBD::DBM;
-\&
-\& use base qw( DBI::DBD::SqlEngine );
-\&
-\& sub driver
-\& {
-\& my ( $class, $attr ) = @_;
-\& ...
-\& my $drh = $class\->SUPER::driver( $attr );
-\& ...
-\& return $drh;
-\& }
-.Ve
-.PP
-It is not necessary to implement your own driver method as long as
-additional initialization (e.g. installing more private driver
-methods) is not required. You do not need to call \f(CW\*(C`setup_driver\*(C'\fR
-as DBI::DBD::SqlEngine takes care of it.
-.SS "DBI::DBD::SqlEngine::dr"
-.IX Subsection "DBI::DBD::SqlEngine::dr"
-The driver package contains the methods \s-1DBI\s0 calls indirectly via the \s-1DBI\s0
-interface (see \*(L"\s-1DBI\s0 Class Methods\*(R" in \s-1DBI\s0).
-.PP
-DBI::DBD::SqlEngine based \s-1DBI\s0 drivers usually do not need to implement anything here,
-it is enough to do the basic initialization:
-.PP
-.Vb 1
-\& package DBD:XXX::dr;
-\&
-\& @DBD::XXX::dr::ISA = qw (DBI::DBD::SqlEngine::dr);
-\& $DBD::XXX::dr::imp_data_size = 0;
-\& $DBD::XXX::dr::data_sources_attr = undef;
-\& $DBD::XXX::ATTRIBUTION = "DBD::XXX $DBD::XXX::VERSION by Hans Mustermann";
-.Ve
-.PP
-\fIMethods provided by \f(CI\*(C`DBI::DBD::SqlEngine::dr\*(C'\fI:\fR
-.IX Subsection "Methods provided by DBI::DBD::SqlEngine::dr:"
-.IP "connect" 4
-.IX Item "connect"
-Supervises the driver bootstrap when calling
-.Sp
-.Vb 1
-\& DBI\->connect( "dbi:Foo", , , { ... } );
-.Ve
-.Sp
-First it instantiates a new driver using \f(CW\*(C`DBI::_new_dbh\*(C'\fR. After that,
-initial bootstrap of the newly instantiated driver is done by
-.Sp
-.Vb 1
-\& $dbh\->func( 0, "init_default_attributes" );
-.Ve
-.Sp
-The first argument (\f(CW0\fR) signals that this is the very first call to
-\&\f(CW\*(C`init_default_attributes\*(C'\fR. Modern drivers understand that and do early
-stage setup here after calling
-.Sp
-.Vb 2
-\& package DBD::Foo::db;
-\& our @DBD::Foo::db::ISA = qw(DBI::DBD::SqlEngine::db);
-\&
-\& sub init_default_attributes
-\& {
-\& my ($dbh, $phase) = @_;
-\& $dbh\->SUPER::init_default_attributes($phase);
-\& ...; # own setup code, maybe separated by phases
-\& }
-.Ve
-.Sp
-When the \f(CW$phase\fR argument is passed down until
-\&\f(CW\*(C`DBI::DBD::SqlEngine::db::init_default_attributes\*(C'\fR, \f(CW\*(C`connect()\*(C'\fR recognizes
-a \fImodern\fR driver and initializes the attributes from \fI\s-1DSN\s0\fR and \fI\f(CI$attr\fI\fR
-arguments passed via \f(CW\*(C`DBI\->connect( $dsn, $user, $pass, \e%attr )\*(C'\fR.
-.Sp
-At the end of the attribute initialization after \fIphase 0\fR, \f(CW\*(C`connect()\*(C'\fR
-invoked \f(CW\*(C`init_default_attributes\*(C'\fR again for \fIphase 1\fR:
-.Sp
-.Vb 1
-\& $dbh\->func( 1, "init_default_attributes" );
-.Ve
-.IP "data_sources" 4
-.IX Item "data_sources"
-Returns a list of \fI\s-1DSN\s0\fR's using the \f(CW\*(C`data_sources\*(C'\fR method of the
-class specified in \f(CW\*(C`$dbh\->{sql_table_source}\*(C'\fR or via \f(CW\*(C`\e%attr\*(C'\fR:
-.Sp
-.Vb 2
-\& @ary = DBI\->data_sources($driver);
-\& @ary = DBI\->data_sources($driver, \e%attr);
-.Ve
-.IP "disconnect_all" 4
-.IX Item "disconnect_all"
-\&\f(CW\*(C`DBI::DBD::SqlEngine\*(C'\fR doesn't have an overall driver cache, so nothing
-happens here at all.
-.SS "DBI::DBD::SqlEngine::db"
-.IX Subsection "DBI::DBD::SqlEngine::db"
-This package defines the database methods, which are called via the \s-1DBI\s0
-database handle \f(CW$dbh\fR.
-.PP
-\fIMethods provided by \f(CI\*(C`DBI::DBD::SqlEngine::db\*(C'\fI:\fR
-.IX Subsection "Methods provided by DBI::DBD::SqlEngine::db:"
-.IP "ping" 4
-.IX Item "ping"
-Simply returns the content of the \f(CW\*(C`Active\*(C'\fR attribute. Override
-when your driver needs more complicated actions here.
-.IP "prepare" 4
-.IX Item "prepare"
-Prepares a new \s-1SQL\s0 statement to execute. Returns a statement handle,
-\&\f(CW$sth\fR \- instance of the DBD:XXX::st. It is neither required nor
-recommended to override this method.
-.IP "validate_FETCH_attr" 4
-.IX Item "validate_FETCH_attr"
-Called by \f(CW\*(C`FETCH\*(C'\fR to allow inherited drivers do their own attribute
-name validation. Calling convention is similar to \f(CW\*(C`FETCH\*(C'\fR and the
-return value is the approved attribute name.
-.Sp
-.Vb 1
-\& return $validated_attribute_name;
-.Ve
-.Sp
-In case of validation fails (e.g. accessing private attribute or similar),
-\&\f(CW\*(C`validate_FETCH_attr\*(C'\fR is permitted to throw an exception.
-.IP "\s-1FETCH\s0" 4
-.IX Item "FETCH"
-Fetches an attribute of a \s-1DBI\s0 database object. Private handle attributes
-must have a prefix (this is mandatory). If a requested attribute is
-detected as a private attribute without a valid prefix, the driver prefix
-(written as \f(CW$drv_prefix\fR) is added.
-.Sp
-The driver prefix is extracted from the attribute name and verified against
-\&\f(CW\*(C`$dbh\->{ $drv_prefix . "valid_attrs" }\*(C'\fR (when it exists). If the
-requested attribute value is not listed as a valid attribute, this method
-croaks. If the attribute is valid and readonly (listed in \f(CW\*(C`$dbh\->{
-$drv_prefix . "readonly_attrs" }\*(C'\fR when it exists), a real copy of the
-attribute value is returned. So it's not possible to modify
-\&\f(CW\*(C`f_valid_attrs\*(C'\fR from outside of DBI::DBD::SqlEngine::db or a derived class.
-.IP "validate_STORE_attr" 4
-.IX Item "validate_STORE_attr"
-Called by \f(CW\*(C`STORE\*(C'\fR to allow inherited drivers do their own attribute
-name validation. Calling convention is similar to \f(CW\*(C`STORE\*(C'\fR and the
-return value is the approved attribute name followed by the approved
-new value.
-.Sp
-.Vb 1
-\& return ($validated_attribute_name, $validated_attribute_value);
-.Ve
-.Sp
-In case of validation fails (e.g. accessing private attribute or similar),
-\&\f(CW\*(C`validate_STORE_attr\*(C'\fR is permitted to throw an exception
-(\f(CW\*(C`DBI::DBD::SqlEngine::db::validate_STORE_attr\*(C'\fR throws an exception when
-someone tries to assign value other than \f(CW\*(C`SQL_IC_UPPER .. SQL_IC_MIXED\*(C'\fR
-to \f(CW\*(C`$dbh\->{sql_identifier_case}\*(C'\fR or
-\&\f(CW\*(C`$dbh\->{sql_quoted_identifier_case}\*(C'\fR).
-.IP "\s-1STORE\s0" 4
-.IX Item "STORE"
-Stores a database private attribute. Private handle attributes must have a
-prefix (this is mandatory). If a requested attribute is detected as a private
-attribute without a valid prefix, the driver prefix (written as
-\&\f(CW$drv_prefix\fR) is added. If the database handle has an attribute
-\&\f(CW\*(C`${drv_prefix}_valid_attrs\*(C'\fR \- for attribute names which are not listed in
-that hash, this method croaks. If the database handle has an attribute
-\&\f(CW\*(C`${drv_prefix}_readonly_attrs\*(C'\fR, only attributes which are not listed there
-can be stored (once they are initialized). Trying to overwrite such an
-immutable attribute forces this method to croak.
-.Sp
-An example of a valid attributes list can be found in
-\&\f(CW\*(C`DBI::DBD::SqlEngine::db::init_valid_attributes\*(C'\fR.
-.IP "set_versions" 4
-.IX Item "set_versions"
-This method sets the attributes \f(CW\*(C`f_version\*(C'\fR, \f(CW\*(C`sql_nano_version\*(C'\fR,
-\&\f(CW\*(C`sql_statement_version\*(C'\fR and (if not prohibited by a restrictive
-\&\f(CW\*(C`${prefix}_valid_attrs\*(C'\fR) \f(CW\*(C`${prefix}_version\*(C'\fR.
-.Sp
-This method is called at the end of the \f(CW\*(C`connect ()\*(C'\fR phase.
-.Sp
-When overriding this method, do not forget to invoke the superior one.
-.IP "init_valid_attributes" 4
-.IX Item "init_valid_attributes"
-This method is called after the database handle is instantiated as the
-first attribute initialization.
-.Sp
-\&\f(CW\*(C`DBI::DBD::SqlEngine::db::init_valid_attributes\*(C'\fR initializes the
-attributes \f(CW\*(C`sql_valid_attrs\*(C'\fR and \f(CW\*(C`sql_readonly_attrs\*(C'\fR.
-.Sp
-When overriding this method, do not forget to invoke the superior one,
-preferably before doing anything else.
-.IP "init_default_attributes" 4
-.IX Item "init_default_attributes"
-This method is called after the database handle is instantiated to
-initialize the default attributes. It expects one argument: \f(CW$phase\fR.
-If \f(CW$phase\fR is not given, \f(CW\*(C`connect\*(C'\fR of \f(CW\*(C`DBI::DBD::SqlEngine::dr\*(C'\fR
-expects this is an old-fashioned driver which isn't capable of multi-phased
-initialization.
-.Sp
-\&\f(CW\*(C`DBI::DBD::SqlEngine::db::init_default_attributes\*(C'\fR initializes the
-attributes \f(CW\*(C`sql_identifier_case\*(C'\fR, \f(CW\*(C`sql_quoted_identifier_case\*(C'\fR,
-\&\f(CW\*(C`sql_handler\*(C'\fR, \f(CW\*(C`sql_init_order\*(C'\fR, \f(CW\*(C`sql_meta\*(C'\fR, \f(CW\*(C`sql_engine_version\*(C'\fR,
-\&\f(CW\*(C`sql_nano_version\*(C'\fR and \f(CW\*(C`sql_statement_version\*(C'\fR when SQL::Statement
-is available.
-.Sp
-It sets \f(CW\*(C`sql_init_order\*(C'\fR to the given \f(CW$phase\fR.
-.Sp
-When the derived implementor class provides the attribute to validate
-attributes (e.g. \f(CW\*(C`$dbh\->{dbm_valid_attrs} = {...};\*(C'\fR) or the attribute
-containing the immutable attributes (e.g. \f(CW\*(C`$dbh\->{dbm_readonly_attrs}
-= {...};\*(C'\fR), the attributes \f(CW\*(C`drv_valid_attrs\*(C'\fR, \f(CW\*(C`drv_readonly_attrs\*(C'\fR and
-\&\f(CW\*(C`drv_version\*(C'\fR are added (when available) to the list of valid and
-immutable attributes (where \f(CW\*(C`drv_\*(C'\fR is interpreted as the driver prefix).
-.IP "get_versions" 4
-.IX Item "get_versions"
-This method is called by the code injected into the instantiated driver to
-provide the user callable driver method \f(CW\*(C`${prefix}versions\*(C'\fR (e.g.
-\&\f(CW\*(C`dbm_versions\*(C'\fR, \f(CW\*(C`csv_versions\*(C'\fR, ...).
-.Sp
-The DBI::DBD::SqlEngine implementation returns all version information known by
-DBI::DBD::SqlEngine (e.g. \s-1DBI\s0 version, Perl version, DBI::DBD::SqlEngine version and
-the \s-1SQL\s0 handler version).
-.Sp
-\&\f(CW\*(C`get_versions\*(C'\fR takes the \f(CW$dbh\fR as the first argument and optionally a
-second argument containing a table name. The second argument is not
-evaluated in \f(CW\*(C`DBI::DBD::SqlEngine::db::get_versions\*(C'\fR itself \- but
-might be in the future.
-.Sp
-If the derived implementor class provides a method named
-\&\f(CW\*(C`get_${drv_prefix}versions\*(C'\fR, this is invoked and the return value of
-it is associated to the derived driver name:
-.Sp
-.Vb 4
-\& if (my $dgv = $dbh\->{ImplementorClass}\->can ("get_" . $drv_prefix . "versions") {
-\& (my $derived_driver = $dbh\->{ImplementorClass}) =~ s/::db$//;
-\& $versions{$derived_driver} = &$dgv ($dbh, $table);
-\& }
-.Ve
-.Sp
-Override it to add more version information about your module, (e.g.
-some kind of parser version in case of \s-1DBD::CSV, ...\s0), if one line is not
-enough room to provide all relevant information.
-.IP "sql_parser_object" 4
-.IX Item "sql_parser_object"
-Returns a SQL::Parser instance, when \f(CW\*(C`sql_handler\*(C'\fR is set to
-\&\*(L"SQL::Statement\*(R". The parser instance is stored in \f(CW\*(C`sql_parser_object\*(C'\fR.
-.Sp
-It is not recommended to override this method.
-.IP "disconnect" 4
-.IX Item "disconnect"
-Disconnects from a database. All local table information is discarded and
-the \f(CW\*(C`Active\*(C'\fR attribute is set to 0.
-.IP "type_info_all" 4
-.IX Item "type_info_all"
-Returns information about all the types supported by DBI::DBD::SqlEngine.
-.IP "table_info" 4
-.IX Item "table_info"
-Returns a statement handle which is prepared to deliver information about
-all known tables.
-.IP "list_tables" 4
-.IX Item "list_tables"
-Returns a list of all known table names.
-.IP "quote" 4
-.IX Item "quote"
-Quotes a string for use in \s-1SQL\s0 statements.
-.IP "commit" 4
-.IX Item "commit"
-Warns about a useless call (if warnings enabled) and returns.
-DBI::DBD::SqlEngine is typically a driver which commits every action
-instantly when executed.
-.IP "rollback" 4
-.IX Item "rollback"
-Warns about a useless call (if warnings enabled) and returns.
-DBI::DBD::SqlEngine is typically a driver which commits every action
-instantly when executed.
-.PP
-\fIAttributes used by \f(CI\*(C`DBI::DBD::SqlEngine::db\*(C'\fI:\fR
-.IX Subsection "Attributes used by DBI::DBD::SqlEngine::db:"
-.PP
-This section describes attributes which are important to developers of \s-1DBI\s0
-Database Drivers derived from \f(CW\*(C`DBI::DBD::SqlEngine\*(C'\fR.
-.IP "sql_init_order" 4
-.IX Item "sql_init_order"
-This attribute contains a hash with priorities as key and an array
-containing the \f(CW$dbh\fR attributes to be initialized during before/after
-other attributes.
-.Sp
-\&\f(CW\*(C`DBI::DBD::SqlEngine\*(C'\fR initializes following attributes:
-.Sp
-.Vb 4
-\& $dbh\->{sql_init_order} = {
-\& 0 => [qw( Profile RaiseError PrintError AutoCommit )],
-\& 90 => [ "sql_meta", $dbh\->{$drv_pfx_meta} ? $dbh\->{$drv_pfx_meta} : () ]
-\& }
-.Ve
-.Sp
-The default priority of not listed attribute keys is \f(CW50\fR. It is well
-known that a lot of attributes needed to be set before some table settings
-are initialized. For example, for \s-1DBD::DBM\s0, when using
-.Sp
-.Vb 11
-\& my $dbh = DBI\->connect( "dbi:DBM:", undef, undef, {
-\& f_dir => "/path/to/dbm/databases",
-\& dbm_type => "BerkeleyDB",
-\& dbm_mldbm => "JSON", # use MLDBM::Serializer::JSON
-\& dbm_tables => {
-\& quick => {
-\& dbm_type => "GDBM_File",
-\& dbm_MLDBM => "FreezeThaw"
-\& }
-\& }
-\& });
-.Ve
-.Sp
-This defines a known table \f(CW\*(C`quick\*(C'\fR which uses the GDBM_File backend and
-FreezeThaw as serializer instead of the overall default BerkeleyDB and
-\&\s-1JSON\s0. \fBBut\fR all files containing the table data have to be searched in
-\&\f(CW\*(C`$dbh\->{f_dir}\*(C'\fR, which requires \f(CW\*(C`$dbh\->{f_dir}\*(C'\fR must be initialized
-before \f(CW\*(C`$dbh\->{sql_meta}\->{quick}\*(C'\fR is initialized by
-\&\f(CW\*(C`bootstrap_table_meta\*(C'\fR method of \*(L"DBI::DBD::SqlEngine::Table\*(R" to get
-\&\f(CW\*(C`$dbh\->{sql_meta}\->{quick}\->{f_dir}\*(C'\fR being initialized properly.
-.IP "sql_init_phase" 4
-.IX Item "sql_init_phase"
-This attribute is only set during the initialization steps of the \s-1DBI\s0
-Database Driver. It contains the value of the currently run initialization
-phase. Currently supported phases are \fIphase 0\fR and \fIphase 1\fR. This
-attribute is set in \f(CW\*(C`init_default_attributes\*(C'\fR and removed in \f(CW\*(C`init_done\*(C'\fR.
-.IP "sql_engine_in_gofer" 4
-.IX Item "sql_engine_in_gofer"
-This value has a true value in case of this driver is operated via
-DBD::Gofer. The impact of being operated via Gofer is a read-only
-driver (not read-only databases!), so you cannot modify any attributes
-later \- neither any table settings. \fBBut\fR you won't get an error in
-cases you modify table attributes, so please carefully watch
-\&\f(CW\*(C`sql_engine_in_gofer\*(C'\fR.
-.IP "sql_table_source" 4
-.IX Item "sql_table_source"
-Names a class which is responsible for delivering \fIdata sources\fR and
-\&\fIavailable tables\fR (Database Driver related). \fIdata sources\fR here
-refers to \*(L"data_sources\*(R" in \s-1DBI\s0, not \f(CW\*(C`sql_data_source\*(C'\fR.
-.Sp
-See \*(L"DBI::DBD::SqlEngine::TableSource\*(R" for details.
-.IP "sql_data_source" 4
-.IX Item "sql_data_source"
-Name a class which is responsible for handling table resources open
-and completing table names requested via \s-1SQL\s0 statements.
-.Sp
-See \*(L"DBI::DBD::SqlEngine::DataSource\*(R" for details.
-.IP "sql_dialect" 4
-.IX Item "sql_dialect"
-Controls the dialect understood by SQL::Parser. Possible values (delivery
-state of SQL::Statement):
-.Sp
-.Vb 3
-\& * ANSI
-\& * CSV
-\& * AnyData
-.Ve
-.Sp
-Defaults to \*(L"\s-1CSV\*(R". \s0 Because an SQL::Parser is instantiated only once and
-SQL::Parser doesn't allow one to modify the dialect once instantiated,
-it's strongly recommended to set this flag before any statement is
-executed (best place is connect attribute hash).
-.SS "DBI::DBD::SqlEngine::st"
-.IX Subsection "DBI::DBD::SqlEngine::st"
-Contains the methods to deal with prepared statement handles:
-.IP "bind_param" 4
-.IX Item "bind_param"
-Common routine to bind placeholders to a statement for execution. It
-is dangerous to override this method without detailed knowledge about
-the DBI::DBD::SqlEngine internal storage structure.
-.IP "execute" 4
-.IX Item "execute"
-Executes a previously prepared statement (with placeholders, if any).
-.IP "finish" 4
-.IX Item "finish"
-Finishes a statement handle, discards all buffered results. The prepared
-statement is not discarded so the statement can be executed again.
-.IP "fetch" 4
-.IX Item "fetch"
-Fetches the next row from the result-set. This method may be rewritten
-in a later version and if it's overridden in a derived class, the
-derived implementation should not rely on the storage details.
-.IP "fetchrow_arrayref" 4
-.IX Item "fetchrow_arrayref"
-Alias for \f(CW\*(C`fetch\*(C'\fR.
-.IP "\s-1FETCH\s0" 4
-.IX Item "FETCH"
-Fetches statement handle attributes. Supported attributes (for full overview
-see \*(L"Statement Handle Attributes\*(R" in \s-1DBI\s0) are \f(CW\*(C`NAME\*(C'\fR, \f(CW\*(C`TYPE\*(C'\fR, \f(CW\*(C`PRECISION\*(C'\fR
-and \f(CW\*(C`NULLABLE\*(C'\fR. Each column is returned as \f(CW\*(C`NULLABLE\*(C'\fR which might be wrong
-depending on the derived backend storage. If the statement handle has
-private attributes, they can be fetched using this method, too. \fBNote\fR that
-statement attributes are not associated with any table used in this statement.
-.Sp
-This method usually requires extending in a derived implementation.
-See \s-1DBD::CSV\s0 or \s-1DBD::DBM\s0 for some example.
-.IP "\s-1STORE\s0" 4
-.IX Item "STORE"
-Allows storing of statement private attributes. No special handling is
-currently implemented here.
-.IP "rows" 4
-.IX Item "rows"
-Returns the number of rows affected by the last execute. This method might
-return \f(CW\*(C`undef\*(C'\fR.
-.SS "DBI::DBD::SqlEngine::TableSource"
-.IX Subsection "DBI::DBD::SqlEngine::TableSource"
-Provides data sources and table information on database driver and database
-handle level.
-.PP
-.Vb 1
-\& package DBI::DBD::SqlEngine::TableSource;
-\&
-\& sub data_sources ($;$)
-\& {
-\& my ( $class, $drh, $attrs ) = @_;
-\& ...
-\& }
-\&
-\& sub avail_tables
-\& {
-\& my ( $class, $drh ) = @_;
-\& ...
-\& }
-.Ve
-.PP
-The \f(CW\*(C`data_sources\*(C'\fR method is called when the user invokes any of the
-following:
-.PP
-.Vb 2
-\& @ary = DBI\->data_sources($driver);
-\& @ary = DBI\->data_sources($driver, \e%attr);
-\&
-\& @ary = $dbh\->data_sources();
-\& @ary = $dbh\->data_sources(\e%attr);
-.Ve
-.PP
-The \f(CW\*(C`avail_tables\*(C'\fR method is called when the user invokes any of the
-following:
-.PP
-.Vb 1
-\& @names = $dbh\->tables( $catalog, $schema, $table, $type );
-\&
-\& $sth = $dbh\->table_info( $catalog, $schema, $table, $type );
-\& $sth = $dbh\->table_info( $catalog, $schema, $table, $type, \e%attr );
-\&
-\& $dbh\->func( "list_tables" );
-.Ve
-.PP
-Every time where an \f(CW\*(C`\e%attr\*(C'\fR argument can be specified, this \f(CW\*(C`\e%attr\*(C'\fR
-object's \f(CW\*(C`sql_table_source\*(C'\fR attribute is preferred over the \f(CW$dbh\fR
-attribute or the driver default.
-.SS "DBI::DBD::SqlEngine::DataSource"
-.IX Subsection "DBI::DBD::SqlEngine::DataSource"
-Provides base functionality for dealing with tables. It is primarily
-designed for allowing transparent access to files on disk or already
-opened (file\-)streams (e.g. for \s-1DBD::CSV\s0).
-.PP
-Derived classes shall be restricted to similar functionality, too (e.g.
-opening streams from an archive, transparently compress/uncompress
-log files before parsing them,
-.PP
-.Vb 1
-\& package DBI::DBD::SqlEngine::DataSource;
-\&
-\& sub complete_table_name ($$;$)
-\& {
-\& my ( $self, $meta, $table, $respect_case ) = @_;
-\& ...
-\& }
-.Ve
-.PP
-The method \f(CW\*(C`complete_table_name\*(C'\fR is called when first setting up the
-\&\fImeta information\fR for a table:
-.PP
-.Vb 1
-\& "SELECT user.id, user.name, user.shell FROM user WHERE ..."
-.Ve
-.PP
-results in opening the table \f(CW\*(C`user\*(C'\fR. First step of the table open
-process is completing the name. Let's imagine you're having a \s-1DBD::CSV\s0
-handle with following settings:
-.PP
-.Vb 3
-\& $dbh\->{sql_identifier_case} = SQL_IC_LOWER;
-\& $dbh\->{f_ext} = \*(Aq.lst\*(Aq;
-\& $dbh\->{f_dir} = \*(Aq/data/web/adrmgr\*(Aq;
-.Ve
-.PP
-Those settings will result in looking for files matching
-\&\f(CW\*(C`[Uu][Ss][Ee][Rr](\e.lst)?$\*(C'\fR in \f(CW\*(C`/data/web/adrmgr/\*(C'\fR. The scanning of the
-directory \f(CW\*(C`/data/web/adrmgr/\*(C'\fR and the pattern match check will be done
-in \f(CW\*(C`DBD::File::DataSource::File\*(C'\fR by the \f(CW\*(C`complete_table_name\*(C'\fR method.
-.PP
-If you intend to provide other sources of data streams than files, in
-addition to provide an appropriate \f(CW\*(C`complete_table_name\*(C'\fR method, a method
-to open the resource is required:
-.PP
-.Vb 1
-\& package DBI::DBD::SqlEngine::DataSource;
-\&
-\& sub open_data ($)
-\& {
-\& my ( $self, $meta, $attrs, $flags ) = @_;
-\& ...
-\& }
-.Ve
-.PP
-After the method \f(CW\*(C`open_data\*(C'\fR has been run successfully, the table's meta
-information are in a state which allows the table's data accessor methods
-will be able to fetch/store row information. Implementation details heavily
-depends on the table implementation, whereby the most famous is surely
-DBD::File::Table.
-.SS "DBI::DBD::SqlEngine::Statement"
-.IX Subsection "DBI::DBD::SqlEngine::Statement"
-Derives from DBI::SQL::Nano::Statement for unified naming when deriving
-new drivers. No additional feature is provided from here.
-.SS "DBI::DBD::SqlEngine::Table"
-.IX Subsection "DBI::DBD::SqlEngine::Table"
-Derives from DBI::SQL::Nano::Table for unified naming when deriving
-new drivers.
-.PP
-You should consult the documentation of \f(CW\*(C`SQL::Eval::Table\*(C'\fR (see
-SQL::Eval) to get more information about the abstract methods of the
-table's base class you have to override and a description of the table
-meta information expected by the \s-1SQL\s0 engines.
-.IP "bootstrap_table_meta" 4
-.IX Item "bootstrap_table_meta"
-Initializes a table meta structure. Can be safely overridden in a
-derived class, as long as the \f(CW\*(C`SUPER\*(C'\fR method is called at the end
-of the overridden method.
-.Sp
-It copies the following attributes from the database into the table meta data
-\&\f(CW\*(C`$dbh\->{ReadOnly}\*(C'\fR into \f(CW\*(C`$meta\->{readonly}\*(C'\fR, \f(CW\*(C`sql_identifier_case\*(C'\fR
-and \f(CW\*(C`sql_data_source\*(C'\fR and makes them sticky to the table.
-.Sp
-This method should be called before you attempt to map between file
-name and table name to ensure the correct directory, extension etc. are
-used.
-.IP "init_table_meta" 4
-.IX Item "init_table_meta"
-Initializes more attributes of the table meta data \- usually more
-expensive ones (e.g. those which require class instantiations) \- when
-the file name and the table name could mapped.
-.IP "get_table_meta" 4
-.IX Item "get_table_meta"
-Returns the table meta data. If there are none for the required table,
-a new one is initialized. When after bootstrapping a new \fItable_meta\fR
-and completing the table name a
-mapping can be established between an existing \fItable_meta\fR and the
-new bootstrapped one, the already existing is used and a mapping
-shortcut between the recent used table name and the already known
-table name is hold in \f(CW\*(C`$dbh\->{sql_meta_map}\*(C'\fR. When it fails,
-nothing is returned. On success, the name of the table and the meta data
-structure is returned.
-.IP "get_table_meta_attr" 4
-.IX Item "get_table_meta_attr"
-Returns a single attribute from the table meta data. If the attribute
-name appears in \f(CW%compat_map\fR, the attribute name is updated from
-there.
-.IP "set_table_meta_attr" 4
-.IX Item "set_table_meta_attr"
-Sets a single attribute in the table meta data. If the attribute
-name appears in \f(CW%compat_map\fR, the attribute name is updated from
-there.
-.IP "table_meta_attr_changed" 4
-.IX Item "table_meta_attr_changed"
-Called when an attribute of the meta data is modified.
-.Sp
-If the modified attribute requires to reset a calculated attribute, the
-calculated attribute is reset (deleted from meta data structure) and
-the \fIinitialized\fR flag is removed, too. The decision is made based on
-\&\f(CW%register_reset_on_modify\fR.
-.IP "register_reset_on_modify" 4
-.IX Item "register_reset_on_modify"
-Allows \f(CW\*(C`set_table_meta_attr\*(C'\fR to reset meta attributes when special
-attributes are modified. For DBD::File, modifying one of \f(CW\*(C`f_file\*(C'\fR, \f(CW\*(C`f_dir\*(C'\fR,
-\&\f(CW\*(C`f_ext\*(C'\fR or \f(CW\*(C`f_lockfile\*(C'\fR will reset \f(CW\*(C`f_fqfn\*(C'\fR. \s-1DBD::DBM\s0 extends the
-list for \f(CW\*(C`dbm_type\*(C'\fR and \f(CW\*(C`dbm_mldbm\*(C'\fR to reset the value of \f(CW\*(C`dbm_tietype\*(C'\fR.
-.Sp
-If your \s-1DBD\s0 has calculated values in the meta data area, then call
-\&\f(CW\*(C`register_reset_on_modify\*(C'\fR:
-.Sp
-.Vb 2
-\& my %reset_on_modify = ( "xxx_foo" => "xxx_bar" );
-\& _\|_PACKAGE_\|_\->register_reset_on_modify( \e%reset_on_modify );
-.Ve
-.IP "register_compat_map" 4
-.IX Item "register_compat_map"
-Allows \f(CW\*(C`get_table_meta_attr\*(C'\fR and \f(CW\*(C`set_table_meta_attr\*(C'\fR to update the
-attribute name to the current favored one:
-.Sp
-.Vb 3
-\& # from DBD::DBM
-\& my %compat_map = ( "dbm_ext" => "f_ext" );
-\& _\|_PACKAGE_\|_\->register_compat_map( \e%compat_map );
-.Ve
-.IP "open_data" 4
-.IX Item "open_data"
-Called to open the table's data storage. This is silently forwarded
-to \f(CW\*(C`$meta\->{sql_data_source}\->open_data()\*(C'\fR.
-.Sp
-After this is done, a derived class might add more steps in an overridden
-\&\f(CW\*(C`open_file\*(C'\fR method.
-.IP "new" 4
-.IX Item "new"
-Instantiates the table. This is done in 3 steps:
-.Sp
-.Vb 3
-\& 1. get the table meta data
-\& 2. open the data file
-\& 3. bless the table data structure using inherited constructor new
-.Ve
-.Sp
-It is not recommended to override the constructor of the table class.
-Find a reasonable place to add you extensions in one of the above four
-methods.
-.SH "AUTHOR"
-.IX Header "AUTHOR"
-The module DBI::DBD::SqlEngine is currently maintained by
-.PP
-H.Merijn Brand < h.m.brand at xs4all.nl > and
-Jens Rehsack < rehsack at googlemail.com >
-.SH "COPYRIGHT AND LICENSE"
-.IX Header "COPYRIGHT AND LICENSE"
-Copyright (C) 2010 by H.Merijn Brand & Jens Rehsack
-.PP
-All rights reserved.
-.PP
-You may freely distribute and/or modify this module under the terms of
-either the \s-1GNU\s0 General Public License (\s-1GPL\s0) or the Artistic License, as
-specified in the Perl \s-1README\s0 file.
+++ /dev/null
-.\" Automatically generated by Pod::Man 2.28 (Pod::Simple 3.29)
-.\"
-.\" Standard preamble:
-.\" ========================================================================
-.de Sp \" Vertical space (when we can't use .PP)
-.if t .sp .5v
-.if n .sp
-..
-.de Vb \" Begin verbatim text
-.ft CW
-.nf
-.ne \\$1
-..
-.de Ve \" End verbatim text
-.ft R
-.fi
-..
-.\" Set up some character translations and predefined strings. \*(-- will
-.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
-.\" double quote, and \*(R" will give a right double quote. \*(C+ will
-.\" give a nicer C++. Capital omega is used to do unbreakable dashes and
-.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff,
-.\" nothing in troff, for use with C<>.
-.tr \(*W-
-.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
-.ie n \{\
-. ds -- \(*W-
-. ds PI pi
-. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
-. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch
-. ds L" ""
-. ds R" ""
-. ds C` ""
-. ds C' ""
-'br\}
-.el\{\
-. ds -- \|\(em\|
-. ds PI \(*p
-. ds L" ``
-. ds R" ''
-. ds C`
-. ds C'
-'br\}
-.\"
-.\" Escape single quotes in literal strings from groff's Unicode transform.
-.ie \n(.g .ds Aq \(aq
-.el .ds Aq '
-.\"
-.\" If the F register is turned on, we'll generate index entries on stderr for
-.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
-.\" entries marked with X<> in POD. Of course, you'll have to process the
-.\" output yourself in some meaningful fashion.
-.\"
-.\" Avoid warning from groff about undefined register 'F'.
-.de IX
-..
-.nr rF 0
-.if \n(.g .if rF .nr rF 1
-.if (\n(rF:(\n(.g==0)) \{
-. if \nF \{
-. de IX
-. tm Index:\\$1\t\\n%\t"\\$2"
-..
-. if !\nF==2 \{
-. nr % 0
-. nr F 2
-. \}
-. \}
-.\}
-.rr rF
-.\" ========================================================================
-.\"
-.IX Title "DBI::DBD::SqlEngine::HowTo 3pm"
-.TH DBI::DBD::SqlEngine::HowTo 3pm "2016-04-21" "perl v5.22.1" "User Contributed Perl Documentation"
-.\" For nroff, turn off justification. Always turn off hyphenation; it makes
-.\" way too many mistakes in technical documents.
-.if n .ad l
-.nh
-.SH "NAME"
-DBI::DBD::SqlEngine::HowTo \- Guide to create DBI::DBD::SqlEngine based driver
-.SH "SYNOPSIS"
-.IX Header "SYNOPSIS"
-.Vb 8
-\& perldoc DBI::DBD::SqlEngine::HowTo
-\& perldoc DBI
-\& perldoc DBI::DBD
-\& perldoc DBI::DBD::SqlEngine::Developers
-\& perldoc SQL::Eval
-\& perldoc DBI::DBD::SqlEngine
-\& perldoc DBI::DBD::SqlEngine::HowTo
-\& perldoc SQL::Statement::Embed
-.Ve
-.SH "DESCRIPTION"
-.IX Header "DESCRIPTION"
-This document provides a step-by-step guide, how to create a new
-\&\f(CW\*(C`DBI::DBD::SqlEngine\*(C'\fR based \s-1DBD.\s0 It expects that you carefully read the
-\&\s-1DBI\s0 documentation and that you're familiar with \s-1DBI::DBD\s0 and had
-read and understood DBD::ExampleP.
-.PP
-This document addresses experienced developers who are really sure that
-they need to invest time when writing a new \s-1DBI\s0 Driver. Writing a \s-1DBI\s0
-Driver is neither a weekend project nor an easy job for hobby coders
-after work. Expect one or two man-month of time for the first start.
-.PP
-Those who are still reading, should be able to sing the rules of
-\&\*(L"\s-1CREATING A NEW DRIVER\*(R"\s0 in \s-1DBI::DBD\s0.
-.SH "CREATING DRIVER CLASSES"
-.IX Header "CREATING DRIVER CLASSES"
-Do you have an entry in \s-1DBI\s0's \s-1DBD\s0 registry? DBI::DBD::SqlEngine expect
-having a unique prefix for every driver class in inheritance chain.
-.PP
-It's easy to get a prefix \- just drop the \s-1DBI\s0 team a note
-(\*(L"\s-1GETTING_HELP\*(R"\s0 in \s-1DBI\s0). If you want for some reason hide your work, take
-a look at Class::Method::Modifiers how to wrap a private prefix method
-around existing \f(CW\*(C`driver_prefix\*(C'\fR.
-.PP
-For this guide, a prefix of \f(CW\*(C`foo_\*(C'\fR is assumed.
-.SS "Sample Skeleton"
-.IX Subsection "Sample Skeleton"
-.Vb 1
-\& package DBD::Foo;
-\&
-\& use strict;
-\& use warnings;
-\& use vars qw($VERSION);
-\& use base qw(DBI::DBD::SqlEngine);
-\&
-\& use DBI ();
-\&
-\& $VERSION = "0.001";
-\&
-\& package DBD::Foo::dr;
-\&
-\& use vars qw(@ISA $imp_data_size);
-\&
-\& @ISA = qw(DBI::DBD::SqlEngine::dr);
-\& $imp_data_size = 0;
-\&
-\& package DBD::Foo::db;
-\&
-\& use vars qw(@ISA $imp_data_size);
-\&
-\& @ISA = qw(DBI::DBD::SqlEngine::db);
-\& $imp_data_size = 0;
-\&
-\& package DBD::Foo::st;
-\&
-\& use vars qw(@ISA $imp_data_size);
-\&
-\& @ISA = qw(DBI::DBD::SqlEngine::st);
-\& $imp_data_size = 0;
-\&
-\& package DBD::Foo::Statement;
-\&
-\& use vars qw(@ISA);
-\&
-\& @ISA = qw(DBI::DBD::SqlEngine::Statement);
-\&
-\& package DBD::Foo::Table;
-\&
-\& use vars qw(@ISA);
-\&
-\& @ISA = qw(DBI::DBD::SqlEngine::Table);
-\&
-\& 1;
-.Ve
-.PP
-Tiny, eh? And all you have now is a \s-1DBD\s0 named foo which will is able to
-deal with temporary tables, as long as you use SQL::Statement. In
-DBI::SQL::Nano environments, this \s-1DBD\s0 can do nothing.
-.SS "Deal with own attributes"
-.IX Subsection "Deal with own attributes"
-Before we start doing usable stuff with our \s-1DBI\s0 driver, we need to think
-about what we want to do and how we want to do it.
-.PP
-Do we need tunable knobs accessible by users? Do we need status
-information? All this is handled in attributes of the database handles (be
-careful when your \s-1DBD\s0 is running \*(L"behind\*(R" a DBD::Gofer proxy).
-.PP
-How come the attributes into the \s-1DBD\s0 and how are they fetchable by the
-user? Good question, but you should know because you've read the \s-1DBI\s0
-documentation.
-.PP
-\&\f(CW\*(C`DBI::DBD::SqlEngine::db::FETCH\*(C'\fR and \f(CW\*(C`DBI::DBD::SqlEngine::db::STORE\*(C'\fR
-taking care for you \- all they need to know is which attribute names
-are valid and mutable or immutable. Tell them by adding
-\&\f(CW\*(C`init_valid_attributes\*(C'\fR to your db class:
-.PP
-.Vb 3
-\& sub init_valid_attributes
-\& {
-\& my $dbh = $_[0];
-\&
-\& $dbh\->SUPER::init_valid_attributes ();
-\&
-\& $dbh\->{foo_valid_attrs} = {
-\& foo_version => 1, # contains version of this driver
-\& foo_valid_attrs => 1, # contains the valid attributes of foo drivers
-\& foo_readonly_attrs => 1, # contains immutable attributes of foo drivers
-\& foo_bar => 1, # contains the bar attribute
-\& foo_baz => 1, # contains the baz attribute
-\& foo_manager => 1, # contains the manager of the driver instance
-\& foo_manager_type => 1, # contains the manager class of the driver instance
-\& };
-\& $dbh\->{foo_readonly_attrs} = {
-\& foo_version => 1, # ensure no\-one modifies the driver version
-\& foo_valid_attrs => 1, # do not permit one to add more valid attributes ...
-\& foo_readonly_attrs => 1, # ... or make the immutable mutable
-\& foo_manager => 1, # manager is set internally only
-\& };
-\&
-\& return $dbh;
-\& }
-.Ve
-.PP
-Woooho \- but now the user cannot assign new managers? This is intended,
-overwrite \f(CW\*(C`STORE\*(C'\fR to handle it!
-.PP
-.Vb 3
-\& sub STORE ($$$)
-\& {
-\& my ( $dbh, $attrib, $value ) = @_;
-\&
-\& $dbh\->SUPER::STORE( $attrib, $value );
-\&
-\& # we\*(Aqre still alive, so no exception is thrown ...
-\& # by DBI::DBD::SqlEngine::db::STORE
-\& if ( $attrib eq "foo_manager_type" )
-\& {
-\& $dbh\->{foo_manager} = $dbh\->{foo_manager_type}\->new();
-\& # ... probably correct some states based on the new
-\& # foo_manager_type \- see DBD::Sys for an example
-\& }
-\& }
-.Ve
-.PP
-But ... my driver runs without a manager until someone first assignes
-a \f(CW\*(C`foo_manager_type\*(C'\fR. Well, no \- there're two places where you can
-initialize defaults:
-.PP
-.Vb 3
-\& sub init_default_attributes
-\& {
-\& my ($dbh, $phase) = @_;
-\&
-\& $dbh\->SUPER::init_default_attributes($phase);
-\&
-\& if( 0 == $phase )
-\& {
-\& # init all attributes which have no knowledge about
-\& # user settings from DSN or the attribute hash
-\& $dbh\->{foo_manager_type} = "DBD::Foo::Manager";
-\& }
-\& elsif( 1 == $phase )
-\& {
-\& # init phase with more knowledge from DSN or attribute
-\& # hash
-\& $dbh\->{foo_manager} = $dbh\->{foo_manager_type}\->new();
-\& }
-\&
-\& return $dbh;
-\& }
-.Ve
-.PP
-So far we can prevent the users to use our database driver as data
-storage for anything and everything. We care only about the real important
-stuff for peace on earth and alike attributes. But in fact, the driver
-still can't do anything. It can do less than nothing \- meanwhile it's
-not a stupid storage area anymore.
-.SS "User comfort"
-.IX Subsection "User comfort"
-\&\f(CW\*(C`DBI::DBD::SqlEngine\*(C'\fR since \f(CW0.05\fR consolidates all persistent meta data
-of a table into a single structure stored in \f(CW\*(C`$dbh\->{sql_meta}\*(C'\fR. While
-DBI::DBD::SqlEngine provides only readonly access to this structure,
-modifications are still allowed.
-.PP
-Primarily DBI::DBD::SqlEngine provides access via the setters
-\&\f(CW\*(C`new_sql_engine_meta\*(C'\fR, \f(CW\*(C`get_sql_engine_meta\*(C'\fR, \f(CW\*(C`get_single_table_meta\*(C'\fR,
-\&\f(CW\*(C`set_single_table_meta\*(C'\fR, \f(CW\*(C`set_sql_engine_meta\*(C'\fR and \f(CW\*(C`clear_sql_engine_meta\*(C'\fR.
-Those methods are easily accessible by the users via the \f(CW\*(C`$dbh\->func ()\*(C'\fR
-interface provided by \s-1DBI.\s0 Well, many users don't feel comfortize when calling
-.PP
-.Vb 2
-\& # don\*(Aqt require extension for tables cars
-\& $dbh\->func ("cars", "f_ext", ".csv", "set_sql_engine_meta");
-.Ve
-.PP
-DBI::DBD::SqlEngine will inject a method into your driver to increase the
-user comfort to allow:
-.PP
-.Vb 2
-\& # don\*(Aqt require extension for tables cars
-\& $dbh\->foo_set_meta ("cars", "f_ext", ".csv");
-.Ve
-.PP
-Better, but here and there users likes to do:
-.PP
-.Vb 2
-\& # don\*(Aqt require extension for tables cars
-\& $dbh\->{foo_tables}\->{cars}\->{f_ext} = ".csv";
-.Ve
-.PP
-This interface is provided when derived \s-1DBD\s0's define following in
-\&\f(CW\*(C`init_valid_attributes\*(C'\fR (re-capture \*(L"Deal with own attributes\*(R"):
-.PP
-.Vb 3
-\& sub init_valid_attributes
-\& {
-\& my $dbh = $_[0];
-\&
-\& $dbh\->SUPER::init_valid_attributes ();
-\&
-\& $dbh\->{foo_valid_attrs} = {
-\& foo_version => 1, # contains version of this driver
-\& foo_valid_attrs => 1, # contains the valid attributes of foo drivers
-\& foo_readonly_attrs => 1, # contains immutable attributes of foo drivers
-\& foo_bar => 1, # contains the bar attribute
-\& foo_baz => 1, # contains the baz attribute
-\& foo_manager => 1, # contains the manager of the driver instance
-\& foo_manager_type => 1, # contains the manager class of the driver instance
-\& foo_meta => 1, # contains the public interface to modify table meta attributes
-\& };
-\& $dbh\->{foo_readonly_attrs} = {
-\& foo_version => 1, # ensure no\-one modifies the driver version
-\& foo_valid_attrs => 1, # do not permit one to add more valid attributes ...
-\& foo_readonly_attrs => 1, # ... or make the immutable mutable
-\& foo_manager => 1, # manager is set internally only
-\& foo_meta => 1, # ensure public interface to modify table meta attributes are immutable
-\& };
-\&
-\& $dbh\->{foo_meta} = "foo_tables";
-\&
-\& return $dbh;
-\& }
-.Ve
-.PP
-This provides a tied hash in \f(CW\*(C`$dbh\->{foo_tables}\*(C'\fR and a tied hash for
-each table's meta data in \f(CW\*(C`$dbh\->{foo_tables}\->{$table_name}\*(C'\fR.
-Modifications on the table meta attributes are done using the table
-methods:
-.PP
-.Vb 2
-\& sub get_table_meta_attr { ... }
-\& sub set_table_meta_attr { ... }
-.Ve
-.PP
-Both methods can adjust the attribute name for compatibility reasons, e.g.
-when former versions of the \s-1DBD\s0 allowed different names to be used for the
-same flag:
-.PP
-.Vb 5
-\& my %compat_map = (
-\& abc => \*(Aqfoo_abc\*(Aq,
-\& xyz => \*(Aqfoo_xyz\*(Aq,
-\& );
-\& _\|_PACKAGE_\|_\->register_compat_map( \e%compat_map );
-.Ve
-.PP
-If any user modification on a meta attribute needs reinitialization of
-the meta structure (in case of \f(CW\*(C`DBI::DBD::SqlEngine\*(C'\fR these are the attributes
-\&\f(CW\*(C`f_file\*(C'\fR, \f(CW\*(C`f_dir\*(C'\fR, \f(CW\*(C`f_ext\*(C'\fR and \f(CW\*(C`f_lockfile\*(C'\fR), inform DBI::DBD::SqlEngine by
-doing
-.PP
-.Vb 5
-\& my %reset_on_modify = (
-\& foo_xyz => "foo_bar",
-\& foo_abc => "foo_bar",
-\& );
-\& _\|_PACKAGE_\|_\->register_reset_on_modify( \e%reset_on_modify );
-.Ve
-.PP
-The next access to the table meta data will force DBI::DBD::SqlEngine to re-do the
-entire meta initialization process.
-.PP
-Any further action which needs to be taken can handled in
-\&\f(CW\*(C`table_meta_attr_changed\*(C'\fR:
-.PP
-.Vb 6
-\& sub table_meta_attr_changed
-\& {
-\& my ($class, $meta, $attrib, $value) = @_;
-\& ...
-\& $class\->SUPER::table_meta_attr_changed ($meta, $attrib, $value);
-\& }
-.Ve
-.PP
-This is done before the new value is set in \f(CW$meta\fR, so the attribute
-changed handler can act depending on the old value.
-.SS "Dealing with Tables"
-.IX Subsection "Dealing with Tables"
-Let's put some life into it \- it's going to be time for it.
-.PP
-This is a good point where a quick side step to SQL::Statement::Embed
-will help to shorten the next paragraph. The documentation in
-SQL::Statement::Embed regarding embedding in own \s-1DBD\s0's works pretty
-fine with SQL::Statement and DBI::SQL::Nano.
-.PP
-Second look should go to DBI::DBD::SqlEngine::Developers to get a
-picture over the driver part of the table \s-1API.\s0 Usually there isn't much
-to do for an easy driver.
-.SS "Testing"
-.IX Subsection "Testing"
-Now you should have your first own \s-1DBD.\s0 Was easy, wasn't it? But does
-it work well? Prove it by writing tests and remember to use
-dbd_edit_mm_attribs from \s-1DBI::DBD\s0 to ensure testing even rare cases.
-.SH "AUTHOR"
-.IX Header "AUTHOR"
-This guide is written by Jens Rehsack. DBI::DBD::SqlEngine is written by
-Jens Rehsack using code from DBD::File originally written by Jochen
-Wiedmann and Jeff Zucker.
-.PP
-The module DBI::DBD::SqlEngine is currently maintained by
-.PP
-H.Merijn Brand < h.m.brand at xs4all.nl > and
-Jens Rehsack < rehsack at googlemail.com >
-.SH "COPYRIGHT AND LICENSE"
-.IX Header "COPYRIGHT AND LICENSE"
-Copyright (C) 2010 by H.Merijn Brand & Jens Rehsack
-.PP
-All rights reserved.
-.PP
-You may freely distribute and/or modify this module under the terms of
-either the \s-1GNU\s0 General Public License (\s-1GPL\s0) or the Artistic License, as
-specified in the Perl \s-1README\s0 file.
+++ /dev/null
-.\" Automatically generated by Pod::Man 2.28 (Pod::Simple 3.29)
-.\"
-.\" Standard preamble:
-.\" ========================================================================
-.de Sp \" Vertical space (when we can't use .PP)
-.if t .sp .5v
-.if n .sp
-..
-.de Vb \" Begin verbatim text
-.ft CW
-.nf
-.ne \\$1
-..
-.de Ve \" End verbatim text
-.ft R
-.fi
-..
-.\" Set up some character translations and predefined strings. \*(-- will
-.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
-.\" double quote, and \*(R" will give a right double quote. \*(C+ will
-.\" give a nicer C++. Capital omega is used to do unbreakable dashes and
-.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff,
-.\" nothing in troff, for use with C<>.
-.tr \(*W-
-.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
-.ie n \{\
-. ds -- \(*W-
-. ds PI pi
-. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
-. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch
-. ds L" ""
-. ds R" ""
-. ds C` ""
-. ds C' ""
-'br\}
-.el\{\
-. ds -- \|\(em\|
-. ds PI \(*p
-. ds L" ``
-. ds R" ''
-. ds C`
-. ds C'
-'br\}
-.\"
-.\" Escape single quotes in literal strings from groff's Unicode transform.
-.ie \n(.g .ds Aq \(aq
-.el .ds Aq '
-.\"
-.\" If the F register is turned on, we'll generate index entries on stderr for
-.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
-.\" entries marked with X<> in POD. Of course, you'll have to process the
-.\" output yourself in some meaningful fashion.
-.\"
-.\" Avoid warning from groff about undefined register 'F'.
-.de IX
-..
-.nr rF 0
-.if \n(.g .if rF .nr rF 1
-.if (\n(rF:(\n(.g==0)) \{
-. if \nF \{
-. de IX
-. tm Index:\\$1\t\\n%\t"\\$2"
-..
-. if !\nF==2 \{
-. nr % 0
-. nr F 2
-. \}
-. \}
-.\}
-.rr rF
-.\" ========================================================================
-.\"
-.IX Title "DBI::Gofer::Execute 3pm"
-.TH DBI::Gofer::Execute 3pm "2013-06-24" "perl v5.22.1" "User Contributed Perl Documentation"
-.\" For nroff, turn off justification. Always turn off hyphenation; it makes
-.\" way too many mistakes in technical documents.
-.if n .ad l
-.nh
-.SH "NAME"
-DBI::Gofer::Execute \- Executes Gofer requests and returns Gofer responses
-.SH "SYNOPSIS"
-.IX Header "SYNOPSIS"
-.Vb 1
-\& $executor = DBI::Gofer::Execute\->new( { ...config... });
-\&
-\& $response = $executor\->execute_request( $request );
-.Ve
-.SH "DESCRIPTION"
-.IX Header "DESCRIPTION"
-Accepts a DBI::Gofer::Request object, executes the requested \s-1DBI\s0 method calls,
-and returns a DBI::Gofer::Response object.
-.PP
-Any error, including any internal 'fatal' errors are caught and converted into
-a DBI::Gofer::Response object.
-.PP
-This module is usually invoked by a 'server\-side' Gofer transport module.
-They usually have names in the "\f(CW\*(C`DBI::Gofer::Transport::*\*(C'\fR" namespace.
-Examples include: DBI::Gofer::Transport::stream and DBI::Gofer::Transport::mod_perl.
-.SH "CONFIGURATION"
-.IX Header "CONFIGURATION"
-.SS "check_request_sub"
-.IX Subsection "check_request_sub"
-If defined, it must be a reference to a subroutine that will 'check' the request.
-It is passed the request object and the executor as its only arguments.
-.PP
-The subroutine can either return the original request object or die with a
-suitable error message (which will be turned into a Gofer response).
-.PP
-It can also construct and return a new request that should be executed instead
-of the original request.
-.SS "check_response_sub"
-.IX Subsection "check_response_sub"
-If defined, it must be a reference to a subroutine that will 'check' the response.
-It is passed the response object, the executor, and the request object.
-The sub may alter the response object and return undef, or return a new response object.
-.PP
-This mechanism can be used to, for example, terminate the service if specific
-database errors are seen.
-.SS "forced_connect_dsn"
-.IX Subsection "forced_connect_dsn"
-If set, this \s-1DSN\s0 is always used instead of the one in the request.
-.SS "default_connect_dsn"
-.IX Subsection "default_connect_dsn"
-If set, this \s-1DSN\s0 is used if \f(CW\*(C`forced_connect_dsn\*(C'\fR is not set and the request does not contain a \s-1DSN\s0 itself.
-.SS "forced_connect_attributes"
-.IX Subsection "forced_connect_attributes"
-A reference to a hash of \fIconnect()\fR attributes. Individual attributes in
-\&\f(CW\*(C`forced_connect_attributes\*(C'\fR will take precedence over corresponding attributes
-in the request.
-.SS "default_connect_attributes"
-.IX Subsection "default_connect_attributes"
-A reference to a hash of \fIconnect()\fR attributes. Individual attributes in the
-request take precedence over corresponding attributes in \f(CW\*(C`default_connect_attributes\*(C'\fR.
-.SS "max_cached_dbh_per_drh"
-.IX Subsection "max_cached_dbh_per_drh"
-If set, the loaded drivers will be checked to ensure they don't have more than
-this number of cached connections. There is no default value. This limit is not
-enforced for every request.
-.SS "max_cached_sth_per_dbh"
-.IX Subsection "max_cached_sth_per_dbh"
-If set, all the cached statement handles will be cleared once the number of
-cached statement handles rises above this limit. The default is 1000.
-.SS "forced_single_resultset"
-.IX Subsection "forced_single_resultset"
-If true, then only the first result set will be fetched and returned in the response.
-.SS "forced_response_attributes"
-.IX Subsection "forced_response_attributes"
-A reference to a data structure that can specify extra attributes to be returned in responses.
-.PP
-.Vb 6
-\& forced_response_attributes => {
-\& DriverName => {
-\& dbh => [ qw(dbh_attrib_name) ],
-\& sth => [ qw(sth_attrib_name) ],
-\& },
-\& },
-.Ve
-.PP
-This can be useful in cases where the driver has not implemented the
-\&\fIprivate_attribute_info()\fR method and DBI::Gofer::Execute's own fallback list of
-private attributes doesn't include the driver or attributes you need.
-.SS "track_recent"
-.IX Subsection "track_recent"
-If set, specifies the number of recent requests and responses that should be
-kept by the \fIupdate_stats()\fR method for diagnostics. See DBI::Gofer::Transport::mod_perl.
-.PP
-Note that this setting can significantly increase memory use. Use with caution.
-.SS "forced_gofer_random"
-.IX Subsection "forced_gofer_random"
-Enable forced random failures and/or delays for testing. See \*(L"\s-1DBI_GOFER_RANDOM\*(R"\s0 below.
-.SH "DRIVER-SPECIFIC ISSUES"
-.IX Header "DRIVER-SPECIFIC ISSUES"
-Gofer needs to know about any driver-private attributes that should have their
-values sent back to the client.
-.PP
-If the driver doesn't support \fIprivate_attribute_info()\fR method, and very few do,
-then the module fallsback to using some hard-coded details, if available, for
-the driver being used. Currently hard-coded details are available for the
-mysql, Pg, Sybase, and SQLite drivers.
-.SH "TESTING"
-.IX Header "TESTING"
-DBD::Gofer, DBD::Execute and related packages are well tested by executing the
-\&\s-1DBI\s0 test suite with \s-1DBI_AUTOPROXY\s0 configured to route all \s-1DBI\s0 calls via DBD::Gofer.
-.PP
-Because Gofer includes timeout and 'retry on error' mechanisms there is a need
-for some way to trigger delays and/or errors. This can be done via the
-\&\f(CW\*(C`forced_gofer_random\*(C'\fR configuration item, or else the \s-1DBI_GOFER_RANDOM\s0 environment
-variable.
-.SS "\s-1DBI_GOFER_RANDOM\s0"
-.IX Subsection "DBI_GOFER_RANDOM"
-The value of the \f(CW\*(C`forced_gofer_random\*(C'\fR configuration item (or else the
-\&\s-1DBI_GOFER_RANDOM\s0 environment variable) is treated as a series of tokens
-separated by commas.
-.PP
-The tokens can be one of three types:
-.IP "fail=R%" 4
-.IX Item "fail=R%"
-Set the current failure rate to R where R is a percentage.
-The value R can be floating point, e.g., \f(CW\*(C`fail=0.05%\*(C'\fR.
-Negative values for R have special meaning, see below.
-.IP "err=N" 4
-.IX Item "err=N"
-Sets the current failure err value to N (instead of the \s-1DBI\s0's default 'standard
-err value' of 2000000000). This is useful when you want to simulate a
-specific error.
-.IP "delayN=R%" 4
-.IX Item "delayN=R%"
-Set the current random delay rate to R where R is a percentage, and set the
-current delay duration to N seconds. The values of R and N can be floating point,
-e.g., \f(CW\*(C`delay0.5=0.2%\*(C'\fR. Negative values for R have special meaning, see below.
-.Sp
-If R is an odd number (R % 2 == 1) then a message is logged via \fIwarn()\fR which
-will be returned to, and echoed at, the client.
-.IP "methodname" 4
-.IX Item "methodname"
-Applies the current fail, err, and delay values to the named method.
-If neither a fail nor delay have been set yet then a warning is generated.
-.PP
-For example:
-.PP
-.Vb 3
-\& $executor = DBI::Gofer::Execute\->new( {
-\& forced_gofer_random => "fail=0.01%,do,delay60=1%,execute",
-\& });
-.Ve
-.PP
-will cause the \fIdo()\fR method to fail for 0.01% of calls, and the \fIexecute()\fR method to
-fail 0.01% of calls and be delayed by 60 seconds on 1% of calls.
-.PP
-If the percentage value (\f(CW\*(C`R\*(C'\fR) is negative then instead of the failures being
-triggered randomly (via the \fIrand()\fR function) they are triggered via a sequence
-number. In other words "\f(CW\*(C`fail=\-20%\*(C'\fR" will mean every fifth call will fail.
-Each method has a distinct sequence number.
-.SH "AUTHOR"
-.IX Header "AUTHOR"
-Tim Bunce, <http://www.tim.bunce.name>
-.SH "LICENCE AND COPYRIGHT"
-.IX Header "LICENCE AND COPYRIGHT"
-Copyright (c) 2007, Tim Bunce, Ireland. All rights reserved.
-.PP
-This module is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself. See perlartistic.
+++ /dev/null
-.\" Automatically generated by Pod::Man 2.28 (Pod::Simple 3.29)
-.\"
-.\" Standard preamble:
-.\" ========================================================================
-.de Sp \" Vertical space (when we can't use .PP)
-.if t .sp .5v
-.if n .sp
-..
-.de Vb \" Begin verbatim text
-.ft CW
-.nf
-.ne \\$1
-..
-.de Ve \" End verbatim text
-.ft R
-.fi
-..
-.\" Set up some character translations and predefined strings. \*(-- will
-.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
-.\" double quote, and \*(R" will give a right double quote. \*(C+ will
-.\" give a nicer C++. Capital omega is used to do unbreakable dashes and
-.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff,
-.\" nothing in troff, for use with C<>.
-.tr \(*W-
-.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
-.ie n \{\
-. ds -- \(*W-
-. ds PI pi
-. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
-. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch
-. ds L" ""
-. ds R" ""
-. ds C` ""
-. ds C' ""
-'br\}
-.el\{\
-. ds -- \|\(em\|
-. ds PI \(*p
-. ds L" ``
-. ds R" ''
-. ds C`
-. ds C'
-'br\}
-.\"
-.\" Escape single quotes in literal strings from groff's Unicode transform.
-.ie \n(.g .ds Aq \(aq
-.el .ds Aq '
-.\"
-.\" If the F register is turned on, we'll generate index entries on stderr for
-.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
-.\" entries marked with X<> in POD. Of course, you'll have to process the
-.\" output yourself in some meaningful fashion.
-.\"
-.\" Avoid warning from groff about undefined register 'F'.
-.de IX
-..
-.nr rF 0
-.if \n(.g .if rF .nr rF 1
-.if (\n(rF:(\n(.g==0)) \{
-. if \nF \{
-. de IX
-. tm Index:\\$1\t\\n%\t"\\$2"
-..
-. if !\nF==2 \{
-. nr % 0
-. nr F 2
-. \}
-. \}
-.\}
-.rr rF
-.\" ========================================================================
-.\"
-.IX Title "DBI::Gofer::Request 3pm"
-.TH DBI::Gofer::Request 3pm "2013-06-24" "perl v5.22.1" "User Contributed Perl Documentation"
-.\" For nroff, turn off justification. Always turn off hyphenation; it makes
-.\" way too many mistakes in technical documents.
-.if n .ad l
-.nh
-.SH "NAME"
-DBI::Gofer::Request \- Encapsulate a request from DBD::Gofer to DBI::Gofer::Execute
-.SH "DESCRIPTION"
-.IX Header "DESCRIPTION"
-This is an internal class.
-.SH "AUTHOR"
-.IX Header "AUTHOR"
-Tim Bunce, <http://www.tim.bunce.name>
-.SH "LICENCE AND COPYRIGHT"
-.IX Header "LICENCE AND COPYRIGHT"
-Copyright (c) 2007, Tim Bunce, Ireland. All rights reserved.
-.PP
-This module is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself. See perlartistic.
+++ /dev/null
-.\" Automatically generated by Pod::Man 2.28 (Pod::Simple 3.29)
-.\"
-.\" Standard preamble:
-.\" ========================================================================
-.de Sp \" Vertical space (when we can't use .PP)
-.if t .sp .5v
-.if n .sp
-..
-.de Vb \" Begin verbatim text
-.ft CW
-.nf
-.ne \\$1
-..
-.de Ve \" End verbatim text
-.ft R
-.fi
-..
-.\" Set up some character translations and predefined strings. \*(-- will
-.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
-.\" double quote, and \*(R" will give a right double quote. \*(C+ will
-.\" give a nicer C++. Capital omega is used to do unbreakable dashes and
-.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff,
-.\" nothing in troff, for use with C<>.
-.tr \(*W-
-.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
-.ie n \{\
-. ds -- \(*W-
-. ds PI pi
-. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
-. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch
-. ds L" ""
-. ds R" ""
-. ds C` ""
-. ds C' ""
-'br\}
-.el\{\
-. ds -- \|\(em\|
-. ds PI \(*p
-. ds L" ``
-. ds R" ''
-. ds C`
-. ds C'
-'br\}
-.\"
-.\" Escape single quotes in literal strings from groff's Unicode transform.
-.ie \n(.g .ds Aq \(aq
-.el .ds Aq '
-.\"
-.\" If the F register is turned on, we'll generate index entries on stderr for
-.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
-.\" entries marked with X<> in POD. Of course, you'll have to process the
-.\" output yourself in some meaningful fashion.
-.\"
-.\" Avoid warning from groff about undefined register 'F'.
-.de IX
-..
-.nr rF 0
-.if \n(.g .if rF .nr rF 1
-.if (\n(rF:(\n(.g==0)) \{
-. if \nF \{
-. de IX
-. tm Index:\\$1\t\\n%\t"\\$2"
-..
-. if !\nF==2 \{
-. nr % 0
-. nr F 2
-. \}
-. \}
-.\}
-.rr rF
-.\" ========================================================================
-.\"
-.IX Title "DBI::Gofer::Response 3pm"
-.TH DBI::Gofer::Response 3pm "2013-06-24" "perl v5.22.1" "User Contributed Perl Documentation"
-.\" For nroff, turn off justification. Always turn off hyphenation; it makes
-.\" way too many mistakes in technical documents.
-.if n .ad l
-.nh
-.SH "NAME"
-DBI::Gofer::Response \- Encapsulate a response from DBI::Gofer::Execute to DBD::Gofer
-.SH "DESCRIPTION"
-.IX Header "DESCRIPTION"
-This is an internal class.
-.SH "AUTHOR"
-.IX Header "AUTHOR"
-Tim Bunce, <http://www.tim.bunce.name>
-.SH "LICENCE AND COPYRIGHT"
-.IX Header "LICENCE AND COPYRIGHT"
-Copyright (c) 2007, Tim Bunce, Ireland. All rights reserved.
-.PP
-This module is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself. See perlartistic.
+++ /dev/null
-.\" Automatically generated by Pod::Man 2.28 (Pod::Simple 3.29)
-.\"
-.\" Standard preamble:
-.\" ========================================================================
-.de Sp \" Vertical space (when we can't use .PP)
-.if t .sp .5v
-.if n .sp
-..
-.de Vb \" Begin verbatim text
-.ft CW
-.nf
-.ne \\$1
-..
-.de Ve \" End verbatim text
-.ft R
-.fi
-..
-.\" Set up some character translations and predefined strings. \*(-- will
-.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
-.\" double quote, and \*(R" will give a right double quote. \*(C+ will
-.\" give a nicer C++. Capital omega is used to do unbreakable dashes and
-.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff,
-.\" nothing in troff, for use with C<>.
-.tr \(*W-
-.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
-.ie n \{\
-. ds -- \(*W-
-. ds PI pi
-. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
-. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch
-. ds L" ""
-. ds R" ""
-. ds C` ""
-. ds C' ""
-'br\}
-.el\{\
-. ds -- \|\(em\|
-. ds PI \(*p
-. ds L" ``
-. ds R" ''
-. ds C`
-. ds C'
-'br\}
-.\"
-.\" Escape single quotes in literal strings from groff's Unicode transform.
-.ie \n(.g .ds Aq \(aq
-.el .ds Aq '
-.\"
-.\" If the F register is turned on, we'll generate index entries on stderr for
-.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
-.\" entries marked with X<> in POD. Of course, you'll have to process the
-.\" output yourself in some meaningful fashion.
-.\"
-.\" Avoid warning from groff about undefined register 'F'.
-.de IX
-..
-.nr rF 0
-.if \n(.g .if rF .nr rF 1
-.if (\n(rF:(\n(.g==0)) \{
-. if \nF \{
-. de IX
-. tm Index:\\$1\t\\n%\t"\\$2"
-..
-. if !\nF==2 \{
-. nr % 0
-. nr F 2
-. \}
-. \}
-.\}
-.rr rF
-.\" ========================================================================
-.\"
-.IX Title "DBI::Gofer::Serializer::Base 3pm"
-.TH DBI::Gofer::Serializer::Base 3pm "2013-06-24" "perl v5.22.1" "User Contributed Perl Documentation"
-.\" For nroff, turn off justification. Always turn off hyphenation; it makes
-.\" way too many mistakes in technical documents.
-.if n .ad l
-.nh
-.SH "NAME"
-DBI::Gofer::Serializer::Base \- base class for Gofer serialization
-.SH "SYNOPSIS"
-.IX Header "SYNOPSIS"
-.Vb 1
-\& $serializer = $serializer_class\->new();
-\&
-\& $string = $serializer\->serialize( $data );
-\& ($string, $deserializer_class) = $serializer\->serialize( $data );
-\&
-\& $data = $serializer\->deserialize( $string );
-.Ve
-.SH "DESCRIPTION"
-.IX Header "DESCRIPTION"
-DBI::Gofer::Serializer::* classes implement a very minimal subset of the Data::Serializer \s-1API.\s0
-.PP
-Gofer serializers are expected to be very fast and are not required to deal
-with anything other than non-blessed references to arrays and hashes, and plain scalars.
+++ /dev/null
-.\" Automatically generated by Pod::Man 2.28 (Pod::Simple 3.29)
-.\"
-.\" Standard preamble:
-.\" ========================================================================
-.de Sp \" Vertical space (when we can't use .PP)
-.if t .sp .5v
-.if n .sp
-..
-.de Vb \" Begin verbatim text
-.ft CW
-.nf
-.ne \\$1
-..
-.de Ve \" End verbatim text
-.ft R
-.fi
-..
-.\" Set up some character translations and predefined strings. \*(-- will
-.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
-.\" double quote, and \*(R" will give a right double quote. \*(C+ will
-.\" give a nicer C++. Capital omega is used to do unbreakable dashes and
-.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff,
-.\" nothing in troff, for use with C<>.
-.tr \(*W-
-.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
-.ie n \{\
-. ds -- \(*W-
-. ds PI pi
-. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
-. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch
-. ds L" ""
-. ds R" ""
-. ds C` ""
-. ds C' ""
-'br\}
-.el\{\
-. ds -- \|\(em\|
-. ds PI \(*p
-. ds L" ``
-. ds R" ''
-. ds C`
-. ds C'
-'br\}
-.\"
-.\" Escape single quotes in literal strings from groff's Unicode transform.
-.ie \n(.g .ds Aq \(aq
-.el .ds Aq '
-.\"
-.\" If the F register is turned on, we'll generate index entries on stderr for
-.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
-.\" entries marked with X<> in POD. Of course, you'll have to process the
-.\" output yourself in some meaningful fashion.
-.\"
-.\" Avoid warning from groff about undefined register 'F'.
-.de IX
-..
-.nr rF 0
-.if \n(.g .if rF .nr rF 1
-.if (\n(rF:(\n(.g==0)) \{
-. if \nF \{
-. de IX
-. tm Index:\\$1\t\\n%\t"\\$2"
-..
-. if !\nF==2 \{
-. nr % 0
-. nr F 2
-. \}
-. \}
-.\}
-.rr rF
-.\" ========================================================================
-.\"
-.IX Title "DBI::Gofer::Serializer::DataDumper 3pm"
-.TH DBI::Gofer::Serializer::DataDumper 3pm "2013-06-24" "perl v5.22.1" "User Contributed Perl Documentation"
-.\" For nroff, turn off justification. Always turn off hyphenation; it makes
-.\" way too many mistakes in technical documents.
-.if n .ad l
-.nh
-.SH "NAME"
-DBI::Gofer::Serializer::DataDumper \- Gofer serialization using DataDumper
-.SH "SYNOPSIS"
-.IX Header "SYNOPSIS"
-.Vb 1
-\& $serializer = DBI::Gofer::Serializer::DataDumper\->new();
-\&
-\& $string = $serializer\->serialize( $data );
-.Ve
-.SH "DESCRIPTION"
-.IX Header "DESCRIPTION"
-Uses DataDumper to serialize. Deserialization is not supported.
-The output of this class is only meant for human consumption.
-.PP
-See also DBI::Gofer::Serializer::Base.
+++ /dev/null
-.\" Automatically generated by Pod::Man 2.28 (Pod::Simple 3.29)
-.\"
-.\" Standard preamble:
-.\" ========================================================================
-.de Sp \" Vertical space (when we can't use .PP)
-.if t .sp .5v
-.if n .sp
-..
-.de Vb \" Begin verbatim text
-.ft CW
-.nf
-.ne \\$1
-..
-.de Ve \" End verbatim text
-.ft R
-.fi
-..
-.\" Set up some character translations and predefined strings. \*(-- will
-.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
-.\" double quote, and \*(R" will give a right double quote. \*(C+ will
-.\" give a nicer C++. Capital omega is used to do unbreakable dashes and
-.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff,
-.\" nothing in troff, for use with C<>.
-.tr \(*W-
-.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
-.ie n \{\
-. ds -- \(*W-
-. ds PI pi
-. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
-. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch
-. ds L" ""
-. ds R" ""
-. ds C` ""
-. ds C' ""
-'br\}
-.el\{\
-. ds -- \|\(em\|
-. ds PI \(*p
-. ds L" ``
-. ds R" ''
-. ds C`
-. ds C'
-'br\}
-.\"
-.\" Escape single quotes in literal strings from groff's Unicode transform.
-.ie \n(.g .ds Aq \(aq
-.el .ds Aq '
-.\"
-.\" If the F register is turned on, we'll generate index entries on stderr for
-.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
-.\" entries marked with X<> in POD. Of course, you'll have to process the
-.\" output yourself in some meaningful fashion.
-.\"
-.\" Avoid warning from groff about undefined register 'F'.
-.de IX
-..
-.nr rF 0
-.if \n(.g .if rF .nr rF 1
-.if (\n(rF:(\n(.g==0)) \{
-. if \nF \{
-. de IX
-. tm Index:\\$1\t\\n%\t"\\$2"
-..
-. if !\nF==2 \{
-. nr % 0
-. nr F 2
-. \}
-. \}
-.\}
-.rr rF
-.\" ========================================================================
-.\"
-.IX Title "DBI::Gofer::Serializer::Storable 3pm"
-.TH DBI::Gofer::Serializer::Storable 3pm "2013-06-24" "perl v5.22.1" "User Contributed Perl Documentation"
-.\" For nroff, turn off justification. Always turn off hyphenation; it makes
-.\" way too many mistakes in technical documents.
-.if n .ad l
-.nh
-.SH "NAME"
-DBI::Gofer::Serializer::Storable \- Gofer serialization using Storable
-.SH "SYNOPSIS"
-.IX Header "SYNOPSIS"
-.Vb 1
-\& $serializer = DBI::Gofer::Serializer::Storable\->new();
-\&
-\& $string = $serializer\->serialize( $data );
-\& ($string, $deserializer_class) = $serializer\->serialize( $data );
-\&
-\& $data = $serializer\->deserialize( $string );
-.Ve
-.SH "DESCRIPTION"
-.IX Header "DESCRIPTION"
-Uses \fIStorable::nfreeze()\fR to serialize and \fIStorable::thaw()\fR to deserialize.
-.PP
-The \fIserialize()\fR method sets local \f(CW$Storable::forgive_me\fR = 1; so it doesn't
-croak if it encounters any data types that can't be serialized, such as code refs.
-.PP
-See also DBI::Gofer::Serializer::Base.
+++ /dev/null
-.\" Automatically generated by Pod::Man 2.28 (Pod::Simple 3.29)
-.\"
-.\" Standard preamble:
-.\" ========================================================================
-.de Sp \" Vertical space (when we can't use .PP)
-.if t .sp .5v
-.if n .sp
-..
-.de Vb \" Begin verbatim text
-.ft CW
-.nf
-.ne \\$1
-..
-.de Ve \" End verbatim text
-.ft R
-.fi
-..
-.\" Set up some character translations and predefined strings. \*(-- will
-.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
-.\" double quote, and \*(R" will give a right double quote. \*(C+ will
-.\" give a nicer C++. Capital omega is used to do unbreakable dashes and
-.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff,
-.\" nothing in troff, for use with C<>.
-.tr \(*W-
-.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
-.ie n \{\
-. ds -- \(*W-
-. ds PI pi
-. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
-. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch
-. ds L" ""
-. ds R" ""
-. ds C` ""
-. ds C' ""
-'br\}
-.el\{\
-. ds -- \|\(em\|
-. ds PI \(*p
-. ds L" ``
-. ds R" ''
-. ds C`
-. ds C'
-'br\}
-.\"
-.\" Escape single quotes in literal strings from groff's Unicode transform.
-.ie \n(.g .ds Aq \(aq
-.el .ds Aq '
-.\"
-.\" If the F register is turned on, we'll generate index entries on stderr for
-.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
-.\" entries marked with X<> in POD. Of course, you'll have to process the
-.\" output yourself in some meaningful fashion.
-.\"
-.\" Avoid warning from groff about undefined register 'F'.
-.de IX
-..
-.nr rF 0
-.if \n(.g .if rF .nr rF 1
-.if (\n(rF:(\n(.g==0)) \{
-. if \nF \{
-. de IX
-. tm Index:\\$1\t\\n%\t"\\$2"
-..
-. if !\nF==2 \{
-. nr % 0
-. nr F 2
-. \}
-. \}
-.\}
-.rr rF
-.\" ========================================================================
-.\"
-.IX Title "DBI::Gofer::Transport::Base 3pm"
-.TH DBI::Gofer::Transport::Base 3pm "2013-06-24" "perl v5.22.1" "User Contributed Perl Documentation"
-.\" For nroff, turn off justification. Always turn off hyphenation; it makes
-.\" way too many mistakes in technical documents.
-.if n .ad l
-.nh
-.SH "NAME"
-DBI::Gofer::Transport::Base \- Base class for Gofer transports
-.SH "DESCRIPTION"
-.IX Header "DESCRIPTION"
-This is the base class for server-side Gofer transports.
-.PP
-It's also the base class for the client-side base class DBD::Gofer::Transport::Base.
-.PP
-This is an internal class.
-.SH "AUTHOR"
-.IX Header "AUTHOR"
-Tim Bunce, <http://www.tim.bunce.name>
-.SH "LICENCE AND COPYRIGHT"
-.IX Header "LICENCE AND COPYRIGHT"
-Copyright (c) 2007, Tim Bunce, Ireland. All rights reserved.
-.PP
-This module is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself. See perlartistic.
+++ /dev/null
-.\" Automatically generated by Pod::Man 2.28 (Pod::Simple 3.29)
-.\"
-.\" Standard preamble:
-.\" ========================================================================
-.de Sp \" Vertical space (when we can't use .PP)
-.if t .sp .5v
-.if n .sp
-..
-.de Vb \" Begin verbatim text
-.ft CW
-.nf
-.ne \\$1
-..
-.de Ve \" End verbatim text
-.ft R
-.fi
-..
-.\" Set up some character translations and predefined strings. \*(-- will
-.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
-.\" double quote, and \*(R" will give a right double quote. \*(C+ will
-.\" give a nicer C++. Capital omega is used to do unbreakable dashes and
-.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff,
-.\" nothing in troff, for use with C<>.
-.tr \(*W-
-.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
-.ie n \{\
-. ds -- \(*W-
-. ds PI pi
-. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
-. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch
-. ds L" ""
-. ds R" ""
-. ds C` ""
-. ds C' ""
-'br\}
-.el\{\
-. ds -- \|\(em\|
-. ds PI \(*p
-. ds L" ``
-. ds R" ''
-. ds C`
-. ds C'
-'br\}
-.\"
-.\" Escape single quotes in literal strings from groff's Unicode transform.
-.ie \n(.g .ds Aq \(aq
-.el .ds Aq '
-.\"
-.\" If the F register is turned on, we'll generate index entries on stderr for
-.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
-.\" entries marked with X<> in POD. Of course, you'll have to process the
-.\" output yourself in some meaningful fashion.
-.\"
-.\" Avoid warning from groff about undefined register 'F'.
-.de IX
-..
-.nr rF 0
-.if \n(.g .if rF .nr rF 1
-.if (\n(rF:(\n(.g==0)) \{
-. if \nF \{
-. de IX
-. tm Index:\\$1\t\\n%\t"\\$2"
-..
-. if !\nF==2 \{
-. nr % 0
-. nr F 2
-. \}
-. \}
-.\}
-.rr rF
-.\" ========================================================================
-.\"
-.IX Title "DBI::Gofer::Transport::pipeone 3pm"
-.TH DBI::Gofer::Transport::pipeone 3pm "2016-04-21" "perl v5.22.1" "User Contributed Perl Documentation"
-.\" For nroff, turn off justification. Always turn off hyphenation; it makes
-.\" way too many mistakes in technical documents.
-.if n .ad l
-.nh
-.SH "NAME"
-DBI::Gofer::Transport::pipeone \- DBD::Gofer server\-side transport for pipeone
-.SH "SYNOPSIS"
-.IX Header "SYNOPSIS"
-See DBD::Gofer::Transport::pipeone.
-.SH "AUTHOR"
-.IX Header "AUTHOR"
-Tim Bunce, <http://www.tim.bunce.name>
-.SH "LICENCE AND COPYRIGHT"
-.IX Header "LICENCE AND COPYRIGHT"
-Copyright (c) 2007, Tim Bunce, Ireland. All rights reserved.
-.PP
-This module is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself. See perlartistic.
+++ /dev/null
-.\" Automatically generated by Pod::Man 2.28 (Pod::Simple 3.29)
-.\"
-.\" Standard preamble:
-.\" ========================================================================
-.de Sp \" Vertical space (when we can't use .PP)
-.if t .sp .5v
-.if n .sp
-..
-.de Vb \" Begin verbatim text
-.ft CW
-.nf
-.ne \\$1
-..
-.de Ve \" End verbatim text
-.ft R
-.fi
-..
-.\" Set up some character translations and predefined strings. \*(-- will
-.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
-.\" double quote, and \*(R" will give a right double quote. \*(C+ will
-.\" give a nicer C++. Capital omega is used to do unbreakable dashes and
-.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff,
-.\" nothing in troff, for use with C<>.
-.tr \(*W-
-.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
-.ie n \{\
-. ds -- \(*W-
-. ds PI pi
-. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
-. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch
-. ds L" ""
-. ds R" ""
-. ds C` ""
-. ds C' ""
-'br\}
-.el\{\
-. ds -- \|\(em\|
-. ds PI \(*p
-. ds L" ``
-. ds R" ''
-. ds C`
-. ds C'
-'br\}
-.\"
-.\" Escape single quotes in literal strings from groff's Unicode transform.
-.ie \n(.g .ds Aq \(aq
-.el .ds Aq '
-.\"
-.\" If the F register is turned on, we'll generate index entries on stderr for
-.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
-.\" entries marked with X<> in POD. Of course, you'll have to process the
-.\" output yourself in some meaningful fashion.
-.\"
-.\" Avoid warning from groff about undefined register 'F'.
-.de IX
-..
-.nr rF 0
-.if \n(.g .if rF .nr rF 1
-.if (\n(rF:(\n(.g==0)) \{
-. if \nF \{
-. de IX
-. tm Index:\\$1\t\\n%\t"\\$2"
-..
-. if !\nF==2 \{
-. nr % 0
-. nr F 2
-. \}
-. \}
-.\}
-.rr rF
-.\" ========================================================================
-.\"
-.IX Title "DBI::Gofer::Transport::stream 3pm"
-.TH DBI::Gofer::Transport::stream 3pm "2013-06-24" "perl v5.22.1" "User Contributed Perl Documentation"
-.\" For nroff, turn off justification. Always turn off hyphenation; it makes
-.\" way too many mistakes in technical documents.
-.if n .ad l
-.nh
-.SH "NAME"
-DBI::Gofer::Transport::stream \- DBD::Gofer server\-side transport for stream
-.SH "SYNOPSIS"
-.IX Header "SYNOPSIS"
-See DBD::Gofer::Transport::stream.
-.SH "AUTHOR"
-.IX Header "AUTHOR"
-Tim Bunce, <http://www.tim.bunce.name>
-.SH "LICENCE AND COPYRIGHT"
-.IX Header "LICENCE AND COPYRIGHT"
-Copyright (c) 2007, Tim Bunce, Ireland. All rights reserved.
-.PP
-This module is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself. See perlartistic.
+++ /dev/null
-.\" Automatically generated by Pod::Man 2.28 (Pod::Simple 3.29)
-.\"
-.\" Standard preamble:
-.\" ========================================================================
-.de Sp \" Vertical space (when we can't use .PP)
-.if t .sp .5v
-.if n .sp
-..
-.de Vb \" Begin verbatim text
-.ft CW
-.nf
-.ne \\$1
-..
-.de Ve \" End verbatim text
-.ft R
-.fi
-..
-.\" Set up some character translations and predefined strings. \*(-- will
-.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
-.\" double quote, and \*(R" will give a right double quote. \*(C+ will
-.\" give a nicer C++. Capital omega is used to do unbreakable dashes and
-.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff,
-.\" nothing in troff, for use with C<>.
-.tr \(*W-
-.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
-.ie n \{\
-. ds -- \(*W-
-. ds PI pi
-. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
-. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch
-. ds L" ""
-. ds R" ""
-. ds C` ""
-. ds C' ""
-'br\}
-.el\{\
-. ds -- \|\(em\|
-. ds PI \(*p
-. ds L" ``
-. ds R" ''
-. ds C`
-. ds C'
-'br\}
-.\"
-.\" Escape single quotes in literal strings from groff's Unicode transform.
-.ie \n(.g .ds Aq \(aq
-.el .ds Aq '
-.\"
-.\" If the F register is turned on, we'll generate index entries on stderr for
-.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
-.\" entries marked with X<> in POD. Of course, you'll have to process the
-.\" output yourself in some meaningful fashion.
-.\"
-.\" Avoid warning from groff about undefined register 'F'.
-.de IX
-..
-.nr rF 0
-.if \n(.g .if rF .nr rF 1
-.if (\n(rF:(\n(.g==0)) \{
-. if \nF \{
-. de IX
-. tm Index:\\$1\t\\n%\t"\\$2"
-..
-. if !\nF==2 \{
-. nr % 0
-. nr F 2
-. \}
-. \}
-.\}
-.rr rF
-.\" ========================================================================
-.\"
-.IX Title "DBI::Profile 3pm"
-.TH DBI::Profile 3pm "2016-04-21" "perl v5.22.1" "User Contributed Perl Documentation"
-.\" For nroff, turn off justification. Always turn off hyphenation; it makes
-.\" way too many mistakes in technical documents.
-.if n .ad l
-.nh
-.SH "NAME"
-DBI::Profile \- Performance profiling and benchmarking for the DBI
-.SH "SYNOPSIS"
-.IX Header "SYNOPSIS"
-The easiest way to enable \s-1DBI\s0 profiling is to set the \s-1DBI_PROFILE\s0
-environment variable to 2 and then run your code as usual:
-.PP
-.Vb 1
-\& DBI_PROFILE=2 prog.pl
-.Ve
-.PP
-This will profile your program and then output a textual summary
-grouped by query when the program exits. You can also enable profiling by
-setting the Profile attribute of any \s-1DBI\s0 handle:
-.PP
-.Vb 1
-\& $dbh\->{Profile} = 2;
-.Ve
-.PP
-Then the summary will be printed when the handle is destroyed.
-.PP
-Many other values apart from are possible \- see \*(L"\s-1ENABLING A PROFILE\*(R"\s0 below.
-.SH "DESCRIPTION"
-.IX Header "DESCRIPTION"
-The DBI::Profile module provides a simple interface to collect and
-report performance and benchmarking data from the \s-1DBI.\s0
-.PP
-For a more elaborate interface, suitable for larger programs, see
-DBI::ProfileDumper and dbiprof.
-For Apache/mod_perl applications see
-DBI::ProfileDumper::Apache.
-.SH "OVERVIEW"
-.IX Header "OVERVIEW"
-Performance data collection for the \s-1DBI\s0 is built around several
-concepts which are important to understand clearly.
-.IP "Method Dispatch" 4
-.IX Item "Method Dispatch"
-Every method call on a \s-1DBI\s0 handle passes through a single 'dispatch'
-function which manages all the common aspects of \s-1DBI\s0 method calls,
-such as handling the RaiseError attribute.
-.IP "Data Collection" 4
-.IX Item "Data Collection"
-If profiling is enabled for a handle then the dispatch code takes
-a high-resolution timestamp soon after it is entered. Then, after
-calling the appropriate method and just before returning, it takes
-another high-resolution timestamp and calls a function to record
-the information. That function is passed the two timestamps
-plus the \s-1DBI\s0 handle and the name of the method that was called.
-That data about a single \s-1DBI\s0 method call is called a \fIprofile sample\fR.
-.IP "Data Filtering" 4
-.IX Item "Data Filtering"
-If the method call was invoked by the \s-1DBI\s0 or by a driver then the call is
-ignored for profiling because the time spent will be accounted for by the
-original 'outermost' call for your code.
-.Sp
-For example, the calls that the \fIselectrow_arrayref()\fR method makes
-to \fIprepare()\fR and \fIexecute()\fR etc. are not counted individually
-because the time spent in those methods is going to be allocated
-to the \fIselectrow_arrayref()\fR method when it returns. If this was not
-done then it would be very easy to double count time spent inside
-the \s-1DBI.\s0
-.IP "Data Storage Tree" 4
-.IX Item "Data Storage Tree"
-The profile data is accumulated as 'leaves on a tree'. The 'path' through the
-branches of the tree to a particular leaf is determined dynamically for each sample.
-This is a key feature of \s-1DBI\s0 profiling.
-.Sp
-For each profiled method call the \s-1DBI\s0 walks along the Path and uses each value
-in the Path to step into and grow the Data tree.
-.Sp
-For example, if the Path is
-.Sp
-.Vb 1
-\& [ \*(Aqfoo\*(Aq, \*(Aqbar\*(Aq, \*(Aqbaz\*(Aq ]
-.Ve
-.Sp
-then the new profile sample data will be \fImerged\fR into the tree at
-.Sp
-.Vb 1
-\& $h\->{Profile}\->{Data}\->{foo}\->{bar}\->{baz}
-.Ve
-.Sp
-But it's not very useful to merge all the call data into one leaf node (except
-to get an overall 'time spent inside the \s-1DBI\s0' total). It's more common to want
-the Path to include dynamic values such as the current statement text and/or
-the name of the method called to show what the time spent inside the \s-1DBI\s0 was for.
-.Sp
-The Path can contain some 'magic cookie' values that are automatically replaced
-by corresponding dynamic values when they're used. These magic cookies always
-start with a punctuation character.
-.Sp
-For example a value of '\f(CW\*(C`!MethodName\*(C'\fR' in the Path causes the corresponding
-entry in the Data to be the name of the method that was called.
-For example, if the Path was:
-.Sp
-.Vb 1
-\& [ \*(Aqfoo\*(Aq, \*(Aq!MethodName\*(Aq, \*(Aqbar\*(Aq ]
-.Ve
-.Sp
-and the \fIselectall_arrayref()\fR method was called, then the profile sample data
-for that call will be merged into the tree at:
-.Sp
-.Vb 1
-\& $h\->{Profile}\->{Data}\->{foo}\->{selectall_arrayref}\->{bar}
-.Ve
-.IP "Profile Data" 4
-.IX Item "Profile Data"
-Profile data is stored at the 'leaves' of the tree as references
-to an array of numeric values. For example:
-.Sp
-.Vb 9
-\& [
-\& 106, # 0: count of samples at this node
-\& 0.0312958955764771, # 1: total duration
-\& 0.000490069389343262, # 2: first duration
-\& 0.000176072120666504, # 3: shortest duration
-\& 0.00140702724456787, # 4: longest duration
-\& 1023115819.83019, # 5: time of first sample
-\& 1023115819.86576, # 6: time of last sample
-\& ]
-.Ve
-.Sp
-After the first sample, later samples always update elements 0, 1, and 6, and
-may update 3 or 4 depending on the duration of the sampled call.
-.SH "ENABLING A PROFILE"
-.IX Header "ENABLING A PROFILE"
-Profiling is enabled for a handle by assigning to the Profile
-attribute. For example:
-.PP
-.Vb 1
-\& $h\->{Profile} = DBI::Profile\->new();
-.Ve
-.PP
-The Profile attribute holds a blessed reference to a hash object
-that contains the profile data and attributes relating to it.
-.PP
-The class the Profile object is blessed into is expected to
-provide at least a \s-1DESTROY\s0 method which will dump the profile data
-to the \s-1DBI\s0 trace file handle (\s-1STDERR\s0 by default).
-.PP
-All these examples have the same effect as each other:
-.PP
-.Vb 5
-\& $h\->{Profile} = 0;
-\& $h\->{Profile} = "/DBI::Profile";
-\& $h\->{Profile} = DBI::Profile\->new();
-\& $h\->{Profile} = {};
-\& $h\->{Profile} = { Path => [] };
-.Ve
-.PP
-Similarly, these examples have the same effect as each other:
-.PP
-.Vb 4
-\& $h\->{Profile} = 6;
-\& $h\->{Profile} = "6/DBI::Profile";
-\& $h\->{Profile} = "!Statement:!MethodName/DBI::Profile";
-\& $h\->{Profile} = { Path => [ \*(Aq!Statement\*(Aq, \*(Aq!MethodName\*(Aq ] };
-.Ve
-.PP
-If a non-blessed hash reference is given then the DBI::Profile
-module is automatically \f(CW\*(C`require\*(C'\fR'd and the reference is blessed
-into that class.
-.PP
-If a string is given then it is processed like this:
-.PP
-.Vb 1
-\& ($path, $module, $args) = split /\e//, $string, 3
-\&
-\& @path = split /:/, $path
-\& @args = split /:/, $args
-\&
-\& eval "require $module" if $module
-\& $module ||= "DBI::Profile"
-\&
-\& $module\->new( Path => \e@Path, @args )
-.Ve
-.PP
-So the first value is used to select the Path to be used (see below).
-The second value, if present, is used as the name of a module which
-will be loaded and it's \f(CW\*(C`new\*(C'\fR method called. If not present it
-defaults to DBI::Profile. Any other values are passed as arguments
-to the \f(CW\*(C`new\*(C'\fR method. For example: "\f(CW\*(C`2/DBIx::OtherProfile/Foo:42\*(C'\fR".
-.PP
-Numbers can be used as a shorthand way to enable common Path values.
-The simplest way to explain how the values are interpreted is to show the code:
-.PP
-.Vb 5
-\& push @Path, "DBI" if $path_elem & 0x01;
-\& push @Path, "!Statement" if $path_elem & 0x02;
-\& push @Path, "!MethodName" if $path_elem & 0x04;
-\& push @Path, "!MethodClass" if $path_elem & 0x08;
-\& push @Path, "!Caller2" if $path_elem & 0x10;
-.Ve
-.PP
-So \*(L"2\*(R" is the same as \*(L"!Statement\*(R" and \*(L"6\*(R" (2+4) is the same as
-\&\*(L"!Statement:!Method\*(R". Those are the two most commonly used values. Using a
-negative number will reverse the path. Thus \*(L"\-6\*(R" will group by method name then
-statement.
-.PP
-The splitting and parsing of string values assigned to the Profile
-attribute may seem a little odd, but there's a good reason for it.
-Remember that attributes can be embedded in the Data Source Name
-string which can be passed in to a script as a parameter. For
-example:
-.PP
-.Vb 2
-\& dbi:DriverName(Profile=>2):dbname
-\& dbi:DriverName(Profile=>{Username}:!Statement/MyProfiler/Foo:42):dbname
-.Ve
-.PP
-And also, if the \f(CW\*(C`DBI_PROFILE\*(C'\fR environment variable is set then
-The \s-1DBI\s0 arranges for every driver handle to share the same profile
-object. When perl exits a single profile summary will be generated
-that reflects (as nearly as practical) the total use of the \s-1DBI\s0 by
-the application.
-.SH "THE PROFILE OBJECT"
-.IX Header "THE PROFILE OBJECT"
-The \s-1DBI\s0 core expects the Profile attribute value to be a hash
-reference and if the following values don't exist it will create
-them as needed:
-.SS "Data"
-.IX Subsection "Data"
-A reference to a hash containing the collected profile data.
-.SS "Path"
-.IX Subsection "Path"
-The Path value is a reference to an array. Each element controls the
-value to use at the corresponding level of the profile Data tree.
-.PP
-If the value of Path is anything other than an array reference,
-it is treated as if it was:
-.PP
-.Vb 1
-\& [ \*(Aq!Statement\*(Aq ]
-.Ve
-.PP
-The elements of Path array can be one of the following types:
-.PP
-\fISpecial Constant\fR
-.IX Subsection "Special Constant"
-.PP
-\&\fB!Statement\fR
-.PP
-Use the current Statement text. Typically that's the value of the Statement
-attribute for the handle the method was called with. Some methods, like
-\&\fIcommit()\fR and \fIrollback()\fR, are unrelated to a particular statement. For those
-methods !Statement records an empty string.
-.PP
-For statement handles this is always simply the string that was
-given to \fIprepare()\fR when the handle was created. For database handles
-this is the statement that was last prepared or executed on that
-database handle. That can lead to a little 'fuzzyness' because, for
-example, calls to the \fIquote()\fR method to build a new statement will
-typically be associated with the previous statement. In practice
-this isn't a significant issue and the dynamic Path mechanism can
-be used to setup your own rules.
-.PP
-\&\fB!MethodName\fR
-.PP
-Use the name of the \s-1DBI\s0 method that the profile sample relates to.
-.PP
-\&\fB!MethodClass\fR
-.PP
-Use the fully qualified name of the \s-1DBI\s0 method, including
-the package, that the profile sample relates to. This shows you
-where the method was implemented. For example:
-.PP
-.Vb 4
-\& \*(AqDBD::_::db::selectrow_arrayref\*(Aq =>
-\& 0.022902s
-\& \*(AqDBD::mysql::db::selectrow_arrayref\*(Aq =>
-\& 2.244521s / 99 = 0.022445s avg (first 0.022813s, min 0.022051s, max 0.028932s)
-.Ve
-.PP
-The \*(L"DBD::_::db::selectrow_arrayref\*(R" shows that the driver has
-inherited the selectrow_arrayref method provided by the \s-1DBI.\s0
-.PP
-But you'll note that there is only one call to
-DBD::_::db::selectrow_arrayref but another 99 to
-DBD::mysql::db::selectrow_arrayref. Currently the first
-call doesn't record the true location. That may change.
-.PP
-\&\fB!Caller\fR
-.PP
-Use a string showing the filename and line number of the code calling the method.
-.PP
-\&\fB!Caller2\fR
-.PP
-Use a string showing the filename and line number of the code calling the
-method, as for !Caller, but also include filename and line number of the code
-that called that. Calls from \s-1DBI::\s0 and \s-1DBD::\s0 packages are skipped.
-.PP
-\&\fB!File\fR
-.PP
-Same as !Caller above except that only the filename is included, not the line number.
-.PP
-\&\fB!File2\fR
-.PP
-Same as !Caller2 above except that only the filenames are included, not the line number.
-.PP
-\&\fB!Time\fR
-.PP
-Use the current value of \fItime()\fR. Rarely used. See the more useful \f(CW\*(C`!Time~N\*(C'\fR below.
-.PP
-\&\fB!Time~N\fR
-.PP
-Where \f(CW\*(C`N\*(C'\fR is an integer. Use the current value of \fItime()\fR but with reduced precision.
-The value used is determined in this way:
-.PP
-.Vb 1
-\& int( time() / N ) * N
-.Ve
-.PP
-This is a useful way to segregate a profile into time slots. For example:
-.PP
-.Vb 1
-\& [ \*(Aq!Time~60\*(Aq, \*(Aq!Statement\*(Aq ]
-.Ve
-.PP
-\fICode Reference\fR
-.IX Subsection "Code Reference"
-.PP
-The subroutine is passed the handle it was called on and the \s-1DBI\s0 method name.
-The current Statement is in \f(CW$_\fR. The statement string should not be modified,
-so most subs start with \f(CW\*(C`local $_ = $_;\*(C'\fR.
-.PP
-The list of values it returns is used at that point in the Profile Path.
-Any undefined values are treated as the string "\f(CW\*(C`undef\*(C'\fR".
-.PP
-The sub can 'veto' (reject) a profile sample by including a reference to undef
-(\f(CW\*(C`\eundef\*(C'\fR) in the returned list. That can be useful when you want to only profile
-statements that match a certain pattern, or only profile certain methods.
-.PP
-\fISubroutine Specifier\fR
-.IX Subsection "Subroutine Specifier"
-.PP
-A Path element that begins with '\f(CW\*(C`&\*(C'\fR' is treated as the name of a subroutine
-in the DBI::ProfileSubs namespace and replaced with the corresponding code reference.
-.PP
-Currently this only works when the Path is specified by the \f(CW\*(C`DBI_PROFILE\*(C'\fR
-environment variable.
-.PP
-Also, currently, the only subroutine in the DBI::ProfileSubs namespace is
-\&\f(CW\*(Aq&norm_std_n3\*(Aq\fR. That's a very handy subroutine when profiling code that
-doesn't use placeholders. See DBI::ProfileSubs for more information.
-.PP
-\fIAttribute Specifier\fR
-.IX Subsection "Attribute Specifier"
-.PP
-A string enclosed in braces, such as '\f(CW\*(C`{Username}\*(C'\fR', specifies that the current
-value of the corresponding database handle attribute should be used at that
-point in the Path.
-.PP
-\fIReference to a Scalar\fR
-.IX Subsection "Reference to a Scalar"
-.PP
-Specifies that the current value of the referenced scalar be used at that point
-in the Path. This provides an efficient way to get 'contextual' values into
-your profile.
-.PP
-\fIOther Values\fR
-.IX Subsection "Other Values"
-.PP
-Any other values are stringified and used literally.
-.PP
-(References, and values that begin with punctuation characters are reserved.)
-.SH "REPORTING"
-.IX Header "REPORTING"
-.SS "Report Format"
-.IX Subsection "Report Format"
-The current accumulated profile data can be formatted and output using
-.PP
-.Vb 1
-\& print $h\->{Profile}\->format;
-.Ve
-.PP
-To discard the profile data and start collecting fresh data
-you can do:
-.PP
-.Vb 1
-\& $h\->{Profile}\->{Data} = undef;
-.Ve
-.PP
-The default results format looks like this:
-.PP
-.Vb 5
-\& DBI::Profile: 0.001015s 42.7% (5 calls) programname @ YYYY\-MM\-DD HH:MM:SS
-\& \*(Aq\*(Aq =>
-\& 0.000024s / 2 = 0.000012s avg (first 0.000015s, min 0.000009s, max 0.000015s)
-\& \*(AqSELECT mode,size,name FROM table\*(Aq =>
-\& 0.000991s / 3 = 0.000330s avg (first 0.000678s, min 0.000009s, max 0.000678s)
-.Ve
-.PP
-Which shows the total time spent inside the \s-1DBI,\s0 with a count of
-the total number of method calls and the name of the script being
-run, then a formatted version of the profile data tree.
-.PP
-If the results are being formatted when the perl process is exiting
-(which is usually the case when the \s-1DBI_PROFILE\s0 environment variable
-is used) then the percentage of time the process spent inside the
-\&\s-1DBI\s0 is also shown. If the process is not exiting then the percentage is
-calculated using the time between the first and last call to the \s-1DBI.\s0
-.PP
-In the example above the paths in the tree are only one level deep and
-use the Statement text as the value (that's the default behaviour).
-.PP
-The merged profile data at the 'leaves' of the tree are presented
-as total time spent, count, average time spent (which is simply total
-time divided by the count), then the time spent on the first call,
-the time spent on the fastest call, and finally the time spent on
-the slowest call.
-.PP
-The 'avg', 'first', 'min' and 'max' times are not particularly
-useful when the profile data path only contains the statement text.
-Here's an extract of a more detailed example using both statement
-text and method name in the path:
-.PP
-.Vb 5
-\& \*(AqSELECT mode,size,name FROM table\*(Aq =>
-\& \*(AqFETCH\*(Aq =>
-\& 0.000076s
-\& \*(Aqfetchrow_hashref\*(Aq =>
-\& 0.036203s / 108 = 0.000335s avg (first 0.000490s, min 0.000152s, max 0.002786s)
-.Ve
-.PP
-Here you can see the 'avg', 'first', 'min' and 'max' for the
-108 calls to \fIfetchrow_hashref()\fR become rather more interesting.
-Also the data for \s-1FETCH\s0 just shows a time value because it was only
-called once.
-.PP
-Currently the profile data is output sorted by branch names. That
-may change in a later version so the leaf nodes are sorted by total
-time per leaf node.
-.SS "Report Destination"
-.IX Subsection "Report Destination"
-The default method of reporting is for the \s-1DESTROY\s0 method of the
-Profile object to format the results and write them using:
-.PP
-.Vb 1
-\& DBI\->trace_msg($results, 0); # see $ON_DESTROY_DUMP below
-.Ve
-.PP
-to write them to the \s-1DBI\s0 \fItrace()\fR filehandle (which defaults to
-\&\s-1STDERR\s0). To direct the \s-1DBI\s0 trace filehandle to write to a file
-without enabling tracing the \fItrace()\fR method can be called with a
-trace level of 0. For example:
-.PP
-.Vb 1
-\& DBI\->trace(0, $filename);
-.Ve
-.PP
-The same effect can be achieved without changing the code by
-setting the \f(CW\*(C`DBI_TRACE\*(C'\fR environment variable to \f(CW\*(C`0=filename\*(C'\fR.
-.PP
-The \f(CW$DBI::Profile::ON_DESTROY_DUMP\fR variable holds a code ref
-that's called to perform the output of the formatted results.
-The default value is:
-.PP
-.Vb 1
-\& $ON_DESTROY_DUMP = sub { DBI\->trace_msg($results, 0) };
-.Ve
-.PP
-Apart from making it easy to send the dump elsewhere, it can also
-be useful as a simple way to disable dumping results.
-.SH "CHILD HANDLES"
-.IX Header "CHILD HANDLES"
-Child handles inherit a reference to the Profile attribute value
-of their parent. So if profiling is enabled for a database handle
-then by default the statement handles created from it all contribute
-to the same merged profile data tree.
-.SH "PROFILE OBJECT METHODS"
-.IX Header "PROFILE OBJECT METHODS"
-.SS "format"
-.IX Subsection "format"
-See \*(L"\s-1REPORTING\*(R"\s0.
-.SS "as_node_path_list"
-.IX Subsection "as_node_path_list"
-.Vb 2
-\& @ary = $dbh\->{Profile}\->as_node_path_list();
-\& @ary = $dbh\->{Profile}\->as_node_path_list($node, $path);
-.Ve
-.PP
-Returns the collected data ($dbh\->{Profile}{Data}) restructured into a list of
-array refs, one for each leaf node in the Data tree. This 'flat' structure is
-often much simpler for applications to work with.
-.PP
-The first element of each array ref is a reference to the leaf node.
-The remaining elements are the 'path' through the data tree to that node.
-.PP
-For example, given a data tree like this:
-.PP
-.Vb 3
-\& {key1a}{key2a}[node1]
-\& {key1a}{key2b}[node2]
-\& {key1b}{key2a}{key3a}[node3]
-.Ve
-.PP
-The \fIas_node_path_list()\fR method will return this list:
-.PP
-.Vb 3
-\& [ [node1], \*(Aqkey1a\*(Aq, \*(Aqkey2a\*(Aq ]
-\& [ [node2], \*(Aqkey1a\*(Aq, \*(Aqkey2b\*(Aq ]
-\& [ [node3], \*(Aqkey1b\*(Aq, \*(Aqkey2a\*(Aq, \*(Aqkey3a\*(Aq ]
-.Ve
-.PP
-The nodes are ordered by key, depth-first.
-.PP
-The \f(CW$node\fR argument can be used to focus on a sub-tree.
-If not specified it defaults to \f(CW$dbh\fR\->{Profile}{Data}.
-.PP
-The \f(CW$path\fR argument can be used to specify a list of path elements that will be
-added to each element of the returned list. If not specified it defaults to a
-ref to an empty array.
-.SS "as_text"
-.IX Subsection "as_text"
-.Vb 8
-\& @txt = $dbh\->{Profile}\->as_text();
-\& $txt = $dbh\->{Profile}\->as_text({
-\& node => undef,
-\& path => [],
-\& separator => " > ",
-\& format => \*(Aq%1$s: %11$fs / %10$d = %2$fs avg (first %12$fs, min %13$fs, max %14$fs)\*(Aq."\en";
-\& sortsub => sub { ... },
-\& );
-.Ve
-.PP
-Returns the collected data ($dbh\->{Profile}{Data}) reformatted into a list of formatted strings.
-In scalar context the list is returned as a single concatenated string.
-.PP
-A hashref can be used to pass in arguments, the default values are shown in the example above.
-.PP
-The \f(CW\*(C`node\*(C'\fR and <path> arguments are passed to \fIas_node_path_list()\fR.
-.PP
-The \f(CW\*(C`separator\*(C'\fR argument is used to join the elements of the path for each leaf node.
-.PP
-The \f(CW\*(C`sortsub\*(C'\fR argument is used to pass in a ref to a sub that will order the list.
-The subroutine will be passed a reference to the array returned by
-\&\fIas_node_path_list()\fR and should sort the contents of the array in place.
-The return value from the sub is ignored. For example, to sort the nodes by the
-second level key you could use:
-.PP
-.Vb 1
-\& sortsub => sub { my $ary=shift; @$ary = sort { $a\->[2] cmp $b\->[2] } @$ary }
-.Ve
-.PP
-The \f(CW\*(C`format\*(C'\fR argument is a \f(CW\*(C`sprintf\*(C'\fR format string that specifies the format
-to use for each leaf node. It uses the explicit format parameter index
-mechanism to specify which of the arguments should appear where in the string.
-The arguments to sprintf are:
-.PP
-.Vb 10
-\& 1: path to node, joined with the separator
-\& 2: average duration (total duration/count)
-\& (3 thru 9 are currently unused)
-\& 10: count
-\& 11: total duration
-\& 12: first duration
-\& 13: smallest duration
-\& 14: largest duration
-\& 15: time of first call
-\& 16: time of first call
-.Ve
-.SH "CUSTOM DATA MANIPULATION"
-.IX Header "CUSTOM DATA MANIPULATION"
-Recall that \f(CW\*(C`$h\->{Profile}\->{Data}\*(C'\fR is a reference to the collected data.
-Either to a 'leaf' array (when the Path is empty, i.e., \s-1DBI_PROFILE\s0 env var is 1),
-or a reference to hash containing values that are either further hash
-references or leaf array references.
-.PP
-Sometimes it's useful to be able to summarise some or all of the collected data.
-The \fIdbi_profile_merge_nodes()\fR function can be used to merge leaf node values.
-.SS "dbi_profile_merge_nodes"
-.IX Subsection "dbi_profile_merge_nodes"
-.Vb 1
-\& use DBI qw(dbi_profile_merge_nodes);
-\&
-\& $time_in_dbi = dbi_profile_merge_nodes(my $totals=[], @$leaves);
-.Ve
-.PP
-Merges profile data node. Given a reference to a destination array, and zero or
-more references to profile data, merges the profile data into the destination array.
-For example:
-.PP
-.Vb 5
-\& $time_in_dbi = dbi_profile_merge_nodes(
-\& my $totals=[],
-\& [ 10, 0.51, 0.11, 0.01, 0.22, 1023110000, 1023110010 ],
-\& [ 15, 0.42, 0.12, 0.02, 0.23, 1023110005, 1023110009 ],
-\& );
-.Ve
-.PP
-\&\f(CW$totals\fR will then contain
-.PP
-.Vb 1
-\& [ 25, 0.93, 0.11, 0.01, 0.23, 1023110000, 1023110010 ]
-.Ve
-.PP
-and \f(CW$time_in_dbi\fR will be 0.93;
-.PP
-The second argument need not be just leaf nodes. If given a reference to a hash
-then the hash is recursively searched for leaf nodes and all those found
-are merged.
-.PP
-For example, to get the time spent 'inside' the \s-1DBI\s0 during an http request,
-your logging code run at the end of the request (i.e. mod_perl LogHandler)
-could use:
-.PP
-.Vb 5
-\& my $time_in_dbi = 0;
-\& if (my $Profile = $dbh\->{Profile}) { # if DBI profiling is enabled
-\& $time_in_dbi = dbi_profile_merge_nodes(my $total=[], $Profile\->{Data});
-\& $Profile\->{Data} = {}; # reset the profile data
-\& }
-.Ve
-.PP
-If profiling has been enabled then \f(CW$time_in_dbi\fR will hold the time spent inside
-the \s-1DBI\s0 for that handle (and any other handles that share the same profile data)
-since the last request.
-.PP
-Prior to \s-1DBI 1.56\s0 the \fIdbi_profile_merge_nodes()\fR function was called \fIdbi_profile_merge()\fR.
-That name still exists as an alias.
-.SH "CUSTOM DATA COLLECTION"
-.IX Header "CUSTOM DATA COLLECTION"
-.SS "Using The Path Attribute"
-.IX Subsection "Using The Path Attribute"
-.Vb 6
-\& XXX example to be added later using a selectall_arrayref call
-\& XXX nested inside a fetch loop where the first column of the
-\& XXX outer loop is bound to the profile Path using
-\& XXX bind_column(1, \e${ $dbh\->{Profile}\->{Path}\->[0] })
-\& XXX so you end up with separate profiles for each loop
-\& XXX (patches welcome to add this to the docs :)
-.Ve
-.SS "Adding Your Own Samples"
-.IX Subsection "Adding Your Own Samples"
-The \fIdbi_profile()\fR function can be used to add extra sample data
-into the profile data tree. For example:
-.PP
-.Vb 2
-\& use DBI;
-\& use DBI::Profile (dbi_profile dbi_time);
-\&
-\& my $t1 = dbi_time(); # floating point high\-resolution time
-\&
-\& ... execute code you want to profile here ...
-\&
-\& my $t2 = dbi_time();
-\& dbi_profile($h, $statement, $method, $t1, $t2);
-.Ve
-.PP
-The \f(CW$h\fR parameter is the handle the extra profile sample should be
-associated with. The \f(CW$statement\fR parameter is the string to use where
-the Path specifies !Statement. If \f(CW$statement\fR is undef
-then \f(CW$h\fR\->{Statement} will be used. Similarly \f(CW$method\fR is the string
-to use if the Path specifies !MethodName. There is no
-default value for \f(CW$method\fR.
-.PP
-The \f(CW$h\fR\->{Profile}{Path} attribute is processed by \fIdbi_profile()\fR in
-the usual way.
-.PP
-The \f(CW$h\fR parameter is usually a \s-1DBI\s0 handle but it can also be a reference to a
-hash, in which case the \fIdbi_profile()\fR acts on each defined value in the hash.
-This is an efficient way to update multiple profiles with a single sample,
-and is used by the DashProfiler module.
-.SH "SUBCLASSING"
-.IX Header "SUBCLASSING"
-Alternate profile modules must subclass DBI::Profile to help ensure
-they work with future versions of the \s-1DBI.\s0
-.SH "CAVEATS"
-.IX Header "CAVEATS"
-Applications which generate many different statement strings
-(typically because they don't use placeholders) and profile with
-!Statement in the Path (the default) will consume memory
-in the Profile Data structure for each statement. Use a code ref
-in the Path to return an edited (simplified) form of the statement.
-.PP
-If a method throws an exception itself (not via RaiseError) then
-it won't be counted in the profile.
-.PP
-If a HandleError subroutine throws an exception (rather than returning
-0 and letting RaiseError do it) then the method call won't be counted
-in the profile.
-.PP
-Time spent in \s-1DESTROY\s0 is added to the profile of the parent handle.
-.PP
-Time spent in \s-1DBI\-\s0>*() methods is not counted. The time spent in
-the driver connect method, \f(CW$drh\fR\->\fIconnect()\fR, when it's called by
-\&\s-1DBI\-\s0>connect is counted if the \s-1DBI_PROFILE\s0 environment variable is set.
-.PP
-Time spent fetching tied variables, \f(CW$DBI::errstr\fR, is counted.
-.PP
-Time spent in \s-1FETCH\s0 for \f(CW$h\fR\->{Profile} is not counted, so getting the profile
-data doesn't alter it.
-.PP
-DBI::PurePerl does not support profiling (though it could in theory).
-.PP
-For asynchronous queries, time spent while the query is running on the
-backend is not counted.
-.PP
-A few platforms don't support the \fIgettimeofday()\fR high resolution
-time function used by the \s-1DBI \s0(and available via the \fIdbi_time()\fR function).
-In which case you'll get integer resolution time which is mostly useless.
-.PP
-On Windows platforms the \fIdbi_time()\fR function is limited to millisecond
-resolution. Which isn't sufficiently fine for our needs, but still
-much better than integer resolution. This limited resolution means
-that fast method calls will often register as taking 0 time. And
-timings in general will have much more 'jitter' depending on where
-within the 'current millisecond' the start and end timing was taken.
-.PP
-This documentation could be more clear. Probably needs to be reordered
-to start with several examples and build from there. Trying to
-explain the concepts first seems painful and to lead to just as
-many forward references. (Patches welcome!)
+++ /dev/null
-.\" Automatically generated by Pod::Man 2.28 (Pod::Simple 3.29)
-.\"
-.\" Standard preamble:
-.\" ========================================================================
-.de Sp \" Vertical space (when we can't use .PP)
-.if t .sp .5v
-.if n .sp
-..
-.de Vb \" Begin verbatim text
-.ft CW
-.nf
-.ne \\$1
-..
-.de Ve \" End verbatim text
-.ft R
-.fi
-..
-.\" Set up some character translations and predefined strings. \*(-- will
-.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
-.\" double quote, and \*(R" will give a right double quote. \*(C+ will
-.\" give a nicer C++. Capital omega is used to do unbreakable dashes and
-.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff,
-.\" nothing in troff, for use with C<>.
-.tr \(*W-
-.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
-.ie n \{\
-. ds -- \(*W-
-. ds PI pi
-. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
-. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch
-. ds L" ""
-. ds R" ""
-. ds C` ""
-. ds C' ""
-'br\}
-.el\{\
-. ds -- \|\(em\|
-. ds PI \(*p
-. ds L" ``
-. ds R" ''
-. ds C`
-. ds C'
-'br\}
-.\"
-.\" Escape single quotes in literal strings from groff's Unicode transform.
-.ie \n(.g .ds Aq \(aq
-.el .ds Aq '
-.\"
-.\" If the F register is turned on, we'll generate index entries on stderr for
-.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
-.\" entries marked with X<> in POD. Of course, you'll have to process the
-.\" output yourself in some meaningful fashion.
-.\"
-.\" Avoid warning from groff about undefined register 'F'.
-.de IX
-..
-.nr rF 0
-.if \n(.g .if rF .nr rF 1
-.if (\n(rF:(\n(.g==0)) \{
-. if \nF \{
-. de IX
-. tm Index:\\$1\t\\n%\t"\\$2"
-..
-. if !\nF==2 \{
-. nr % 0
-. nr F 2
-. \}
-. \}
-.\}
-.rr rF
-.\" ========================================================================
-.\"
-.IX Title "DBI::ProfileData 3pm"
-.TH DBI::ProfileData 3pm "2017-08-13" "perl v5.22.1" "User Contributed Perl Documentation"
-.\" For nroff, turn off justification. Always turn off hyphenation; it makes
-.\" way too many mistakes in technical documents.
-.if n .ad l
-.nh
-.SH "NAME"
-DBI::ProfileData \- manipulate DBI::ProfileDumper data dumps
-.SH "SYNOPSIS"
-.IX Header "SYNOPSIS"
-The easiest way to use this module is through the dbiprof frontend
-(see dbiprof for details):
-.PP
-.Vb 1
-\& dbiprof \-\-number 15 \-\-sort count
-.Ve
-.PP
-This module can also be used to roll your own profile analysis:
-.PP
-.Vb 2
-\& # load data from dbi.prof
-\& $prof = DBI::ProfileData\->new(File => "dbi.prof");
-\&
-\& # get a count of the records (unique paths) in the data set
-\& $count = $prof\->count();
-\&
-\& # sort by longest overall time
-\& $prof\->sort(field => "longest");
-\&
-\& # sort by longest overall time, least to greatest
-\& $prof\->sort(field => "longest", reverse => 1);
-\&
-\& # exclude records with key2 eq \*(Aqdisconnect\*(Aq
-\& $prof\->exclude(key2 => \*(Aqdisconnect\*(Aq);
-\&
-\& # exclude records with key1 matching /^UPDATE/i
-\& $prof\->exclude(key1 => qr/^UPDATE/i);
-\&
-\& # remove all records except those where key1 matches /^SELECT/i
-\& $prof\->match(key1 => qr/^SELECT/i);
-\&
-\& # produce a formatted report with the given number of items
-\& $report = $prof\->report(number => 10);
-\&
-\& # clone the profile data set
-\& $clone = $prof\->clone();
-\&
-\& # get access to hash of header values
-\& $header = $prof\->header();
-\&
-\& # get access to sorted array of nodes
-\& $nodes = $prof\->nodes();
-\&
-\& # format a single node in the same style as report()
-\& $text = $prof\->format($nodes\->[0]);
-\&
-\& # get access to Data hash in DBI::Profile format
-\& $Data = $prof\->Data();
-.Ve
-.SH "DESCRIPTION"
-.IX Header "DESCRIPTION"
-This module offers the ability to read, manipulate and format
-DBI::ProfileDumper profile data.
-.PP
-Conceptually, a profile consists of a series of records, or nodes,
-each of each has a set of statistics and set of keys. Each record
-must have a unique set of keys, but there is no requirement that every
-record have the same number of keys.
-.SH "METHODS"
-.IX Header "METHODS"
-The following methods are supported by DBI::ProfileData objects.
-.ie n .SS "$prof = DBI::ProfileData\->new(File => ""dbi.prof"")"
-.el .SS "\f(CW$prof\fP = DBI::ProfileData\->new(File => ``dbi.prof'')"
-.IX Subsection "$prof = DBI::ProfileData->new(File => dbi.prof)"
-.ie n .SS "$prof = DBI::ProfileData\->new(File => ""dbi.prof"", Filter => sub { ... })"
-.el .SS "\f(CW$prof\fP = DBI::ProfileData\->new(File => ``dbi.prof'', Filter => sub { ... })"
-.IX Subsection "$prof = DBI::ProfileData->new(File => dbi.prof, Filter => sub { ... })"
-.ie n .SS "$prof = DBI::ProfileData\->new(Files => [ ""dbi.prof.1"", ""dbi.prof.2"" ])"
-.el .SS "\f(CW$prof\fP = DBI::ProfileData\->new(Files => [ ``dbi.prof.1'', ``dbi.prof.2'' ])"
-.IX Subsection "$prof = DBI::ProfileData->new(Files => [ dbi.prof.1, dbi.prof.2 ])"
-Creates a new DBI::ProfileData object. Takes either a single file
-through the File option or a list of Files in an array ref. If
-multiple files are specified then the header data from the first file
-is used.
-.PP
-\fIFiles\fR
-.IX Subsection "Files"
-.PP
-Reference to an array of file names to read.
-.PP
-\fIFile\fR
-.IX Subsection "File"
-.PP
-Name of file to read. Takes precedence over \f(CW\*(C`Files\*(C'\fR.
-.PP
-\fIDeleteFiles\fR
-.IX Subsection "DeleteFiles"
-.PP
-If true, the files are deleted after being read.
-.PP
-Actually the files are renamed with a \f(CW\*(C`deleteme\*(C'\fR suffix before being read,
-and then, after reading all the files, they're all deleted together.
-.PP
-The files are locked while being read which, combined with the rename, makes it
-safe to 'consume' files that are still being generated by DBI::ProfileDumper.
-.PP
-\fIFilter\fR
-.IX Subsection "Filter"
-.PP
-The \f(CW\*(C`Filter\*(C'\fR parameter can be used to supply a code reference that can
-manipulate the profile data as it is being read. This is most useful for
-editing \s-1SQL\s0 statements so that slightly different statements in the raw data
-will be merged and aggregated in the loaded data. For example:
-.PP
-.Vb 4
-\& Filter => sub {
-\& my ($path_ref, $data_ref) = @_;
-\& s/foo = \*(Aq.*?\*(Aq/foo = \*(Aq...\*(Aq/ for @$path_ref;
-\& }
-.Ve
-.PP
-Here's an example that performs some normalization on the \s-1SQL.\s0 It converts all
-numbers to \f(CW\*(C`N\*(C'\fR and all quoted strings to \f(CW\*(C`S\*(C'\fR. It can also convert digits to
-N within names. Finally, it summarizes long \*(L"\s-1IN \s0(...)\*(R" clauses.
-.PP
-It's aggressive and simplistic, but it's often sufficient, and serves as an
-example that you can tailor to suit your own needs:
-.PP
-.Vb 12
-\& Filter => sub {
-\& my ($path_ref, $data_ref) = @_;
-\& local $_ = $path_ref\->[0]; # whichever element contains the SQL Statement
-\& s/\eb\ed+\eb/N/g; # 42 \-> N
-\& s/\eb0x[0\-9A\-Fa\-f]+\eb/N/g; # 0xFE \-> N
-\& s/\*(Aq.*?\*(Aq/\*(AqS\*(Aq/g; # single quoted strings (doesn\*(Aqt handle escapes)
-\& s/".*?"/"S"/g; # double quoted strings (doesn\*(Aqt handle escapes)
-\& # convert names like log_20001231 into log_NNNNNNNN, controlled by $opt{n}
-\& s/([a\-z_]+)(\ed{$opt{n},})/$1.(\*(AqN\*(Aq x length($2))/ieg if $opt{n};
-\& # abbreviate massive "in (...)" statements and similar
-\& s!(([NS],){100,})!sprintf("$2,{repeated %d times}",length($1)/2)!eg;
-\& }
-.Ve
-.PP
-It's often better to perform this kinds of normalization in the \s-1DBI\s0 while the
-data is being collected, to avoid too much memory being used by storing profile
-data for many different \s-1SQL\s0 statement. See DBI::Profile.
-.ie n .SS "$copy = $prof\->\fIclone()\fP;"
-.el .SS "\f(CW$copy\fP = \f(CW$prof\fP\->\fIclone()\fP;"
-.IX Subsection "$copy = $prof->clone();"
-Clone a profile data set creating a new object.
-.ie n .SS "$header = $prof\->\fIheader()\fP;"
-.el .SS "\f(CW$header\fP = \f(CW$prof\fP\->\fIheader()\fP;"
-.IX Subsection "$header = $prof->header();"
-Returns a reference to a hash of header values. These are the key
-value pairs included in the header section of the DBI::ProfileDumper
-data format. For example:
-.PP
-.Vb 4
-\& $header = {
-\& Path => [ \*(Aq!Statement\*(Aq, \*(Aq!MethodName\*(Aq ],
-\& Program => \*(Aqt/42profile_data.t\*(Aq,
-\& };
-.Ve
-.PP
-Note that modifying this hash will modify the header data stored
-inside the profile object.
-.ie n .SS "$nodes = $prof\->\fInodes()\fP"
-.el .SS "\f(CW$nodes\fP = \f(CW$prof\fP\->\fInodes()\fP"
-.IX Subsection "$nodes = $prof->nodes()"
-Returns a reference the sorted nodes array. Each element in the array
-is a single record in the data set. The first seven elements are the
-same as the elements provided by DBI::Profile. After that each key is
-in a separate element. For example:
-.PP
-.Vb 10
-\& $nodes = [
-\& [
-\& 2, # 0, count
-\& 0.0312958955764771, # 1, total duration
-\& 0.000490069389343262, # 2, first duration
-\& 0.000176072120666504, # 3, shortest duration
-\& 0.00140702724456787, # 4, longest duration
-\& 1023115819.83019, # 5, time of first event
-\& 1023115819.86576, # 6, time of last event
-\& \*(AqSELECT foo FROM bar\*(Aq # 7, key1
-\& \*(Aqexecute\*(Aq # 8, key2
-\& # 6+N, keyN
-\& ],
-\& # ...
-\& ];
-.Ve
-.PP
-Note that modifying this array will modify the node data stored inside
-the profile object.
-.ie n .SS "$count = $prof\->\fIcount()\fP"
-.el .SS "\f(CW$count\fP = \f(CW$prof\fP\->\fIcount()\fP"
-.IX Subsection "$count = $prof->count()"
-Returns the number of items in the profile data set.
-.ie n .SS "$prof\->sort(field => ""field"")"
-.el .SS "\f(CW$prof\fP\->sort(field => ``field'')"
-.IX Subsection "$prof->sort(field => field)"
-.ie n .SS "$prof\->sort(field => ""field"", reverse => 1)"
-.el .SS "\f(CW$prof\fP\->sort(field => ``field'', reverse => 1)"
-.IX Subsection "$prof->sort(field => field, reverse => 1)"
-Sorts data by the given field. Available fields are:
-.PP
-.Vb 4
-\& longest
-\& total
-\& count
-\& shortest
-.Ve
-.PP
-The default sort is greatest to smallest, which is the opposite of the
-normal Perl meaning. This, however, matches the expected behavior of
-the dbiprof frontend.
-.ie n .SS "$count = $prof\->exclude(key2 => ""disconnect"")"
-.el .SS "\f(CW$count\fP = \f(CW$prof\fP\->exclude(key2 => ``disconnect'')"
-.IX Subsection "$count = $prof->exclude(key2 => disconnect)"
-.ie n .SS "$count = $prof\->exclude(key2 => ""disconnect"", case_sensitive => 1)"
-.el .SS "\f(CW$count\fP = \f(CW$prof\fP\->exclude(key2 => ``disconnect'', case_sensitive => 1)"
-.IX Subsection "$count = $prof->exclude(key2 => disconnect, case_sensitive => 1)"
-.ie n .SS "$count = $prof\->exclude(key1 => qr/^SELECT/i)"
-.el .SS "\f(CW$count\fP = \f(CW$prof\fP\->exclude(key1 => qr/^SELECT/i)"
-.IX Subsection "$count = $prof->exclude(key1 => qr/^SELECT/i)"
-Removes records from the data set that match the given string or
-regular expression. This method modifies the data in a permanent
-fashion \- use \fIclone()\fR first to maintain the original data after
-\&\fIexclude()\fR. Returns the number of nodes left in the profile data set.
-.ie n .SS "$count = $prof\->match(key2 => ""disconnect"")"
-.el .SS "\f(CW$count\fP = \f(CW$prof\fP\->match(key2 => ``disconnect'')"
-.IX Subsection "$count = $prof->match(key2 => disconnect)"
-.ie n .SS "$count = $prof\->match(key2 => ""disconnect"", case_sensitive => 1)"
-.el .SS "\f(CW$count\fP = \f(CW$prof\fP\->match(key2 => ``disconnect'', case_sensitive => 1)"
-.IX Subsection "$count = $prof->match(key2 => disconnect, case_sensitive => 1)"
-.ie n .SS "$count = $prof\->match(key1 => qr/^SELECT/i)"
-.el .SS "\f(CW$count\fP = \f(CW$prof\fP\->match(key1 => qr/^SELECT/i)"
-.IX Subsection "$count = $prof->match(key1 => qr/^SELECT/i)"
-Removes records from the data set that do not match the given string
-or regular expression. This method modifies the data in a permanent
-fashion \- use \fIclone()\fR first to maintain the original data after
-\&\fImatch()\fR. Returns the number of nodes left in the profile data set.
-.ie n .SS "$Data = $prof\->\fIData()\fP"
-.el .SS "\f(CW$Data\fP = \f(CW$prof\fP\->\fIData()\fP"
-.IX Subsection "$Data = $prof->Data()"
-Returns the same Data hash structure as seen in DBI::Profile. This
-structure is not sorted. The \fInodes()\fR structure probably makes more
-sense for most analysis.
-.ie n .SS "$text = $prof\->format($nodes\->[0])"
-.el .SS "\f(CW$text\fP = \f(CW$prof\fP\->format($nodes\->[0])"
-.IX Subsection "$text = $prof->format($nodes->[0])"
-Formats a single node into a human-readable block of text.
-.ie n .SS "$text = $prof\->report(number => 10)"
-.el .SS "\f(CW$text\fP = \f(CW$prof\fP\->report(number => 10)"
-.IX Subsection "$text = $prof->report(number => 10)"
-Produces a report with the given number of items.
-.SH "AUTHOR"
-.IX Header "AUTHOR"
-Sam Tregar <sam@tregar.com>
-.SH "COPYRIGHT AND LICENSE"
-.IX Header "COPYRIGHT AND LICENSE"
-Copyright (C) 2002 Sam Tregar
-.PP
-This program is free software; you can redistribute it and/or modify
-it under the same terms as Perl 5 itself.
+++ /dev/null
-.\" Automatically generated by Pod::Man 2.28 (Pod::Simple 3.29)
-.\"
-.\" Standard preamble:
-.\" ========================================================================
-.de Sp \" Vertical space (when we can't use .PP)
-.if t .sp .5v
-.if n .sp
-..
-.de Vb \" Begin verbatim text
-.ft CW
-.nf
-.ne \\$1
-..
-.de Ve \" End verbatim text
-.ft R
-.fi
-..
-.\" Set up some character translations and predefined strings. \*(-- will
-.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
-.\" double quote, and \*(R" will give a right double quote. \*(C+ will
-.\" give a nicer C++. Capital omega is used to do unbreakable dashes and
-.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff,
-.\" nothing in troff, for use with C<>.
-.tr \(*W-
-.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
-.ie n \{\
-. ds -- \(*W-
-. ds PI pi
-. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
-. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch
-. ds L" ""
-. ds R" ""
-. ds C` ""
-. ds C' ""
-'br\}
-.el\{\
-. ds -- \|\(em\|
-. ds PI \(*p
-. ds L" ``
-. ds R" ''
-. ds C`
-. ds C'
-'br\}
-.\"
-.\" Escape single quotes in literal strings from groff's Unicode transform.
-.ie \n(.g .ds Aq \(aq
-.el .ds Aq '
-.\"
-.\" If the F register is turned on, we'll generate index entries on stderr for
-.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
-.\" entries marked with X<> in POD. Of course, you'll have to process the
-.\" output yourself in some meaningful fashion.
-.\"
-.\" Avoid warning from groff about undefined register 'F'.
-.de IX
-..
-.nr rF 0
-.if \n(.g .if rF .nr rF 1
-.if (\n(rF:(\n(.g==0)) \{
-. if \nF \{
-. de IX
-. tm Index:\\$1\t\\n%\t"\\$2"
-..
-. if !\nF==2 \{
-. nr % 0
-. nr F 2
-. \}
-. \}
-.\}
-.rr rF
-.\" ========================================================================
-.\"
-.IX Title "DBI::ProfileDumper 3pm"
-.TH DBI::ProfileDumper 3pm "2013-06-24" "perl v5.22.1" "User Contributed Perl Documentation"
-.\" For nroff, turn off justification. Always turn off hyphenation; it makes
-.\" way too many mistakes in technical documents.
-.if n .ad l
-.nh
-.SH "NAME"
-DBI::ProfileDumper \- profile DBI usage and output data to a file
-.SH "SYNOPSIS"
-.IX Header "SYNOPSIS"
-To profile an existing program using DBI::ProfileDumper, set the
-\&\s-1DBI_PROFILE\s0 environment variable and run your program as usual. For
-example, using bash:
-.PP
-.Vb 1
-\& DBI_PROFILE=2/DBI::ProfileDumper program.pl
-.Ve
-.PP
-Then analyze the generated file (\fIdbi.prof\fR) with dbiprof:
-.PP
-.Vb 1
-\& dbiprof
-.Ve
-.PP
-You can also activate DBI::ProfileDumper from within your code:
-.PP
-.Vb 1
-\& use DBI;
-\&
-\& # profile with default path (2) and output file (dbi.prof)
-\& $dbh\->{Profile} = "!Statement/DBI::ProfileDumper";
-\&
-\& # same thing, spelled out
-\& $dbh\->{Profile} = "!Statement/DBI::ProfileDumper/File:dbi.prof";
-\&
-\& # another way to say it
-\& use DBI::ProfileDumper;
-\& $dbh\->{Profile} = DBI::ProfileDumper\->new(
-\& Path => [ \*(Aq!Statement\*(Aq ],
-\& File => \*(Aqdbi.prof\*(Aq );
-\&
-\& # using a custom path
-\& $dbh\->{Profile} = DBI::ProfileDumper\->new(
-\& Path => [ "foo", "bar" ],
-\& File => \*(Aqdbi.prof\*(Aq,
-\& );
-.Ve
-.SH "DESCRIPTION"
-.IX Header "DESCRIPTION"
-DBI::ProfileDumper is a subclass of DBI::Profile which
-dumps profile data to disk instead of printing a summary to your
-screen. You can then use dbiprof to analyze the data in
-a number of interesting ways, or you can roll your own analysis using
-DBI::ProfileData.
-.PP
-\&\fB\s-1NOTE:\s0\fR For Apache/mod_perl applications, use
-DBI::ProfileDumper::Apache.
-.SH "USAGE"
-.IX Header "USAGE"
-One way to use this module is just to enable it in your \f(CW$dbh\fR:
-.PP
-.Vb 1
-\& $dbh\->{Profile} = "1/DBI::ProfileDumper";
-.Ve
-.PP
-This will write out profile data by statement into a file called
-\&\fIdbi.prof\fR. If you want to modify either of these properties, you
-can construct the DBI::ProfileDumper object yourself:
-.PP
-.Vb 5
-\& use DBI::ProfileDumper;
-\& $dbh\->{Profile} = DBI::ProfileDumper\->new(
-\& Path => [ \*(Aq!Statement\*(Aq ],
-\& File => \*(Aqdbi.prof\*(Aq
-\& );
-.Ve
-.PP
-The \f(CW\*(C`Path\*(C'\fR option takes the same values as in
-DBI::Profile. The \f(CW\*(C`File\*(C'\fR option gives the name of the
-file where results will be collected. If it already exists it will be
-overwritten.
-.PP
-You can also activate this module by setting the \s-1DBI_PROFILE\s0
-environment variable:
-.PP
-.Vb 1
-\& $ENV{DBI_PROFILE} = "!Statement/DBI::ProfileDumper";
-.Ve
-.PP
-This will cause all \s-1DBI\s0 handles to share the same profiling object.
-.SH "METHODS"
-.IX Header "METHODS"
-The following methods are available to be called using the profile
-object. You can get access to the profile object from the Profile key
-in any \s-1DBI\s0 handle:
-.PP
-.Vb 1
-\& my $profile = $dbh\->{Profile};
-.Ve
-.SS "flush_to_disk"
-.IX Subsection "flush_to_disk"
-.Vb 1
-\& $profile\->flush_to_disk()
-.Ve
-.PP
-Flushes all collected profile data to disk and empties the Data hash. Returns
-the filename written to. If no profile data has been collected then the file is
-not written and \fIflush_to_disk()\fR returns undef.
-.PP
-The file is locked while it's being written. A process 'consuming' the files
-while they're being written to, should rename the file first, then lock it,
-then read it, then close and delete it. The \f(CW\*(C`DeleteFiles\*(C'\fR option to
-DBI::ProfileData does the right thing.
-.PP
-This method may be called multiple times during a program run.
-.SS "empty"
-.IX Subsection "empty"
-.Vb 1
-\& $profile\->empty()
-.Ve
-.PP
-Clears the Data hash without writing to disk.
-.SS "filename"
-.IX Subsection "filename"
-.Vb 1
-\& $filename = $profile\->filename();
-.Ve
-.PP
-Get or set the filename.
-.PP
-The filename can be specified as a \s-1CODE\s0 reference, in which case the referenced
-code should return the filename to be used. The code will be called with the
-profile object as its first argument.
-.SH "DATA FORMAT"
-.IX Header "DATA FORMAT"
-The data format written by DBI::ProfileDumper starts with a header
-containing the version number of the module used to generate it. Then
-a block of variable declarations describes the profile. After two
-newlines, the profile data forms the body of the file. For example:
-.PP
-.Vb 3
-\& DBI::ProfileDumper 2.003762
-\& Path = [ \*(Aq!Statement\*(Aq, \*(Aq!MethodName\*(Aq ]
-\& Program = t/42profile_data.t
-\&
-\& + 1 SELECT name FROM users WHERE id = ?
-\& + 2 prepare
-\& = 1 0.0312958955764771 0.000490069389343262 0.000176072120666504 0.00140702724456787 1023115819.83019 1023115819.86576
-\& + 2 execute
-\& 1 0.0312958955764771 0.000490069389343262 0.000176072120666504 0.00140702724456787 1023115819.83019 1023115819.86576
-\& + 2 fetchrow_hashref
-\& = 1 0.0312958955764771 0.000490069389343262 0.000176072120666504 0.00140702724456787 1023115819.83019 1023115819.86576
-\& + 1 UPDATE users SET name = ? WHERE id = ?
-\& + 2 prepare
-\& = 1 0.0312958955764771 0.000490069389343262 0.000176072120666504 0.00140702724456787 1023115819.83019 1023115819.86576
-\& + 2 execute
-\& = 1 0.0312958955764771 0.000490069389343262 0.000176072120666504 0.00140702724456787 1023115819.83019 1023115819.86576
-.Ve
-.PP
-The lines beginning with \f(CW\*(C`+\*(C'\fR signs signify keys. The number after
-the \f(CW\*(C`+\*(C'\fR sign shows the nesting level of the key. Lines beginning
-with \f(CW\*(C`=\*(C'\fR are the actual profile data, in the same order as
-in DBI::Profile.
-.PP
-Note that the same path may be present multiple times in the data file
-since \f(CW\*(C`format()\*(C'\fR may be called more than once. When read by
-DBI::ProfileData the data points will be merged to produce a single
-data set for each distinct path.
-.PP
-The key strings are transformed in three ways. First, all backslashes
-are doubled. Then all newlines and carriage-returns are transformed
-into \f(CW\*(C`\en\*(C'\fR and \f(CW\*(C`\er\*(C'\fR respectively. Finally, any \s-1NULL\s0 bytes (\f(CW\*(C`\e0\*(C'\fR)
-are entirely removed. When DBI::ProfileData reads the file the first
-two transformations will be reversed, but \s-1NULL\s0 bytes will not be
-restored.
-.SH "AUTHOR"
-.IX Header "AUTHOR"
-Sam Tregar <sam@tregar.com>
-.SH "COPYRIGHT AND LICENSE"
-.IX Header "COPYRIGHT AND LICENSE"
-Copyright (C) 2002 Sam Tregar
-.PP
-This program is free software; you can redistribute it and/or modify
-it under the same terms as Perl 5 itself.
+++ /dev/null
-.\" Automatically generated by Pod::Man 2.28 (Pod::Simple 3.29)
-.\"
-.\" Standard preamble:
-.\" ========================================================================
-.de Sp \" Vertical space (when we can't use .PP)
-.if t .sp .5v
-.if n .sp
-..
-.de Vb \" Begin verbatim text
-.ft CW
-.nf
-.ne \\$1
-..
-.de Ve \" End verbatim text
-.ft R
-.fi
-..
-.\" Set up some character translations and predefined strings. \*(-- will
-.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
-.\" double quote, and \*(R" will give a right double quote. \*(C+ will
-.\" give a nicer C++. Capital omega is used to do unbreakable dashes and
-.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff,
-.\" nothing in troff, for use with C<>.
-.tr \(*W-
-.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
-.ie n \{\
-. ds -- \(*W-
-. ds PI pi
-. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
-. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch
-. ds L" ""
-. ds R" ""
-. ds C` ""
-. ds C' ""
-'br\}
-.el\{\
-. ds -- \|\(em\|
-. ds PI \(*p
-. ds L" ``
-. ds R" ''
-. ds C`
-. ds C'
-'br\}
-.\"
-.\" Escape single quotes in literal strings from groff's Unicode transform.
-.ie \n(.g .ds Aq \(aq
-.el .ds Aq '
-.\"
-.\" If the F register is turned on, we'll generate index entries on stderr for
-.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
-.\" entries marked with X<> in POD. Of course, you'll have to process the
-.\" output yourself in some meaningful fashion.
-.\"
-.\" Avoid warning from groff about undefined register 'F'.
-.de IX
-..
-.nr rF 0
-.if \n(.g .if rF .nr rF 1
-.if (\n(rF:(\n(.g==0)) \{
-. if \nF \{
-. de IX
-. tm Index:\\$1\t\\n%\t"\\$2"
-..
-. if !\nF==2 \{
-. nr % 0
-. nr F 2
-. \}
-. \}
-.\}
-.rr rF
-.\" ========================================================================
-.\"
-.IX Title "DBI::ProfileDumper::Apache 3pm"
-.TH DBI::ProfileDumper::Apache 3pm "2013-06-24" "perl v5.22.1" "User Contributed Perl Documentation"
-.\" For nroff, turn off justification. Always turn off hyphenation; it makes
-.\" way too many mistakes in technical documents.
-.if n .ad l
-.nh
-.SH "NAME"
-DBI::ProfileDumper::Apache \- capture DBI profiling data from Apache/mod_perl
-.SH "SYNOPSIS"
-.IX Header "SYNOPSIS"
-Add this line to your \fIhttpd.conf\fR:
-.PP
-.Vb 1
-\& PerlSetEnv DBI_PROFILE 2/DBI::ProfileDumper::Apache
-.Ve
-.PP
-(If you're using mod_perl2, see \*(L"When using mod_perl2\*(R" for some additional notes.)
-.PP
-Then restart your server. Access the code you wish to test using a
-web browser, then shutdown your server. This will create a set of
-\&\fIdbi.prof.*\fR files in your Apache log directory.
-.PP
-Get a profiling report with dbiprof:
-.PP
-.Vb 1
-\& dbiprof /path/to/your/apache/logs/dbi.prof.*
-.Ve
-.PP
-When you're ready to perform another profiling run, delete the old files and start again.
-.SH "DESCRIPTION"
-.IX Header "DESCRIPTION"
-This module interfaces DBI::ProfileDumper to Apache/mod_perl. Using
-this module you can collect profiling data from mod_perl applications.
-It works by creating a DBI::ProfileDumper data file for each Apache
-process. These files are created in your Apache log directory. You
-can then use the dbiprof utility to analyze the profile files.
-.SH "USAGE"
-.IX Header "USAGE"
-.SS "\s-1LOADING THE MODULE\s0"
-.IX Subsection "LOADING THE MODULE"
-The easiest way to use this module is just to set the \s-1DBI_PROFILE\s0
-environment variable in your \fIhttpd.conf\fR:
-.PP
-.Vb 1
-\& PerlSetEnv DBI_PROFILE 2/DBI::ProfileDumper::Apache
-.Ve
-.PP
-The \s-1DBI\s0 will look after loading and using the module when the first \s-1DBI\s0 handle
-is created.
-.PP
-It's also possible to use this module by setting the Profile attribute
-of any \s-1DBI\s0 handle:
-.PP
-.Vb 1
-\& $dbh\->{Profile} = "2/DBI::ProfileDumper::Apache";
-.Ve
-.PP
-See DBI::ProfileDumper for more possibilities, and DBI::Profile for full
-details of the \s-1DBI\s0's profiling mechanism.
-.SS "\s-1WRITING PROFILE DATA\s0"
-.IX Subsection "WRITING PROFILE DATA"
-The profile data files will be written to your Apache log directory by default.
-.PP
-The user that the httpd processes run as will need write access to the
-directory. So, for example, if you're running the child httpds as user 'nobody'
-and using chronolog to write to the logs directory, then you'll need to change
-the default.
-.PP
-You can change the destination directory either by specifying a \f(CW\*(C`Dir\*(C'\fR value
-when creating the profile (like \f(CW\*(C`File\*(C'\fR in the DBI::ProfileDumper docs),
-or you can use the \f(CW\*(C`DBI_PROFILE_APACHE_LOG_DIR\*(C'\fR env var to change that. For example:
-.PP
-.Vb 1
-\& PerlSetEnv DBI_PROFILE_APACHE_LOG_DIR /server_root/logs
-.Ve
-.PP
-\fIWhen using mod_perl2\fR
-.IX Subsection "When using mod_perl2"
-.PP
-Under mod_perl2 you'll need to either set the \f(CW\*(C`DBI_PROFILE_APACHE_LOG_DIR\*(C'\fR env var,
-or enable the mod_perl2 \f(CW\*(C`GlobalRequest\*(C'\fR option, like this:
-.PP
-.Vb 1
-\& PerlOptions +GlobalRequest
-.Ve
-.PP
-to the global config section you're about test with DBI::ProfileDumper::Apache.
-If you don't do one of those then you'll see messages in your error_log similar to:
-.PP
-.Vb 2
-\& DBI::ProfileDumper::Apache on_destroy failed: Global $r object is not available. Set:
-\& PerlOptions +GlobalRequest in httpd.conf at ..../DBI/ProfileDumper/Apache.pm line 144
-.Ve
-.PP
-\fINaming the files\fR
-.IX Subsection "Naming the files"
-.PP
-The default file name is inherited from DBI::ProfileDumper via the
-\&\fIfilename()\fR method, but DBI::ProfileDumper::Apache appends the parent pid and
-the current pid, separated by dots, to that name.
-.PP
-\fISilencing the log\fR
-.IX Subsection "Silencing the log"
-.PP
-By default a message is written to \s-1STDERR \s0(i.e., the apache error_log file)
-when \fIflush_to_disk()\fR is called (either explicitly, or implicitly via \s-1DESTROY\s0).
-.PP
-That's usually very useful. If you don't want the log message you can silence
-it by setting the \f(CW\*(C`Quiet\*(C'\fR attribute true.
-.PP
-.Vb 1
-\& PerlSetEnv DBI_PROFILE 2/DBI::ProfileDumper::Apache/Quiet:1
-\&
-\& $dbh\->{Profile} = "!Statement/DBI::ProfileDumper/Quiet:1";
-\&
-\& $dbh\->{Profile} = DBI::ProfileDumper\->new(
-\& Path => [ \*(Aq!Statement\*(Aq ]
-\& Quiet => 1
-\& );
-.Ve
-.SS "\s-1GATHERING PROFILE DATA\s0"
-.IX Subsection "GATHERING PROFILE DATA"
-Once you have the module loaded, use your application as you normally
-would. Stop the webserver when your tests are complete. Profile data
-files will be produced when Apache exits and you'll see something like
-this in your error_log:
-.PP
-.Vb 1
-\& DBI::ProfileDumper::Apache writing to /usr/local/apache/logs/dbi.prof.2604.2619
-.Ve
-.PP
-Now you can use dbiprof to examine the data:
-.PP
-.Vb 1
-\& dbiprof /usr/local/apache/logs/dbi.prof.2604.*
-.Ve
-.PP
-By passing dbiprof a list of all generated files, dbiprof will
-automatically merge them into one result set. You can also pass
-dbiprof sorting and querying options, see dbiprof for details.
-.SS "\s-1CLEANING UP\s0"
-.IX Subsection "CLEANING UP"
-Once you've made some code changes, you're ready to start again.
-First, delete the old profile data files:
-.PP
-.Vb 1
-\& rm /usr/local/apache/logs/dbi.prof.*
-.Ve
-.PP
-Then restart your server and get back to work.
-.SH "OTHER ISSUES"
-.IX Header "OTHER ISSUES"
-.SS "Memory usage"
-.IX Subsection "Memory usage"
-DBI::Profile can use a lot of memory for very active applications because it
-collects profiling data in memory for each distinct query run.
-Calling \f(CW\*(C`flush_to_disk()\*(C'\fR will write the current data to disk and free the
-memory it's using. For example:
-.PP
-.Vb 1
-\& $dbh\->{Profile}\->flush_to_disk() if $dbh\->{Profile};
-.Ve
-.PP
-or, rather than flush every time, you could flush less often:
-.PP
-.Vb 2
-\& $dbh\->{Profile}\->flush_to_disk()
-\& if $dbh\->{Profile} and ++$i % 100;
-.Ve
-.SH "AUTHOR"
-.IX Header "AUTHOR"
-Sam Tregar <sam@tregar.com>
-.SH "COPYRIGHT AND LICENSE"
-.IX Header "COPYRIGHT AND LICENSE"
-Copyright (C) 2002 Sam Tregar
-.PP
-This program is free software; you can redistribute it and/or modify
-it under the same terms as Perl 5 itself.
+++ /dev/null
-.\" Automatically generated by Pod::Man 2.28 (Pod::Simple 3.29)
-.\"
-.\" Standard preamble:
-.\" ========================================================================
-.de Sp \" Vertical space (when we can't use .PP)
-.if t .sp .5v
-.if n .sp
-..
-.de Vb \" Begin verbatim text
-.ft CW
-.nf
-.ne \\$1
-..
-.de Ve \" End verbatim text
-.ft R
-.fi
-..
-.\" Set up some character translations and predefined strings. \*(-- will
-.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
-.\" double quote, and \*(R" will give a right double quote. \*(C+ will
-.\" give a nicer C++. Capital omega is used to do unbreakable dashes and
-.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff,
-.\" nothing in troff, for use with C<>.
-.tr \(*W-
-.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
-.ie n \{\
-. ds -- \(*W-
-. ds PI pi
-. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
-. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch
-. ds L" ""
-. ds R" ""
-. ds C` ""
-. ds C' ""
-'br\}
-.el\{\
-. ds -- \|\(em\|
-. ds PI \(*p
-. ds L" ``
-. ds R" ''
-. ds C`
-. ds C'
-'br\}
-.\"
-.\" Escape single quotes in literal strings from groff's Unicode transform.
-.ie \n(.g .ds Aq \(aq
-.el .ds Aq '
-.\"
-.\" If the F register is turned on, we'll generate index entries on stderr for
-.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
-.\" entries marked with X<> in POD. Of course, you'll have to process the
-.\" output yourself in some meaningful fashion.
-.\"
-.\" Avoid warning from groff about undefined register 'F'.
-.de IX
-..
-.nr rF 0
-.if \n(.g .if rF .nr rF 1
-.if (\n(rF:(\n(.g==0)) \{
-. if \nF \{
-. de IX
-. tm Index:\\$1\t\\n%\t"\\$2"
-..
-. if !\nF==2 \{
-. nr % 0
-. nr F 2
-. \}
-. \}
-.\}
-.rr rF
-.\" ========================================================================
-.\"
-.IX Title "DBI::ProfileSubs 3pm"
-.TH DBI::ProfileSubs 3pm "2013-06-24" "perl v5.22.1" "User Contributed Perl Documentation"
-.\" For nroff, turn off justification. Always turn off hyphenation; it makes
-.\" way too many mistakes in technical documents.
-.if n .ad l
-.nh
-.SH "NAME"
-DBI::ProfileSubs \- Subroutines for dynamic profile Path
-.SH "SYNOPSIS"
-.IX Header "SYNOPSIS"
-.Vb 1
-\& DBI_PROFILE=\*(Aq&norm_std_n3\*(Aq prog.pl
-.Ve
-.PP
-This is new and still experimental.
-.SH "TO DO"
-.IX Header "TO DO"
-Define come kind of naming convention for the subs.
+++ /dev/null
-.\" Automatically generated by Pod::Man 2.28 (Pod::Simple 3.29)
-.\"
-.\" Standard preamble:
-.\" ========================================================================
-.de Sp \" Vertical space (when we can't use .PP)
-.if t .sp .5v
-.if n .sp
-..
-.de Vb \" Begin verbatim text
-.ft CW
-.nf
-.ne \\$1
-..
-.de Ve \" End verbatim text
-.ft R
-.fi
-..
-.\" Set up some character translations and predefined strings. \*(-- will
-.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
-.\" double quote, and \*(R" will give a right double quote. \*(C+ will
-.\" give a nicer C++. Capital omega is used to do unbreakable dashes and
-.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff,
-.\" nothing in troff, for use with C<>.
-.tr \(*W-
-.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
-.ie n \{\
-. ds -- \(*W-
-. ds PI pi
-. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
-. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch
-. ds L" ""
-. ds R" ""
-. ds C` ""
-. ds C' ""
-'br\}
-.el\{\
-. ds -- \|\(em\|
-. ds PI \(*p
-. ds L" ``
-. ds R" ''
-. ds C`
-. ds C'
-'br\}
-.\"
-.\" Escape single quotes in literal strings from groff's Unicode transform.
-.ie \n(.g .ds Aq \(aq
-.el .ds Aq '
-.\"
-.\" If the F register is turned on, we'll generate index entries on stderr for
-.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
-.\" entries marked with X<> in POD. Of course, you'll have to process the
-.\" output yourself in some meaningful fashion.
-.\"
-.\" Avoid warning from groff about undefined register 'F'.
-.de IX
-..
-.nr rF 0
-.if \n(.g .if rF .nr rF 1
-.if (\n(rF:(\n(.g==0)) \{
-. if \nF \{
-. de IX
-. tm Index:\\$1\t\\n%\t"\\$2"
-..
-. if !\nF==2 \{
-. nr % 0
-. nr F 2
-. \}
-. \}
-.\}
-.rr rF
-.\" ========================================================================
-.\"
-.IX Title "DBI::ProxyServer 3pm"
-.TH DBI::ProxyServer 3pm "2016-04-21" "perl v5.22.1" "User Contributed Perl Documentation"
-.\" For nroff, turn off justification. Always turn off hyphenation; it makes
-.\" way too many mistakes in technical documents.
-.if n .ad l
-.nh
-.SH "NAME"
-DBI::ProxyServer \- a server for the DBD::Proxy driver
-.SH "SYNOPSIS"
-.IX Header "SYNOPSIS"
-.Vb 2
-\& use DBI::ProxyServer;
-\& DBI::ProxyServer::main(@ARGV);
-.Ve
-.SH "DESCRIPTION"
-.IX Header "DESCRIPTION"
-DBI::Proxy Server is a module for implementing a proxy for the \s-1DBI\s0 proxy
-driver, DBD::Proxy. It allows access to databases over the network if the
-\&\s-1DBMS\s0 does not offer networked operations. But the proxy server might be
-useful for you, even if you have a \s-1DBMS\s0 with integrated network
-functionality: It can be used as a \s-1DBI\s0 proxy in a firewalled environment.
-.PP
-DBI::ProxyServer runs as a daemon on the machine with the \s-1DBMS\s0 or on the
-firewall. The client connects to the agent using the \s-1DBI\s0 driver DBD::Proxy,
-thus in the exactly same way than using DBD::mysql, DBD::mSQL or any other
-\&\s-1DBI\s0 driver.
-.PP
-The agent is implemented as a RPC::PlServer application. Thus you have
-access to all the possibilities of this module, in particular encryption
-and a similar configuration file. DBI::ProxyServer adds the possibility of
-query restrictions: You can define a set of queries that a client may
-execute and restrict access to those. (Requires a \s-1DBI\s0 driver that supports
-parameter binding.) See \*(L"\s-1CONFIGURATION FILE\*(R"\s0.
-.PP
-The provided driver script, dbiproxy, may either be used as it is or
-used as the basis for a local version modified to meet your needs.
-.SH "OPTIONS"
-.IX Header "OPTIONS"
-When calling the \fIDBI::ProxyServer::main()\fR function, you supply an
-array of options. These options are parsed by the Getopt::Long module.
-The ProxyServer inherits all of RPC::PlServer's and hence Net::Daemon's
-options and option handling, in particular the ability to read
-options from either the command line or a config file. See
-RPC::PlServer. See Net::Daemon. Available options include
-.IP "\fIchroot\fR (\fB\-\-chroot=dir\fR)" 4
-.IX Item "chroot (--chroot=dir)"
-(\s-1UNIX\s0 only) After doing a \fIbind()\fR, change root directory to the given
-directory by doing a \fIchroot()\fR. This is useful for security, but it
-restricts the environment a lot. For example, you need to load \s-1DBI\s0
-drivers in the config file or you have to create hard links to Unix
-sockets, if your drivers are using them. For example, with MySQL, a
-config file might contain the following lines:
-.Sp
-.Vb 9
-\& my $rootdir = \*(Aq/var/dbiproxy\*(Aq;
-\& my $unixsockdir = \*(Aq/tmp\*(Aq;
-\& my $unixsockfile = \*(Aqmysql.sock\*(Aq;
-\& foreach $dir ($rootdir, "$rootdir$unixsockdir") {
-\& mkdir 0755, $dir;
-\& }
-\& link("$unixsockdir/$unixsockfile",
-\& "$rootdir$unixsockdir/$unixsockfile");
-\& require DBD::mysql;
-\&
-\& {
-\& \*(Aqchroot\*(Aq => $rootdir,
-\& ...
-\& }
-.Ve
-.Sp
-If you don't know \fIchroot()\fR, think of an \s-1FTP\s0 server where you can see a
-certain directory tree only after logging in. See also the \-\-group and
-\&\-\-user options.
-.IP "\fIclients\fR" 4
-.IX Item "clients"
-An array ref with a list of clients. Clients are hash refs, the attributes
-\&\fIaccept\fR (0 for denying access and 1 for permitting) and \fImask\fR, a Perl
-regular expression for the clients \s-1IP\s0 number or its host name.
-.IP "\fIconfigfile\fR (\fB\-\-configfile=file\fR)" 4
-.IX Item "configfile (--configfile=file)"
-Config files are assumed to return a single hash ref that overrides the
-arguments of the new method. However, command line arguments in turn take
-precedence over the config file. See the \*(L"\s-1CONFIGURATION FILE\*(R"\s0 section
-below for details on the config file.
-.IP "\fIdebug\fR (\fB\-\-debug\fR)" 4
-.IX Item "debug (--debug)"
-Turn debugging mode on. Mainly this asserts that logging messages of
-level \*(L"debug\*(R" are created.
-.IP "\fIfacility\fR (\fB\-\-facility=mode\fR)" 4
-.IX Item "facility (--facility=mode)"
-(\s-1UNIX\s0 only) Facility to use for Sys::Syslog. The default is
-\&\fBdaemon\fR.
-.IP "\fIgroup\fR (\fB\-\-group=gid\fR)" 4
-.IX Item "group (--group=gid)"
-After doing a \fIbind()\fR, change the real and effective \s-1GID\s0 to the given.
-This is useful, if you want your server to bind to a privileged port
-(<1024), but don't want the server to execute as root. See also
-the \-\-user option.
-.Sp
-\&\s-1GID\s0's can be passed as group names or numeric values.
-.IP "\fIlocaladdr\fR (\fB\-\-localaddr=ip\fR)" 4
-.IX Item "localaddr (--localaddr=ip)"
-By default a daemon is listening to any \s-1IP\s0 number that a machine
-has. This attribute allows one to restrict the server to the given
-\&\s-1IP\s0 number.
-.IP "\fIlocalport\fR (\fB\-\-localport=port\fR)" 4
-.IX Item "localport (--localport=port)"
-This attribute sets the port on which the daemon is listening. It
-must be given somehow, as there's no default.
-.IP "\fIlogfile\fR (\fB\-\-logfile=file\fR)" 4
-.IX Item "logfile (--logfile=file)"
-Be default logging messages will be written to the syslog (Unix) or
-to the event log (Windows \s-1NT\s0). On other operating systems you need to
-specify a log file. The special value \*(L"\s-1STDERR\*(R"\s0 forces logging to
-stderr. See Net::Daemon::Log for details.
-.IP "\fImode\fR (\fB\-\-mode=modename\fR)" 4
-.IX Item "mode (--mode=modename)"
-The server can run in three different modes, depending on the environment.
-.Sp
-If you are running Perl 5.005 and did compile it for threads, then the
-server will create a new thread for each connection. The thread will
-execute the server's \fIRun()\fR method and then terminate. This mode is the
-default, you can force it with \*(L"\-\-mode=threads\*(R".
-.Sp
-If threads are not available, but you have a working \fIfork()\fR, then the
-server will behave similar by creating a new process for each connection.
-This mode will be used automatically in the absence of threads or if
-you use the \*(L"\-\-mode=fork\*(R" option.
-.Sp
-Finally there's a single-connection mode: If the server has accepted a
-connection, he will enter the \fIRun()\fR method. No other connections are
-accepted until the \fIRun()\fR method returns (if the client disconnects).
-This operation mode is useful if you have neither threads nor \fIfork()\fR,
-for example on the Macintosh. For debugging purposes you can force this
-mode with \*(L"\-\-mode=single\*(R".
-.IP "\fIpidfile\fR (\fB\-\-pidfile=file\fR)" 4
-.IX Item "pidfile (--pidfile=file)"
-(\s-1UNIX\s0 only) If this option is present, a \s-1PID\s0 file will be created at the
-given location. Default is to not create a pidfile.
-.IP "\fIuser\fR (\fB\-\-user=uid\fR)" 4
-.IX Item "user (--user=uid)"
-After doing a \fIbind()\fR, change the real and effective \s-1UID\s0 to the given.
-This is useful, if you want your server to bind to a privileged port
-(<1024), but don't want the server to execute as root. See also
-the \-\-group and the \-\-chroot options.
-.Sp
-\&\s-1UID\s0's can be passed as group names or numeric values.
-.IP "\fIversion\fR (\fB\-\-version\fR)" 4
-.IX Item "version (--version)"
-Suppresses startup of the server; instead the version string will
-be printed and the program exits immediately.
-.SH "SHUTDOWN"
-.IX Header "SHUTDOWN"
-DBI::ProxyServer is built on RPC::PlServer which is, in turn, built on Net::Daemon.
-.PP
-You should refer to Net::Daemon for how to shutdown the server, except that
-you can't because it's not currently documented there (as of v0.43).
-The bottom-line is that it seems that there's no support for graceful shutdown.
-.SH "CONFIGURATION FILE"
-.IX Header "CONFIGURATION FILE"
-The configuration file is just that of \fIRPC::PlServer\fR or \fINet::Daemon\fR
-with some additional attributes in the client list.
-.PP
-The config file is a Perl script. At the top of the file you may include
-arbitrary Perl source, for example load drivers at the start (useful
-to enhance performance), prepare a chroot environment and so on.
-.PP
-The important thing is that you finally return a hash ref of option
-name/value pairs. The possible options are listed above.
-.PP
-All possibilities of Net::Daemon and RPC::PlServer apply, in particular
-.IP "Host and/or User dependent access control" 4
-.IX Item "Host and/or User dependent access control"
-.PD 0
-.IP "Host and/or User dependent encryption" 4
-.IX Item "Host and/or User dependent encryption"
-.IP "Changing \s-1UID\s0 and/or \s-1GID\s0 after binding to the port" 4
-.IX Item "Changing UID and/or GID after binding to the port"
-.IP "Running in a \fIchroot()\fR environment" 4
-.IX Item "Running in a chroot() environment"
-.PD
-.PP
-Additionally the server offers you query restrictions. Suggest the
-following client list:
-.PP
-.Vb 10
-\& \*(Aqclients\*(Aq => [
-\& { \*(Aqmask\*(Aq => \*(Aq^admin\e.company\e.com$\*(Aq,
-\& \*(Aqaccept\*(Aq => 1,
-\& \*(Aqusers\*(Aq => [ \*(Aqroot\*(Aq, \*(Aqwwwrun\*(Aq ],
-\& },
-\& {
-\& \*(Aqmask\*(Aq => \*(Aq^admin\e.company\e.com$\*(Aq,
-\& \*(Aqaccept\*(Aq => 1,
-\& \*(Aqusers\*(Aq => [ \*(Aqroot\*(Aq, \*(Aqwwwrun\*(Aq ],
-\& \*(Aqsql\*(Aq => {
-\& \*(Aqselect\*(Aq => \*(AqSELECT * FROM foo\*(Aq,
-\& \*(Aqinsert\*(Aq => \*(AqINSERT INTO foo VALUES (?, ?, ?)\*(Aq
-\& }
-\& }
-.Ve
-.PP
-then only the users root and wwwrun may connect from admin.company.com,
-executing arbitrary queries, but only wwwrun may connect from other
-hosts and is restricted to
-.PP
-.Vb 1
-\& $sth\->prepare("select");
-.Ve
-.PP
-or
-.PP
-.Vb 1
-\& $sth\->prepare("insert");
-.Ve
-.PP
-which in fact are \*(L"\s-1SELECT\s0 * \s-1FROM\s0 foo\*(R" or \*(L"\s-1INSERT INTO\s0 foo \s-1VALUES \s0(?, ?, ?)\*(R".
-.SH "Proxyserver Configuration file (bigger example)"
-.IX Header "Proxyserver Configuration file (bigger example)"
-This section tells you how to restrict a DBI-Proxy: Not every user from
-every workstation shall be able to execute every query.
-.PP
-There is a perl program \*(L"dbiproxy\*(R" which runs on a machine which is able
-to connect to all the databases we wish to reach. All Perl-DBD-drivers must
-be installed on this machine. You can also reach databases for which drivers
-are not available on the machine where you run the program querying the
-database, e.g. ask MS-Access-database from Linux.
-.PP
-Create a configuration file \*(L"proxy_oracle.cfg\*(R" at the dbproxy-server:
-.PP
-.Vb 8
-\& {
-\& # This shall run in a shell or a DOS\-window
-\& # facility => \*(Aqdaemon\*(Aq,
-\& pidfile => \*(Aqyour_dbiproxy.pid\*(Aq,
-\& logfile => 1,
-\& debug => 0,
-\& mode => \*(Aqsingle\*(Aq,
-\& localport => \*(Aq12400\*(Aq,
-\&
-\& # Access control, the first match in this list wins!
-\& # So the order is important
-\& clients => [
-\& # hint to organize:
-\& # the most specialized rules for single machines/users are 1st
-\& # then the denying rules
-\& # then the rules about whole networks
-\&
-\& # rule: internal_webserver
-\& # desc: to get statistical information
-\& {
-\& # this IP\-address only is meant
-\& mask => \*(Aq^10\e.95\e.81\e.243$\*(Aq,
-\& # accept (not defer) connections like this
-\& accept => 1,
-\& # only users from this list
-\& # are allowed to log on
-\& users => [ \*(Aqinformationdesk\*(Aq ],
-\& # only this statistical query is allowed
-\& # to get results for a web\-query
-\& sql => {
-\& alive => \*(Aqselect count(*) from dual\*(Aq,
-\& statistic_area => \*(Aqselect count(*) from e01admin.e01e203 where geb_bezei like ?\*(Aq,
-\& }
-\& },
-\&
-\& # rule: internal_bad_guy_1
-\& {
-\& mask => \*(Aq^10\e.95\e.81\e.1$\*(Aq,
-\& accept => 0,
-\& },
-\&
-\& # rule: employee_workplace
-\& # desc: get detailed information
-\& {
-\& # any IP\-address is meant here
-\& mask => \*(Aq^10\e.95\e.81\e.(\ed+)$\*(Aq,
-\& # accept (not defer) connections like this
-\& accept => 1,
-\& # only users from this list
-\& # are allowed to log on
-\& users => [ \*(Aqinformationdesk\*(Aq, \*(Aqlippmann\*(Aq ],
-\& # all these queries are allowed:
-\& sql => {
-\& search_city => \*(Aqselect ort_nr, plz, ort from e01admin.e01e200 where plz like ?\*(Aq,
-\& search_area => \*(Aqselect gebiettyp, geb_bezei from e01admin.e01e203 where geb_bezei like ? or geb_bezei like ?\*(Aq,
-\& }
-\& },
-\&
-\& # rule: internal_bad_guy_2
-\& # This does NOT work, because rule "employee_workplace" hits
-\& # with its ip\-address\-mask of the whole network
-\& {
-\& # don\*(Aqt accept connection from this ip\-address
-\& mask => \*(Aq^10\e.95\e.81\e.5$\*(Aq,
-\& accept => 0,
-\& }
-\& ]
-\& }
-.Ve
-.PP
-Start the proxyserver like this:
-.PP
-.Vb 3
-\& rem well\-set Oracle_home needed for Oracle
-\& set ORACLE_HOME=d:\eoracle\eora81
-\& dbiproxy \-\-configfile proxy_oracle.cfg
-.Ve
-.SS "Testing the connection from a remote machine"
-.IX Subsection "Testing the connection from a remote machine"
-Call a program \*(L"dbish\*(R" from your commandline. I take the machine from rule \*(L"internal_webserver\*(R"
-.PP
-.Vb 1
-\& dbish "dbi:Proxy:hostname=oracle.zdf;port=12400;dsn=dbi:Oracle:e01" informationdesk xxx
-.Ve
-.PP
-There will be a shell-prompt:
-.PP
-.Vb 1
-\& informationdesk@dbi...> alive
-\&
-\& Current statement buffer (enter \*(Aq/\*(Aq...):
-\& alive
-\&
-\& informationdesk@dbi...> /
-\& COUNT(*)
-\& \*(Aq1\*(Aq
-\& [1 rows of 1 fields returned]
-.Ve
-.SS "Testing the connection with a perl-script"
-.IX Subsection "Testing the connection with a perl-script"
-Create a perl-script like this:
-.PP
-.Vb 2
-\& # file: oratest.pl
-\& # call me like this: perl oratest.pl user password
-\&
-\& use strict;
-\& use DBI;
-\&
-\& my $user = shift || die "Usage: $0 user password";
-\& my $pass = shift || die "Usage: $0 user password";
-\& my $config = {
-\& dsn_at_proxy => "dbi:Oracle:e01",
-\& proxy => "hostname=oechsle.zdf;port=12400",
-\& };
-\& my $dsn = sprintf "dbi:Proxy:%s;dsn=%s",
-\& $config\->{proxy},
-\& $config\->{dsn_at_proxy};
-\&
-\& my $dbh = DBI\->connect( $dsn, $user, $pass )
-\& || die "connect did not work: $DBI::errstr";
-\&
-\& my $sql = "search_city";
-\& printf "%s\en%s\en%s\en", "="x40, $sql, "="x40;
-\& my $cur = $dbh\->prepare($sql);
-\& $cur\->bind_param(1,\*(Aq905%\*(Aq);
-\& &show_result ($cur);
-\&
-\& my $sql = "search_area";
-\& printf "%s\en%s\en%s\en", "="x40, $sql, "="x40;
-\& my $cur = $dbh\->prepare($sql);
-\& $cur\->bind_param(1,\*(AqPfarr%\*(Aq);
-\& $cur\->bind_param(2,\*(AqBronnamberg%\*(Aq);
-\& &show_result ($cur);
-\&
-\& my $sql = "statistic_area";
-\& printf "%s\en%s\en%s\en", "="x40, $sql, "="x40;
-\& my $cur = $dbh\->prepare($sql);
-\& $cur\->bind_param(1,\*(AqPfarr%\*(Aq);
-\& &show_result ($cur);
-\&
-\& $dbh\->disconnect;
-\& exit;
-\&
-\&
-\& sub show_result {
-\& my $cur = shift;
-\& unless ($cur\->execute()) {
-\& print "Could not execute\en";
-\& return;
-\& }
-\&
-\& my $rownum = 0;
-\& while (my @row = $cur\->fetchrow_array()) {
-\& printf "Row is: %s\en", join(", ",@row);
-\& if ($rownum++ > 5) {
-\& print "... and so on\en";
-\& last;
-\& }
-\& }
-\& $cur\->finish;
-\& }
-.Ve
-.PP
-The result
-.PP
-.Vb 10
-\& C:\e>perl oratest.pl informationdesk xxx
-\& ========================================
-\& search_city
-\& ========================================
-\& Row is: 3322, 9050, Chemnitz
-\& Row is: 3678, 9051, Chemnitz
-\& Row is: 10447, 9051, Chemnitz
-\& Row is: 12128, 9051, Chemnitz
-\& Row is: 10954, 90513, Zirndorf
-\& Row is: 5808, 90513, Zirndorf
-\& Row is: 5715, 90513, Zirndorf
-\& ... and so on
-\& ========================================
-\& search_area
-\& ========================================
-\& Row is: 101, Bronnamberg
-\& Row is: 400, Pfarramt Zirndorf
-\& Row is: 400, Pfarramt Rosstal
-\& Row is: 400, Pfarramt Oberasbach
-\& Row is: 401, Pfarramt Zirndorf
-\& Row is: 401, Pfarramt Rosstal
-\& ========================================
-\& statistic_area
-\& ========================================
-\& DBD::Proxy::st execute failed: Server returned error: Failed to execute method CallMethod: Unknown SQL query: statistic_area at E:/Perl/site/lib/DBI/ProxyServer.pm line 258.
-\& Could not execute
-.Ve
-.SS "How the configuration works"
-.IX Subsection "How the configuration works"
-The most important section to control access to your dbi-proxy is \*(L"client=>\*(R"
-in the file \*(L"proxy_oracle.cfg\*(R":
-.PP
-Controlling which person at which machine is allowed to access
-.IP "\(bu" 4
-\&\*(L"mask\*(R" is a perl regular expression against the plain ip-address of the machine which wishes to connect _or_ the reverse-lookup from a nameserver.
-.IP "\(bu" 4
-\&\*(L"accept\*(R" tells the dbiproxy-server whether ip-adresse like in \*(L"mask\*(R" are allowed to connect or not (0/1)
-.IP "\(bu" 4
-\&\*(L"users\*(R" is a reference to a list of usernames which must be matched, this is \s-1NOT\s0 a regular expression.
-.PP
-Controlling which SQL-statements are allowed
-.PP
-You can put every SQL-statement you like in simply omitting \*(L"sql => ...\*(R", but the more important thing is to restrict the connection so that only allowed queries are possible.
-.PP
-If you include an sql-section in your config-file like this:
-.PP
-.Vb 4
-\& sql => {
-\& alive => \*(Aqselect count(*) from dual\*(Aq,
-\& statistic_area => \*(Aqselect count(*) from e01admin.e01e203 where geb_bezei like ?\*(Aq,
-\& }
-.Ve
-.PP
-The user is allowed to put two queries against the dbi-proxy. The queries are _not_ \*(L"select count(*)...\*(R", the queries are \*(L"alive\*(R" and \*(L"statistic_area\*(R"! These keywords are replaced by the real query. So you can run a query for \*(L"alive\*(R":
-.PP
-.Vb 3
-\& my $sql = "alive";
-\& my $cur = $dbh\->prepare($sql);
-\& ...
-.Ve
-.PP
-The flexibility is that you can put parameters in the where-part of the query so the query are not static. Simply replace a value in the where-part of the query through a question mark and bind it as a parameter to the query.
-.PP
-.Vb 5
-\& my $sql = "statistic_area";
-\& my $cur = $dbh\->prepare($sql);
-\& $cur\->bind_param(1,\*(Aq905%\*(Aq);
-\& # A second parameter would be called like this:
-\& # $cur\->bind_param(2,\*(Aq98%\*(Aq);
-.Ve
-.PP
-The result is this query:
-.PP
-.Vb 2
-\& select count(*) from e01admin.e01e203
-\& where geb_bezei like \*(Aq905%\*(Aq
-.Ve
-.PP
-Don't try to put parameters into the sql-query like this:
-.PP
-.Vb 7
-\& # Does not work like you think.
-\& # Only the first word of the query is parsed,
-\& # so it\*(Aqs changed to "statistic_area", the rest is omitted.
-\& # You _have_ to work with $cur\->bind_param.
-\& my $sql = "statistic_area 905%";
-\& my $cur = $dbh\->prepare($sql);
-\& ...
-.Ve
-.SS "Problems"
-.IX Subsection "Problems"
-.IP "\(bu" 4
-I don't know how to restrict users to special databases.
-.IP "\(bu" 4
-I don't know how to pass query-parameters via dbish
-.SH "SECURITY WARNING"
-.IX Header "SECURITY WARNING"
-RPC::PlServer used underneath is not secure due to serializing and
-deserializing data with Storable module. Use the proxy driver only in
-trusted environment.
-.SH "AUTHOR"
-.IX Header "AUTHOR"
-.Vb 4
-\& Copyright (c) 1997 Jochen Wiedmann
-\& Am Eisteich 9
-\& 72555 Metzingen
-\& Germany
-\&
-\& Email: joe@ispsoft.de
-\& Phone: +49 7123 14881
-.Ve
-.PP
-The DBI::ProxyServer module is free software; you can redistribute it
-and/or modify it under the same terms as Perl itself. In particular
-permission is granted to Tim Bunce for distributing this as a part of
-the \s-1DBI.\s0
-.SH "SEE ALSO"
-.IX Header "SEE ALSO"
-dbiproxy, DBD::Proxy, \s-1DBI\s0, RPC::PlServer,
-RPC::PlClient, Net::Daemon, Net::Daemon::Log,
-Sys::Syslog, Win32::EventLog, syslog
+++ /dev/null
-.\" Automatically generated by Pod::Man 2.28 (Pod::Simple 3.29)
-.\"
-.\" Standard preamble:
-.\" ========================================================================
-.de Sp \" Vertical space (when we can't use .PP)
-.if t .sp .5v
-.if n .sp
-..
-.de Vb \" Begin verbatim text
-.ft CW
-.nf
-.ne \\$1
-..
-.de Ve \" End verbatim text
-.ft R
-.fi
-..
-.\" Set up some character translations and predefined strings. \*(-- will
-.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
-.\" double quote, and \*(R" will give a right double quote. \*(C+ will
-.\" give a nicer C++. Capital omega is used to do unbreakable dashes and
-.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff,
-.\" nothing in troff, for use with C<>.
-.tr \(*W-
-.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
-.ie n \{\
-. ds -- \(*W-
-. ds PI pi
-. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
-. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch
-. ds L" ""
-. ds R" ""
-. ds C` ""
-. ds C' ""
-'br\}
-.el\{\
-. ds -- \|\(em\|
-. ds PI \(*p
-. ds L" ``
-. ds R" ''
-. ds C`
-. ds C'
-'br\}
-.\"
-.\" Escape single quotes in literal strings from groff's Unicode transform.
-.ie \n(.g .ds Aq \(aq
-.el .ds Aq '
-.\"
-.\" If the F register is turned on, we'll generate index entries on stderr for
-.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
-.\" entries marked with X<> in POD. Of course, you'll have to process the
-.\" output yourself in some meaningful fashion.
-.\"
-.\" Avoid warning from groff about undefined register 'F'.
-.de IX
-..
-.nr rF 0
-.if \n(.g .if rF .nr rF 1
-.if (\n(rF:(\n(.g==0)) \{
-. if \nF \{
-. de IX
-. tm Index:\\$1\t\\n%\t"\\$2"
-..
-. if !\nF==2 \{
-. nr % 0
-. nr F 2
-. \}
-. \}
-.\}
-.rr rF
-.\" ========================================================================
-.\"
-.IX Title "DBI::PurePerl 3pm"
-.TH DBI::PurePerl 3pm "2016-04-24" "perl v5.22.1" "User Contributed Perl Documentation"
-.\" For nroff, turn off justification. Always turn off hyphenation; it makes
-.\" way too many mistakes in technical documents.
-.if n .ad l
-.nh
-.SH "NAME"
-DBI::PurePerl \-\- a DBI emulation using pure perl (no C/XS compilation required)
-.SH "SYNOPSIS"
-.IX Header "SYNOPSIS"
-.Vb 2
-\& BEGIN { $ENV{DBI_PUREPERL} = 2 }
-\& use DBI;
-.Ve
-.SH "DESCRIPTION"
-.IX Header "DESCRIPTION"
-This is a pure perl emulation of the \s-1DBI\s0 internals. In almost all
-cases you will be better off using standard \s-1DBI\s0 since the portions
-of the standard version written in C make it *much* faster.
-.PP
-However, if you are in a situation where it isn't possible to install
-a compiled version of standard \s-1DBI,\s0 and you're using pure-perl \s-1DBD\s0
-drivers, then this module allows you to use most common features
-of \s-1DBI\s0 without needing any changes in your scripts.
-.SH "EXPERIMENTAL STATUS"
-.IX Header "EXPERIMENTAL STATUS"
-DBI::PurePerl is new so please treat it as experimental pending
-more extensive testing. So far it has passed all tests with \s-1DBD::CSV,\s0
-DBD::AnyData, DBD::XBase, DBD::Sprite, DBD::mysqlPP. Please send
-bug reports to Jeff Zucker at <jeff@vpservices.com> with a cc to
-<dbi\-dev@perl.org>.
-.SH "USAGE"
-.IX Header "USAGE"
-The usage is the same as for standard \s-1DBI\s0 with the exception
-that you need to set the environment variable \s-1DBI_PUREPERL\s0 if
-you want to use the PurePerl version.
-.PP
-.Vb 2
-\& DBI_PUREPERL == 0 (the default) Always use compiled DBI, die
-\& if it isn\*(Aqt properly compiled & installed
-\&
-\& DBI_PUREPERL == 1 Use compiled DBI if it is properly compiled
-\& & installed, otherwise use PurePerl
-\&
-\& DBI_PUREPERL == 2 Always use PurePerl
-.Ve
-.PP
-You may set the environment variable in your shell (e.g. with
-set or setenv or export, etc) or else set it in your script like
-this:
-.PP
-.Vb 1
-\& BEGIN { $ENV{DBI_PUREPERL}=2 }
-.Ve
-.PP
-before you \f(CW\*(C`use DBI;\*(C'\fR.
-.SH "INSTALLATION"
-.IX Header "INSTALLATION"
-In most situations simply install \s-1DBI \s0(see the \s-1DBI\s0 pod for details).
-.PP
-In the situation in which you can not install \s-1DBI\s0 itself, you
-may manually copy \s-1DBI\s0.pm and PurePerl.pm into the appropriate
-directories.
-.PP
-For example:
-.PP
-.Vb 2
-\& cp DBI.pm /usr/jdoe/mylibs/.
-\& cp PurePerl.pm /usr/jdoe/mylibs/DBI/.
-.Ve
-.PP
-Then add this to the top of scripts:
-.PP
-.Vb 4
-\& BEGIN {
-\& $ENV{DBI_PUREPERL} = 1; # or =2
-\& unshift @INC, \*(Aq/usr/jdoe/mylibs\*(Aq;
-\& }
-.Ve
-.PP
-(Or should we perhaps patch Makefile.PL so that if \s-1DBI_PUREPERL\s0
-is set to 2 prior to make, the normal compile process is skipped
-and the files are installed automatically?)
-.SH "DIFFERENCES BETWEEN DBI AND DBI::PurePerl"
-.IX Header "DIFFERENCES BETWEEN DBI AND DBI::PurePerl"
-.SS "Attributes"
-.IX Subsection "Attributes"
-Boolean attributes still return boolean values but the actual values
-used may be different, i.e., 0 or undef instead of an empty string.
-.PP
-Some handle attributes are either not supported or have very limited
-functionality:
-.PP
-.Vb 7
-\& ActiveKids
-\& InactiveDestroy
-\& AutoInactiveDestroy
-\& Kids
-\& Taint
-\& TaintIn
-\& TaintOut
-.Ve
-.PP
-(and probably others)
-.SS "Tracing"
-.IX Subsection "Tracing"
-Trace functionality is more limited and the code to handle tracing is
-only embedded into DBI:PurePerl if the \s-1DBI_TRACE\s0 environment variable
-is defined. To enable total tracing you can set the \s-1DBI_TRACE\s0
-environment variable as usual. But to enable individual handle
-tracing using the \fItrace()\fR method you also need to set the \s-1DBI_TRACE\s0
-environment variable, but set it to 0.
-.SS "Parameter Usage Checking"
-.IX Subsection "Parameter Usage Checking"
-The \s-1DBI\s0 does some basic parameter count checking on method calls.
-DBI::PurePerl doesn't.
-.SS "Speed"
-.IX Subsection "Speed"
-DBI::PurePerl is slower. Although, with some drivers in some
-contexts this may not be very significant for you.
-.PP
-By way of example... the test.pl script in the \s-1DBI\s0 source
-distribution has a simple benchmark that just does:
-.PP
-.Vb 3
-\& my $null_dbh = DBI\->connect(\*(Aqdbi:NullP:\*(Aq,\*(Aq\*(Aq,\*(Aq\*(Aq);
-\& my $i = 10_000;
-\& $null_dbh\->prepare(\*(Aq\*(Aq) while $i\-\-;
-.Ve
-.PP
-In other words just prepares a statement, creating and destroying
-a statement handle, over and over again. Using the real \s-1DBI\s0 this
-runs at ~4550 handles per second whereas DBI::PurePerl manages
-~2800 per second on the same machine (not too bad really).
-.SS "May not fully support \fIhash()\fP"
-.IX Subsection "May not fully support hash()"
-If you want to use type 1 hash, i.e., \f(CW\*(C`hash($string,1)\*(C'\fR with
-DBI::PurePerl, you'll need version 1.56 or higher of Math::BigInt
-(available on \s-1CPAN\s0).
-.SS "Doesn't support \fIpreparse()\fP"
-.IX Subsection "Doesn't support preparse()"
-The \s-1DBI\-\s0>\fIpreparse()\fR method isn't supported in DBI::PurePerl.
-.SS "Doesn't support DBD::Proxy"
-.IX Subsection "Doesn't support DBD::Proxy"
-There's a subtle problem somewhere I've not been able to identify.
-DBI::ProxyServer seem to work fine with DBI::PurePerl but DBD::Proxy
-does not work 100% (which is sad because that would be far more useful :)
-Try re-enabling t/80proxy.t for DBI::PurePerl to see if the problem
-that remains will affect you're usage.
-.SS "Others"
-.IX Subsection "Others"
-.Vb 1
-\& can() \- doesn\*(Aqt have any special behaviour
-.Ve
-.PP
-Please let us know if you find any other differences between \s-1DBI\s0
-and DBI::PurePerl.
-.SH "AUTHORS"
-.IX Header "AUTHORS"
-Tim Bunce and Jeff Zucker.
-.PP
-Tim provided the direction and basis for the code. The original
-idea for the module and most of the brute force porting from C to
-Perl was by Jeff. Tim then reworked some core parts to boost the
-performance and accuracy of the emulation. Thanks also to Randal
-Schwartz and John Tobey for patches.
-.SH "COPYRIGHT"
-.IX Header "COPYRIGHT"
-Copyright (c) 2002 Tim Bunce Ireland.
-.PP
-See \s-1COPYRIGHT\s0 section in \s-1DBI\s0.pm for usage and distribution rights.
+++ /dev/null
-.\" Automatically generated by Pod::Man 2.28 (Pod::Simple 3.29)
-.\"
-.\" Standard preamble:
-.\" ========================================================================
-.de Sp \" Vertical space (when we can't use .PP)
-.if t .sp .5v
-.if n .sp
-..
-.de Vb \" Begin verbatim text
-.ft CW
-.nf
-.ne \\$1
-..
-.de Ve \" End verbatim text
-.ft R
-.fi
-..
-.\" Set up some character translations and predefined strings. \*(-- will
-.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
-.\" double quote, and \*(R" will give a right double quote. \*(C+ will
-.\" give a nicer C++. Capital omega is used to do unbreakable dashes and
-.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff,
-.\" nothing in troff, for use with C<>.
-.tr \(*W-
-.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
-.ie n \{\
-. ds -- \(*W-
-. ds PI pi
-. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
-. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch
-. ds L" ""
-. ds R" ""
-. ds C` ""
-. ds C' ""
-'br\}
-.el\{\
-. ds -- \|\(em\|
-. ds PI \(*p
-. ds L" ``
-. ds R" ''
-. ds C`
-. ds C'
-'br\}
-.\"
-.\" Escape single quotes in literal strings from groff's Unicode transform.
-.ie \n(.g .ds Aq \(aq
-.el .ds Aq '
-.\"
-.\" If the F register is turned on, we'll generate index entries on stderr for
-.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
-.\" entries marked with X<> in POD. Of course, you'll have to process the
-.\" output yourself in some meaningful fashion.
-.\"
-.\" Avoid warning from groff about undefined register 'F'.
-.de IX
-..
-.nr rF 0
-.if \n(.g .if rF .nr rF 1
-.if (\n(rF:(\n(.g==0)) \{
-. if \nF \{
-. de IX
-. tm Index:\\$1\t\\n%\t"\\$2"
-..
-. if !\nF==2 \{
-. nr % 0
-. nr F 2
-. \}
-. \}
-.\}
-.rr rF
-.\" ========================================================================
-.\"
-.IX Title "DBI::SQL::Nano 3pm"
-.TH DBI::SQL::Nano 3pm "2016-04-23" "perl v5.22.1" "User Contributed Perl Documentation"
-.\" For nroff, turn off justification. Always turn off hyphenation; it makes
-.\" way too many mistakes in technical documents.
-.if n .ad l
-.nh
-.SH "NAME"
-DBI::SQL::Nano \- a very tiny SQL engine
-.SH "SYNOPSIS"
-.IX Header "SYNOPSIS"
-.Vb 7
-\& BEGIN { $ENV{DBI_SQL_NANO}=1 } # forces use of Nano rather than SQL::Statement
-\& use DBI::SQL::Nano;
-\& use Data::Dumper;
-\& my $stmt = DBI::SQL::Nano::Statement\->new(
-\& "SELECT bar,baz FROM foo WHERE qux = 1"
-\& ) or die "Couldn\*(Aqt parse";
-\& print Dumper $stmt;
-.Ve
-.SH "DESCRIPTION"
-.IX Header "DESCRIPTION"
-\&\f(CW\*(C`DBI::SQL::Nano\*(C'\fR is meant as a \fIvery\fR minimal \s-1SQL\s0 engine for use in
-situations where SQL::Statement is not available. In most situations you are
-better off installing SQL::Statement although DBI::SQL::Nano may be faster
-for some \fBvery\fR simple tasks.
-.PP
-DBI::SQL::Nano, like SQL::Statement is primarily intended to provide a \s-1SQL\s0
-engine for use with some pure perl DBDs including \s-1DBD::DBM\s0, \s-1DBD::CSV\s0,
-DBD::AnyData, and DBD::Excel. It is not of much use in and of itself.
-You can dump out the structure of a parsed \s-1SQL\s0 statement, but that is about
-it.
-.SH "USAGE"
-.IX Header "USAGE"
-.SS "Setting the \s-1DBI_SQL_NANO\s0 flag"
-.IX Subsection "Setting the DBI_SQL_NANO flag"
-By default, when a \f(CW\*(C`DBD\*(C'\fR uses \f(CW\*(C`DBI::SQL::Nano\*(C'\fR, the module will
-look to see if \f(CW\*(C`SQL::Statement\*(C'\fR is installed. If it is, SQL::Statement
-objects are used. If SQL::Statement is not available, DBI::SQL::Nano
-objects are used.
-.PP
-In some cases, you may wish to use DBI::SQL::Nano objects even if
-SQL::Statement is available. To force usage of DBI::SQL::Nano objects
-regardless of the availability of SQL::Statement, set the environment
-variable \s-1DBI_SQL_NANO\s0 to 1.
-.PP
-You can set the environment variable in your shell prior to running your
-script (with \s-1SET\s0 or \s-1EXPORT\s0 or whatever), or else you can set it in your
-script by putting this at the top of the script:
-.PP
-.Vb 1
-\& BEGIN { $ENV{DBI_SQL_NANO} = 1 }
-.Ve
-.SS "Supported \s-1SQL\s0 syntax"
-.IX Subsection "Supported SQL syntax"
-.Vb 2
-\& Here\*(Aqs a pseudo\-BNF. Square brackets [] indicate optional items;
-\& Angle brackets <> indicate items defined elsewhere in the BNF.
-\&
-\& statement ::=
-\& DROP TABLE [IF EXISTS] <table_name>
-\& | CREATE TABLE <table_name> <col_def_list>
-\& | INSERT INTO <table_name> [<insert_col_list>] VALUES <val_list>
-\& | DELETE FROM <table_name> [<where_clause>]
-\& | UPDATE <table_name> SET <set_clause> <where_clause>
-\& | SELECT <select_col_list> FROM <table_name> [<where_clause>]
-\& [<order_clause>]
-\&
-\& the optional IF EXISTS clause ::=
-\& * similar to MySQL \- prevents errors when trying to drop
-\& a table that doesn\*(Aqt exist
-\&
-\& identifiers ::=
-\& * table and column names should be valid SQL identifiers
-\& * especially avoid using spaces and commas in identifiers
-\& * note: there is no error checking for invalid names, some
-\& will be accepted, others will cause parse failures
-\&
-\& table_name ::=
-\& * only one table (no multiple table operations)
-\& * see identifier for valid table names
-\&
-\& col_def_list ::=
-\& * a parens delimited, comma\-separated list of column names
-\& * see identifier for valid column names
-\& * column types and column constraints may be included but are ignored
-\& e.g. these are all the same:
-\& (id,phrase)
-\& (id INT, phrase VARCHAR(40))
-\& (id INT PRIMARY KEY, phrase VARCHAR(40) NOT NULL)
-\& * you are *strongly* advised to put in column types even though
-\& they are ignored ... it increases portability
-\&
-\& insert_col_list ::=
-\& * a parens delimited, comma\-separated list of column names
-\& * as in standard SQL, this is optional
-\&
-\& select_col_list ::=
-\& * a comma\-separated list of column names
-\& * or an asterisk denoting all columns
-\&
-\& val_list ::=
-\& * a parens delimited, comma\-separated list of values which can be:
-\& * placeholders (an unquoted question mark)
-\& * numbers (unquoted numbers)
-\& * column names (unquoted strings)
-\& * nulls (unquoted word NULL)
-\& * strings (delimited with single quote marks);
-\& * note: leading and trailing percent mark (%) and underscore (_)
-\& can be used as wildcards in quoted strings for use with
-\& the LIKE and CLIKE operators
-\& * note: escaped single quotation marks within strings are not
-\& supported, neither are embedded commas, use placeholders instead
-\&
-\& set_clause ::=
-\& * a comma\-separated list of column = value pairs
-\& * see val_list for acceptable value formats
-\&
-\& where_clause ::=
-\& * a single "column/value <op> column/value" predicate, optionally
-\& preceded by "NOT"
-\& * note: multiple predicates combined with ORs or ANDs are not supported
-\& * see val_list for acceptable value formats
-\& * op may be one of:
-\& < > >= <= = <> LIKE CLIKE IS
-\& * CLIKE is a case insensitive LIKE
-\&
-\& order_clause ::= column_name [ASC|DESC]
-\& * a single column optional ORDER BY clause is supported
-\& * as in standard SQL, if neither ASC (ascending) nor
-\& DESC (descending) is specified, ASC becomes the default
-.Ve
-.SH "TABLES"
-.IX Header "TABLES"
-DBI::SQL::Nano::Statement operates on exactly one table. This table will be
-opened by inherit from DBI::SQL::Nano::Statement and implements the
-\&\f(CW\*(C`open_table\*(C'\fR method.
-.PP
-.Vb 5
-\& sub open_table ($$$$$)
-\& {
-\& ...
-\& return Your::Table\->new( \e%attributes );
-\& }
-.Ve
-.PP
-DBI::SQL::Nano::Statement_ expects a rudimentary interface is implemented by
-the table object, as well as SQL::Statement expects.
-.PP
-.Vb 1
-\& package Your::Table;
-\&
-\& use vars qw(@ISA);
-\& @ISA = qw(DBI::SQL::Nano::Table);
-\&
-\& sub drop ($$) { ... }
-\& sub fetch_row ($$$) { ... }
-\& sub push_row ($$$) { ... }
-\& sub push_names ($$$) { ... }
-\& sub truncate ($$) { ... }
-\& sub seek ($$$$) { ... }
-.Ve
-.PP
-The base class interfaces are provided by DBI::SQL::Nano::Table_ in case of
-relying on DBI::SQL::Nano or SQL::Eval::Table (see SQL::Eval for details)
-otherwise.
-.SH "BUGS AND LIMITATIONS"
-.IX Header "BUGS AND LIMITATIONS"
-There are no known bugs in DBI::SQL::Nano::Statement. If you find a one
-and want to report, please see \s-1DBI\s0 for how to report bugs.
-.PP
-DBI::SQL::Nano::Statement is designed to provide a minimal subset for
-executing \s-1SQL\s0 statements.
-.PP
-The most important limitation might be the restriction on one table per
-statement. This implies, that no JOINs are supported and there cannot be
-any foreign key relation between tables.
-.PP
-The where clause evaluation of DBI::SQL::Nano::Statement is very slow
-(SQL::Statement uses a precompiled evaluation).
-.PP
-\&\s-1INSERT\s0 can handle only one row per statement. To insert multiple rows,
-use placeholders as explained in \s-1DBI.\s0
-.PP
-The DBI::SQL::Nano parser is very limited and does not support any
-additional syntax such as brackets, comments, functions, aggregations
-etc.
-.PP
-In contrast to SQL::Statement, temporary tables are not supported.
-.SH "ACKNOWLEDGEMENTS"
-.IX Header "ACKNOWLEDGEMENTS"
-Tim Bunce provided the original idea for this module, helped me out of the
-tangled trap of namespaces, and provided help and advice all along the way.
-Although I wrote it from the ground up, it is based on Jochen Wiedmann's
-original design of SQL::Statement, so much of the credit for the \s-1API\s0 goes
-to him.
-.SH "AUTHOR AND COPYRIGHT"
-.IX Header "AUTHOR AND COPYRIGHT"
-This module is originally written by Jeff Zucker < jzucker \s-1AT\s0 cpan.org >
-.PP
-This module is currently maintained by Jens Rehsack < jrehsack \s-1AT\s0 cpan.org >
-.PP
-Copyright (C) 2010 by Jens Rehsack, all rights reserved.
-Copyright (C) 2004 by Jeff Zucker, all rights reserved.
-.PP
-You may freely distribute and/or modify this module under the terms of
-either the \s-1GNU\s0 General Public License (\s-1GPL\s0) or the Artistic License,
-as specified in the Perl \s-1README\s0 file.
+++ /dev/null
-.\" Automatically generated by Pod::Man 2.28 (Pod::Simple 3.29)
-.\"
-.\" Standard preamble:
-.\" ========================================================================
-.de Sp \" Vertical space (when we can't use .PP)
-.if t .sp .5v
-.if n .sp
-..
-.de Vb \" Begin verbatim text
-.ft CW
-.nf
-.ne \\$1
-..
-.de Ve \" End verbatim text
-.ft R
-.fi
-..
-.\" Set up some character translations and predefined strings. \*(-- will
-.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
-.\" double quote, and \*(R" will give a right double quote. \*(C+ will
-.\" give a nicer C++. Capital omega is used to do unbreakable dashes and
-.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff,
-.\" nothing in troff, for use with C<>.
-.tr \(*W-
-.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
-.ie n \{\
-. ds -- \(*W-
-. ds PI pi
-. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
-. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch
-. ds L" ""
-. ds R" ""
-. ds C` ""
-. ds C' ""
-'br\}
-.el\{\
-. ds -- \|\(em\|
-. ds PI \(*p
-. ds L" ``
-. ds R" ''
-. ds C`
-. ds C'
-'br\}
-.\"
-.\" Escape single quotes in literal strings from groff's Unicode transform.
-.ie \n(.g .ds Aq \(aq
-.el .ds Aq '
-.\"
-.\" If the F register is turned on, we'll generate index entries on stderr for
-.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
-.\" entries marked with X<> in POD. Of course, you'll have to process the
-.\" output yourself in some meaningful fashion.
-.\"
-.\" Avoid warning from groff about undefined register 'F'.
-.de IX
-..
-.nr rF 0
-.if \n(.g .if rF .nr rF 1
-.if (\n(rF:(\n(.g==0)) \{
-. if \nF \{
-. de IX
-. tm Index:\\$1\t\\n%\t"\\$2"
-..
-. if !\nF==2 \{
-. nr % 0
-. nr F 2
-. \}
-. \}
-.\}
-.rr rF
-.\" ========================================================================
-.\"
-.IX Title "DBI::Util::CacheMemory 3pm"
-.TH DBI::Util::CacheMemory 3pm "2013-06-24" "perl v5.22.1" "User Contributed Perl Documentation"
-.\" For nroff, turn off justification. Always turn off hyphenation; it makes
-.\" way too many mistakes in technical documents.
-.if n .ad l
-.nh
-.SH "NAME"
-DBI::Util::CacheMemory \- a very fast but very minimal subset of Cache::Memory
-.SH "DESCRIPTION"
-.IX Header "DESCRIPTION"
-Like Cache::Memory (part of the Cache distribution) but doesn't support any fancy features.
-.PP
-This module aims to be a very fast compatible strict sub-set for simple cases,
-such as basic client-side caching for DBD::Gofer.
-.PP
-Like Cache::Memory, and other caches in the Cache and Cache::Cache
-distributions, the data will remain in the cache until cleared, it expires,
-or the process dies. The cache object simply going out of scope will \fInot\fR
-destroy the data.
-.SH "METHODS WITH CHANGES"
-.IX Header "METHODS WITH CHANGES"
-.SS "new"
-.IX Subsection "new"
-All options except \f(CW\*(C`namespace\*(C'\fR are ignored.
-.SS "set"
-.IX Subsection "set"
-Doesn't support expiry.
-.SS "purge"
-.IX Subsection "purge"
-Same as \fIclear()\fR \- deletes everything in the namespace.
-.SH "METHODS WITHOUT CHANGES"
-.IX Header "METHODS WITHOUT CHANGES"
-.IP "clear" 4
-.IX Item "clear"
-.PD 0
-.IP "count" 4
-.IX Item "count"
-.IP "exists" 4
-.IX Item "exists"
-.IP "remove" 4
-.IX Item "remove"
-.PD
-.SH "UNSUPPORTED METHODS"
-.IX Header "UNSUPPORTED METHODS"
-If it's not listed above, it's not supported.
+++ /dev/null
-.\" Automatically generated by Pod::Man 2.28 (Pod::Simple 3.29)
-.\"
-.\" Standard preamble:
-.\" ========================================================================
-.de Sp \" Vertical space (when we can't use .PP)
-.if t .sp .5v
-.if n .sp
-..
-.de Vb \" Begin verbatim text
-.ft CW
-.nf
-.ne \\$1
-..
-.de Ve \" End verbatim text
-.ft R
-.fi
-..
-.\" Set up some character translations and predefined strings. \*(-- will
-.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
-.\" double quote, and \*(R" will give a right double quote. \*(C+ will
-.\" give a nicer C++. Capital omega is used to do unbreakable dashes and
-.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff,
-.\" nothing in troff, for use with C<>.
-.tr \(*W-
-.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
-.ie n \{\
-. ds -- \(*W-
-. ds PI pi
-. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
-. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch
-. ds L" ""
-. ds R" ""
-. ds C` ""
-. ds C' ""
-'br\}
-.el\{\
-. ds -- \|\(em\|
-. ds PI \(*p
-. ds L" ``
-. ds R" ''
-. ds C`
-. ds C'
-'br\}
-.\"
-.\" Escape single quotes in literal strings from groff's Unicode transform.
-.ie \n(.g .ds Aq \(aq
-.el .ds Aq '
-.\"
-.\" If the F register is turned on, we'll generate index entries on stderr for
-.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
-.\" entries marked with X<> in POD. Of course, you'll have to process the
-.\" output yourself in some meaningful fashion.
-.\"
-.\" Avoid warning from groff about undefined register 'F'.
-.de IX
-..
-.nr rF 0
-.if \n(.g .if rF .nr rF 1
-.if (\n(rF:(\n(.g==0)) \{
-. if \nF \{
-. de IX
-. tm Index:\\$1\t\\n%\t"\\$2"
-..
-. if !\nF==2 \{
-. nr % 0
-. nr F 2
-. \}
-. \}
-.\}
-.rr rF
-.\" ========================================================================
-.\"
-.IX Title "DBI::W32ODBC 3pm"
-.TH DBI::W32ODBC 3pm "2013-05-23" "perl v5.22.1" "User Contributed Perl Documentation"
-.\" For nroff, turn off justification. Always turn off hyphenation; it makes
-.\" way too many mistakes in technical documents.
-.if n .ad l
-.nh
-.SH "NAME"
-DBI::W32ODBC \- An experimental DBI emulation layer for Win32::ODBC
-.SH "SYNOPSIS"
-.IX Header "SYNOPSIS"
-.Vb 1
-\& use DBI::W32ODBC;
-\&
-\& # apart from the line above everything is just the same as with
-\& # the real DBI when using a basic driver with few features.
-.Ve
-.SH "DESCRIPTION"
-.IX Header "DESCRIPTION"
-This is an experimental pure perl \s-1DBI\s0 emulation layer for Win32::ODBC
-.PP
-If you can improve this code I'd be interested in hearing about it. If
-you are having trouble using it please respect the fact that it's very
-experimental. Ideally fix it yourself and send me the details.
-.SS "Some Things Not Yet Implemented"
-.IX Subsection "Some Things Not Yet Implemented"
-.Vb 2
-\& Most attributes including PrintError & RaiseError.
-\& type_info and table_info
-.Ve
-.PP
-Volunteers welcome!
+++ /dev/null
-.\" Automatically generated by Pod::Man 2.28 (Pod::Simple 3.29)
-.\"
-.\" Standard preamble:
-.\" ========================================================================
-.de Sp \" Vertical space (when we can't use .PP)
-.if t .sp .5v
-.if n .sp
-..
-.de Vb \" Begin verbatim text
-.ft CW
-.nf
-.ne \\$1
-..
-.de Ve \" End verbatim text
-.ft R
-.fi
-..
-.\" Set up some character translations and predefined strings. \*(-- will
-.\" give an unbreakable dash, \*(PI will give pi, \*(L" will give a left
-.\" double quote, and \*(R" will give a right double quote. \*(C+ will
-.\" give a nicer C++. Capital omega is used to do unbreakable dashes and
-.\" therefore won't be available. \*(C` and \*(C' expand to `' in nroff,
-.\" nothing in troff, for use with C<>.
-.tr \(*W-
-.ds C+ C\v'-.1v'\h'-1p'\s-2+\h'-1p'+\s0\v'.1v'\h'-1p'
-.ie n \{\
-. ds -- \(*W-
-. ds PI pi
-. if (\n(.H=4u)&(1m=24u) .ds -- \(*W\h'-12u'\(*W\h'-12u'-\" diablo 10 pitch
-. if (\n(.H=4u)&(1m=20u) .ds -- \(*W\h'-12u'\(*W\h'-8u'-\" diablo 12 pitch
-. ds L" ""
-. ds R" ""
-. ds C` ""
-. ds C' ""
-'br\}
-.el\{\
-. ds -- \|\(em\|
-. ds PI \(*p
-. ds L" ``
-. ds R" ''
-. ds C`
-. ds C'
-'br\}
-.\"
-.\" Escape single quotes in literal strings from groff's Unicode transform.
-.ie \n(.g .ds Aq \(aq
-.el .ds Aq '
-.\"
-.\" If the F register is turned on, we'll generate index entries on stderr for
-.\" titles (.TH), headers (.SH), subsections (.SS), items (.Ip), and index
-.\" entries marked with X<> in POD. Of course, you'll have to process the
-.\" output yourself in some meaningful fashion.
-.\"
-.\" Avoid warning from groff about undefined register 'F'.
-.de IX
-..
-.nr rF 0
-.if \n(.g .if rF .nr rF 1
-.if (\n(rF:(\n(.g==0)) \{
-. if \nF \{
-. de IX
-. tm Index:\\$1\t\\n%\t"\\$2"
-..
-. if !\nF==2 \{
-. nr % 0
-. nr F 2
-. \}
-. \}
-.\}
-.rr rF
-.\" ========================================================================
-.\"
-.IX Title "Win32::DBIODBC 3pm"
-.TH Win32::DBIODBC 3pm "2015-05-26" "perl v5.22.1" "User Contributed Perl Documentation"
-.\" For nroff, turn off justification. Always turn off hyphenation; it makes
-.\" way too many mistakes in technical documents.
-.if n .ad l
-.nh
-.SH "NAME"
-Win32::DBIODBC \- Win32::ODBC emulation layer for the DBI
-.SH "SYNOPSIS"
-.IX Header "SYNOPSIS"
-.Vb 1
-\& use Win32::DBIODBC; # instead of use Win32::ODBC
-.Ve
-.SH "DESCRIPTION"
-.IX Header "DESCRIPTION"
-This is a \fIvery\fR basic \fIvery\fR alpha quality Win32::ODBC emulation
-for the \s-1DBI.\s0 To use it just replace
-.PP
-.Vb 1
-\& use Win32::ODBC;
-.Ve
-.PP
-in your scripts with
-.PP
-.Vb 1
-\& use Win32::DBIODBC;
-.Ve
-.PP
-or, while experimenting, you can pre-load this module without changing your
-scripts by doing
-.PP
-.Vb 1
-\& perl \-MWin32::DBIODBC your_script_name
-.Ve
-.SH "TO DO"
-.IX Header "TO DO"
-Error handling is virtually non-existent.
-.SH "AUTHOR"
-.IX Header "AUTHOR"
-Tom Horen <tho@melexis.com>
+++ /dev/null
-#!/usr/bin/perl
-
-=head1 NAME
-
-dbilogstrip - filter to normalize DBI trace logs for diff'ing
-
-=head1 SYNOPSIS
-
-Read DBI trace file C<dbitrace.log> and write out a stripped version to C<dbitrace_stripped.log>
-
- dbilogstrip dbitrace.log > dbitrace_stripped.log
-
-Run C<yourscript.pl> twice, each with different sets of arguments, with
-DBI_TRACE enabled. Filter the output and trace through C<dbilogstrip> into a
-separate file for each run. Then compare using diff. (This example assumes
-you're using a standard shell.)
-
- DBI_TRACE=2 perl yourscript.pl ...args1... 2>&1 | dbilogstrip > dbitrace1.log
- DBI_TRACE=2 perl yourscript.pl ...args2... 2>&1 | dbilogstrip > dbitrace2.log
- diff -u dbitrace1.log dbitrace2.log
-
-=head1 DESCRIPTION
-
-Replaces any hex addresses, e.g, C<0x128f72ce> with C<0xN>.
-
-Replaces any references to process id or thread id, like C<pid#6254> with C<pidN>.
-
-So a DBI trace line like this:
-
- -> STORE for DBD::DBM::st (DBI::st=HASH(0x19162a0)~0x191f9c8 'f_params' ARRAY(0x1922018)) thr#1800400
-
-will look like this:
-
- -> STORE for DBD::DBM::st (DBI::st=HASH(0xN)~0xN 'f_params' ARRAY(0xN)) thrN
-
-=cut
-
-use strict;
-
-while (<>) {
- # normalize hex addresses: 0xDEADHEAD => 0xN
- s/ \b 0x [0-9a-f]+ /0xN/gx;
- # normalize process and thread id number
- s/ \b (pid|tid|thr) \W? \d+ /${1}N/gx;
-
-} continue {
- print or die "-p destination: $!\n";
-}
-
-
+++ /dev/null
-#!/usr/bin/perl
-
-use strict;
-
-my $VERSION = sprintf("1.%06d", q$Revision$ =~ /(\d+)/o);
-
-use Data::Dumper;
-use DBI::ProfileData;
-use Getopt::Long;
-
-# default options
-my $number = 10;
-my $sort = 'total';
-my $filename = 'dbi.prof';
-my $reverse = 0;
-my $case_sensitive = 0;
-my (%match, %exclude);
-
-# get options from command line
-GetOptions(
- 'version' => sub { die "dbiprof $VERSION\n" },
- 'help' => sub { exit usage() },
- 'number=i' => \$number,
- 'sort=s' => \$sort,
- 'dumpnodes!' => \my $dumpnodes,
- 'reverse' => \$reverse,
- 'match=s' => \%match,
- 'exclude=s' => \%exclude,
- 'case-sensitive' => \$case_sensitive,
- 'delete!' => \my $opt_delete,
-) or exit usage();
-
-sub usage {
- print <<EOS;
-dbiprof [options] [files]
-
-Reads and merges DBI profile data from files and prints a summary.
-
-files: defaults to $filename
-
-options:
-
- -number=N show top N, defaults to $number
- -sort=S sort by S, defaults to $sort
- -reverse reverse the sort
- -match=K=V for filtering, see docs
- -exclude=K=V for filtering, see docs
- -case_sensitive for -match and -exclude
- -delete rename files before reading then delete afterwards
- -version print version number and exit
- -help print this help
-
-EOS
- return 1;
-}
-
-# list of files defaults to dbi.prof
-my @files = @ARGV ? @ARGV : ('dbi.prof');
-
-
-# instantiate ProfileData object
-my $prof = eval {
- DBI::ProfileData->new(
- Files => \@files,
- DeleteFiles => $opt_delete,
- );
-};
-die "Unable to load profile data: $@\n" if $@;
-
-if (%match) { # handle matches
- while (my ($key, $val) = each %match) {
- if ($val =~ m!^/(.+)/$!) {
- $val = $case_sensitive ? qr/$1/ : qr/$1/i;
- }
- $prof->match($key, $val, case_sensitive => $case_sensitive);
- }
-}
-
-if (%exclude) { # handle excludes
- while (my ($key, $val) = each %exclude) {
- if ($val =~ m!^/(.+)/$!) {
- $val = $case_sensitive ? qr/$1/ : qr/$1/i;
- }
- $prof->exclude($key, $val, case_sensitive => $case_sensitive);
- }
-}
-
-# sort the data
-$prof->sort(field => $sort, reverse => $reverse);
-
-# all done, print it out
-if ($dumpnodes) {
- $Data::Dumper::Indent = 1;
- $Data::Dumper::Terse = 1;
- $Data::Dumper::Useqq = 1;
- $Data::Dumper::Deparse = 0;
- print Dumper($prof->nodes);
-}
-else {
- print $prof->report(number => $number);
-}
-exit 0;
-
-__END__
-
-=head1 NAME
-
-dbiprof - command-line client for DBI::ProfileData
-
-=head1 SYNOPSIS
-
-See a report of the ten queries with the longest total runtime in the
-profile dump file F<prof1.out>:
-
- dbiprof prof1.out
-
-See the top 10 most frequently run queries in the profile file
-F<dbi.prof> (the default):
-
- dbiprof --sort count
-
-See the same report with 15 entries:
-
- dbiprof --sort count --number 15
-
-=head1 DESCRIPTION
-
-This tool is a command-line client for the DBI::ProfileData. It
-allows you to analyze the profile data file produced by
-DBI::ProfileDumper and produce various useful reports.
-
-=head1 OPTIONS
-
-This program accepts the following options:
-
-=over 4
-
-=item --number N
-
-Produce this many items in the report. Defaults to 10. If set to
-"all" then all results are shown.
-
-=item --sort field
-
-Sort results by the given field. Sorting by multiple fields isn't currently
-supported (patches welcome). The available sort fields are:
-
-=over 4
-
-=item total
-
-Sorts by total time run time across all runs. This is the default
-sort.
-
-=item longest
-
-Sorts by the longest single run.
-
-=item count
-
-Sorts by total number of runs.
-
-=item first
-
-Sorts by the time taken in the first run.
-
-=item shortest
-
-Sorts by the shortest single run.
-
-=item key1
-
-Sorts by the value of the first element in the Path, which should be numeric.
-You can also sort by C<key2> and C<key3>.
-
-=back
-
-=item --reverse
-
-Reverses the selected sort. For example, to see a report of the
-shortest overall time:
-
- dbiprof --sort total --reverse
-
-=item --match keyN=value
-
-Consider only items where the specified key matches the given value.
-Keys are numbered from 1. For example, let's say you used a
-DBI::Profile Path of:
-
- [ DBIprofile_Statement, DBIprofile_Methodname ]
-
-And called dbiprof as in:
-
- dbiprof --match key2=execute
-
-Your report would only show execute queries, leaving out prepares,
-fetches, etc.
-
-If the value given starts and ends with slashes (C</>) then it will be
-treated as a regular expression. For example, to only include SELECT
-queries where key1 is the statement:
-
- dbiprof --match key1=/^SELECT/
-
-By default the match expression is matched case-insensitively, but
-this can be changed with the --case-sensitive option.
-
-=item --exclude keyN=value
-
-Remove items for where the specified key matches the given value. For
-example, to exclude all prepare entries where key2 is the method name:
-
- dbiprof --exclude key2=prepare
-
-Like C<--match>, If the value given starts and ends with slashes
-(C</>) then it will be treated as a regular expression. For example,
-to exclude UPDATE queries where key1 is the statement:
-
- dbiprof --match key1=/^UPDATE/
-
-By default the exclude expression is matched case-insensitively, but
-this can be changed with the --case-sensitive option.
-
-=item --case-sensitive
-
-Using this option causes --match and --exclude to work
-case-sensitively. Defaults to off.
-
-=item --delete
-
-Sets the C<DeleteFiles> option to L<DBI::ProfileData> which causes the
-files to be deleted after reading. See L<DBI::ProfileData> for more details.
-
-=item --dumpnodes
-
-Print the list of nodes in the form of a perl data structure.
-Use the C<-sort> option if you want the list sorted.
-
-=item --version
-
-Print the dbiprof version number and exit.
-
-=back
-
-=head1 AUTHOR
-
-Sam Tregar <sam@tregar.com>
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright (C) 2002 Sam Tregar
-
-This program is free software; you can redistribute it and/or modify
-it under the same terms as Perl 5 itself.
-
-=head1 SEE ALSO
-
-L<DBI::ProfileDumper|DBI::ProfileDumper>,
-L<DBI::Profile|DBI::Profile>, L<DBI|DBI>.
-
-=cut
-
+++ /dev/null
-#!/usr/bin/perl
-
-use strict;
-
-my $VERSION = sprintf("1.%06d", q$Revision$ =~ /(\d+)/o);
-
-my $arg_test = shift(@ARGV) if $ARGV[0] eq '--test';
-$ENV{DBI_TRACE} = shift(@ARGV) || 2 if $ARGV[0] =~ s/^--dbitrace=?//;
-
-require DBI::ProxyServer;
-
-# XXX these should probably be moved into DBI::ProxyServer
-delete $ENV{IFS};
-delete $ENV{CDPATH};
-delete $ENV{ENV};
-delete $ENV{BASH_ENV};
-
-if ($arg_test) {
- require RPC::PlServer::Test;
- @DBI::ProxyServer::ISA = qw(RPC::PlServer::Test DBI);
-}
-
-DBI::ProxyServer::main(@ARGV);
-
-exit(0);
-
-
-__END__
-
-=head1 NAME
-
-dbiproxy - A proxy server for the DBD::Proxy driver
-
-=head1 SYNOPSIS
-
- dbiproxy <options> --localport=<port>
-
-
-=head1 DESCRIPTION
-
-This tool is just a front end for the DBI::ProxyServer package. All it
-does is picking options from the command line and calling
-DBI::ProxyServer::main(). See L<DBI::ProxyServer> for details.
-
-Available options include:
-
-=over 4
-
-=item B<--chroot=dir>
-
-(UNIX only) After doing a bind(), change root directory to the given
-directory by doing a chroot(). This is useful for security, but it
-restricts the environment a lot. For example, you need to load DBI
-drivers in the config file or you have to create hard links to Unix
-sockets, if your drivers are using them. For example, with MySQL, a
-config file might contain the following lines:
-
- my $rootdir = '/var/dbiproxy';
- my $unixsockdir = '/tmp';
- my $unixsockfile = 'mysql.sock';
- foreach $dir ($rootdir, "$rootdir$unixsockdir") {
- mkdir 0755, $dir;
- }
- link("$unixsockdir/$unixsockfile",
- "$rootdir$unixsockdir/$unixsockfile");
- require DBD::mysql;
-
- {
- 'chroot' => $rootdir,
- ...
- }
-
-If you don't know chroot(), think of an FTP server where you can see a
-certain directory tree only after logging in. See also the --group and
---user options.
-
-=item B<--configfile=file>
-
-Config files are assumed to return a single hash ref that overrides the
-arguments of the new method. However, command line arguments in turn take
-precedence over the config file. See the "CONFIGURATION FILE" section
-in the L<DBI::ProxyServer> documentation for details on the config file.
-
-=item B<--debug>
-
-Turn debugging mode on. Mainly this asserts that logging messages of
-level "debug" are created.
-
-=item B<--facility=mode>
-
-(UNIX only) Facility to use for L<Sys::Syslog>. The default is
-B<daemon>.
-
-=item B<--group=gid>
-
-After doing a bind(), change the real and effective GID to the given.
-This is useful, if you want your server to bind to a privileged port
-(<1024), but don't want the server to execute as root. See also
-the --user option.
-
-GID's can be passed as group names or numeric values.
-
-=item B<--localaddr=ip>
-
-By default a daemon is listening to any IP number that a machine
-has. This attribute allows one to restrict the server to the given
-IP number.
-
-=item B<--localport=port>
-
-This attribute sets the port on which the daemon is listening. It
-must be given somehow, as there's no default.
-
-=item B<--logfile=file>
-
-Be default logging messages will be written to the syslog (Unix) or
-to the event log (Windows NT). On other operating systems you need to
-specify a log file. The special value "STDERR" forces logging to
-stderr. See L<Net::Daemon::Log> for details.
-
-=item B<--mode=modename>
-
-The server can run in three different modes, depending on the environment.
-
-If you are running Perl 5.005 and did compile it for threads, then the
-server will create a new thread for each connection. The thread will
-execute the server's Run() method and then terminate. This mode is the
-default, you can force it with "--mode=threads".
-
-If threads are not available, but you have a working fork(), then the
-server will behave similar by creating a new process for each connection.
-This mode will be used automatically in the absence of threads or if
-you use the "--mode=fork" option.
-
-Finally there's a single-connection mode: If the server has accepted a
-connection, he will enter the Run() method. No other connections are
-accepted until the Run() method returns (if the client disconnects).
-This operation mode is useful if you have neither threads nor fork(),
-for example on the Macintosh. For debugging purposes you can force this
-mode with "--mode=single".
-
-=item B<--pidfile=file>
-
-(UNIX only) If this option is present, a PID file will be created at the
-given location. Default is to not create a pidfile.
-
-=item B<--user=uid>
-
-After doing a bind(), change the real and effective UID to the given.
-This is useful, if you want your server to bind to a privileged port
-(<1024), but don't want the server to execute as root. See also
-the --group and the --chroot options.
-
-UID's can be passed as group names or numeric values.
-
-=item B<--version>
-
-Suppresses startup of the server; instead the version string will
-be printed and the program exits immediately.
-
-=back
-
-
-=head1 AUTHOR
-
- Copyright (c) 1997 Jochen Wiedmann
- Am Eisteich 9
- 72555 Metzingen
- Germany
-
- Email: joe@ispsoft.de
- Phone: +49 7123 14881
-
-The DBI::ProxyServer module is free software; you can redistribute it
-and/or modify it under the same terms as Perl itself. In particular
-permission is granted to Tim Bunce for distributing this as a part of
-the DBI.
-
-
-=head1 SEE ALSO
-
-L<DBI::ProxyServer>, L<DBD::Proxy>, L<DBI>
-
-=cut
+++ /dev/null
-/* @(#)$Id$
- *
- * Copyright 2000-2002 Tim Bunce
- * Copyright 2002 Jonathan Leffler
- *
- * These prototypes are for dbdimp.c funcs used in the XS file.
- * These names are #defined to driver specific names by the
- * dbdimp.h file in the driver source.
- */
-
-#ifndef DBI_DBD_XSH_H
-#define DBI_DBD_XSH_H
-
-void dbd_init _((dbistate_t *dbistate));
-
-int dbd_discon_all _((SV *drh, imp_drh_t *imp_drh));
-SV *dbd_take_imp_data _((SV *h, imp_xxh_t *imp_xxh, void *foo));
-
-/* Support for dbd_dr_data_sources and dbd_db_do added to Driver.xst in DBI v1.33 */
-/* dbd_dr_data_sources: optional: defined by a driver that calls a C */
-/* function to get the list of data sources */
-AV *dbd_dr_data_sources(SV *drh, imp_drh_t *imp_drh, SV *attrs);
-
-int dbd_db_login6_sv _((SV *dbh, imp_dbh_t *imp_dbh, SV *dbname, SV *uid, SV *pwd, SV*attribs));
-int dbd_db_login6 _((SV *dbh, imp_dbh_t *imp_dbh, char *dbname, char *uid, char *pwd, SV*attribs));
-int dbd_db_login _((SV *dbh, imp_dbh_t *imp_dbh, char *dbname, char *uid, char *pwd)); /* deprecated */
-/* Note: interface of dbd_db_do changed in v1.33 */
-/* Old prototype: dbd_db_do _((SV *sv, char *statement)); */
-/* dbd_db_do: optional: defined by a driver if the DBI default version is too slow */
-int dbd_db_do4 _((SV *dbh, imp_dbh_t *imp_dbh, char *statement, SV *params));
-IV dbd_db_do4_iv _((SV *dbh, imp_dbh_t *imp_dbh, char *statement, SV *params));
-int dbd_db_commit _((SV *dbh, imp_dbh_t *imp_dbh));
-int dbd_db_rollback _((SV *dbh, imp_dbh_t *imp_dbh));
-int dbd_db_disconnect _((SV *dbh, imp_dbh_t *imp_dbh));
-void dbd_db_destroy _((SV *dbh, imp_dbh_t *imp_dbh));
-int dbd_db_STORE_attrib _((SV *dbh, imp_dbh_t *imp_dbh, SV *keysv, SV *valuesv));
-SV *dbd_db_FETCH_attrib _((SV *dbh, imp_dbh_t *imp_dbh, SV *keysv));
-SV *dbd_db_last_insert_id _((SV *dbh, imp_dbh_t *imp_dbh, SV *catalog, SV *schema, SV *table, SV *field, SV *attr));
-AV *dbd_db_data_sources _((SV *dbh, imp_dbh_t *imp_dbh, SV *attr));
-
-int dbd_st_prepare _((SV *sth, imp_sth_t *imp_sth, char *statement, SV *attribs));
-int dbd_st_prepare_sv _((SV *sth, imp_sth_t *imp_sth, SV *statement, SV *attribs));
-int dbd_st_rows _((SV *sth, imp_sth_t *imp_sth));
-IV dbd_st_rows_iv _((SV *sth, imp_sth_t *imp_sth));
-int dbd_st_execute _((SV *sth, imp_sth_t *imp_sth));
-IV dbd_st_execute_iv _((SV *sth, imp_sth_t *imp_sth));
-AV *dbd_st_fetch _((SV *sth, imp_sth_t *imp_sth));
-int dbd_st_finish3 _((SV *sth, imp_sth_t *imp_sth, int from_destroy));
-int dbd_st_finish _((SV *sth, imp_sth_t *imp_sth)); /* deprecated */
-void dbd_st_destroy _((SV *sth, imp_sth_t *imp_sth));
-int dbd_st_blob_read _((SV *sth, imp_sth_t *imp_sth,
- int field, long offset, long len, SV *destrv, long destoffset));
-int dbd_st_STORE_attrib _((SV *sth, imp_sth_t *imp_sth, SV *keysv, SV *valuesv));
-SV *dbd_st_FETCH_attrib _((SV *sth, imp_sth_t *imp_sth, SV *keysv));
-SV *dbd_st_execute_for_fetch _((SV *sth, imp_sth_t *imp_sth, SV *fetch_tuple_sub, SV *tuple_status));
-
-int dbd_bind_ph _((SV *sth, imp_sth_t *imp_sth,
- SV *param, SV *value, IV sql_type, SV *attribs,
- int is_inout, IV maxlen));
-
-#endif /* end of dbd_xsh.h */
+++ /dev/null
-/* $Id$
- *
- * Copyright (c) 1997,1998,1999 Tim Bunce England
- *
- * See COPYRIGHT section in DBI.pm for usage and distribution rights.
- */
-
-
-/* Some core SQL CLI standard (ODBC) declarations */
-#ifndef SQL_SUCCESS /* don't clash with ODBC based drivers */
-
-/* SQL datatype codes */
-#define SQL_GUID (-11)
-#define SQL_WLONGVARCHAR (-10)
-#define SQL_WVARCHAR (-9)
-#define SQL_WCHAR (-8)
-#define SQL_BIT (-7)
-#define SQL_TINYINT (-6)
-#define SQL_BIGINT (-5)
-#define SQL_LONGVARBINARY (-4)
-#define SQL_VARBINARY (-3)
-#define SQL_BINARY (-2)
-#define SQL_LONGVARCHAR (-1)
-#define SQL_UNKNOWN_TYPE 0
-#define SQL_ALL_TYPES 0
-#define SQL_CHAR 1
-#define SQL_NUMERIC 2
-#define SQL_DECIMAL 3
-#define SQL_INTEGER 4
-#define SQL_SMALLINT 5
-#define SQL_FLOAT 6
-#define SQL_REAL 7
-#define SQL_DOUBLE 8
-#define SQL_DATETIME 9
-#define SQL_DATE 9
-#define SQL_INTERVAL 10
-#define SQL_TIME 10
-#define SQL_TIMESTAMP 11
-#define SQL_VARCHAR 12
-#define SQL_BOOLEAN 16
-#define SQL_UDT 17
-#define SQL_UDT_LOCATOR 18
-#define SQL_ROW 19
-#define SQL_REF 20
-#define SQL_BLOB 30
-#define SQL_BLOB_LOCATOR 31
-#define SQL_CLOB 40
-#define SQL_CLOB_LOCATOR 41
-#define SQL_ARRAY 50
-#define SQL_ARRAY_LOCATOR 51
-#define SQL_MULTISET 55
-#define SQL_MULTISET_LOCATOR 56
-#define SQL_TYPE_DATE 91
-#define SQL_TYPE_TIME 92
-#define SQL_TYPE_TIMESTAMP 93
-#define SQL_TYPE_TIME_WITH_TIMEZONE 94
-#define SQL_TYPE_TIMESTAMP_WITH_TIMEZONE 95
-#define SQL_INTERVAL_YEAR 101
-#define SQL_INTERVAL_MONTH 102
-#define SQL_INTERVAL_DAY 103
-#define SQL_INTERVAL_HOUR 104
-#define SQL_INTERVAL_MINUTE 105
-#define SQL_INTERVAL_SECOND 106
-#define SQL_INTERVAL_YEAR_TO_MONTH 107
-#define SQL_INTERVAL_DAY_TO_HOUR 108
-#define SQL_INTERVAL_DAY_TO_MINUTE 109
-#define SQL_INTERVAL_DAY_TO_SECOND 110
-#define SQL_INTERVAL_HOUR_TO_MINUTE 111
-#define SQL_INTERVAL_HOUR_TO_SECOND 112
-#define SQL_INTERVAL_MINUTE_TO_SECOND 113
-
-
-/* Main return codes */
-#define SQL_ERROR (-1)
-#define SQL_SUCCESS 0
-#define SQL_SUCCESS_WITH_INFO 1
-#define SQL_NO_DATA_FOUND 100
-
-/*
- * for ODBC SQL Cursor Types
- */
-#define SQL_CURSOR_FORWARD_ONLY 0UL
-#define SQL_CURSOR_KEYSET_DRIVEN 1UL
-#define SQL_CURSOR_DYNAMIC 2UL
-#define SQL_CURSOR_STATIC 3UL
-#define SQL_CURSOR_TYPE_DEFAULT SQL_CURSOR_FORWARD_ONLY
-
-#endif /* SQL_SUCCESS */
-
-/* Handy macro for testing for success and success with info. */
-/* BEWARE that this macro can have side effects since rc appears twice! */
-/* So DONT use it as if(SQL_ok(func(...))) { ... } */
-#define SQL_ok(rc) ((rc)==SQL_SUCCESS || (rc)==SQL_SUCCESS_WITH_INFO)
-
-
-/* end of dbi_sql.h */
+++ /dev/null
-#!/usr/bin/perl
-
-=head1 NAME
-
-dbilogstrip - filter to normalize DBI trace logs for diff'ing
-
-=head1 SYNOPSIS
-
-Read DBI trace file C<dbitrace.log> and write out a stripped version to C<dbitrace_stripped.log>
-
- dbilogstrip dbitrace.log > dbitrace_stripped.log
-
-Run C<yourscript.pl> twice, each with different sets of arguments, with
-DBI_TRACE enabled. Filter the output and trace through C<dbilogstrip> into a
-separate file for each run. Then compare using diff. (This example assumes
-you're using a standard shell.)
-
- DBI_TRACE=2 perl yourscript.pl ...args1... 2>&1 | dbilogstrip > dbitrace1.log
- DBI_TRACE=2 perl yourscript.pl ...args2... 2>&1 | dbilogstrip > dbitrace2.log
- diff -u dbitrace1.log dbitrace2.log
-
-=head1 DESCRIPTION
-
-Replaces any hex addresses, e.g, C<0x128f72ce> with C<0xN>.
-
-Replaces any references to process id or thread id, like C<pid#6254> with C<pidN>.
-
-So a DBI trace line like this:
-
- -> STORE for DBD::DBM::st (DBI::st=HASH(0x19162a0)~0x191f9c8 'f_params' ARRAY(0x1922018)) thr#1800400
-
-will look like this:
-
- -> STORE for DBD::DBM::st (DBI::st=HASH(0xN)~0xN 'f_params' ARRAY(0xN)) thrN
-
-=cut
-
-use strict;
-
-while (<>) {
- # normalize hex addresses: 0xDEADHEAD => 0xN
- s/ \b 0x [0-9a-f]+ /0xN/gx;
- # normalize process and thread id number
- s/ \b (pid|tid|thr) \W? \d+ /${1}N/gx;
-
-} continue {
- print or die "-p destination: $!\n";
-}
-
-
+++ /dev/null
-# -*- perl -*-
-my $file = $ARGV[0] || 'dbilogstrip';
-
-my $script = <<'SCRIPT';
-~startperl~
-
-=head1 NAME
-
-dbilogstrip - filter to normalize DBI trace logs for diff'ing
-
-=head1 SYNOPSIS
-
-Read DBI trace file C<dbitrace.log> and write out a stripped version to C<dbitrace_stripped.log>
-
- dbilogstrip dbitrace.log > dbitrace_stripped.log
-
-Run C<yourscript.pl> twice, each with different sets of arguments, with
-DBI_TRACE enabled. Filter the output and trace through C<dbilogstrip> into a
-separate file for each run. Then compare using diff. (This example assumes
-you're using a standard shell.)
-
- DBI_TRACE=2 perl yourscript.pl ...args1... 2>&1 | dbilogstrip > dbitrace1.log
- DBI_TRACE=2 perl yourscript.pl ...args2... 2>&1 | dbilogstrip > dbitrace2.log
- diff -u dbitrace1.log dbitrace2.log
-
-=head1 DESCRIPTION
-
-Replaces any hex addresses, e.g, C<0x128f72ce> with C<0xN>.
-
-Replaces any references to process id or thread id, like C<pid#6254> with C<pidN>.
-
-So a DBI trace line like this:
-
- -> STORE for DBD::DBM::st (DBI::st=HASH(0x19162a0)~0x191f9c8 'f_params' ARRAY(0x1922018)) thr#1800400
-
-will look like this:
-
- -> STORE for DBD::DBM::st (DBI::st=HASH(0xN)~0xN 'f_params' ARRAY(0xN)) thrN
-
-=cut
-
-use strict;
-
-while (<>) {
- # normalize hex addresses: 0xDEADHEAD => 0xN
- s/ \b 0x [0-9a-f]+ /0xN/gx;
- # normalize process and thread id number
- s/ \b (pid|tid|thr) \W? \d+ /${1}N/gx;
-
-} continue {
- print or die "-p destination: $!\n";
-}
-
-
-SCRIPT
-
-require Config;
-my $config = {};
-$config->{'startperl'} = $Config::Config{'startperl'};
-
-$script =~ s/\~(\w+)\~/$config->{$1}/eg;
-if (!(open(FILE, ">$file")) ||
- !(print FILE $script) ||
- !(close(FILE))) {
- die "Error while writing $file: $!\n";
-}
-chmod 0755, $file;
-print "Extracted $file from ",__FILE__," with variable substitutions.\n";
-# syntax check resulting file, but only for developers
-exit 1 if -d ".svn" and system($^X, '-wc', '-Mblib', $file) != 0;
-
+++ /dev/null
-#if 0
-<<'SKIP';
-#endif
-/*
-----------------------------------------------------------------------
-
- ppport.h -- Perl/Pollution/Portability Version 3.32
-
- Automatically created by Devel::PPPort running under perl 5.018002.
-
- Do NOT edit this file directly! -- Edit PPPort_pm.PL and the
- includes in parts/inc/ instead.
-
- Use 'perldoc ppport.h' to view the documentation below.
-
-----------------------------------------------------------------------
-
-SKIP
-
-=pod
-
-=head1 NAME
-
-ppport.h - Perl/Pollution/Portability version 3.32
-
-=head1 SYNOPSIS
-
- perl ppport.h [options] [source files]
-
- Searches current directory for files if no [source files] are given
-
- --help show short help
-
- --version show version
-
- --patch=file write one patch file with changes
- --copy=suffix write changed copies with suffix
- --diff=program use diff program and options
-
- --compat-version=version provide compatibility with Perl version
- --cplusplus accept C++ comments
-
- --quiet don't output anything except fatal errors
- --nodiag don't show diagnostics
- --nohints don't show hints
- --nochanges don't suggest changes
- --nofilter don't filter input files
-
- --strip strip all script and doc functionality from
- ppport.h
-
- --list-provided list provided API
- --list-unsupported list unsupported API
- --api-info=name show Perl API portability information
-
-=head1 COMPATIBILITY
-
-This version of F<ppport.h> is designed to support operation with Perl
-installations back to 5.003, and has been tested up to 5.20.
-
-=head1 OPTIONS
-
-=head2 --help
-
-Display a brief usage summary.
-
-=head2 --version
-
-Display the version of F<ppport.h>.
-
-=head2 --patch=I<file>
-
-If this option is given, a single patch file will be created if
-any changes are suggested. This requires a working diff program
-to be installed on your system.
-
-=head2 --copy=I<suffix>
-
-If this option is given, a copy of each file will be saved with
-the given suffix that contains the suggested changes. This does
-not require any external programs. Note that this does not
-automagically add a dot between the original filename and the
-suffix. If you want the dot, you have to include it in the option
-argument.
-
-If neither C<--patch> or C<--copy> are given, the default is to
-simply print the diffs for each file. This requires either
-C<Text::Diff> or a C<diff> program to be installed.
-
-=head2 --diff=I<program>
-
-Manually set the diff program and options to use. The default
-is to use C<Text::Diff>, when installed, and output unified
-context diffs.
-
-=head2 --compat-version=I<version>
-
-Tell F<ppport.h> to check for compatibility with the given
-Perl version. The default is to check for compatibility with Perl
-version 5.003. You can use this option to reduce the output
-of F<ppport.h> if you intend to be backward compatible only
-down to a certain Perl version.
-
-=head2 --cplusplus
-
-Usually, F<ppport.h> will detect C++ style comments and
-replace them with C style comments for portability reasons.
-Using this option instructs F<ppport.h> to leave C++
-comments untouched.
-
-=head2 --quiet
-
-Be quiet. Don't print anything except fatal errors.
-
-=head2 --nodiag
-
-Don't output any diagnostic messages. Only portability
-alerts will be printed.
-
-=head2 --nohints
-
-Don't output any hints. Hints often contain useful portability
-notes. Warnings will still be displayed.
-
-=head2 --nochanges
-
-Don't suggest any changes. Only give diagnostic output and hints
-unless these are also deactivated.
-
-=head2 --nofilter
-
-Don't filter the list of input files. By default, files not looking
-like source code (i.e. not *.xs, *.c, *.cc, *.cpp or *.h) are skipped.
-
-=head2 --strip
-
-Strip all script and documentation functionality from F<ppport.h>.
-This reduces the size of F<ppport.h> dramatically and may be useful
-if you want to include F<ppport.h> in smaller modules without
-increasing their distribution size too much.
-
-The stripped F<ppport.h> will have a C<--unstrip> option that allows
-you to undo the stripping, but only if an appropriate C<Devel::PPPort>
-module is installed.
-
-=head2 --list-provided
-
-Lists the API elements for which compatibility is provided by
-F<ppport.h>. Also lists if it must be explicitly requested,
-if it has dependencies, and if there are hints or warnings for it.
-
-=head2 --list-unsupported
-
-Lists the API elements that are known not to be supported by
-F<ppport.h> and below which version of Perl they probably
-won't be available or work.
-
-=head2 --api-info=I<name>
-
-Show portability information for API elements matching I<name>.
-If I<name> is surrounded by slashes, it is interpreted as a regular
-expression.
-
-=head1 DESCRIPTION
-
-In order for a Perl extension (XS) module to be as portable as possible
-across differing versions of Perl itself, certain steps need to be taken.
-
-=over 4
-
-=item *
-
-Including this header is the first major one. This alone will give you
-access to a large part of the Perl API that hasn't been available in
-earlier Perl releases. Use
-
- perl ppport.h --list-provided
-
-to see which API elements are provided by ppport.h.
-
-=item *
-
-You should avoid using deprecated parts of the API. For example, using
-global Perl variables without the C<PL_> prefix is deprecated. Also,
-some API functions used to have a C<perl_> prefix. Using this form is
-also deprecated. You can safely use the supported API, as F<ppport.h>
-will provide wrappers for older Perl versions.
-
-=item *
-
-If you use one of a few functions or variables that were not present in
-earlier versions of Perl, and that can't be provided using a macro, you
-have to explicitly request support for these functions by adding one or
-more C<#define>s in your source code before the inclusion of F<ppport.h>.
-
-These functions or variables will be marked C<explicit> in the list shown
-by C<--list-provided>.
-
-Depending on whether you module has a single or multiple files that
-use such functions or variables, you want either C<static> or global
-variants.
-
-For a C<static> function or variable (used only in a single source
-file), use:
-
- #define NEED_function
- #define NEED_variable
-
-For a global function or variable (used in multiple source files),
-use:
-
- #define NEED_function_GLOBAL
- #define NEED_variable_GLOBAL
-
-Note that you mustn't have more than one global request for the
-same function or variable in your project.
-
- Function / Variable Static Request Global Request
- -----------------------------------------------------------------------------------------
- PL_parser NEED_PL_parser NEED_PL_parser_GLOBAL
- PL_signals NEED_PL_signals NEED_PL_signals_GLOBAL
- caller_cx() NEED_caller_cx NEED_caller_cx_GLOBAL
- eval_pv() NEED_eval_pv NEED_eval_pv_GLOBAL
- grok_bin() NEED_grok_bin NEED_grok_bin_GLOBAL
- grok_hex() NEED_grok_hex NEED_grok_hex_GLOBAL
- grok_number() NEED_grok_number NEED_grok_number_GLOBAL
- grok_numeric_radix() NEED_grok_numeric_radix NEED_grok_numeric_radix_GLOBAL
- grok_oct() NEED_grok_oct NEED_grok_oct_GLOBAL
- load_module() NEED_load_module NEED_load_module_GLOBAL
- mg_findext() NEED_mg_findext NEED_mg_findext_GLOBAL
- my_snprintf() NEED_my_snprintf NEED_my_snprintf_GLOBAL
- my_sprintf() NEED_my_sprintf NEED_my_sprintf_GLOBAL
- my_strlcat() NEED_my_strlcat NEED_my_strlcat_GLOBAL
- my_strlcpy() NEED_my_strlcpy NEED_my_strlcpy_GLOBAL
- newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL
- newRV_noinc() NEED_newRV_noinc NEED_newRV_noinc_GLOBAL
- newSV_type() NEED_newSV_type NEED_newSV_type_GLOBAL
- newSVpvn_flags() NEED_newSVpvn_flags NEED_newSVpvn_flags_GLOBAL
- newSVpvn_share() NEED_newSVpvn_share NEED_newSVpvn_share_GLOBAL
- pv_display() NEED_pv_display NEED_pv_display_GLOBAL
- pv_escape() NEED_pv_escape NEED_pv_escape_GLOBAL
- pv_pretty() NEED_pv_pretty NEED_pv_pretty_GLOBAL
- sv_2pv_flags() NEED_sv_2pv_flags NEED_sv_2pv_flags_GLOBAL
- sv_2pvbyte() NEED_sv_2pvbyte NEED_sv_2pvbyte_GLOBAL
- sv_catpvf_mg() NEED_sv_catpvf_mg NEED_sv_catpvf_mg_GLOBAL
- sv_catpvf_mg_nocontext() NEED_sv_catpvf_mg_nocontext NEED_sv_catpvf_mg_nocontext_GLOBAL
- sv_pvn_force_flags() NEED_sv_pvn_force_flags NEED_sv_pvn_force_flags_GLOBAL
- sv_setpvf_mg() NEED_sv_setpvf_mg NEED_sv_setpvf_mg_GLOBAL
- sv_setpvf_mg_nocontext() NEED_sv_setpvf_mg_nocontext NEED_sv_setpvf_mg_nocontext_GLOBAL
- sv_unmagicext() NEED_sv_unmagicext NEED_sv_unmagicext_GLOBAL
- vload_module() NEED_vload_module NEED_vload_module_GLOBAL
- vnewSVpvf() NEED_vnewSVpvf NEED_vnewSVpvf_GLOBAL
- warner() NEED_warner NEED_warner_GLOBAL
-
-To avoid namespace conflicts, you can change the namespace of the
-explicitly exported functions / variables using the C<DPPP_NAMESPACE>
-macro. Just C<#define> the macro before including C<ppport.h>:
-
- #define DPPP_NAMESPACE MyOwnNamespace_
- #include "ppport.h"
-
-The default namespace is C<DPPP_>.
-
-=back
-
-The good thing is that most of the above can be checked by running
-F<ppport.h> on your source code. See the next section for
-details.
-
-=head1 EXAMPLES
-
-To verify whether F<ppport.h> is needed for your module, whether you
-should make any changes to your code, and whether any special defines
-should be used, F<ppport.h> can be run as a Perl script to check your
-source code. Simply say:
-
- perl ppport.h
-
-The result will usually be a list of patches suggesting changes
-that should at least be acceptable, if not necessarily the most
-efficient solution, or a fix for all possible problems.
-
-If you know that your XS module uses features only available in
-newer Perl releases, if you're aware that it uses C++ comments,
-and if you want all suggestions as a single patch file, you could
-use something like this:
-
- perl ppport.h --compat-version=5.6.0 --cplusplus --patch=test.diff
-
-If you only want your code to be scanned without any suggestions
-for changes, use:
-
- perl ppport.h --nochanges
-
-You can specify a different C<diff> program or options, using
-the C<--diff> option:
-
- perl ppport.h --diff='diff -C 10'
-
-This would output context diffs with 10 lines of context.
-
-If you want to create patched copies of your files instead, use:
-
- perl ppport.h --copy=.new
-
-To display portability information for the C<newSVpvn> function,
-use:
-
- perl ppport.h --api-info=newSVpvn
-
-Since the argument to C<--api-info> can be a regular expression,
-you can use
-
- perl ppport.h --api-info=/_nomg$/
-
-to display portability information for all C<_nomg> functions or
-
- perl ppport.h --api-info=/./
-
-to display information for all known API elements.
-
-=head1 BUGS
-
-If this version of F<ppport.h> is causing failure during
-the compilation of this module, please check if newer versions
-of either this module or C<Devel::PPPort> are available on CPAN
-before sending a bug report.
-
-If F<ppport.h> was generated using the latest version of
-C<Devel::PPPort> and is causing failure of this module, please
-file a bug report here: L<https://github.com/mhx/Devel-PPPort/issues/>
-
-Please include the following information:
-
-=over 4
-
-=item 1.
-
-The complete output from running "perl -V"
-
-=item 2.
-
-This file.
-
-=item 3.
-
-The name and version of the module you were trying to build.
-
-=item 4.
-
-A full log of the build that failed.
-
-=item 5.
-
-Any other information that you think could be relevant.
-
-=back
-
-For the latest version of this code, please get the C<Devel::PPPort>
-module from CPAN.
-
-=head1 COPYRIGHT
-
-Version 3.x, Copyright (c) 2004-2013, Marcus Holland-Moritz.
-
-Version 2.x, Copyright (C) 2001, Paul Marquess.
-
-Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
-
-This program is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself.
-
-=head1 SEE ALSO
-
-See L<Devel::PPPort>.
-
-=cut
-
-use strict;
-
-# Disable broken TRIE-optimization
-BEGIN { eval '${^RE_TRIE_MAXBUF} = -1' if $] >= 5.009004 && $] <= 5.009005 }
-
-my $VERSION = 3.32;
-
-my %opt = (
- quiet => 0,
- diag => 1,
- hints => 1,
- changes => 1,
- cplusplus => 0,
- filter => 1,
- strip => 0,
- version => 0,
-);
-
-my($ppport) = $0 =~ /([\w.]+)$/;
-my $LF = '(?:\r\n|[\r\n])'; # line feed
-my $HS = "[ \t]"; # horizontal whitespace
-
-# Never use C comments in this file!
-my $ccs = '/'.'*';
-my $cce = '*'.'/';
-my $rccs = quotemeta $ccs;
-my $rcce = quotemeta $cce;
-
-eval {
- require Getopt::Long;
- Getopt::Long::GetOptions(\%opt, qw(
- help quiet diag! filter! hints! changes! cplusplus strip version
- patch=s copy=s diff=s compat-version=s
- list-provided list-unsupported api-info=s
- )) or usage();
-};
-
-if ($@ and grep /^-/, @ARGV) {
- usage() if "@ARGV" =~ /^--?h(?:elp)?$/;
- die "Getopt::Long not found. Please don't use any options.\n";
-}
-
-if ($opt{version}) {
- print "This is $0 $VERSION.\n";
- exit 0;
-}
-
-usage() if $opt{help};
-strip() if $opt{strip};
-
-if (exists $opt{'compat-version'}) {
- my($r,$v,$s) = eval { parse_version($opt{'compat-version'}) };
- if ($@) {
- die "Invalid version number format: '$opt{'compat-version'}'\n";
- }
- die "Only Perl 5 is supported\n" if $r != 5;
- die "Invalid version number: $opt{'compat-version'}\n" if $v >= 1000 || $s >= 1000;
- $opt{'compat-version'} = sprintf "%d.%03d%03d", $r, $v, $s;
-}
-else {
- $opt{'compat-version'} = 5;
-}
-
-my %API = map { /^(\w+)\|([^|]*)\|([^|]*)\|(\w*)$/
- ? ( $1 => {
- ($2 ? ( base => $2 ) : ()),
- ($3 ? ( todo => $3 ) : ()),
- (index($4, 'v') >= 0 ? ( varargs => 1 ) : ()),
- (index($4, 'p') >= 0 ? ( provided => 1 ) : ()),
- (index($4, 'n') >= 0 ? ( nothxarg => 1 ) : ()),
- } )
- : die "invalid spec: $_" } qw(
-ASCII_TO_NEED||5.007001|n
-AvFILLp|5.004050||p
-AvFILL|||
-BhkDISABLE||5.021008|
-BhkENABLE||5.021008|
-BhkENTRY_set||5.021008|
-BhkENTRY|||
-BhkFLAGS|||
-CALL_BLOCK_HOOKS|||
-CLASS|||n
-CPERLscope|5.005000||p
-CX_CURPAD_SAVE|||
-CX_CURPAD_SV|||
-CopFILEAV|5.006000||p
-CopFILEGV_set|5.006000||p
-CopFILEGV|5.006000||p
-CopFILESV|5.006000||p
-CopFILE_set|5.006000||p
-CopFILE|5.006000||p
-CopSTASHPV_set|5.006000||p
-CopSTASHPV|5.006000||p
-CopSTASH_eq|5.006000||p
-CopSTASH_set|5.006000||p
-CopSTASH|5.006000||p
-CopyD|5.009002|5.004050|p
-Copy|||
-CvPADLIST||5.008001|
-CvSTASH|||
-CvWEAKOUTSIDE|||
-DEFSV_set|5.010001||p
-DEFSV|5.004050||p
-END_EXTERN_C|5.005000||p
-ENTER|||
-ERRSV|5.004050||p
-EXTEND|||
-EXTERN_C|5.005000||p
-F0convert|||n
-FREETMPS|||
-GIMME_V||5.004000|n
-GIMME|||n
-GROK_NUMERIC_RADIX|5.007002||p
-G_ARRAY|||
-G_DISCARD|||
-G_EVAL|||
-G_METHOD|5.006001||p
-G_NOARGS|||
-G_SCALAR|||
-G_VOID||5.004000|
-GetVars|||
-GvAV|||
-GvCV|||
-GvHV|||
-GvSVn|5.009003||p
-GvSV|||
-Gv_AMupdate||5.011000|
-HEf_SVKEY|5.003070||p
-HeHASH||5.003070|
-HeKEY||5.003070|
-HeKLEN||5.003070|
-HePV||5.004000|
-HeSVKEY_force||5.003070|
-HeSVKEY_set||5.004000|
-HeSVKEY||5.003070|
-HeUTF8|5.010001|5.008000|p
-HeVAL||5.003070|
-HvENAMELEN||5.015004|
-HvENAMEUTF8||5.015004|
-HvENAME||5.013007|
-HvNAMELEN_get|5.009003||p
-HvNAMELEN||5.015004|
-HvNAMEUTF8||5.015004|
-HvNAME_get|5.009003||p
-HvNAME|||
-INT2PTR|5.006000||p
-IN_LOCALE_COMPILETIME|5.007002||p
-IN_LOCALE_RUNTIME|5.007002||p
-IN_LOCALE|5.007002||p
-IN_PERL_COMPILETIME|5.008001||p
-IS_NUMBER_GREATER_THAN_UV_MAX|5.007002||p
-IS_NUMBER_INFINITY|5.007002||p
-IS_NUMBER_IN_UV|5.007002||p
-IS_NUMBER_NAN|5.007003||p
-IS_NUMBER_NEG|5.007002||p
-IS_NUMBER_NOT_INT|5.007002||p
-IVSIZE|5.006000||p
-IVTYPE|5.006000||p
-IVdf|5.006000||p
-LEAVE|||
-LINKLIST||5.013006|
-LVRET|||
-MARK|||
-MULTICALL||5.021008|
-MUTABLE_PTR|5.010001||p
-MUTABLE_SV|5.010001||p
-MY_CXT_CLONE|5.009002||p
-MY_CXT_INIT|5.007003||p
-MY_CXT|5.007003||p
-MoveD|5.009002|5.004050|p
-Move|||
-NATIVE_TO_NEED||5.007001|n
-NOOP|5.005000||p
-NUM2PTR|5.006000||p
-NVTYPE|5.006000||p
-NVef|5.006001||p
-NVff|5.006001||p
-NVgf|5.006001||p
-Newxc|5.009003||p
-Newxz|5.009003||p
-Newx|5.009003||p
-Nullav|||
-Nullch|||
-Nullcv|||
-Nullhv|||
-Nullsv|||
-OP_CLASS||5.013007|
-OP_DESC||5.007003|
-OP_NAME||5.007003|
-OP_TYPE_IS_OR_WAS||5.019010|
-OP_TYPE_IS||5.019007|
-ORIGMARK|||
-OpHAS_SIBLING||5.021007|
-OpSIBLING_set||5.021007|
-OpSIBLING||5.021007|
-PAD_BASE_SV|||
-PAD_CLONE_VARS|||
-PAD_COMPNAME_FLAGS|||
-PAD_COMPNAME_GEN_set|||
-PAD_COMPNAME_GEN|||
-PAD_COMPNAME_OURSTASH|||
-PAD_COMPNAME_PV|||
-PAD_COMPNAME_TYPE|||
-PAD_RESTORE_LOCAL|||
-PAD_SAVE_LOCAL|||
-PAD_SAVE_SETNULLPAD|||
-PAD_SETSV|||
-PAD_SET_CUR_NOSAVE|||
-PAD_SET_CUR|||
-PAD_SVl|||
-PAD_SV|||
-PERLIO_FUNCS_CAST|5.009003||p
-PERLIO_FUNCS_DECL|5.009003||p
-PERL_ABS|5.008001||p
-PERL_BCDVERSION|5.021008||p
-PERL_GCC_BRACE_GROUPS_FORBIDDEN|5.008001||p
-PERL_HASH|5.003070||p
-PERL_INT_MAX|5.003070||p
-PERL_INT_MIN|5.003070||p
-PERL_LONG_MAX|5.003070||p
-PERL_LONG_MIN|5.003070||p
-PERL_MAGIC_arylen|5.007002||p
-PERL_MAGIC_backref|5.007002||p
-PERL_MAGIC_bm|5.007002||p
-PERL_MAGIC_collxfrm|5.007002||p
-PERL_MAGIC_dbfile|5.007002||p
-PERL_MAGIC_dbline|5.007002||p
-PERL_MAGIC_defelem|5.007002||p
-PERL_MAGIC_envelem|5.007002||p
-PERL_MAGIC_env|5.007002||p
-PERL_MAGIC_ext|5.007002||p
-PERL_MAGIC_fm|5.007002||p
-PERL_MAGIC_glob|5.021008||p
-PERL_MAGIC_isaelem|5.007002||p
-PERL_MAGIC_isa|5.007002||p
-PERL_MAGIC_mutex|5.021008||p
-PERL_MAGIC_nkeys|5.007002||p
-PERL_MAGIC_overload_elem|5.021008||p
-PERL_MAGIC_overload_table|5.007002||p
-PERL_MAGIC_overload|5.021008||p
-PERL_MAGIC_pos|5.007002||p
-PERL_MAGIC_qr|5.007002||p
-PERL_MAGIC_regdata|5.007002||p
-PERL_MAGIC_regdatum|5.007002||p
-PERL_MAGIC_regex_global|5.007002||p
-PERL_MAGIC_shared_scalar|5.007003||p
-PERL_MAGIC_shared|5.007003||p
-PERL_MAGIC_sigelem|5.007002||p
-PERL_MAGIC_sig|5.007002||p
-PERL_MAGIC_substr|5.007002||p
-PERL_MAGIC_sv|5.007002||p
-PERL_MAGIC_taint|5.007002||p
-PERL_MAGIC_tiedelem|5.007002||p
-PERL_MAGIC_tiedscalar|5.007002||p
-PERL_MAGIC_tied|5.007002||p
-PERL_MAGIC_utf8|5.008001||p
-PERL_MAGIC_uvar_elem|5.007003||p
-PERL_MAGIC_uvar|5.007002||p
-PERL_MAGIC_vec|5.007002||p
-PERL_MAGIC_vstring|5.008001||p
-PERL_PV_ESCAPE_ALL|5.009004||p
-PERL_PV_ESCAPE_FIRSTCHAR|5.009004||p
-PERL_PV_ESCAPE_NOBACKSLASH|5.009004||p
-PERL_PV_ESCAPE_NOCLEAR|5.009004||p
-PERL_PV_ESCAPE_QUOTE|5.009004||p
-PERL_PV_ESCAPE_RE|5.009005||p
-PERL_PV_ESCAPE_UNI_DETECT|5.009004||p
-PERL_PV_ESCAPE_UNI|5.009004||p
-PERL_PV_PRETTY_DUMP|5.009004||p
-PERL_PV_PRETTY_ELLIPSES|5.010000||p
-PERL_PV_PRETTY_LTGT|5.009004||p
-PERL_PV_PRETTY_NOCLEAR|5.010000||p
-PERL_PV_PRETTY_QUOTE|5.009004||p
-PERL_PV_PRETTY_REGPROP|5.009004||p
-PERL_QUAD_MAX|5.003070||p
-PERL_QUAD_MIN|5.003070||p
-PERL_REVISION|5.006000||p
-PERL_SCAN_ALLOW_UNDERSCORES|5.007003||p
-PERL_SCAN_DISALLOW_PREFIX|5.007003||p
-PERL_SCAN_GREATER_THAN_UV_MAX|5.007003||p
-PERL_SCAN_SILENT_ILLDIGIT|5.008001||p
-PERL_SHORT_MAX|5.003070||p
-PERL_SHORT_MIN|5.003070||p
-PERL_SIGNALS_UNSAFE_FLAG|5.008001||p
-PERL_SUBVERSION|5.006000||p
-PERL_SYS_INIT3||5.006000|
-PERL_SYS_INIT|||
-PERL_SYS_TERM||5.021008|
-PERL_UCHAR_MAX|5.003070||p
-PERL_UCHAR_MIN|5.003070||p
-PERL_UINT_MAX|5.003070||p
-PERL_UINT_MIN|5.003070||p
-PERL_ULONG_MAX|5.003070||p
-PERL_ULONG_MIN|5.003070||p
-PERL_UNUSED_ARG|5.009003||p
-PERL_UNUSED_CONTEXT|5.009004||p
-PERL_UNUSED_DECL|5.007002||p
-PERL_UNUSED_VAR|5.007002||p
-PERL_UQUAD_MAX|5.003070||p
-PERL_UQUAD_MIN|5.003070||p
-PERL_USE_GCC_BRACE_GROUPS|5.009004||p
-PERL_USHORT_MAX|5.003070||p
-PERL_USHORT_MIN|5.003070||p
-PERL_VERSION|5.006000||p
-PL_DBsignal|5.005000||p
-PL_DBsingle|||pn
-PL_DBsub|||pn
-PL_DBtrace|||pn
-PL_Sv|5.005000||p
-PL_bufend|5.021008||p
-PL_bufptr|5.021008||p
-PL_check||5.006000|
-PL_compiling|5.004050||p
-PL_comppad_name||5.017004|
-PL_comppad||5.008001|
-PL_copline|5.021008||p
-PL_curcop|5.004050||p
-PL_curpad||5.005000|
-PL_curstash|5.004050||p
-PL_debstash|5.004050||p
-PL_defgv|5.004050||p
-PL_diehook|5.004050||p
-PL_dirty|5.004050||p
-PL_dowarn|||pn
-PL_errgv|5.004050||p
-PL_error_count|5.021008||p
-PL_expect|5.021008||p
-PL_hexdigit|5.005000||p
-PL_hints|5.005000||p
-PL_in_my_stash|5.021008||p
-PL_in_my|5.021008||p
-PL_keyword_plugin||5.011002|
-PL_last_in_gv|||n
-PL_laststatval|5.005000||p
-PL_lex_state|5.021008||p
-PL_lex_stuff|5.021008||p
-PL_linestr|5.021008||p
-PL_modglobal||5.005000|n
-PL_na|5.004050||pn
-PL_no_modify|5.006000||p
-PL_ofsgv|||n
-PL_opfreehook||5.011000|n
-PL_parser|5.009005||p
-PL_peepp||5.007003|n
-PL_perl_destruct_level|5.004050||p
-PL_perldb|5.004050||p
-PL_ppaddr|5.006000||p
-PL_rpeepp||5.013005|n
-PL_rsfp_filters|5.021008||p
-PL_rsfp|5.021008||p
-PL_rs|||n
-PL_signals|5.008001||p
-PL_stack_base|5.004050||p
-PL_stack_sp|5.004050||p
-PL_statcache|5.005000||p
-PL_stdingv|5.004050||p
-PL_sv_arenaroot|5.004050||p
-PL_sv_no|5.004050||pn
-PL_sv_undef|5.004050||pn
-PL_sv_yes|5.004050||pn
-PL_tainted|5.004050||p
-PL_tainting|5.004050||p
-PL_tokenbuf|5.021008||p
-POP_MULTICALL||5.021008|
-POPi|||n
-POPl|||n
-POPn|||n
-POPpbytex||5.007001|n
-POPpx||5.005030|n
-POPp|||n
-POPs|||n
-PTR2IV|5.006000||p
-PTR2NV|5.006000||p
-PTR2UV|5.006000||p
-PTR2nat|5.009003||p
-PTR2ul|5.007001||p
-PTRV|5.006000||p
-PUSHMARK|||
-PUSH_MULTICALL||5.021008|
-PUSHi|||
-PUSHmortal|5.009002||p
-PUSHn|||
-PUSHp|||
-PUSHs|||
-PUSHu|5.004000||p
-PUTBACK|||
-PadARRAY||5.021008|
-PadMAX||5.021008|
-PadlistARRAY||5.021008|
-PadlistMAX||5.021008|
-PadlistNAMESARRAY||5.021008|
-PadlistNAMESMAX||5.021008|
-PadlistNAMES||5.021008|
-PadlistREFCNT||5.017004|
-PadnameIsOUR|||
-PadnameIsSTATE|||
-PadnameLEN||5.021008|
-PadnameOURSTASH|||
-PadnameOUTER|||
-PadnamePV||5.021008|
-PadnameREFCNT_dec||5.021008|
-PadnameREFCNT||5.021008|
-PadnameSV||5.021008|
-PadnameTYPE|||
-PadnameUTF8||5.021007|
-PadnamelistARRAY||5.021008|
-PadnamelistMAX||5.021008|
-PadnamelistREFCNT_dec||5.021008|
-PadnamelistREFCNT||5.021008|
-PerlIO_clearerr||5.007003|
-PerlIO_close||5.007003|
-PerlIO_context_layers||5.009004|
-PerlIO_eof||5.007003|
-PerlIO_error||5.007003|
-PerlIO_fileno||5.007003|
-PerlIO_fill||5.007003|
-PerlIO_flush||5.007003|
-PerlIO_get_base||5.007003|
-PerlIO_get_bufsiz||5.007003|
-PerlIO_get_cnt||5.007003|
-PerlIO_get_ptr||5.007003|
-PerlIO_read||5.007003|
-PerlIO_restore_errno|||
-PerlIO_save_errno|||
-PerlIO_seek||5.007003|
-PerlIO_set_cnt||5.007003|
-PerlIO_set_ptrcnt||5.007003|
-PerlIO_setlinebuf||5.007003|
-PerlIO_stderr||5.007003|
-PerlIO_stdin||5.007003|
-PerlIO_stdout||5.007003|
-PerlIO_tell||5.007003|
-PerlIO_unread||5.007003|
-PerlIO_write||5.007003|
-Perl_signbit||5.009005|n
-PoisonFree|5.009004||p
-PoisonNew|5.009004||p
-PoisonWith|5.009004||p
-Poison|5.008000||p
-READ_XDIGIT||5.017006|
-RETVAL|||n
-Renewc|||
-Renew|||
-SAVECLEARSV|||
-SAVECOMPPAD|||
-SAVEPADSV|||
-SAVETMPS|||
-SAVE_DEFSV|5.004050||p
-SPAGAIN|||
-SP|||
-START_EXTERN_C|5.005000||p
-START_MY_CXT|5.007003||p
-STMT_END|||p
-STMT_START|||p
-STR_WITH_LEN|5.009003||p
-ST|||
-SV_CONST_RETURN|5.009003||p
-SV_COW_DROP_PV|5.008001||p
-SV_COW_SHARED_HASH_KEYS|5.009005||p
-SV_GMAGIC|5.007002||p
-SV_HAS_TRAILING_NUL|5.009004||p
-SV_IMMEDIATE_UNREF|5.007001||p
-SV_MUTABLE_RETURN|5.009003||p
-SV_NOSTEAL|5.009002||p
-SV_SMAGIC|5.009003||p
-SV_UTF8_NO_ENCODING|5.008001||p
-SVfARG|5.009005||p
-SVf_UTF8|5.006000||p
-SVf|5.006000||p
-SVt_INVLIST||5.019002|
-SVt_IV|||
-SVt_NULL|||
-SVt_NV|||
-SVt_PVAV|||
-SVt_PVCV|||
-SVt_PVFM|||
-SVt_PVGV|||
-SVt_PVHV|||
-SVt_PVIO|||
-SVt_PVIV|||
-SVt_PVLV|||
-SVt_PVMG|||
-SVt_PVNV|||
-SVt_PV|||
-SVt_REGEXP||5.011000|
-Safefree|||
-Slab_Alloc|||
-Slab_Free|||
-Slab_to_ro|||
-Slab_to_rw|||
-StructCopy|||
-SvCUR_set|||
-SvCUR|||
-SvEND|||
-SvGAMAGIC||5.006001|
-SvGETMAGIC|5.004050||p
-SvGROW|||
-SvIOK_UV||5.006000|
-SvIOK_notUV||5.006000|
-SvIOK_off|||
-SvIOK_only_UV||5.006000|
-SvIOK_only|||
-SvIOK_on|||
-SvIOKp|||
-SvIOK|||
-SvIVX|||
-SvIV_nomg|5.009001||p
-SvIV_set|||
-SvIVx|||
-SvIV|||
-SvIsCOW_shared_hash||5.008003|
-SvIsCOW||5.008003|
-SvLEN_set|||
-SvLEN|||
-SvLOCK||5.007003|
-SvMAGIC_set|5.009003||p
-SvNIOK_off|||
-SvNIOKp|||
-SvNIOK|||
-SvNOK_off|||
-SvNOK_only|||
-SvNOK_on|||
-SvNOKp|||
-SvNOK|||
-SvNVX|||
-SvNV_nomg||5.013002|
-SvNV_set|||
-SvNVx|||
-SvNV|||
-SvOK|||
-SvOOK_offset||5.011000|
-SvOOK|||
-SvPOK_off|||
-SvPOK_only_UTF8||5.006000|
-SvPOK_only|||
-SvPOK_on|||
-SvPOKp|||
-SvPOK|||
-SvPVX_const|5.009003||p
-SvPVX_mutable|5.009003||p
-SvPVX|||
-SvPV_const|5.009003||p
-SvPV_flags_const_nolen|5.009003||p
-SvPV_flags_const|5.009003||p
-SvPV_flags_mutable|5.009003||p
-SvPV_flags|5.007002||p
-SvPV_force_flags_mutable|5.009003||p
-SvPV_force_flags_nolen|5.009003||p
-SvPV_force_flags|5.007002||p
-SvPV_force_mutable|5.009003||p
-SvPV_force_nolen|5.009003||p
-SvPV_force_nomg_nolen|5.009003||p
-SvPV_force_nomg|5.007002||p
-SvPV_force|||p
-SvPV_mutable|5.009003||p
-SvPV_nolen_const|5.009003||p
-SvPV_nolen|5.006000||p
-SvPV_nomg_const_nolen|5.009003||p
-SvPV_nomg_const|5.009003||p
-SvPV_nomg_nolen|5.013007||p
-SvPV_nomg|5.007002||p
-SvPV_renew|5.009003||p
-SvPV_set|||
-SvPVbyte_force||5.009002|
-SvPVbyte_nolen||5.006000|
-SvPVbytex_force||5.006000|
-SvPVbytex||5.006000|
-SvPVbyte|5.006000||p
-SvPVutf8_force||5.006000|
-SvPVutf8_nolen||5.006000|
-SvPVutf8x_force||5.006000|
-SvPVutf8x||5.006000|
-SvPVutf8||5.006000|
-SvPVx|||
-SvPV|||
-SvREFCNT_dec_NN||5.017007|
-SvREFCNT_dec|||
-SvREFCNT_inc_NN|5.009004||p
-SvREFCNT_inc_simple_NN|5.009004||p
-SvREFCNT_inc_simple_void_NN|5.009004||p
-SvREFCNT_inc_simple_void|5.009004||p
-SvREFCNT_inc_simple|5.009004||p
-SvREFCNT_inc_void_NN|5.009004||p
-SvREFCNT_inc_void|5.009004||p
-SvREFCNT_inc|||p
-SvREFCNT|||
-SvROK_off|||
-SvROK_on|||
-SvROK|||
-SvRV_set|5.009003||p
-SvRV|||
-SvRXOK||5.009005|
-SvRX||5.009005|
-SvSETMAGIC|||
-SvSHARED_HASH|5.009003||p
-SvSHARE||5.007003|
-SvSTASH_set|5.009003||p
-SvSTASH|||
-SvSetMagicSV_nosteal||5.004000|
-SvSetMagicSV||5.004000|
-SvSetSV_nosteal||5.004000|
-SvSetSV|||
-SvTAINTED_off||5.004000|
-SvTAINTED_on||5.004000|
-SvTAINTED||5.004000|
-SvTAINT|||
-SvTHINKFIRST|||
-SvTRUE_nomg||5.013006|
-SvTRUE|||
-SvTYPE|||
-SvUNLOCK||5.007003|
-SvUOK|5.007001|5.006000|p
-SvUPGRADE|||
-SvUTF8_off||5.006000|
-SvUTF8_on||5.006000|
-SvUTF8||5.006000|
-SvUVXx|5.004000||p
-SvUVX|5.004000||p
-SvUV_nomg|5.009001||p
-SvUV_set|5.009003||p
-SvUVx|5.004000||p
-SvUV|5.004000||p
-SvVOK||5.008001|
-SvVSTRING_mg|5.009004||p
-THIS|||n
-UNDERBAR|5.009002||p
-UTF8_MAXBYTES|5.009002||p
-UVSIZE|5.006000||p
-UVTYPE|5.006000||p
-UVXf|5.007001||p
-UVof|5.006000||p
-UVuf|5.006000||p
-UVxf|5.006000||p
-WARN_ALL|5.006000||p
-WARN_AMBIGUOUS|5.006000||p
-WARN_ASSERTIONS|5.021008||p
-WARN_BAREWORD|5.006000||p
-WARN_CLOSED|5.006000||p
-WARN_CLOSURE|5.006000||p
-WARN_DEBUGGING|5.006000||p
-WARN_DEPRECATED|5.006000||p
-WARN_DIGIT|5.006000||p
-WARN_EXEC|5.006000||p
-WARN_EXITING|5.006000||p
-WARN_GLOB|5.006000||p
-WARN_INPLACE|5.006000||p
-WARN_INTERNAL|5.006000||p
-WARN_IO|5.006000||p
-WARN_LAYER|5.008000||p
-WARN_MALLOC|5.006000||p
-WARN_MISC|5.006000||p
-WARN_NEWLINE|5.006000||p
-WARN_NUMERIC|5.006000||p
-WARN_ONCE|5.006000||p
-WARN_OVERFLOW|5.006000||p
-WARN_PACK|5.006000||p
-WARN_PARENTHESIS|5.006000||p
-WARN_PIPE|5.006000||p
-WARN_PORTABLE|5.006000||p
-WARN_PRECEDENCE|5.006000||p
-WARN_PRINTF|5.006000||p
-WARN_PROTOTYPE|5.006000||p
-WARN_QW|5.006000||p
-WARN_RECURSION|5.006000||p
-WARN_REDEFINE|5.006000||p
-WARN_REGEXP|5.006000||p
-WARN_RESERVED|5.006000||p
-WARN_SEMICOLON|5.006000||p
-WARN_SEVERE|5.006000||p
-WARN_SIGNAL|5.006000||p
-WARN_SUBSTR|5.006000||p
-WARN_SYNTAX|5.006000||p
-WARN_TAINT|5.006000||p
-WARN_THREADS|5.008000||p
-WARN_UNINITIALIZED|5.006000||p
-WARN_UNOPENED|5.006000||p
-WARN_UNPACK|5.006000||p
-WARN_UNTIE|5.006000||p
-WARN_UTF8|5.006000||p
-WARN_VOID|5.006000||p
-WIDEST_UTYPE|5.015004||p
-XCPT_CATCH|5.009002||p
-XCPT_RETHROW|5.009002||p
-XCPT_TRY_END|5.009002||p
-XCPT_TRY_START|5.009002||p
-XPUSHi|||
-XPUSHmortal|5.009002||p
-XPUSHn|||
-XPUSHp|||
-XPUSHs|||
-XPUSHu|5.004000||p
-XSPROTO|5.010000||p
-XSRETURN_EMPTY|||
-XSRETURN_IV|||
-XSRETURN_NO|||
-XSRETURN_NV|||
-XSRETURN_PV|||
-XSRETURN_UNDEF|||
-XSRETURN_UV|5.008001||p
-XSRETURN_YES|||
-XSRETURN|||p
-XST_mIV|||
-XST_mNO|||
-XST_mNV|||
-XST_mPV|||
-XST_mUNDEF|||
-XST_mUV|5.008001||p
-XST_mYES|||
-XS_APIVERSION_BOOTCHECK||5.021008|
-XS_EXTERNAL||5.021008|
-XS_INTERNAL||5.021008|
-XS_VERSION_BOOTCHECK||5.021008|
-XS_VERSION|||
-XSprePUSH|5.006000||p
-XS|||
-XopDISABLE||5.021008|
-XopENABLE||5.021008|
-XopENTRYCUSTOM||5.021008|
-XopENTRY_set||5.021008|
-XopENTRY||5.021008|
-XopFLAGS||5.013007|
-ZeroD|5.009002||p
-Zero|||
-_aMY_CXT|5.007003||p
-_add_range_to_invlist|||
-_append_range_to_invlist|||
-_core_swash_init|||
-_get_encoding|||
-_get_regclass_nonbitmap_data|||
-_get_swash_invlist|||
-_invlist_array_init|||n
-_invlist_contains_cp|||n
-_invlist_contents|||
-_invlist_dump|||
-_invlist_intersection_maybe_complement_2nd|||
-_invlist_intersection|||
-_invlist_invert|||
-_invlist_len|||n
-_invlist_populate_swatch|||n
-_invlist_search|||n
-_invlist_subtract|||
-_invlist_union_maybe_complement_2nd|||
-_invlist_union|||
-_is_cur_LC_category_utf8|||
-_is_in_locale_category||5.021001|
-_is_uni_FOO||5.017008|
-_is_uni_perl_idcont||5.017008|
-_is_uni_perl_idstart||5.017007|
-_is_utf8_FOO||5.017008|
-_is_utf8_char_slow||5.021001|n
-_is_utf8_idcont||5.021001|
-_is_utf8_idstart||5.021001|
-_is_utf8_mark||5.017008|
-_is_utf8_perl_idcont||5.017008|
-_is_utf8_perl_idstart||5.017007|
-_is_utf8_xidcont||5.021001|
-_is_utf8_xidstart||5.021001|
-_load_PL_utf8_foldclosures|||
-_make_exactf_invlist|||
-_new_invlist_C_array|||
-_new_invlist|||
-_pMY_CXT|5.007003||p
-_setup_canned_invlist|||
-_swash_inversion_hash|||
-_swash_to_invlist|||
-_to_fold_latin1|||
-_to_uni_fold_flags||5.014000|
-_to_upper_title_latin1|||
-_to_utf8_fold_flags||5.019009|
-_to_utf8_lower_flags||5.019009|
-_to_utf8_title_flags||5.019009|
-_to_utf8_upper_flags||5.019009|
-_warn_problematic_locale|||n
-aMY_CXT_|5.007003||p
-aMY_CXT|5.007003||p
-aTHXR_|5.021008||p
-aTHXR|5.021008||p
-aTHX_|5.006000||p
-aTHX|5.006000||p
-aassign_common_vars|||
-add_above_Latin1_folds|||
-add_cp_to_invlist|||
-add_data|||n
-add_multi_match|||
-add_utf16_textfilter|||
-adjust_size_and_find_bucket|||n
-advance_one_SB|||
-advance_one_WB|||
-alloc_maybe_populate_EXACT|||
-alloccopstash|||
-allocmy|||
-amagic_call|||
-amagic_cmp_locale|||
-amagic_cmp|||
-amagic_deref_call||5.013007|
-amagic_i_ncmp|||
-amagic_is_enabled|||
-amagic_ncmp|||
-anonymise_cv_maybe|||
-any_dup|||
-ao|||
-append_utf8_from_native_byte||5.019004|n
-apply_attrs_my|||
-apply_attrs_string||5.006001|
-apply_attrs|||
-apply|||
-assert_uft8_cache_coherent|||
-assignment_type|||
-atfork_lock||5.007003|n
-atfork_unlock||5.007003|n
-av_arylen_p||5.009003|
-av_clear|||
-av_create_and_push||5.009005|
-av_create_and_unshift_one||5.009005|
-av_delete||5.006000|
-av_exists||5.006000|
-av_extend_guts|||
-av_extend|||
-av_fetch|||
-av_fill|||
-av_iter_p||5.011000|
-av_len|||
-av_make|||
-av_pop|||
-av_push|||
-av_reify|||
-av_shift|||
-av_store|||
-av_tindex||5.017009|
-av_top_index||5.017009|
-av_undef|||
-av_unshift|||
-ax|||n
-backup_one_SB|||
-backup_one_WB|||
-bad_type_gv|||
-bad_type_pv|||
-bind_match|||
-block_end||5.004000|
-block_gimme||5.004000|
-block_start||5.004000|
-blockhook_register||5.013003|
-boolSV|5.004000||p
-boot_core_PerlIO|||
-boot_core_UNIVERSAL|||
-boot_core_mro|||
-bytes_cmp_utf8||5.013007|
-bytes_from_utf8||5.007001|
-bytes_to_utf8||5.006001|
-call_argv|5.006000||p
-call_atexit||5.006000|
-call_list||5.004000|
-call_method|5.006000||p
-call_pv|5.006000||p
-call_sv|5.006000||p
-caller_cx|5.013005|5.006000|p
-calloc||5.007002|n
-cando|||
-cast_i32||5.006000|n
-cast_iv||5.006000|n
-cast_ulong||5.006000|n
-cast_uv||5.006000|n
-check_locale_boundary_crossing|||
-check_type_and_open|||
-check_uni|||
-check_utf8_print|||
-checkcomma|||
-ckWARN|5.006000||p
-ck_entersub_args_core|||
-ck_entersub_args_list||5.013006|
-ck_entersub_args_proto_or_list||5.013006|
-ck_entersub_args_proto||5.013006|
-ck_warner_d||5.011001|v
-ck_warner||5.011001|v
-ckwarn_common|||
-ckwarn_d||5.009003|
-ckwarn||5.009003|
-clear_placeholders|||
-clear_special_blocks|||
-clone_params_del|||n
-clone_params_new|||n
-closest_cop|||
-cntrl_to_mnemonic|||n
-compute_EXACTish|||n
-construct_ahocorasick_from_trie|||
-cop_fetch_label||5.015001|
-cop_free|||
-cop_hints_2hv||5.013007|
-cop_hints_fetch_pvn||5.013007|
-cop_hints_fetch_pvs||5.013007|
-cop_hints_fetch_pv||5.013007|
-cop_hints_fetch_sv||5.013007|
-cop_store_label||5.015001|
-cophh_2hv||5.013007|
-cophh_copy||5.013007|
-cophh_delete_pvn||5.013007|
-cophh_delete_pvs||5.013007|
-cophh_delete_pv||5.013007|
-cophh_delete_sv||5.013007|
-cophh_fetch_pvn||5.013007|
-cophh_fetch_pvs||5.013007|
-cophh_fetch_pv||5.013007|
-cophh_fetch_sv||5.013007|
-cophh_free||5.013007|
-cophh_new_empty||5.021008|
-cophh_store_pvn||5.013007|
-cophh_store_pvs||5.013007|
-cophh_store_pv||5.013007|
-cophh_store_sv||5.013007|
-core_prototype|||
-coresub_op|||
-could_it_be_a_POSIX_class|||n
-cr_textfilter|||
-create_eval_scope|||
-croak_memory_wrap||5.019003|n
-croak_no_mem|||n
-croak_no_modify||5.013003|n
-croak_nocontext|||vn
-croak_popstack|||n
-croak_sv||5.013001|
-croak_xs_usage||5.010001|n
-croak|||v
-csighandler||5.009003|n
-current_re_engine|||
-curse|||
-custom_op_desc||5.007003|
-custom_op_get_field|||
-custom_op_name||5.007003|
-custom_op_register||5.013007|
-custom_op_xop||5.013007|
-cv_ckproto_len_flags|||
-cv_clone_into|||
-cv_clone|||
-cv_const_sv_or_av|||n
-cv_const_sv||5.003070|n
-cv_dump|||
-cv_forget_slab|||
-cv_get_call_checker||5.013006|
-cv_name||5.021005|
-cv_set_call_checker_flags||5.021004|
-cv_set_call_checker||5.013006|
-cv_undef_flags|||
-cv_undef|||
-cvgv_from_hek|||
-cvgv_set|||
-cvstash_set|||
-cx_dump||5.005000|
-cx_dup|||
-cxinc|||
-dAXMARK|5.009003||p
-dAX|5.007002||p
-dITEMS|5.007002||p
-dMARK|||
-dMULTICALL||5.009003|
-dMY_CXT_SV|5.007003||p
-dMY_CXT|5.007003||p
-dNOOP|5.006000||p
-dORIGMARK|||
-dSP|||
-dTHR|5.004050||p
-dTHXR|5.021008||p
-dTHXa|5.006000||p
-dTHXoa|5.006000||p
-dTHX|5.006000||p
-dUNDERBAR|5.009002||p
-dVAR|5.009003||p
-dXCPT|5.009002||p
-dXSARGS|||
-dXSI32|||
-dXSTARG|5.006000||p
-deb_curcv|||
-deb_nocontext|||vn
-deb_stack_all|||
-deb_stack_n|||
-debop||5.005000|
-debprofdump||5.005000|
-debprof|||
-debstackptrs||5.007003|
-debstack||5.007003|
-debug_start_match|||
-deb||5.007003|v
-defelem_target|||
-del_sv|||
-delete_eval_scope|||
-delimcpy||5.004000|n
-deprecate_commaless_var_list|||
-despatch_signals||5.007001|
-destroy_matcher|||
-die_nocontext|||vn
-die_sv||5.013001|
-die_unwind|||
-die|||v
-dirp_dup|||
-div128|||
-djSP|||
-do_aexec5|||
-do_aexec|||
-do_aspawn|||
-do_binmode||5.004050|
-do_chomp|||
-do_close|||
-do_delete_local|||
-do_dump_pad|||
-do_eof|||
-do_exec3|||
-do_execfree|||
-do_exec|||
-do_gv_dump||5.006000|
-do_gvgv_dump||5.006000|
-do_hv_dump||5.006000|
-do_ipcctl|||
-do_ipcget|||
-do_join|||
-do_magic_dump||5.006000|
-do_msgrcv|||
-do_msgsnd|||
-do_ncmp|||
-do_oddball|||
-do_op_dump||5.006000|
-do_open6|||
-do_open9||5.006000|
-do_open_raw|||
-do_openn||5.007001|
-do_open||5.003070|
-do_pmop_dump||5.006000|
-do_print|||
-do_readline|||
-do_seek|||
-do_semop|||
-do_shmio|||
-do_smartmatch|||
-do_spawn_nowait|||
-do_spawn|||
-do_sprintf|||
-do_sv_dump||5.006000|
-do_sysseek|||
-do_tell|||
-do_trans_complex_utf8|||
-do_trans_complex|||
-do_trans_count_utf8|||
-do_trans_count|||
-do_trans_simple_utf8|||
-do_trans_simple|||
-do_trans|||
-do_vecget|||
-do_vecset|||
-do_vop|||
-docatch|||
-doeval|||
-dofile|||
-dofindlabel|||
-doform|||
-doing_taint||5.008001|n
-dooneliner|||
-doopen_pm|||
-doparseform|||
-dopoptoeval|||
-dopoptogiven|||
-dopoptolabel|||
-dopoptoloop|||
-dopoptosub_at|||
-dopoptowhen|||
-doref||5.009003|
-dounwind|||
-dowantarray|||
-drand48_init_r|||n
-drand48_r|||n
-dump_all_perl|||
-dump_all||5.006000|
-dump_c_backtrace|||
-dump_eval||5.006000|
-dump_exec_pos|||
-dump_form||5.006000|
-dump_indent||5.006000|v
-dump_mstats|||
-dump_packsubs_perl|||
-dump_packsubs||5.006000|
-dump_sub_perl|||
-dump_sub||5.006000|
-dump_sv_child|||
-dump_trie_interim_list|||
-dump_trie_interim_table|||
-dump_trie|||
-dump_vindent||5.006000|
-dumpuntil|||
-dup_attrlist|||
-emulate_cop_io|||
-eval_pv|5.006000||p
-eval_sv|5.006000||p
-exec_failed|||
-expect_number|||
-fbm_compile||5.005000|
-fbm_instr||5.005000|
-feature_is_enabled|||
-filter_add|||
-filter_del|||
-filter_gets|||
-filter_read|||
-finalize_optree|||
-finalize_op|||
-find_and_forget_pmops|||
-find_array_subscript|||
-find_beginning|||
-find_byclass|||
-find_default_stash|||
-find_hash_subscript|||
-find_in_my_stash|||
-find_lexical_cv|||
-find_runcv_where|||
-find_runcv||5.008001|
-find_rundefsv2|||
-find_rundefsvoffset||5.009002|
-find_rundefsv||5.013002|
-find_script|||
-find_uninit_var|||
-first_symbol|||n
-fixup_errno_string|||
-foldEQ_latin1||5.013008|n
-foldEQ_locale||5.013002|n
-foldEQ_utf8_flags||5.013010|
-foldEQ_utf8||5.013002|
-foldEQ||5.013002|n
-fold_constants|||
-forbid_setid|||
-force_ident_maybe_lex|||
-force_ident|||
-force_list|||
-force_next|||
-force_strict_version|||
-force_version|||
-force_word|||
-forget_pmop|||
-form_nocontext|||vn
-form_short_octal_warning|||
-form||5.004000|v
-fp_dup|||
-fprintf_nocontext|||vn
-free_c_backtrace|||
-free_global_struct|||
-free_tied_hv_pool|||
-free_tmps|||
-gen_constant_list|||
-get_ANYOF_cp_list_for_ssc|||
-get_and_check_backslash_N_name|||
-get_aux_mg|||
-get_av|5.006000||p
-get_c_backtrace_dump|||
-get_c_backtrace|||
-get_context||5.006000|n
-get_cvn_flags|5.009005||p
-get_cvs|5.011000||p
-get_cv|5.006000||p
-get_db_sub|||
-get_debug_opts|||
-get_hash_seed|||
-get_hv|5.006000||p
-get_invlist_iter_addr|||n
-get_invlist_offset_addr|||n
-get_invlist_previous_index_addr|||n
-get_mstats|||
-get_no_modify|||
-get_num|||
-get_op_descs||5.005000|
-get_op_names||5.005000|
-get_opargs|||
-get_ppaddr||5.006000|
-get_re_arg|||
-get_sv|5.006000||p
-get_vtbl||5.005030|
-getcwd_sv||5.007002|
-getenv_len|||
-glob_2number|||
-glob_assign_glob|||
-gp_dup|||
-gp_free|||
-gp_ref|||
-grok_atoUV|||n
-grok_bin|5.007003||p
-grok_bslash_N|||
-grok_bslash_c|||
-grok_bslash_o|||
-grok_bslash_x|||
-grok_hex|5.007003||p
-grok_infnan||5.021004|
-grok_number_flags||5.021002|
-grok_number|5.007002||p
-grok_numeric_radix|5.007002||p
-grok_oct|5.007003||p
-group_end|||
-gv_AVadd|||
-gv_HVadd|||
-gv_IOadd|||
-gv_SVadd|||
-gv_add_by_type||5.011000|
-gv_autoload4||5.004000|
-gv_autoload_pvn||5.015004|
-gv_autoload_pv||5.015004|
-gv_autoload_sv||5.015004|
-gv_check|||
-gv_const_sv||5.009003|
-gv_dump||5.006000|
-gv_efullname3||5.003070|
-gv_efullname4||5.006001|
-gv_efullname|||
-gv_fetchfile_flags||5.009005|
-gv_fetchfile|||
-gv_fetchmeth_autoload||5.007003|
-gv_fetchmeth_internal|||
-gv_fetchmeth_pv_autoload||5.015004|
-gv_fetchmeth_pvn_autoload||5.015004|
-gv_fetchmeth_pvn||5.015004|
-gv_fetchmeth_pv||5.015004|
-gv_fetchmeth_sv_autoload||5.015004|
-gv_fetchmeth_sv||5.015004|
-gv_fetchmethod_autoload||5.004000|
-gv_fetchmethod_pv_flags||5.015004|
-gv_fetchmethod_pvn_flags||5.015004|
-gv_fetchmethod_sv_flags||5.015004|
-gv_fetchmethod|||
-gv_fetchmeth|||
-gv_fetchpvn_flags|5.009002||p
-gv_fetchpvs|5.009004||p
-gv_fetchpv|||
-gv_fetchsv|5.009002||p
-gv_fullname3||5.003070|
-gv_fullname4||5.006001|
-gv_fullname|||
-gv_handler||5.007001|
-gv_init_pvn||5.015004|
-gv_init_pv||5.015004|
-gv_init_svtype|||
-gv_init_sv||5.015004|
-gv_init|||
-gv_is_in_main|||
-gv_magicalize_isa|||
-gv_magicalize|||
-gv_name_set||5.009004|
-gv_override|||
-gv_setref|||
-gv_stashpvn_internal|||
-gv_stashpvn|5.003070||p
-gv_stashpvs|5.009003||p
-gv_stashpv|||
-gv_stashsvpvn_cached|||
-gv_stashsv|||
-gv_try_downgrade|||
-handle_regex_sets|||
-he_dup|||
-hek_dup|||
-hfree_next_entry|||
-hfreeentries|||
-hsplit|||
-hv_assert|||
-hv_auxinit_internal|||n
-hv_auxinit|||
-hv_backreferences_p|||
-hv_clear_placeholders||5.009001|
-hv_clear|||
-hv_common_key_len||5.010000|
-hv_common||5.010000|
-hv_copy_hints_hv||5.009004|
-hv_delayfree_ent||5.004000|
-hv_delete_common|||
-hv_delete_ent||5.003070|
-hv_delete|||
-hv_eiter_p||5.009003|
-hv_eiter_set||5.009003|
-hv_ename_add|||
-hv_ename_delete|||
-hv_exists_ent||5.003070|
-hv_exists|||
-hv_fetch_ent||5.003070|
-hv_fetchs|5.009003||p
-hv_fetch|||
-hv_fill||5.013002|
-hv_free_ent_ret|||
-hv_free_ent||5.004000|
-hv_iterinit|||
-hv_iterkeysv||5.003070|
-hv_iterkey|||
-hv_iternext_flags||5.008000|
-hv_iternextsv|||
-hv_iternext|||
-hv_iterval|||
-hv_kill_backrefs|||
-hv_ksplit||5.003070|
-hv_magic_check|||n
-hv_magic|||
-hv_name_set||5.009003|
-hv_notallowed|||
-hv_placeholders_get||5.009003|
-hv_placeholders_p|||
-hv_placeholders_set||5.009003|
-hv_rand_set||5.018000|
-hv_riter_p||5.009003|
-hv_riter_set||5.009003|
-hv_scalar||5.009001|
-hv_store_ent||5.003070|
-hv_store_flags||5.008000|
-hv_stores|5.009004||p
-hv_store|||
-hv_undef_flags|||
-hv_undef|||
-ibcmp_locale||5.004000|
-ibcmp_utf8||5.007003|
-ibcmp|||
-incline|||
-incpush_if_exists|||
-incpush_use_sep|||
-incpush|||
-ingroup|||
-init_argv_symbols|||
-init_constants|||
-init_dbargs|||
-init_debugger|||
-init_global_struct|||
-init_i18nl10n||5.006000|
-init_i18nl14n||5.006000|
-init_ids|||
-init_interp|||
-init_main_stash|||
-init_perllib|||
-init_postdump_symbols|||
-init_predump_symbols|||
-init_stacks||5.005000|
-init_tm||5.007002|
-inplace_aassign|||
-instr|||n
-intro_my||5.004000|
-intuit_method|||
-intuit_more|||
-invert|||
-invlist_array|||n
-invlist_clone|||
-invlist_extend|||
-invlist_highest|||n
-invlist_is_iterating|||n
-invlist_iterfinish|||n
-invlist_iterinit|||n
-invlist_iternext|||n
-invlist_max|||n
-invlist_previous_index|||n
-invlist_set_len|||
-invlist_set_previous_index|||n
-invlist_trim|||n
-invoke_exception_hook|||
-io_close|||
-isALNUMC|5.006000||p
-isALNUM_lazy||5.021001|
-isALPHANUMERIC||5.017008|
-isALPHA|||
-isASCII|5.006000||p
-isBLANK|5.006001||p
-isCNTRL|5.006000||p
-isDIGIT|||
-isFOO_lc|||
-isFOO_utf8_lc|||
-isGCB|||n
-isGRAPH|5.006000||p
-isGV_with_GP|5.009004||p
-isIDCONT||5.017008|
-isIDFIRST_lazy||5.021001|
-isIDFIRST|||
-isLOWER|||
-isOCTAL||5.013005|
-isPRINT|5.004000||p
-isPSXSPC|5.006001||p
-isPUNCT|5.006000||p
-isSB|||
-isSPACE|||
-isUPPER|||
-isUTF8_CHAR||5.021001|
-isWB|||
-isWORDCHAR||5.013006|
-isXDIGIT|5.006000||p
-is_an_int|||
-is_ascii_string||5.011000|
-is_handle_constructor|||n
-is_invariant_string||5.021007|n
-is_lvalue_sub||5.007001|
-is_safe_syscall||5.019004|
-is_ssc_worth_it|||n
-is_uni_alnum_lc||5.006000|
-is_uni_alnumc_lc||5.017007|
-is_uni_alnumc||5.017007|
-is_uni_alnum||5.006000|
-is_uni_alpha_lc||5.006000|
-is_uni_alpha||5.006000|
-is_uni_ascii_lc||5.006000|
-is_uni_ascii||5.006000|
-is_uni_blank_lc||5.017002|
-is_uni_blank||5.017002|
-is_uni_cntrl_lc||5.006000|
-is_uni_cntrl||5.006000|
-is_uni_digit_lc||5.006000|
-is_uni_digit||5.006000|
-is_uni_graph_lc||5.006000|
-is_uni_graph||5.006000|
-is_uni_idfirst_lc||5.006000|
-is_uni_idfirst||5.006000|
-is_uni_lower_lc||5.006000|
-is_uni_lower||5.006000|
-is_uni_print_lc||5.006000|
-is_uni_print||5.006000|
-is_uni_punct_lc||5.006000|
-is_uni_punct||5.006000|
-is_uni_space_lc||5.006000|
-is_uni_space||5.006000|
-is_uni_upper_lc||5.006000|
-is_uni_upper||5.006000|
-is_uni_xdigit_lc||5.006000|
-is_uni_xdigit||5.006000|
-is_utf8_alnumc||5.017007|
-is_utf8_alnum||5.006000|
-is_utf8_alpha||5.006000|
-is_utf8_ascii||5.006000|
-is_utf8_blank||5.017002|
-is_utf8_char_buf||5.015008|n
-is_utf8_char||5.006000|n
-is_utf8_cntrl||5.006000|
-is_utf8_common|||
-is_utf8_digit||5.006000|
-is_utf8_graph||5.006000|
-is_utf8_idcont||5.008000|
-is_utf8_idfirst||5.006000|
-is_utf8_lower||5.006000|
-is_utf8_mark||5.006000|
-is_utf8_perl_space||5.011001|
-is_utf8_perl_word||5.011001|
-is_utf8_posix_digit||5.011001|
-is_utf8_print||5.006000|
-is_utf8_punct||5.006000|
-is_utf8_space||5.006000|
-is_utf8_string_loclen||5.009003|n
-is_utf8_string_loc||5.008001|n
-is_utf8_string||5.006001|n
-is_utf8_upper||5.006000|
-is_utf8_xdigit||5.006000|
-is_utf8_xidcont||5.013010|
-is_utf8_xidfirst||5.013010|
-isa_lookup|||
-isinfnansv|||
-isinfnan||5.021004|n
-items|||n
-ix|||n
-jmaybe|||
-join_exact|||
-keyword_plugin_standard|||
-keyword|||
-leave_common|||
-leave_scope|||
-lex_bufutf8||5.011002|
-lex_discard_to||5.011002|
-lex_grow_linestr||5.011002|
-lex_next_chunk||5.011002|
-lex_peek_unichar||5.011002|
-lex_read_space||5.011002|
-lex_read_to||5.011002|
-lex_read_unichar||5.011002|
-lex_start||5.009005|
-lex_stuff_pvn||5.011002|
-lex_stuff_pvs||5.013005|
-lex_stuff_pv||5.013006|
-lex_stuff_sv||5.011002|
-lex_unstuff||5.011002|
-listkids|||
-list|||
-load_module_nocontext|||vn
-load_module|5.006000||pv
-localize|||
-looks_like_bool|||
-looks_like_number|||
-lop|||
-mPUSHi|5.009002||p
-mPUSHn|5.009002||p
-mPUSHp|5.009002||p
-mPUSHs|5.010001||p
-mPUSHu|5.009002||p
-mXPUSHi|5.009002||p
-mXPUSHn|5.009002||p
-mXPUSHp|5.009002||p
-mXPUSHs|5.010001||p
-mXPUSHu|5.009002||p
-magic_clear_all_env|||
-magic_cleararylen_p|||
-magic_clearenv|||
-magic_clearhints|||
-magic_clearhint|||
-magic_clearisa|||
-magic_clearpack|||
-magic_clearsig|||
-magic_copycallchecker|||
-magic_dump||5.006000|
-magic_existspack|||
-magic_freearylen_p|||
-magic_freeovrld|||
-magic_getarylen|||
-magic_getdebugvar|||
-magic_getdefelem|||
-magic_getnkeys|||
-magic_getpack|||
-magic_getpos|||
-magic_getsig|||
-magic_getsubstr|||
-magic_gettaint|||
-magic_getuvar|||
-magic_getvec|||
-magic_get|||
-magic_killbackrefs|||
-magic_methcall1|||
-magic_methcall|||v
-magic_methpack|||
-magic_nextpack|||
-magic_regdata_cnt|||
-magic_regdatum_get|||
-magic_regdatum_set|||
-magic_scalarpack|||
-magic_set_all_env|||
-magic_setarylen|||
-magic_setcollxfrm|||
-magic_setdbline|||
-magic_setdebugvar|||
-magic_setdefelem|||
-magic_setenv|||
-magic_sethint|||
-magic_setisa|||
-magic_setlvref|||
-magic_setmglob|||
-magic_setnkeys|||
-magic_setpack|||
-magic_setpos|||
-magic_setregexp|||
-magic_setsig|||
-magic_setsubstr|||
-magic_settaint|||
-magic_setutf8|||
-magic_setuvar|||
-magic_setvec|||
-magic_set|||
-magic_sizepack|||
-magic_wipepack|||
-make_matcher|||
-make_trie|||
-malloc_good_size|||n
-malloced_size|||n
-malloc||5.007002|n
-markstack_grow||5.021001|
-matcher_matches_sv|||
-maybe_multimagic_gv|||
-mayberelocate|||
-measure_struct|||
-memEQs|5.009005||p
-memEQ|5.004000||p
-memNEs|5.009005||p
-memNE|5.004000||p
-mem_collxfrm|||
-mem_log_common|||n
-mess_alloc|||
-mess_nocontext|||vn
-mess_sv||5.013001|
-mess||5.006000|v
-mfree||5.007002|n
-mg_clear|||
-mg_copy|||
-mg_dup|||
-mg_find_mglob|||
-mg_findext|5.013008||pn
-mg_find|||n
-mg_free_type||5.013006|
-mg_free|||
-mg_get|||
-mg_length||5.005000|
-mg_localize|||
-mg_magical|||n
-mg_set|||
-mg_size||5.005000|
-mini_mktime||5.007002|n
-minus_v|||
-missingterm|||
-mode_from_discipline|||
-modkids|||
-more_bodies|||
-more_sv|||
-moreswitches|||
-move_proto_attr|||
-mro_clean_isarev|||
-mro_gather_and_rename|||
-mro_get_from_name||5.010001|
-mro_get_linear_isa_dfs|||
-mro_get_linear_isa||5.009005|
-mro_get_private_data||5.010001|
-mro_isa_changed_in|||
-mro_meta_dup|||
-mro_meta_init|||
-mro_method_changed_in||5.009005|
-mro_package_moved|||
-mro_register||5.010001|
-mro_set_mro||5.010001|
-mro_set_private_data||5.010001|
-mul128|||
-mulexp10|||n
-multideref_stringify|||
-my_atof2||5.007002|
-my_atof||5.006000|
-my_attrs|||
-my_bcopy|||n
-my_bytes_to_utf8|||n
-my_bzero|||n
-my_chsize|||
-my_clearenv|||
-my_cxt_index|||
-my_cxt_init|||
-my_dirfd||5.009005|n
-my_exit_jump|||
-my_exit|||
-my_failure_exit||5.004000|
-my_fflush_all||5.006000|
-my_fork||5.007003|n
-my_kid|||
-my_lstat_flags|||
-my_lstat||5.021008|
-my_memcmp|||n
-my_memset|||n
-my_pclose||5.003070|
-my_popen_list||5.007001|
-my_popen||5.003070|
-my_setenv|||
-my_setlocale|||
-my_snprintf|5.009004||pvn
-my_socketpair||5.007003|n
-my_sprintf|5.009003||pvn
-my_stat_flags|||
-my_stat||5.021008|
-my_strerror||5.021001|
-my_strftime||5.007002|
-my_strlcat|5.009004||pn
-my_strlcpy|5.009004||pn
-my_unexec|||
-my_vsnprintf||5.009004|n
-need_utf8|||n
-newANONATTRSUB||5.006000|
-newANONHASH|||
-newANONLIST|||
-newANONSUB|||
-newASSIGNOP|||
-newATTRSUB_x|||
-newATTRSUB||5.006000|
-newAVREF|||
-newAV|||
-newBINOP|||
-newCONDOP|||
-newCONSTSUB_flags||5.015006|
-newCONSTSUB|5.004050||p
-newCVREF|||
-newDEFSVOP||5.021006|
-newFORM|||
-newFOROP||5.013007|
-newGIVENOP||5.009003|
-newGIVWHENOP|||
-newGP|||
-newGVOP|||
-newGVREF|||
-newGVgen_flags||5.015004|
-newGVgen|||
-newHVREF|||
-newHVhv||5.005000|
-newHV|||
-newIO|||
-newLISTOP|||
-newLOGOP|||
-newLOOPEX|||
-newLOOPOP|||
-newMETHOP_internal|||
-newMETHOP_named||5.021005|
-newMETHOP||5.021005|
-newMYSUB||5.017004|
-newNULLLIST|||
-newOP|||
-newPADNAMELIST||5.021007|n
-newPADNAMEouter||5.021007|n
-newPADNAMEpvn||5.021007|n
-newPADOP|||
-newPMOP|||
-newPROG|||
-newPVOP|||
-newRANGE|||
-newRV_inc|5.004000||p
-newRV_noinc|5.004000||p
-newRV|||
-newSLICEOP|||
-newSTATEOP|||
-newSTUB|||
-newSUB|||
-newSVOP|||
-newSVREF|||
-newSV_type|5.009005||p
-newSVavdefelem|||
-newSVhek||5.009003|
-newSViv|||
-newSVnv|||
-newSVpadname||5.017004|
-newSVpv_share||5.013006|
-newSVpvf_nocontext|||vn
-newSVpvf||5.004000|v
-newSVpvn_flags|5.010001||p
-newSVpvn_share|5.007001||p
-newSVpvn_utf8|5.010001||p
-newSVpvn|5.004050||p
-newSVpvs_flags|5.010001||p
-newSVpvs_share|5.009003||p
-newSVpvs|5.009003||p
-newSVpv|||
-newSVrv|||
-newSVsv|||
-newSVuv|5.006000||p
-newSV|||
-newUNOP_AUX||5.021007|
-newUNOP|||
-newWHENOP||5.009003|
-newWHILEOP||5.013007|
-newXS_deffile|||
-newXS_flags||5.009004|
-newXS_len_flags|||
-newXSproto||5.006000|
-newXS||5.006000|
-new_collate||5.006000|
-new_constant|||
-new_ctype||5.006000|
-new_he|||
-new_logop|||
-new_numeric||5.006000|
-new_stackinfo||5.005000|
-new_version||5.009000|
-new_warnings_bitfield|||
-next_symbol|||
-nextargv|||
-nextchar|||
-ninstr|||n
-no_bareword_allowed|||
-no_fh_allowed|||
-no_op|||
-noperl_die|||vn
-not_a_number|||
-not_incrementable|||
-nothreadhook||5.008000|
-nuke_stacks|||
-num_overflow|||n
-oopsAV|||
-oopsHV|||
-op_append_elem||5.013006|
-op_append_list||5.013006|
-op_clear|||
-op_contextualize||5.013006|
-op_convert_list||5.021006|
-op_dump||5.006000|
-op_free|||
-op_integerize|||
-op_linklist||5.013006|
-op_lvalue_flags|||
-op_lvalue||5.013007|
-op_null||5.007002|
-op_parent||5.021002|n
-op_prepend_elem||5.013006|
-op_refcnt_dec|||
-op_refcnt_inc|||
-op_refcnt_lock||5.009002|
-op_refcnt_unlock||5.009002|
-op_relocate_sv|||
-op_scope||5.013007|
-op_sibling_splice||5.021002|n
-op_std_init|||
-op_unscope|||
-open_script|||
-openn_cleanup|||
-openn_setup|||
-opmethod_stash|||
-opslab_force_free|||
-opslab_free_nopad|||
-opslab_free|||
-pMY_CXT_|5.007003||p
-pMY_CXT|5.007003||p
-pTHX_|5.006000||p
-pTHX|5.006000||p
-packWARN|5.007003||p
-pack_cat||5.007003|
-pack_rec|||
-package_version|||
-package|||
-packlist||5.008001|
-pad_add_anon||5.008001|
-pad_add_name_pvn||5.015001|
-pad_add_name_pvs||5.015001|
-pad_add_name_pv||5.015001|
-pad_add_name_sv||5.015001|
-pad_add_weakref|||
-pad_alloc_name|||
-pad_alloc|||
-pad_block_start|||
-pad_check_dup|||
-pad_compname_type||5.009003|
-pad_findlex|||
-pad_findmy_pvn||5.015001|
-pad_findmy_pvs||5.015001|
-pad_findmy_pv||5.015001|
-pad_findmy_sv||5.015001|
-pad_fixup_inner_anons|||
-pad_free|||
-pad_leavemy|||
-pad_new||5.008001|
-pad_push|||
-pad_reset|||
-pad_setsv|||
-pad_sv|||
-pad_swipe|||
-pad_tidy||5.008001|
-padlist_dup|||
-padlist_store|||
-padname_dup|||
-padname_free|||
-padnamelist_dup|||
-padnamelist_fetch||5.021007|n
-padnamelist_free|||
-padnamelist_store||5.021007|
-parse_arithexpr||5.013008|
-parse_barestmt||5.013007|
-parse_block||5.013007|
-parse_body|||
-parse_fullexpr||5.013008|
-parse_fullstmt||5.013005|
-parse_gv_stash_name|||
-parse_ident|||
-parse_label||5.013007|
-parse_listexpr||5.013008|
-parse_lparen_question_flags|||
-parse_stmtseq||5.013006|
-parse_subsignature|||
-parse_termexpr||5.013008|
-parse_unicode_opts|||
-parser_dup|||
-parser_free_nexttoke_ops|||
-parser_free|||
-path_is_searchable|||n
-peep|||
-pending_ident|||
-perl_alloc_using|||n
-perl_alloc|||n
-perl_clone_using|||n
-perl_clone|||n
-perl_construct|||n
-perl_destruct||5.007003|n
-perl_free|||n
-perl_parse||5.006000|n
-perl_run|||n
-pidgone|||
-pm_description|||
-pmop_dump||5.006000|
-pmruntime|||
-pmtrans|||
-pop_scope|||
-populate_ANYOF_from_invlist|||
-populate_isa|||v
-pregcomp||5.009005|
-pregexec|||
-pregfree2||5.011000|
-pregfree|||
-prescan_version||5.011004|
-printbuf|||
-printf_nocontext|||vn
-process_special_blocks|||
-ptr_hash|||n
-ptr_table_clear||5.009005|
-ptr_table_fetch||5.009005|
-ptr_table_find|||n
-ptr_table_free||5.009005|
-ptr_table_new||5.009005|
-ptr_table_split||5.009005|
-ptr_table_store||5.009005|
-push_scope|||
-put_charclass_bitmap_innards|||
-put_code_point|||
-put_range|||
-pv_display|5.006000||p
-pv_escape|5.009004||p
-pv_pretty|5.009004||p
-pv_uni_display||5.007003|
-qerror|||
-qsortsvu|||
-quadmath_format_needed|||n
-quadmath_format_single|||n
-re_compile||5.009005|
-re_croak2|||
-re_dup_guts|||
-re_intuit_start||5.019001|
-re_intuit_string||5.006000|
-re_op_compile|||
-realloc||5.007002|n
-reentrant_free||5.021008|
-reentrant_init||5.021008|
-reentrant_retry||5.021008|vn
-reentrant_size||5.021008|
-ref_array_or_hash|||
-refcounted_he_chain_2hv|||
-refcounted_he_fetch_pvn|||
-refcounted_he_fetch_pvs|||
-refcounted_he_fetch_pv|||
-refcounted_he_fetch_sv|||
-refcounted_he_free|||
-refcounted_he_inc|||
-refcounted_he_new_pvn|||
-refcounted_he_new_pvs|||
-refcounted_he_new_pv|||
-refcounted_he_new_sv|||
-refcounted_he_value|||
-refkids|||
-refto|||
-ref||5.021008|
-reg2Lanode|||
-reg_check_named_buff_matched|||n
-reg_named_buff_all||5.009005|
-reg_named_buff_exists||5.009005|
-reg_named_buff_fetch||5.009005|
-reg_named_buff_firstkey||5.009005|
-reg_named_buff_iter|||
-reg_named_buff_nextkey||5.009005|
-reg_named_buff_scalar||5.009005|
-reg_named_buff|||
-reg_node|||
-reg_numbered_buff_fetch|||
-reg_numbered_buff_length|||
-reg_numbered_buff_store|||
-reg_qr_package|||
-reg_recode|||
-reg_scan_name|||
-reg_skipcomment|||n
-reg_temp_copy|||
-reganode|||
-regatom|||
-regbranch|||
-regclass_swash||5.009004|
-regclass|||
-regcppop|||
-regcppush|||
-regcurly|||n
-regdump_extflags|||
-regdump_intflags|||
-regdump||5.005000|
-regdupe_internal|||
-regexec_flags||5.005000|
-regfree_internal||5.009005|
-reghop3|||n
-reghop4|||n
-reghopmaybe3|||n
-reginclass|||
-reginitcolors||5.006000|
-reginsert|||
-regmatch|||
-regnext||5.005000|
-regnode_guts|||
-regpatws|||n
-regpiece|||
-regpposixcc|||
-regprop|||
-regrepeat|||
-regtail_study|||
-regtail|||
-regtry|||
-reg|||
-repeatcpy|||n
-report_evil_fh|||
-report_redefined_cv|||
-report_uninit|||
-report_wrongway_fh|||
-require_pv||5.006000|
-require_tie_mod|||
-restore_magic|||
-rninstr|||n
-rpeep|||
-rsignal_restore|||
-rsignal_save|||
-rsignal_state||5.004000|
-rsignal||5.004000|
-run_body|||
-run_user_filter|||
-runops_debug||5.005000|
-runops_standard||5.005000|
-rv2cv_op_cv||5.013006|
-rvpv_dup|||
-rxres_free|||
-rxres_restore|||
-rxres_save|||
-safesyscalloc||5.006000|n
-safesysfree||5.006000|n
-safesysmalloc||5.006000|n
-safesysrealloc||5.006000|n
-same_dirent|||
-save_I16||5.004000|
-save_I32|||
-save_I8||5.006000|
-save_adelete||5.011000|
-save_aelem_flags||5.011000|
-save_aelem||5.004050|
-save_aliased_sv|||
-save_alloc||5.006000|
-save_aptr|||
-save_ary|||
-save_bool||5.008001|
-save_clearsv|||
-save_delete|||
-save_destructor_x||5.006000|
-save_destructor||5.006000|
-save_freeop|||
-save_freepv|||
-save_freesv|||
-save_generic_pvref||5.006001|
-save_generic_svref||5.005030|
-save_gp||5.004000|
-save_hash|||
-save_hdelete||5.011000|
-save_hek_flags|||n
-save_helem_flags||5.011000|
-save_helem||5.004050|
-save_hints||5.010001|
-save_hptr|||
-save_int|||
-save_item|||
-save_iv||5.005000|
-save_lines|||
-save_list|||
-save_long|||
-save_magic_flags|||
-save_mortalizesv||5.007001|
-save_nogv|||
-save_op||5.005000|
-save_padsv_and_mortalize||5.010001|
-save_pptr|||
-save_pushi32ptr||5.010001|
-save_pushptri32ptr|||
-save_pushptrptr||5.010001|
-save_pushptr||5.010001|
-save_re_context||5.006000|
-save_scalar_at|||
-save_scalar|||
-save_set_svflags||5.009000|
-save_shared_pvref||5.007003|
-save_sptr|||
-save_strlen|||
-save_svref|||
-save_vptr||5.006000|
-savepvn|||
-savepvs||5.009003|
-savepv|||
-savesharedpvn||5.009005|
-savesharedpvs||5.013006|
-savesharedpv||5.007003|
-savesharedsvpv||5.013006|
-savestack_grow_cnt||5.008001|
-savestack_grow|||
-savesvpv||5.009002|
-sawparens|||
-scalar_mod_type|||n
-scalarboolean|||
-scalarkids|||
-scalarseq|||
-scalarvoid|||
-scalar|||
-scan_bin||5.006000|
-scan_commit|||
-scan_const|||
-scan_formline|||
-scan_heredoc|||
-scan_hex|||
-scan_ident|||
-scan_inputsymbol|||
-scan_num||5.007001|
-scan_oct|||
-scan_pat|||
-scan_str|||
-scan_subst|||
-scan_trans|||
-scan_version||5.009001|
-scan_vstring||5.009005|
-scan_word|||
-search_const|||
-seed||5.008001|
-sequence_num|||
-set_ANYOF_arg|||
-set_caret_X|||
-set_context||5.006000|n
-set_numeric_local||5.006000|
-set_numeric_radix||5.006000|
-set_numeric_standard||5.006000|
-set_padlist|||n
-setdefout|||
-share_hek_flags|||
-share_hek||5.004000|
-should_warn_nl|||n
-si_dup|||
-sighandler|||n
-simplify_sort|||
-skipspace_flags|||
-softref2xv|||
-sortcv_stacked|||
-sortcv_xsub|||
-sortcv|||
-sortsv_flags||5.009003|
-sortsv||5.007003|
-space_join_names_mortal|||
-ss_dup|||
-ssc_add_range|||
-ssc_and|||
-ssc_anything|||
-ssc_clear_locale|||n
-ssc_cp_and|||
-ssc_finalize|||
-ssc_init|||
-ssc_intersection|||
-ssc_is_anything|||n
-ssc_is_cp_posixl_init|||n
-ssc_or|||
-ssc_union|||
-stack_grow|||
-start_glob|||
-start_subparse||5.004000|
-stdize_locale|||
-strEQ|||
-strGE|||
-strGT|||
-strLE|||
-strLT|||
-strNE|||
-str_to_version||5.006000|
-strip_return|||
-strnEQ|||
-strnNE|||
-study_chunk|||
-sub_crush_depth|||
-sublex_done|||
-sublex_push|||
-sublex_start|||
-sv_2bool_flags||5.013006|
-sv_2bool|||
-sv_2cv|||
-sv_2io|||
-sv_2iuv_common|||
-sv_2iuv_non_preserve|||
-sv_2iv_flags||5.009001|
-sv_2iv|||
-sv_2mortal|||
-sv_2num|||
-sv_2nv_flags||5.013001|
-sv_2pv_flags|5.007002||p
-sv_2pv_nolen|5.006000||p
-sv_2pvbyte_nolen|5.006000||p
-sv_2pvbyte|5.006000||p
-sv_2pvutf8_nolen||5.006000|
-sv_2pvutf8||5.006000|
-sv_2pv|||
-sv_2uv_flags||5.009001|
-sv_2uv|5.004000||p
-sv_add_arena|||
-sv_add_backref|||
-sv_backoff|||n
-sv_bless|||
-sv_buf_to_ro|||
-sv_buf_to_rw|||
-sv_cat_decode||5.008001|
-sv_catpv_flags||5.013006|
-sv_catpv_mg|5.004050||p
-sv_catpv_nomg||5.013006|
-sv_catpvf_mg_nocontext|||pvn
-sv_catpvf_mg|5.006000|5.004000|pv
-sv_catpvf_nocontext|||vn
-sv_catpvf||5.004000|v
-sv_catpvn_flags||5.007002|
-sv_catpvn_mg|5.004050||p
-sv_catpvn_nomg|5.007002||p
-sv_catpvn|||
-sv_catpvs_flags||5.013006|
-sv_catpvs_mg||5.013006|
-sv_catpvs_nomg||5.013006|
-sv_catpvs|5.009003||p
-sv_catpv|||
-sv_catsv_flags||5.007002|
-sv_catsv_mg|5.004050||p
-sv_catsv_nomg|5.007002||p
-sv_catsv|||
-sv_chop|||
-sv_clean_all|||
-sv_clean_objs|||
-sv_clear|||
-sv_cmp_flags||5.013006|
-sv_cmp_locale_flags||5.013006|
-sv_cmp_locale||5.004000|
-sv_cmp|||
-sv_collxfrm_flags||5.013006|
-sv_collxfrm|||
-sv_copypv_flags||5.017002|
-sv_copypv_nomg||5.017002|
-sv_copypv|||
-sv_dec_nomg||5.013002|
-sv_dec|||
-sv_del_backref|||
-sv_derived_from_pvn||5.015004|
-sv_derived_from_pv||5.015004|
-sv_derived_from_sv||5.015004|
-sv_derived_from||5.004000|
-sv_destroyable||5.010000|
-sv_display|||
-sv_does_pvn||5.015004|
-sv_does_pv||5.015004|
-sv_does_sv||5.015004|
-sv_does||5.009004|
-sv_dump|||
-sv_dup_common|||
-sv_dup_inc_multiple|||
-sv_dup_inc|||
-sv_dup|||
-sv_eq_flags||5.013006|
-sv_eq|||
-sv_exp_grow|||
-sv_force_normal_flags||5.007001|
-sv_force_normal||5.006000|
-sv_free2|||
-sv_free_arenas|||
-sv_free|||
-sv_get_backrefs||5.021008|n
-sv_gets||5.003070|
-sv_grow|||
-sv_i_ncmp|||
-sv_inc_nomg||5.013002|
-sv_inc|||
-sv_insert_flags||5.010001|
-sv_insert|||
-sv_isa|||
-sv_isobject|||
-sv_iv||5.005000|
-sv_kill_backrefs|||
-sv_len_utf8_nomg|||
-sv_len_utf8||5.006000|
-sv_len|||
-sv_magic_portable|5.021008|5.004000|p
-sv_magicext_mglob|||
-sv_magicext||5.007003|
-sv_magic|||
-sv_mortalcopy_flags|||
-sv_mortalcopy|||
-sv_ncmp|||
-sv_newmortal|||
-sv_newref|||
-sv_nolocking||5.007003|
-sv_nosharing||5.007003|
-sv_nounlocking|||
-sv_nv||5.005000|
-sv_only_taint_gmagic|||n
-sv_or_pv_pos_u2b|||
-sv_peek||5.005000|
-sv_pos_b2u_flags||5.019003|
-sv_pos_b2u_midway|||
-sv_pos_b2u||5.006000|
-sv_pos_u2b_cached|||
-sv_pos_u2b_flags||5.011005|
-sv_pos_u2b_forwards|||n
-sv_pos_u2b_midway|||n
-sv_pos_u2b||5.006000|
-sv_pvbyten_force||5.006000|
-sv_pvbyten||5.006000|
-sv_pvbyte||5.006000|
-sv_pvn_force_flags|5.007002||p
-sv_pvn_force|||
-sv_pvn_nomg|5.007003|5.005000|p
-sv_pvn||5.005000|
-sv_pvutf8n_force||5.006000|
-sv_pvutf8n||5.006000|
-sv_pvutf8||5.006000|
-sv_pv||5.006000|
-sv_recode_to_utf8||5.007003|
-sv_reftype|||
-sv_ref|||
-sv_release_COW|||
-sv_replace|||
-sv_report_used|||
-sv_resetpvn|||
-sv_reset|||
-sv_rvweaken||5.006000|
-sv_sethek|||
-sv_setiv_mg|5.004050||p
-sv_setiv|||
-sv_setnv_mg|5.006000||p
-sv_setnv|||
-sv_setpv_mg|5.004050||p
-sv_setpvf_mg_nocontext|||pvn
-sv_setpvf_mg|5.006000|5.004000|pv
-sv_setpvf_nocontext|||vn
-sv_setpvf||5.004000|v
-sv_setpviv_mg||5.008001|
-sv_setpviv||5.008001|
-sv_setpvn_mg|5.004050||p
-sv_setpvn|||
-sv_setpvs_mg||5.013006|
-sv_setpvs|5.009004||p
-sv_setpv|||
-sv_setref_iv|||
-sv_setref_nv|||
-sv_setref_pvn|||
-sv_setref_pvs||5.021008|
-sv_setref_pv|||
-sv_setref_uv||5.007001|
-sv_setsv_cow|||
-sv_setsv_flags||5.007002|
-sv_setsv_mg|5.004050||p
-sv_setsv_nomg|5.007002||p
-sv_setsv|||
-sv_setuv_mg|5.004050||p
-sv_setuv|5.004000||p
-sv_tainted||5.004000|
-sv_taint||5.004000|
-sv_true||5.005000|
-sv_unglob|||
-sv_uni_display||5.007003|
-sv_unmagicext|5.013008||p
-sv_unmagic|||
-sv_unref_flags||5.007001|
-sv_unref|||
-sv_untaint||5.004000|
-sv_upgrade|||
-sv_usepvn_flags||5.009004|
-sv_usepvn_mg|5.004050||p
-sv_usepvn|||
-sv_utf8_decode||5.006000|
-sv_utf8_downgrade||5.006000|
-sv_utf8_encode||5.006000|
-sv_utf8_upgrade_flags_grow||5.011000|
-sv_utf8_upgrade_flags||5.007002|
-sv_utf8_upgrade_nomg||5.007002|
-sv_utf8_upgrade||5.007001|
-sv_uv|5.005000||p
-sv_vcatpvf_mg|5.006000|5.004000|p
-sv_vcatpvfn_flags||5.017002|
-sv_vcatpvfn||5.004000|
-sv_vcatpvf|5.006000|5.004000|p
-sv_vsetpvf_mg|5.006000|5.004000|p
-sv_vsetpvfn||5.004000|
-sv_vsetpvf|5.006000|5.004000|p
-svtype|||
-swallow_bom|||
-swash_fetch||5.007002|
-swash_init||5.006000|
-swash_scan_list_line|||
-swatch_get|||
-sync_locale||5.021004|
-sys_init3||5.010000|n
-sys_init||5.010000|n
-sys_intern_clear|||
-sys_intern_dup|||
-sys_intern_init|||
-sys_term||5.010000|n
-taint_env|||
-taint_proper|||
-tied_method|||v
-tmps_grow_p|||
-toFOLD_uni||5.007003|
-toFOLD_utf8||5.019001|
-toFOLD||5.019001|
-toLOWER_L1||5.019001|
-toLOWER_LC||5.004000|
-toLOWER_uni||5.007003|
-toLOWER_utf8||5.015007|
-toLOWER|||
-toTITLE_uni||5.007003|
-toTITLE_utf8||5.015007|
-toTITLE||5.019001|
-toUPPER_uni||5.007003|
-toUPPER_utf8||5.015007|
-toUPPER|||
-to_byte_substr|||
-to_lower_latin1|||n
-to_uni_fold||5.007003|
-to_uni_lower_lc||5.006000|
-to_uni_lower||5.007003|
-to_uni_title_lc||5.006000|
-to_uni_title||5.007003|
-to_uni_upper_lc||5.006000|
-to_uni_upper||5.007003|
-to_utf8_case||5.007003|
-to_utf8_fold||5.015007|
-to_utf8_lower||5.015007|
-to_utf8_substr|||
-to_utf8_title||5.015007|
-to_utf8_upper||5.015007|
-tokenize_use|||
-tokeq|||
-tokereport|||
-too_few_arguments_pv|||
-too_many_arguments_pv|||
-translate_substr_offsets|||n
-try_amagic_bin|||
-try_amagic_un|||
-uiv_2buf|||n
-unlnk|||
-unpack_rec|||
-unpack_str||5.007003|
-unpackstring||5.008001|
-unreferenced_to_tmp_stack|||
-unshare_hek_or_pvn|||
-unshare_hek|||
-unsharepvn||5.003070|
-unwind_handler_stack|||
-update_debugger_info|||
-upg_version||5.009005|
-usage|||
-utf16_textfilter|||
-utf16_to_utf8_reversed||5.006001|
-utf16_to_utf8||5.006001|
-utf8_distance||5.006000|
-utf8_hop||5.006000|n
-utf8_length||5.007001|
-utf8_mg_len_cache_update|||
-utf8_mg_pos_cache_update|||
-utf8_to_bytes||5.006001|
-utf8_to_uvchr_buf||5.015009|
-utf8_to_uvchr||5.007001|
-utf8_to_uvuni_buf||5.015009|
-utf8_to_uvuni||5.007001|
-utf8n_to_uvchr||5.007001|
-utf8n_to_uvuni||5.007001|
-utilize|||
-uvchr_to_utf8_flags||5.007003|
-uvchr_to_utf8||5.007001|
-uvoffuni_to_utf8_flags||5.019004|
-uvuni_to_utf8_flags||5.007003|
-uvuni_to_utf8||5.007001|
-valid_utf8_to_uvchr||5.015009|
-valid_utf8_to_uvuni||5.015009|
-validate_proto|||
-validate_suid|||
-varname|||
-vcmp||5.009000|
-vcroak||5.006000|
-vdeb||5.007003|
-vform||5.006000|
-visit|||
-vivify_defelem|||
-vivify_ref|||
-vload_module|5.006000||p
-vmess||5.006000|
-vnewSVpvf|5.006000|5.004000|p
-vnormal||5.009002|
-vnumify||5.009000|
-vstringify||5.009000|
-vverify||5.009003|
-vwarner||5.006000|
-vwarn||5.006000|
-wait4pid|||
-warn_nocontext|||vn
-warn_sv||5.013001|
-warner_nocontext|||vn
-warner|5.006000|5.004000|pv
-warn|||v
-was_lvalue_sub|||
-watch|||
-whichsig_pvn||5.015004|
-whichsig_pv||5.015004|
-whichsig_sv||5.015004|
-whichsig|||
-win32_croak_not_implemented|||n
-with_queued_errors|||
-wrap_op_checker||5.015008|
-write_to_stderr|||
-xs_boot_epilog|||
-xs_handshake|||vn
-xs_version_bootcheck|||
-yyerror_pvn|||
-yyerror_pv|||
-yyerror|||
-yylex|||
-yyparse|||
-yyunlex|||
-yywarn|||
-);
-
-if (exists $opt{'list-unsupported'}) {
- my $f;
- for $f (sort { lc $a cmp lc $b } keys %API) {
- next unless $API{$f}{todo};
- print "$f ", '.'x(40-length($f)), " ", format_version($API{$f}{todo}), "\n";
- }
- exit 0;
-}
-
-# Scan for possible replacement candidates
-
-my(%replace, %need, %hints, %warnings, %depends);
-my $replace = 0;
-my($hint, $define, $function);
-
-sub find_api
-{
- my $code = shift;
- $code =~ s{
- / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]*)
- | "[^"\\]*(?:\\.[^"\\]*)*"
- | '[^'\\]*(?:\\.[^'\\]*)*' }{}egsx;
- grep { exists $API{$_} } $code =~ /(\w+)/mg;
-}
-
-while (<DATA>) {
- if ($hint) {
- my $h = $hint->[0] eq 'Hint' ? \%hints : \%warnings;
- if (m{^\s*\*\s(.*?)\s*$}) {
- for (@{$hint->[1]}) {
- $h->{$_} ||= ''; # suppress warning with older perls
- $h->{$_} .= "$1\n";
- }
- }
- else { undef $hint }
- }
-
- $hint = [$1, [split /,?\s+/, $2]]
- if m{^\s*$rccs\s+(Hint|Warning):\s+(\w+(?:,?\s+\w+)*)\s*$};
-
- if ($define) {
- if ($define->[1] =~ /\\$/) {
- $define->[1] .= $_;
- }
- else {
- if (exists $API{$define->[0]} && $define->[1] !~ /^DPPP_\(/) {
- my @n = find_api($define->[1]);
- push @{$depends{$define->[0]}}, @n if @n
- }
- undef $define;
- }
- }
-
- $define = [$1, $2] if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(.*)};
-
- if ($function) {
- if (/^}/) {
- if (exists $API{$function->[0]}) {
- my @n = find_api($function->[1]);
- push @{$depends{$function->[0]}}, @n if @n
- }
- undef $function;
- }
- else {
- $function->[1] .= $_;
- }
- }
-
- $function = [$1, ''] if m{^DPPP_\(my_(\w+)\)};
-
- $replace = $1 if m{^\s*$rccs\s+Replace:\s+(\d+)\s+$rcce\s*$};
- $replace{$2} = $1 if $replace and m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+)};
- $replace{$2} = $1 if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+).*$rccs\s+Replace\s+$rcce};
- $replace{$1} = $2 if m{^\s*$rccs\s+Replace (\w+) with (\w+)\s+$rcce\s*$};
-
- if (m{^\s*$rccs\s+(\w+(\s*,\s*\w+)*)\s+depends\s+on\s+(\w+(\s*,\s*\w+)*)\s+$rcce\s*$}) {
- my @deps = map { s/\s+//g; $_ } split /,/, $3;
- my $d;
- for $d (map { s/\s+//g; $_ } split /,/, $1) {
- push @{$depends{$d}}, @deps;
- }
- }
-
- $need{$1} = 1 if m{^#if\s+defined\(NEED_(\w+)(?:_GLOBAL)?\)};
-}
-
-for (values %depends) {
- my %s;
- $_ = [sort grep !$s{$_}++, @$_];
-}
-
-if (exists $opt{'api-info'}) {
- my $f;
- my $count = 0;
- my $match = $opt{'api-info'} =~ m!^/(.*)/$! ? $1 : "^\Q$opt{'api-info'}\E\$";
- for $f (sort { lc $a cmp lc $b } keys %API) {
- next unless $f =~ /$match/;
- print "\n=== $f ===\n\n";
- my $info = 0;
- if ($API{$f}{base} || $API{$f}{todo}) {
- my $base = format_version($API{$f}{base} || $API{$f}{todo});
- print "Supported at least starting from perl-$base.\n";
- $info++;
- }
- if ($API{$f}{provided}) {
- my $todo = $API{$f}{todo} ? format_version($API{$f}{todo}) : "5.003";
- print "Support by $ppport provided back to perl-$todo.\n";
- print "Support needs to be explicitly requested by NEED_$f.\n" if exists $need{$f};
- print "Depends on: ", join(', ', @{$depends{$f}}), ".\n" if exists $depends{$f};
- print "\n$hints{$f}" if exists $hints{$f};
- print "\nWARNING:\n$warnings{$f}" if exists $warnings{$f};
- $info++;
- }
- print "No portability information available.\n" unless $info;
- $count++;
- }
- $count or print "Found no API matching '$opt{'api-info'}'.";
- print "\n";
- exit 0;
-}
-
-if (exists $opt{'list-provided'}) {
- my $f;
- for $f (sort { lc $a cmp lc $b } keys %API) {
- next unless $API{$f}{provided};
- my @flags;
- push @flags, 'explicit' if exists $need{$f};
- push @flags, 'depend' if exists $depends{$f};
- push @flags, 'hint' if exists $hints{$f};
- push @flags, 'warning' if exists $warnings{$f};
- my $flags = @flags ? ' ['.join(', ', @flags).']' : '';
- print "$f$flags\n";
- }
- exit 0;
-}
-
-my @files;
-my @srcext = qw( .xs .c .h .cc .cpp -c.inc -xs.inc );
-my $srcext = join '|', map { quotemeta $_ } @srcext;
-
-if (@ARGV) {
- my %seen;
- for (@ARGV) {
- if (-e) {
- if (-f) {
- push @files, $_ unless $seen{$_}++;
- }
- else { warn "'$_' is not a file.\n" }
- }
- else {
- my @new = grep { -f } glob $_
- or warn "'$_' does not exist.\n";
- push @files, grep { !$seen{$_}++ } @new;
- }
- }
-}
-else {
- eval {
- require File::Find;
- File::Find::find(sub {
- $File::Find::name =~ /($srcext)$/i
- and push @files, $File::Find::name;
- }, '.');
- };
- if ($@) {
- @files = map { glob "*$_" } @srcext;
- }
-}
-
-if (!@ARGV || $opt{filter}) {
- my(@in, @out);
- my %xsc = map { /(.*)\.xs$/ ? ("$1.c" => 1, "$1.cc" => 1) : () } @files;
- for (@files) {
- my $out = exists $xsc{$_} || /\b\Q$ppport\E$/i || !/($srcext)$/i;
- push @{ $out ? \@out : \@in }, $_;
- }
- if (@ARGV && @out) {
- warning("Skipping the following files (use --nofilter to avoid this):\n| ", join "\n| ", @out);
- }
- @files = @in;
-}
-
-die "No input files given!\n" unless @files;
-
-my(%files, %global, %revreplace);
-%revreplace = reverse %replace;
-my $filename;
-my $patch_opened = 0;
-
-for $filename (@files) {
- unless (open IN, "<$filename") {
- warn "Unable to read from $filename: $!\n";
- next;
- }
-
- info("Scanning $filename ...");
-
- my $c = do { local $/; <IN> };
- close IN;
-
- my %file = (orig => $c, changes => 0);
-
- # Temporarily remove C/XS comments and strings from the code
- my @ccom;
-
- $c =~ s{
- ( ^$HS*\#$HS*include\b[^\r\n]+\b(?:\Q$ppport\E|XSUB\.h)\b[^\r\n]*
- | ^$HS*\#$HS*(?:define|elif|if(?:def)?)\b[^\r\n]* )
- | ( ^$HS*\#[^\r\n]*
- | "[^"\\]*(?:\\.[^"\\]*)*"
- | '[^'\\]*(?:\\.[^'\\]*)*'
- | / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]* ) )
- }{ defined $2 and push @ccom, $2;
- defined $1 ? $1 : "$ccs$#ccom$cce" }mgsex;
-
- $file{ccom} = \@ccom;
- $file{code} = $c;
- $file{has_inc_ppport} = $c =~ /^$HS*#$HS*include[^\r\n]+\b\Q$ppport\E\b/m;
-
- my $func;
-
- for $func (keys %API) {
- my $match = $func;
- $match .= "|$revreplace{$func}" if exists $revreplace{$func};
- if ($c =~ /\b(?:Perl_)?($match)\b/) {
- $file{uses_replace}{$1}++ if exists $revreplace{$func} && $1 eq $revreplace{$func};
- $file{uses_Perl}{$func}++ if $c =~ /\bPerl_$func\b/;
- if (exists $API{$func}{provided}) {
- $file{uses_provided}{$func}++;
- if (!exists $API{$func}{base} || $API{$func}{base} > $opt{'compat-version'}) {
- $file{uses}{$func}++;
- my @deps = rec_depend($func);
- if (@deps) {
- $file{uses_deps}{$func} = \@deps;
- for (@deps) {
- $file{uses}{$_} = 0 unless exists $file{uses}{$_};
- }
- }
- for ($func, @deps) {
- $file{needs}{$_} = 'static' if exists $need{$_};
- }
- }
- }
- if (exists $API{$func}{todo} && $API{$func}{todo} > $opt{'compat-version'}) {
- if ($c =~ /\b$func\b/) {
- $file{uses_todo}{$func}++;
- }
- }
- }
- }
-
- while ($c =~ /^$HS*#$HS*define$HS+(NEED_(\w+?)(_GLOBAL)?)\b/mg) {
- if (exists $need{$2}) {
- $file{defined $3 ? 'needed_global' : 'needed_static'}{$2}++;
- }
- else { warning("Possibly wrong #define $1 in $filename") }
- }
-
- for (qw(uses needs uses_todo needed_global needed_static)) {
- for $func (keys %{$file{$_}}) {
- push @{$global{$_}{$func}}, $filename;
- }
- }
-
- $files{$filename} = \%file;
-}
-
-# Globally resolve NEED_'s
-my $need;
-for $need (keys %{$global{needs}}) {
- if (@{$global{needs}{$need}} > 1) {
- my @targets = @{$global{needs}{$need}};
- my @t = grep $files{$_}{needed_global}{$need}, @targets;
- @targets = @t if @t;
- @t = grep /\.xs$/i, @targets;
- @targets = @t if @t;
- my $target = shift @targets;
- $files{$target}{needs}{$need} = 'global';
- for (@{$global{needs}{$need}}) {
- $files{$_}{needs}{$need} = 'extern' if $_ ne $target;
- }
- }
-}
-
-for $filename (@files) {
- exists $files{$filename} or next;
-
- info("=== Analyzing $filename ===");
-
- my %file = %{$files{$filename}};
- my $func;
- my $c = $file{code};
- my $warnings = 0;
-
- for $func (sort keys %{$file{uses_Perl}}) {
- if ($API{$func}{varargs}) {
- unless ($API{$func}{nothxarg}) {
- my $changes = ($c =~ s{\b(Perl_$func\s*\(\s*)(?!aTHX_?)(\)|[^\s)]*\))}
- { $1 . ($2 eq ')' ? 'aTHX' : 'aTHX_ ') . $2 }ge);
- if ($changes) {
- warning("Doesn't pass interpreter argument aTHX to Perl_$func");
- $file{changes} += $changes;
- }
- }
- }
- else {
- warning("Uses Perl_$func instead of $func");
- $file{changes} += ($c =~ s{\bPerl_$func(\s*)\((\s*aTHX_?)?\s*}
- {$func$1(}g);
- }
- }
-
- for $func (sort keys %{$file{uses_replace}}) {
- warning("Uses $func instead of $replace{$func}");
- $file{changes} += ($c =~ s/\b$func\b/$replace{$func}/g);
- }
-
- for $func (sort keys %{$file{uses_provided}}) {
- if ($file{uses}{$func}) {
- if (exists $file{uses_deps}{$func}) {
- diag("Uses $func, which depends on ", join(', ', @{$file{uses_deps}{$func}}));
- }
- else {
- diag("Uses $func");
- }
- }
- $warnings += hint($func);
- }
-
- unless ($opt{quiet}) {
- for $func (sort keys %{$file{uses_todo}}) {
- print "*** WARNING: Uses $func, which may not be portable below perl ",
- format_version($API{$func}{todo}), ", even with '$ppport'\n";
- $warnings++;
- }
- }
-
- for $func (sort keys %{$file{needed_static}}) {
- my $message = '';
- if (not exists $file{uses}{$func}) {
- $message = "No need to define NEED_$func if $func is never used";
- }
- elsif (exists $file{needs}{$func} && $file{needs}{$func} ne 'static') {
- $message = "No need to define NEED_$func when already needed globally";
- }
- if ($message) {
- diag($message);
- $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_$func\b.*$LF//mg);
- }
- }
-
- for $func (sort keys %{$file{needed_global}}) {
- my $message = '';
- if (not exists $global{uses}{$func}) {
- $message = "No need to define NEED_${func}_GLOBAL if $func is never used";
- }
- elsif (exists $file{needs}{$func}) {
- if ($file{needs}{$func} eq 'extern') {
- $message = "No need to define NEED_${func}_GLOBAL when already needed globally";
- }
- elsif ($file{needs}{$func} eq 'static') {
- $message = "No need to define NEED_${func}_GLOBAL when only used in this file";
- }
- }
- if ($message) {
- diag($message);
- $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_${func}_GLOBAL\b.*$LF//mg);
- }
- }
-
- $file{needs_inc_ppport} = keys %{$file{uses}};
-
- if ($file{needs_inc_ppport}) {
- my $pp = '';
-
- for $func (sort keys %{$file{needs}}) {
- my $type = $file{needs}{$func};
- next if $type eq 'extern';
- my $suffix = $type eq 'global' ? '_GLOBAL' : '';
- unless (exists $file{"needed_$type"}{$func}) {
- if ($type eq 'global') {
- diag("Files [@{$global{needs}{$func}}] need $func, adding global request");
- }
- else {
- diag("File needs $func, adding static request");
- }
- $pp .= "#define NEED_$func$suffix\n";
- }
- }
-
- if ($pp && ($c =~ s/^(?=$HS*#$HS*define$HS+NEED_\w+)/$pp/m)) {
- $pp = '';
- $file{changes}++;
- }
-
- unless ($file{has_inc_ppport}) {
- diag("Needs to include '$ppport'");
- $pp .= qq(#include "$ppport"\n)
- }
-
- if ($pp) {
- $file{changes} += ($c =~ s/^($HS*#$HS*define$HS+NEED_\w+.*?)^/$1$pp/ms)
- || ($c =~ s/^(?=$HS*#$HS*include.*\Q$ppport\E)/$pp/m)
- || ($c =~ s/^($HS*#$HS*include.*XSUB.*\s*?)^/$1$pp/m)
- || ($c =~ s/^/$pp/);
- }
- }
- else {
- if ($file{has_inc_ppport}) {
- diag("No need to include '$ppport'");
- $file{changes} += ($c =~ s/^$HS*?#$HS*include.*\Q$ppport\E.*?$LF//m);
- }
- }
-
- # put back in our C comments
- my $ix;
- my $cppc = 0;
- my @ccom = @{$file{ccom}};
- for $ix (0 .. $#ccom) {
- if (!$opt{cplusplus} && $ccom[$ix] =~ s!^//!!) {
- $cppc++;
- $file{changes} += $c =~ s/$rccs$ix$rcce/$ccs$ccom[$ix] $cce/;
- }
- else {
- $c =~ s/$rccs$ix$rcce/$ccom[$ix]/;
- }
- }
-
- if ($cppc) {
- my $s = $cppc != 1 ? 's' : '';
- warning("Uses $cppc C++ style comment$s, which is not portable");
- }
-
- my $s = $warnings != 1 ? 's' : '';
- my $warn = $warnings ? " ($warnings warning$s)" : '';
- info("Analysis completed$warn");
-
- if ($file{changes}) {
- if (exists $opt{copy}) {
- my $newfile = "$filename$opt{copy}";
- if (-e $newfile) {
- error("'$newfile' already exists, refusing to write copy of '$filename'");
- }
- else {
- local *F;
- if (open F, ">$newfile") {
- info("Writing copy of '$filename' with changes to '$newfile'");
- print F $c;
- close F;
- }
- else {
- error("Cannot open '$newfile' for writing: $!");
- }
- }
- }
- elsif (exists $opt{patch} || $opt{changes}) {
- if (exists $opt{patch}) {
- unless ($patch_opened) {
- if (open PATCH, ">$opt{patch}") {
- $patch_opened = 1;
- }
- else {
- error("Cannot open '$opt{patch}' for writing: $!");
- delete $opt{patch};
- $opt{changes} = 1;
- goto fallback;
- }
- }
- mydiff(\*PATCH, $filename, $c);
- }
- else {
-fallback:
- info("Suggested changes:");
- mydiff(\*STDOUT, $filename, $c);
- }
- }
- else {
- my $s = $file{changes} == 1 ? '' : 's';
- info("$file{changes} potentially required change$s detected");
- }
- }
- else {
- info("Looks good");
- }
-}
-
-close PATCH if $patch_opened;
-
-exit 0;
-
-
-sub try_use { eval "use @_;"; return $@ eq '' }
-
-sub mydiff
-{
- local *F = shift;
- my($file, $str) = @_;
- my $diff;
-
- if (exists $opt{diff}) {
- $diff = run_diff($opt{diff}, $file, $str);
- }
-
- if (!defined $diff and try_use('Text::Diff')) {
- $diff = Text::Diff::diff($file, \$str, { STYLE => 'Unified' });
- $diff = <<HEADER . $diff;
---- $file
-+++ $file.patched
-HEADER
- }
-
- if (!defined $diff) {
- $diff = run_diff('diff -u', $file, $str);
- }
-
- if (!defined $diff) {
- $diff = run_diff('diff', $file, $str);
- }
-
- if (!defined $diff) {
- error("Cannot generate a diff. Please install Text::Diff or use --copy.");
- return;
- }
-
- print F $diff;
-}
-
-sub run_diff
-{
- my($prog, $file, $str) = @_;
- my $tmp = 'dppptemp';
- my $suf = 'aaa';
- my $diff = '';
- local *F;
-
- while (-e "$tmp.$suf") { $suf++ }
- $tmp = "$tmp.$suf";
-
- if (open F, ">$tmp") {
- print F $str;
- close F;
-
- if (open F, "$prog $file $tmp |") {
- while (<F>) {
- s/\Q$tmp\E/$file.patched/;
- $diff .= $_;
- }
- close F;
- unlink $tmp;
- return $diff;
- }
-
- unlink $tmp;
- }
- else {
- error("Cannot open '$tmp' for writing: $!");
- }
-
- return undef;
-}
-
-sub rec_depend
-{
- my($func, $seen) = @_;
- return () unless exists $depends{$func};
- $seen = {%{$seen||{}}};
- return () if $seen->{$func}++;
- my %s;
- grep !$s{$_}++, map { ($_, rec_depend($_, $seen)) } @{$depends{$func}};
-}
-
-sub parse_version
-{
- my $ver = shift;
-
- if ($ver =~ /^(\d+)\.(\d+)\.(\d+)$/) {
- return ($1, $2, $3);
- }
- elsif ($ver !~ /^\d+\.[\d_]+$/) {
- die "cannot parse version '$ver'\n";
- }
-
- $ver =~ s/_//g;
- $ver =~ s/$/000000/;
-
- my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/;
-
- $v = int $v;
- $s = int $s;
-
- if ($r < 5 || ($r == 5 && $v < 6)) {
- if ($s % 10) {
- die "cannot parse version '$ver'\n";
- }
- }
-
- return ($r, $v, $s);
-}
-
-sub format_version
-{
- my $ver = shift;
-
- $ver =~ s/$/000000/;
- my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/;
-
- $v = int $v;
- $s = int $s;
-
- if ($r < 5 || ($r == 5 && $v < 6)) {
- if ($s % 10) {
- die "invalid version '$ver'\n";
- }
- $s /= 10;
-
- $ver = sprintf "%d.%03d", $r, $v;
- $s > 0 and $ver .= sprintf "_%02d", $s;
-
- return $ver;
- }
-
- return sprintf "%d.%d.%d", $r, $v, $s;
-}
-
-sub info
-{
- $opt{quiet} and return;
- print @_, "\n";
-}
-
-sub diag
-{
- $opt{quiet} and return;
- $opt{diag} and print @_, "\n";
-}
-
-sub warning
-{
- $opt{quiet} and return;
- print "*** ", @_, "\n";
-}
-
-sub error
-{
- print "*** ERROR: ", @_, "\n";
-}
-
-my %given_hints;
-my %given_warnings;
-sub hint
-{
- $opt{quiet} and return;
- my $func = shift;
- my $rv = 0;
- if (exists $warnings{$func} && !$given_warnings{$func}++) {
- my $warn = $warnings{$func};
- $warn =~ s!^!*** !mg;
- print "*** WARNING: $func\n", $warn;
- $rv++;
- }
- if ($opt{hints} && exists $hints{$func} && !$given_hints{$func}++) {
- my $hint = $hints{$func};
- $hint =~ s/^/ /mg;
- print " --- hint for $func ---\n", $hint;
- }
- $rv;
-}
-
-sub usage
-{
- my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms;
- my %M = ( 'I' => '*' );
- $usage =~ s/^\s*perl\s+\S+/$^X $0/;
- $usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g;
-
- print <<ENDUSAGE;
-
-Usage: $usage
-
-See perldoc $0 for details.
-
-ENDUSAGE
-
- exit 2;
-}
-
-sub strip
-{
- my $self = do { local(@ARGV,$/)=($0); <> };
- my($copy) = $self =~ /^=head\d\s+COPYRIGHT\s*^(.*?)^=\w+/ms;
- $copy =~ s/^(?=\S+)/ /gms;
- $self =~ s/^$HS+Do NOT edit.*?(?=^-)/$copy/ms;
- $self =~ s/^SKIP.*(?=^__DATA__)/SKIP
-if (\@ARGV && \$ARGV[0] eq '--unstrip') {
- eval { require Devel::PPPort };
- \$@ and die "Cannot require Devel::PPPort, please install.\\n";
- if (eval \$Devel::PPPort::VERSION < $VERSION) {
- die "$0 was originally generated with Devel::PPPort $VERSION.\\n"
- . "Your Devel::PPPort is only version \$Devel::PPPort::VERSION.\\n"
- . "Please install a newer version, or --unstrip will not work.\\n";
- }
- Devel::PPPort::WriteFile(\$0);
- exit 0;
-}
-print <<END;
-
-Sorry, but this is a stripped version of \$0.
-
-To be able to use its original script and doc functionality,
-please try to regenerate this file using:
-
- \$^X \$0 --unstrip
-
-END
-/ms;
- my($pl, $c) = $self =~ /(.*^__DATA__)(.*)/ms;
- $c =~ s{
- / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]*)
- | ( "[^"\\]*(?:\\.[^"\\]*)*"
- | '[^'\\]*(?:\\.[^'\\]*)*' )
- | ($HS+) }{ defined $2 ? ' ' : ($1 || '') }gsex;
- $c =~ s!\s+$!!mg;
- $c =~ s!^$LF!!mg;
- $c =~ s!^\s*#\s*!#!mg;
- $c =~ s!^\s+!!mg;
-
- open OUT, ">$0" or die "cannot strip $0: $!\n";
- print OUT "$pl$c\n";
-
- exit 0;
-}
-
-__DATA__
-*/
-
-#ifndef _P_P_PORTABILITY_H_
-#define _P_P_PORTABILITY_H_
-
-#ifndef DPPP_NAMESPACE
-# define DPPP_NAMESPACE DPPP_
-#endif
-
-#define DPPP_CAT2(x,y) CAT2(x,y)
-#define DPPP_(name) DPPP_CAT2(DPPP_NAMESPACE, name)
-
-#ifndef PERL_REVISION
-# if !defined(__PATCHLEVEL_H_INCLUDED__) && !(defined(PATCHLEVEL) && defined(SUBVERSION))
-# define PERL_PATCHLEVEL_H_IMPLICIT
-# include <patchlevel.h>
-# endif
-# if !(defined(PERL_VERSION) || (defined(SUBVERSION) && defined(PATCHLEVEL)))
-# include <could_not_find_Perl_patchlevel.h>
-# endif
-# ifndef PERL_REVISION
-# define PERL_REVISION (5)
- /* Replace: 1 */
-# define PERL_VERSION PATCHLEVEL
-# define PERL_SUBVERSION SUBVERSION
- /* Replace PERL_PATCHLEVEL with PERL_VERSION */
- /* Replace: 0 */
-# endif
-#endif
-
-#define _dpppDEC2BCD(dec) ((((dec)/100)<<8)|((((dec)%100)/10)<<4)|((dec)%10))
-#define PERL_BCDVERSION ((_dpppDEC2BCD(PERL_REVISION)<<24)|(_dpppDEC2BCD(PERL_VERSION)<<12)|_dpppDEC2BCD(PERL_SUBVERSION))
-
-/* It is very unlikely that anyone will try to use this with Perl 6
- (or greater), but who knows.
- */
-#if PERL_REVISION != 5
-# error ppport.h only works with Perl version 5
-#endif /* PERL_REVISION != 5 */
-#ifndef dTHR
-# define dTHR dNOOP
-#endif
-#ifndef dTHX
-# define dTHX dNOOP
-#endif
-
-#ifndef dTHXa
-# define dTHXa(x) dNOOP
-#endif
-#ifndef pTHX
-# define pTHX void
-#endif
-
-#ifndef pTHX_
-# define pTHX_
-#endif
-
-#ifndef aTHX
-# define aTHX
-#endif
-
-#ifndef aTHX_
-# define aTHX_
-#endif
-
-#if (PERL_BCDVERSION < 0x5006000)
-# ifdef USE_THREADS
-# define aTHXR thr
-# define aTHXR_ thr,
-# else
-# define aTHXR
-# define aTHXR_
-# endif
-# define dTHXR dTHR
-#else
-# define aTHXR aTHX
-# define aTHXR_ aTHX_
-# define dTHXR dTHX
-#endif
-#ifndef dTHXoa
-# define dTHXoa(x) dTHXa(x)
-#endif
-
-#ifdef I_LIMITS
-# include <limits.h>
-#endif
-
-#ifndef PERL_UCHAR_MIN
-# define PERL_UCHAR_MIN ((unsigned char)0)
-#endif
-
-#ifndef PERL_UCHAR_MAX
-# ifdef UCHAR_MAX
-# define PERL_UCHAR_MAX ((unsigned char)UCHAR_MAX)
-# else
-# ifdef MAXUCHAR
-# define PERL_UCHAR_MAX ((unsigned char)MAXUCHAR)
-# else
-# define PERL_UCHAR_MAX ((unsigned char)~(unsigned)0)
-# endif
-# endif
-#endif
-
-#ifndef PERL_USHORT_MIN
-# define PERL_USHORT_MIN ((unsigned short)0)
-#endif
-
-#ifndef PERL_USHORT_MAX
-# ifdef USHORT_MAX
-# define PERL_USHORT_MAX ((unsigned short)USHORT_MAX)
-# else
-# ifdef MAXUSHORT
-# define PERL_USHORT_MAX ((unsigned short)MAXUSHORT)
-# else
-# ifdef USHRT_MAX
-# define PERL_USHORT_MAX ((unsigned short)USHRT_MAX)
-# else
-# define PERL_USHORT_MAX ((unsigned short)~(unsigned)0)
-# endif
-# endif
-# endif
-#endif
-
-#ifndef PERL_SHORT_MAX
-# ifdef SHORT_MAX
-# define PERL_SHORT_MAX ((short)SHORT_MAX)
-# else
-# ifdef MAXSHORT /* Often used in <values.h> */
-# define PERL_SHORT_MAX ((short)MAXSHORT)
-# else
-# ifdef SHRT_MAX
-# define PERL_SHORT_MAX ((short)SHRT_MAX)
-# else
-# define PERL_SHORT_MAX ((short) (PERL_USHORT_MAX >> 1))
-# endif
-# endif
-# endif
-#endif
-
-#ifndef PERL_SHORT_MIN
-# ifdef SHORT_MIN
-# define PERL_SHORT_MIN ((short)SHORT_MIN)
-# else
-# ifdef MINSHORT
-# define PERL_SHORT_MIN ((short)MINSHORT)
-# else
-# ifdef SHRT_MIN
-# define PERL_SHORT_MIN ((short)SHRT_MIN)
-# else
-# define PERL_SHORT_MIN (-PERL_SHORT_MAX - ((3 & -1) == 3))
-# endif
-# endif
-# endif
-#endif
-
-#ifndef PERL_UINT_MAX
-# ifdef UINT_MAX
-# define PERL_UINT_MAX ((unsigned int)UINT_MAX)
-# else
-# ifdef MAXUINT
-# define PERL_UINT_MAX ((unsigned int)MAXUINT)
-# else
-# define PERL_UINT_MAX (~(unsigned int)0)
-# endif
-# endif
-#endif
-
-#ifndef PERL_UINT_MIN
-# define PERL_UINT_MIN ((unsigned int)0)
-#endif
-
-#ifndef PERL_INT_MAX
-# ifdef INT_MAX
-# define PERL_INT_MAX ((int)INT_MAX)
-# else
-# ifdef MAXINT /* Often used in <values.h> */
-# define PERL_INT_MAX ((int)MAXINT)
-# else
-# define PERL_INT_MAX ((int)(PERL_UINT_MAX >> 1))
-# endif
-# endif
-#endif
-
-#ifndef PERL_INT_MIN
-# ifdef INT_MIN
-# define PERL_INT_MIN ((int)INT_MIN)
-# else
-# ifdef MININT
-# define PERL_INT_MIN ((int)MININT)
-# else
-# define PERL_INT_MIN (-PERL_INT_MAX - ((3 & -1) == 3))
-# endif
-# endif
-#endif
-
-#ifndef PERL_ULONG_MAX
-# ifdef ULONG_MAX
-# define PERL_ULONG_MAX ((unsigned long)ULONG_MAX)
-# else
-# ifdef MAXULONG
-# define PERL_ULONG_MAX ((unsigned long)MAXULONG)
-# else
-# define PERL_ULONG_MAX (~(unsigned long)0)
-# endif
-# endif
-#endif
-
-#ifndef PERL_ULONG_MIN
-# define PERL_ULONG_MIN ((unsigned long)0L)
-#endif
-
-#ifndef PERL_LONG_MAX
-# ifdef LONG_MAX
-# define PERL_LONG_MAX ((long)LONG_MAX)
-# else
-# ifdef MAXLONG
-# define PERL_LONG_MAX ((long)MAXLONG)
-# else
-# define PERL_LONG_MAX ((long) (PERL_ULONG_MAX >> 1))
-# endif
-# endif
-#endif
-
-#ifndef PERL_LONG_MIN
-# ifdef LONG_MIN
-# define PERL_LONG_MIN ((long)LONG_MIN)
-# else
-# ifdef MINLONG
-# define PERL_LONG_MIN ((long)MINLONG)
-# else
-# define PERL_LONG_MIN (-PERL_LONG_MAX - ((3 & -1) == 3))
-# endif
-# endif
-#endif
-
-#if defined(HAS_QUAD) && (defined(convex) || defined(uts))
-# ifndef PERL_UQUAD_MAX
-# ifdef ULONGLONG_MAX
-# define PERL_UQUAD_MAX ((unsigned long long)ULONGLONG_MAX)
-# else
-# ifdef MAXULONGLONG
-# define PERL_UQUAD_MAX ((unsigned long long)MAXULONGLONG)
-# else
-# define PERL_UQUAD_MAX (~(unsigned long long)0)
-# endif
-# endif
-# endif
-
-# ifndef PERL_UQUAD_MIN
-# define PERL_UQUAD_MIN ((unsigned long long)0L)
-# endif
-
-# ifndef PERL_QUAD_MAX
-# ifdef LONGLONG_MAX
-# define PERL_QUAD_MAX ((long long)LONGLONG_MAX)
-# else
-# ifdef MAXLONGLONG
-# define PERL_QUAD_MAX ((long long)MAXLONGLONG)
-# else
-# define PERL_QUAD_MAX ((long long) (PERL_UQUAD_MAX >> 1))
-# endif
-# endif
-# endif
-
-# ifndef PERL_QUAD_MIN
-# ifdef LONGLONG_MIN
-# define PERL_QUAD_MIN ((long long)LONGLONG_MIN)
-# else
-# ifdef MINLONGLONG
-# define PERL_QUAD_MIN ((long long)MINLONGLONG)
-# else
-# define PERL_QUAD_MIN (-PERL_QUAD_MAX - ((3 & -1) == 3))
-# endif
-# endif
-# endif
-#endif
-
-/* This is based on code from 5.003 perl.h */
-#ifdef HAS_QUAD
-# ifdef cray
-#ifndef IVTYPE
-# define IVTYPE int
-#endif
-
-#ifndef IV_MIN
-# define IV_MIN PERL_INT_MIN
-#endif
-
-#ifndef IV_MAX
-# define IV_MAX PERL_INT_MAX
-#endif
-
-#ifndef UV_MIN
-# define UV_MIN PERL_UINT_MIN
-#endif
-
-#ifndef UV_MAX
-# define UV_MAX PERL_UINT_MAX
-#endif
-
-# ifdef INTSIZE
-#ifndef IVSIZE
-# define IVSIZE INTSIZE
-#endif
-
-# endif
-# else
-# if defined(convex) || defined(uts)
-#ifndef IVTYPE
-# define IVTYPE long long
-#endif
-
-#ifndef IV_MIN
-# define IV_MIN PERL_QUAD_MIN
-#endif
-
-#ifndef IV_MAX
-# define IV_MAX PERL_QUAD_MAX
-#endif
-
-#ifndef UV_MIN
-# define UV_MIN PERL_UQUAD_MIN
-#endif
-
-#ifndef UV_MAX
-# define UV_MAX PERL_UQUAD_MAX
-#endif
-
-# ifdef LONGLONGSIZE
-#ifndef IVSIZE
-# define IVSIZE LONGLONGSIZE
-#endif
-
-# endif
-# else
-#ifndef IVTYPE
-# define IVTYPE long
-#endif
-
-#ifndef IV_MIN
-# define IV_MIN PERL_LONG_MIN
-#endif
-
-#ifndef IV_MAX
-# define IV_MAX PERL_LONG_MAX
-#endif
-
-#ifndef UV_MIN
-# define UV_MIN PERL_ULONG_MIN
-#endif
-
-#ifndef UV_MAX
-# define UV_MAX PERL_ULONG_MAX
-#endif
-
-# ifdef LONGSIZE
-#ifndef IVSIZE
-# define IVSIZE LONGSIZE
-#endif
-
-# endif
-# endif
-# endif
-#ifndef IVSIZE
-# define IVSIZE 8
-#endif
-
-#ifndef LONGSIZE
-# define LONGSIZE 8
-#endif
-
-#ifndef PERL_QUAD_MIN
-# define PERL_QUAD_MIN IV_MIN
-#endif
-
-#ifndef PERL_QUAD_MAX
-# define PERL_QUAD_MAX IV_MAX
-#endif
-
-#ifndef PERL_UQUAD_MIN
-# define PERL_UQUAD_MIN UV_MIN
-#endif
-
-#ifndef PERL_UQUAD_MAX
-# define PERL_UQUAD_MAX UV_MAX
-#endif
-
-#else
-#ifndef IVTYPE
-# define IVTYPE long
-#endif
-
-#ifndef LONGSIZE
-# define LONGSIZE 4
-#endif
-
-#ifndef IV_MIN
-# define IV_MIN PERL_LONG_MIN
-#endif
-
-#ifndef IV_MAX
-# define IV_MAX PERL_LONG_MAX
-#endif
-
-#ifndef UV_MIN
-# define UV_MIN PERL_ULONG_MIN
-#endif
-
-#ifndef UV_MAX
-# define UV_MAX PERL_ULONG_MAX
-#endif
-
-#endif
-
-#ifndef IVSIZE
-# ifdef LONGSIZE
-# define IVSIZE LONGSIZE
-# else
-# define IVSIZE 4 /* A bold guess, but the best we can make. */
-# endif
-#endif
-#ifndef UVTYPE
-# define UVTYPE unsigned IVTYPE
-#endif
-
-#ifndef UVSIZE
-# define UVSIZE IVSIZE
-#endif
-#ifndef sv_setuv
-# define sv_setuv(sv, uv) \
- STMT_START { \
- UV TeMpUv = uv; \
- if (TeMpUv <= IV_MAX) \
- sv_setiv(sv, TeMpUv); \
- else \
- sv_setnv(sv, (double)TeMpUv); \
- } STMT_END
-#endif
-#ifndef newSVuv
-# define newSVuv(uv) ((uv) <= IV_MAX ? newSViv((IV)uv) : newSVnv((NV)uv))
-#endif
-#ifndef sv_2uv
-# define sv_2uv(sv) ((PL_Sv = (sv)), (UV) (SvNOK(PL_Sv) ? SvNV(PL_Sv) : sv_2nv(PL_Sv)))
-#endif
-
-#ifndef SvUVX
-# define SvUVX(sv) ((UV)SvIVX(sv))
-#endif
-
-#ifndef SvUVXx
-# define SvUVXx(sv) SvUVX(sv)
-#endif
-
-#ifndef SvUV
-# define SvUV(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv(sv))
-#endif
-
-#ifndef SvUVx
-# define SvUVx(sv) ((PL_Sv = (sv)), SvUV(PL_Sv))
-#endif
-
-/* Hint: sv_uv
- * Always use the SvUVx() macro instead of sv_uv().
- */
-#ifndef sv_uv
-# define sv_uv(sv) SvUVx(sv)
-#endif
-
-#if !defined(SvUOK) && defined(SvIOK_UV)
-# define SvUOK(sv) SvIOK_UV(sv)
-#endif
-#ifndef XST_mUV
-# define XST_mUV(i,v) (ST(i) = sv_2mortal(newSVuv(v)) )
-#endif
-
-#ifndef XSRETURN_UV
-# define XSRETURN_UV(v) STMT_START { XST_mUV(0,v); XSRETURN(1); } STMT_END
-#endif
-#ifndef PUSHu
-# define PUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); PUSHTARG; } STMT_END
-#endif
-
-#ifndef XPUSHu
-# define XPUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); XPUSHTARG; } STMT_END
-#endif
-
-#ifdef HAS_MEMCMP
-#ifndef memNE
-# define memNE(s1,s2,l) (memcmp(s1,s2,l))
-#endif
-
-#ifndef memEQ
-# define memEQ(s1,s2,l) (!memcmp(s1,s2,l))
-#endif
-
-#else
-#ifndef memNE
-# define memNE(s1,s2,l) (bcmp(s1,s2,l))
-#endif
-
-#ifndef memEQ
-# define memEQ(s1,s2,l) (!bcmp(s1,s2,l))
-#endif
-
-#endif
-#ifndef memEQs
-# define memEQs(s1, l, s2) \
- (sizeof(s2)-1 == l && memEQ(s1, (s2 ""), (sizeof(s2)-1)))
-#endif
-
-#ifndef memNEs
-# define memNEs(s1, l, s2) !memEQs(s1, l, s2)
-#endif
-#ifndef MoveD
-# define MoveD(s,d,n,t) memmove((char*)(d),(char*)(s), (n) * sizeof(t))
-#endif
-
-#ifndef CopyD
-# define CopyD(s,d,n,t) memcpy((char*)(d),(char*)(s), (n) * sizeof(t))
-#endif
-
-#ifdef HAS_MEMSET
-#ifndef ZeroD
-# define ZeroD(d,n,t) memzero((char*)(d), (n) * sizeof(t))
-#endif
-
-#else
-#ifndef ZeroD
-# define ZeroD(d,n,t) ((void)memzero((char*)(d), (n) * sizeof(t)), d)
-#endif
-
-#endif
-#ifndef PoisonWith
-# define PoisonWith(d,n,t,b) (void)memset((char*)(d), (U8)(b), (n) * sizeof(t))
-#endif
-
-#ifndef PoisonNew
-# define PoisonNew(d,n,t) PoisonWith(d,n,t,0xAB)
-#endif
-
-#ifndef PoisonFree
-# define PoisonFree(d,n,t) PoisonWith(d,n,t,0xEF)
-#endif
-
-#ifndef Poison
-# define Poison(d,n,t) PoisonFree(d,n,t)
-#endif
-#ifndef Newx
-# define Newx(v,n,t) New(0,v,n,t)
-#endif
-
-#ifndef Newxc
-# define Newxc(v,n,t,c) Newc(0,v,n,t,c)
-#endif
-
-#ifndef Newxz
-# define Newxz(v,n,t) Newz(0,v,n,t)
-#endif
-
-#ifndef PERL_UNUSED_DECL
-# ifdef HASATTRIBUTE
-# if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
-# define PERL_UNUSED_DECL
-# else
-# define PERL_UNUSED_DECL __attribute__((unused))
-# endif
-# else
-# define PERL_UNUSED_DECL
-# endif
-#endif
-
-#ifndef PERL_UNUSED_ARG
-# if defined(lint) && defined(S_SPLINT_S) /* www.splint.org */
-# include <note.h>
-# define PERL_UNUSED_ARG(x) NOTE(ARGUNUSED(x))
-# else
-# define PERL_UNUSED_ARG(x) ((void)x)
-# endif
-#endif
-
-#ifndef PERL_UNUSED_VAR
-# define PERL_UNUSED_VAR(x) ((void)x)
-#endif
-
-#ifndef PERL_UNUSED_CONTEXT
-# ifdef USE_ITHREADS
-# define PERL_UNUSED_CONTEXT PERL_UNUSED_ARG(my_perl)
-# else
-# define PERL_UNUSED_CONTEXT
-# endif
-#endif
-#ifndef NOOP
-# define NOOP /*EMPTY*/(void)0
-#endif
-
-#ifndef dNOOP
-# define dNOOP extern int /*@unused@*/ Perl___notused PERL_UNUSED_DECL
-#endif
-
-#ifndef NVTYPE
-# if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
-# define NVTYPE long double
-# else
-# define NVTYPE double
-# endif
-typedef NVTYPE NV;
-#endif
-
-#ifndef INT2PTR
-# if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE)
-# define PTRV UV
-# define INT2PTR(any,d) (any)(d)
-# else
-# if PTRSIZE == LONGSIZE
-# define PTRV unsigned long
-# else
-# define PTRV unsigned
-# endif
-# define INT2PTR(any,d) (any)(PTRV)(d)
-# endif
-#endif
-
-#ifndef PTR2ul
-# if PTRSIZE == LONGSIZE
-# define PTR2ul(p) (unsigned long)(p)
-# else
-# define PTR2ul(p) INT2PTR(unsigned long,p)
-# endif
-#endif
-#ifndef PTR2nat
-# define PTR2nat(p) (PTRV)(p)
-#endif
-
-#ifndef NUM2PTR
-# define NUM2PTR(any,d) (any)PTR2nat(d)
-#endif
-
-#ifndef PTR2IV
-# define PTR2IV(p) INT2PTR(IV,p)
-#endif
-
-#ifndef PTR2UV
-# define PTR2UV(p) INT2PTR(UV,p)
-#endif
-
-#ifndef PTR2NV
-# define PTR2NV(p) NUM2PTR(NV,p)
-#endif
-
-#undef START_EXTERN_C
-#undef END_EXTERN_C
-#undef EXTERN_C
-#ifdef __cplusplus
-# define START_EXTERN_C extern "C" {
-# define END_EXTERN_C }
-# define EXTERN_C extern "C"
-#else
-# define START_EXTERN_C
-# define END_EXTERN_C
-# define EXTERN_C extern
-#endif
-
-#if defined(PERL_GCC_PEDANTIC)
-# ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN
-# define PERL_GCC_BRACE_GROUPS_FORBIDDEN
-# endif
-#endif
-
-#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus)
-# ifndef PERL_USE_GCC_BRACE_GROUPS
-# define PERL_USE_GCC_BRACE_GROUPS
-# endif
-#endif
-
-#undef STMT_START
-#undef STMT_END
-#ifdef PERL_USE_GCC_BRACE_GROUPS
-# define STMT_START (void)( /* gcc supports ``({ STATEMENTS; })'' */
-# define STMT_END )
-#else
-# if defined(VOIDFLAGS) && (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && !defined(__GNUC__)
-# define STMT_START if (1)
-# define STMT_END else (void)0
-# else
-# define STMT_START do
-# define STMT_END while (0)
-# endif
-#endif
-#ifndef boolSV
-# define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)
-#endif
-
-/* DEFSV appears first in 5.004_56 */
-#ifndef DEFSV
-# define DEFSV GvSV(PL_defgv)
-#endif
-
-#ifndef SAVE_DEFSV
-# define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
-#endif
-
-#ifndef DEFSV_set
-# define DEFSV_set(sv) (DEFSV = (sv))
-#endif
-
-/* Older perls (<=5.003) lack AvFILLp */
-#ifndef AvFILLp
-# define AvFILLp AvFILL
-#endif
-#ifndef ERRSV
-# define ERRSV get_sv("@",FALSE)
-#endif
-
-/* Hint: gv_stashpvn
- * This function's backport doesn't support the length parameter, but
- * rather ignores it. Portability can only be ensured if the length
- * parameter is used for speed reasons, but the length can always be
- * correctly computed from the string argument.
- */
-#ifndef gv_stashpvn
-# define gv_stashpvn(str,len,create) gv_stashpv(str,create)
-#endif
-
-/* Replace: 1 */
-#ifndef get_cv
-# define get_cv perl_get_cv
-#endif
-
-#ifndef get_sv
-# define get_sv perl_get_sv
-#endif
-
-#ifndef get_av
-# define get_av perl_get_av
-#endif
-
-#ifndef get_hv
-# define get_hv perl_get_hv
-#endif
-
-/* Replace: 0 */
-#ifndef dUNDERBAR
-# define dUNDERBAR dNOOP
-#endif
-
-#ifndef UNDERBAR
-# define UNDERBAR DEFSV
-#endif
-#ifndef dAX
-# define dAX I32 ax = MARK - PL_stack_base + 1
-#endif
-
-#ifndef dITEMS
-# define dITEMS I32 items = SP - MARK
-#endif
-#ifndef dXSTARG
-# define dXSTARG SV * targ = sv_newmortal()
-#endif
-#ifndef dAXMARK
-# define dAXMARK I32 ax = POPMARK; \
- register SV ** const mark = PL_stack_base + ax++
-#endif
-#ifndef XSprePUSH
-# define XSprePUSH (sp = PL_stack_base + ax - 1)
-#endif
-
-#if (PERL_BCDVERSION < 0x5005000)
-# undef XSRETURN
-# define XSRETURN(off) \
- STMT_START { \
- PL_stack_sp = PL_stack_base + ax + ((off) - 1); \
- return; \
- } STMT_END
-#endif
-#ifndef XSPROTO
-# define XSPROTO(name) void name(pTHX_ CV* cv)
-#endif
-
-#ifndef SVfARG
-# define SVfARG(p) ((void*)(p))
-#endif
-#ifndef PERL_ABS
-# define PERL_ABS(x) ((x) < 0 ? -(x) : (x))
-#endif
-#ifndef dVAR
-# define dVAR dNOOP
-#endif
-#ifndef SVf
-# define SVf "_"
-#endif
-#ifndef UTF8_MAXBYTES
-# define UTF8_MAXBYTES UTF8_MAXLEN
-#endif
-#ifndef CPERLscope
-# define CPERLscope(x) x
-#endif
-#ifndef PERL_HASH
-# define PERL_HASH(hash,str,len) \
- STMT_START { \
- const char *s_PeRlHaSh = str; \
- I32 i_PeRlHaSh = len; \
- U32 hash_PeRlHaSh = 0; \
- while (i_PeRlHaSh--) \
- hash_PeRlHaSh = hash_PeRlHaSh * 33 + *s_PeRlHaSh++; \
- (hash) = hash_PeRlHaSh; \
- } STMT_END
-#endif
-
-#ifndef PERLIO_FUNCS_DECL
-# ifdef PERLIO_FUNCS_CONST
-# define PERLIO_FUNCS_DECL(funcs) const PerlIO_funcs funcs
-# define PERLIO_FUNCS_CAST(funcs) (PerlIO_funcs*)(funcs)
-# else
-# define PERLIO_FUNCS_DECL(funcs) PerlIO_funcs funcs
-# define PERLIO_FUNCS_CAST(funcs) (funcs)
-# endif
-#endif
-
-/* provide these typedefs for older perls */
-#if (PERL_BCDVERSION < 0x5009003)
-
-# ifdef ARGSproto
-typedef OP* (CPERLscope(*Perl_ppaddr_t))(ARGSproto);
-# else
-typedef OP* (CPERLscope(*Perl_ppaddr_t))(pTHX);
-# endif
-
-typedef OP* (CPERLscope(*Perl_check_t)) (pTHX_ OP*);
-
-#endif
-#ifndef isPSXSPC
-# define isPSXSPC(c) (isSPACE(c) || (c) == '\v')
-#endif
-
-#ifndef isBLANK
-# define isBLANK(c) ((c) == ' ' || (c) == '\t')
-#endif
-
-#ifdef EBCDIC
-#ifndef isALNUMC
-# define isALNUMC(c) isalnum(c)
-#endif
-
-#ifndef isASCII
-# define isASCII(c) isascii(c)
-#endif
-
-#ifndef isCNTRL
-# define isCNTRL(c) iscntrl(c)
-#endif
-
-#ifndef isGRAPH
-# define isGRAPH(c) isgraph(c)
-#endif
-
-#ifndef isPRINT
-# define isPRINT(c) isprint(c)
-#endif
-
-#ifndef isPUNCT
-# define isPUNCT(c) ispunct(c)
-#endif
-
-#ifndef isXDIGIT
-# define isXDIGIT(c) isxdigit(c)
-#endif
-
-#else
-# if (PERL_BCDVERSION < 0x5010000)
-/* Hint: isPRINT
- * The implementation in older perl versions includes all of the
- * isSPACE() characters, which is wrong. The version provided by
- * Devel::PPPort always overrides a present buggy version.
- */
-# undef isPRINT
-# endif
-
-#ifdef HAS_QUAD
-# ifdef U64TYPE
-# define WIDEST_UTYPE U64TYPE
-# else
-# define WIDEST_UTYPE Quad_t
-# endif
-#else
-# define WIDEST_UTYPE U32
-#endif
-#ifndef isALNUMC
-# define isALNUMC(c) (isALPHA(c) || isDIGIT(c))
-#endif
-
-#ifndef isASCII
-# define isASCII(c) ((WIDEST_UTYPE) (c) <= 127)
-#endif
-
-#ifndef isCNTRL
-# define isCNTRL(c) ((WIDEST_UTYPE) (c) < ' ' || (c) == 127)
-#endif
-
-#ifndef isGRAPH
-# define isGRAPH(c) (isALNUM(c) || isPUNCT(c))
-#endif
-
-#ifndef isPRINT
-# define isPRINT(c) (((c) >= 32 && (c) < 127))
-#endif
-
-#ifndef isPUNCT
-# define isPUNCT(c) (((c) >= 33 && (c) <= 47) || ((c) >= 58 && (c) <= 64) || ((c) >= 91 && (c) <= 96) || ((c) >= 123 && (c) <= 126))
-#endif
-
-#ifndef isXDIGIT
-# define isXDIGIT(c) (isDIGIT(c) || ((c) >= 'a' && (c) <= 'f') || ((c) >= 'A' && (c) <= 'F'))
-#endif
-
-#endif
-
-/* Until we figure out how to support this in older perls... */
-#if (PERL_BCDVERSION >= 0x5008000)
-#ifndef HeUTF8
-# define HeUTF8(he) ((HeKLEN(he) == HEf_SVKEY) ? \
- SvUTF8(HeKEY_sv(he)) : \
- (U32)HeKUTF8(he))
-#endif
-
-#endif
-
-#ifndef PERL_SIGNALS_UNSAFE_FLAG
-
-#define PERL_SIGNALS_UNSAFE_FLAG 0x0001
-
-#if (PERL_BCDVERSION < 0x5008000)
-# define D_PPP_PERL_SIGNALS_INIT PERL_SIGNALS_UNSAFE_FLAG
-#else
-# define D_PPP_PERL_SIGNALS_INIT 0
-#endif
-
-#if defined(NEED_PL_signals)
-static U32 DPPP_(my_PL_signals) = D_PPP_PERL_SIGNALS_INIT;
-#elif defined(NEED_PL_signals_GLOBAL)
-U32 DPPP_(my_PL_signals) = D_PPP_PERL_SIGNALS_INIT;
-#else
-extern U32 DPPP_(my_PL_signals);
-#endif
-#define PL_signals DPPP_(my_PL_signals)
-
-#endif
-
-/* Hint: PL_ppaddr
- * Calling an op via PL_ppaddr requires passing a context argument
- * for threaded builds. Since the context argument is different for
- * 5.005 perls, you can use aTHXR (supplied by ppport.h), which will
- * automatically be defined as the correct argument.
- */
-
-#if (PERL_BCDVERSION <= 0x5005005)
-/* Replace: 1 */
-# define PL_ppaddr ppaddr
-# define PL_no_modify no_modify
-/* Replace: 0 */
-#endif
-
-#if (PERL_BCDVERSION <= 0x5004005)
-/* Replace: 1 */
-# define PL_DBsignal DBsignal
-# define PL_DBsingle DBsingle
-# define PL_DBsub DBsub
-# define PL_DBtrace DBtrace
-# define PL_Sv Sv
-# define PL_bufend bufend
-# define PL_bufptr bufptr
-# define PL_compiling compiling
-# define PL_copline copline
-# define PL_curcop curcop
-# define PL_curstash curstash
-# define PL_debstash debstash
-# define PL_defgv defgv
-# define PL_diehook diehook
-# define PL_dirty dirty
-# define PL_dowarn dowarn
-# define PL_errgv errgv
-# define PL_error_count error_count
-# define PL_expect expect
-# define PL_hexdigit hexdigit
-# define PL_hints hints
-# define PL_in_my in_my
-# define PL_laststatval laststatval
-# define PL_lex_state lex_state
-# define PL_lex_stuff lex_stuff
-# define PL_linestr linestr
-# define PL_na na
-# define PL_perl_destruct_level perl_destruct_level
-# define PL_perldb perldb
-# define PL_rsfp_filters rsfp_filters
-# define PL_rsfp rsfp
-# define PL_stack_base stack_base
-# define PL_stack_sp stack_sp
-# define PL_statcache statcache
-# define PL_stdingv stdingv
-# define PL_sv_arenaroot sv_arenaroot
-# define PL_sv_no sv_no
-# define PL_sv_undef sv_undef
-# define PL_sv_yes sv_yes
-# define PL_tainted tainted
-# define PL_tainting tainting
-# define PL_tokenbuf tokenbuf
-/* Replace: 0 */
-#endif
-
-/* Warning: PL_parser
- * For perl versions earlier than 5.9.5, this is an always
- * non-NULL dummy. Also, it cannot be dereferenced. Don't
- * use it if you can avoid is and unless you absolutely know
- * what you're doing.
- * If you always check that PL_parser is non-NULL, you can
- * define DPPP_PL_parser_NO_DUMMY to avoid the creation of
- * a dummy parser structure.
- */
-
-#if (PERL_BCDVERSION >= 0x5009005)
-# ifdef DPPP_PL_parser_NO_DUMMY
-# define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \
- (croak("panic: PL_parser == NULL in %s:%d", \
- __FILE__, __LINE__), (yy_parser *) NULL))->var)
-# else
-# ifdef DPPP_PL_parser_NO_DUMMY_WARNING
-# define D_PPP_parser_dummy_warning(var)
-# else
-# define D_PPP_parser_dummy_warning(var) \
- warn("warning: dummy PL_" #var " used in %s:%d", __FILE__, __LINE__),
-# endif
-# define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \
- (D_PPP_parser_dummy_warning(var) &DPPP_(dummy_PL_parser)))->var)
-#if defined(NEED_PL_parser)
-static yy_parser DPPP_(dummy_PL_parser);
-#elif defined(NEED_PL_parser_GLOBAL)
-yy_parser DPPP_(dummy_PL_parser);
-#else
-extern yy_parser DPPP_(dummy_PL_parser);
-#endif
-
-# endif
-
-/* PL_expect, PL_copline, PL_rsfp, PL_rsfp_filters, PL_linestr, PL_bufptr, PL_bufend, PL_lex_state, PL_lex_stuff, PL_tokenbuf depends on PL_parser */
-/* Warning: PL_expect, PL_copline, PL_rsfp, PL_rsfp_filters, PL_linestr, PL_bufptr, PL_bufend, PL_lex_state, PL_lex_stuff, PL_tokenbuf
- * Do not use this variable unless you know exactly what you're
- * doint. It is internal to the perl parser and may change or even
- * be removed in the future. As of perl 5.9.5, you have to check
- * for (PL_parser != NULL) for this variable to have any effect.
- * An always non-NULL PL_parser dummy is provided for earlier
- * perl versions.
- * If PL_parser is NULL when you try to access this variable, a
- * dummy is being accessed instead and a warning is issued unless
- * you define DPPP_PL_parser_NO_DUMMY_WARNING.
- * If DPPP_PL_parser_NO_DUMMY is defined, the code trying to access
- * this variable will croak with a panic message.
- */
-
-# define PL_expect D_PPP_my_PL_parser_var(expect)
-# define PL_copline D_PPP_my_PL_parser_var(copline)
-# define PL_rsfp D_PPP_my_PL_parser_var(rsfp)
-# define PL_rsfp_filters D_PPP_my_PL_parser_var(rsfp_filters)
-# define PL_linestr D_PPP_my_PL_parser_var(linestr)
-# define PL_bufptr D_PPP_my_PL_parser_var(bufptr)
-# define PL_bufend D_PPP_my_PL_parser_var(bufend)
-# define PL_lex_state D_PPP_my_PL_parser_var(lex_state)
-# define PL_lex_stuff D_PPP_my_PL_parser_var(lex_stuff)
-# define PL_tokenbuf D_PPP_my_PL_parser_var(tokenbuf)
-# define PL_in_my D_PPP_my_PL_parser_var(in_my)
-# define PL_in_my_stash D_PPP_my_PL_parser_var(in_my_stash)
-# define PL_error_count D_PPP_my_PL_parser_var(error_count)
-
-
-#else
-
-/* ensure that PL_parser != NULL and cannot be dereferenced */
-# define PL_parser ((void *) 1)
-
-#endif
-#ifndef mPUSHs
-# define mPUSHs(s) PUSHs(sv_2mortal(s))
-#endif
-
-#ifndef PUSHmortal
-# define PUSHmortal PUSHs(sv_newmortal())
-#endif
-
-#ifndef mPUSHp
-# define mPUSHp(p,l) sv_setpvn(PUSHmortal, (p), (l))
-#endif
-
-#ifndef mPUSHn
-# define mPUSHn(n) sv_setnv(PUSHmortal, (NV)(n))
-#endif
-
-#ifndef mPUSHi
-# define mPUSHi(i) sv_setiv(PUSHmortal, (IV)(i))
-#endif
-
-#ifndef mPUSHu
-# define mPUSHu(u) sv_setuv(PUSHmortal, (UV)(u))
-#endif
-#ifndef mXPUSHs
-# define mXPUSHs(s) XPUSHs(sv_2mortal(s))
-#endif
-
-#ifndef XPUSHmortal
-# define XPUSHmortal XPUSHs(sv_newmortal())
-#endif
-
-#ifndef mXPUSHp
-# define mXPUSHp(p,l) STMT_START { EXTEND(sp,1); sv_setpvn(PUSHmortal, (p), (l)); } STMT_END
-#endif
-
-#ifndef mXPUSHn
-# define mXPUSHn(n) STMT_START { EXTEND(sp,1); sv_setnv(PUSHmortal, (NV)(n)); } STMT_END
-#endif
-
-#ifndef mXPUSHi
-# define mXPUSHi(i) STMT_START { EXTEND(sp,1); sv_setiv(PUSHmortal, (IV)(i)); } STMT_END
-#endif
-
-#ifndef mXPUSHu
-# define mXPUSHu(u) STMT_START { EXTEND(sp,1); sv_setuv(PUSHmortal, (UV)(u)); } STMT_END
-#endif
-
-/* Replace: 1 */
-#ifndef call_sv
-# define call_sv perl_call_sv
-#endif
-
-#ifndef call_pv
-# define call_pv perl_call_pv
-#endif
-
-#ifndef call_argv
-# define call_argv perl_call_argv
-#endif
-
-#ifndef call_method
-# define call_method perl_call_method
-#endif
-#ifndef eval_sv
-# define eval_sv perl_eval_sv
-#endif
-
-/* Replace: 0 */
-#ifndef PERL_LOADMOD_DENY
-# define PERL_LOADMOD_DENY 0x1
-#endif
-
-#ifndef PERL_LOADMOD_NOIMPORT
-# define PERL_LOADMOD_NOIMPORT 0x2
-#endif
-
-#ifndef PERL_LOADMOD_IMPORT_OPS
-# define PERL_LOADMOD_IMPORT_OPS 0x4
-#endif
-
-#ifndef G_METHOD
-# define G_METHOD 64
-# ifdef call_sv
-# undef call_sv
-# endif
-# if (PERL_BCDVERSION < 0x5006000)
-# define call_sv(sv, flags) ((flags) & G_METHOD ? perl_call_method((char *) SvPV_nolen_const(sv), \
- (flags) & ~G_METHOD) : perl_call_sv(sv, flags))
-# else
-# define call_sv(sv, flags) ((flags) & G_METHOD ? Perl_call_method(aTHX_ (char *) SvPV_nolen_const(sv), \
- (flags) & ~G_METHOD) : Perl_call_sv(aTHX_ sv, flags))
-# endif
-#endif
-
-/* Replace perl_eval_pv with eval_pv */
-
-#ifndef eval_pv
-#if defined(NEED_eval_pv)
-static SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
-static
-#else
-extern SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
-#endif
-
-#ifdef eval_pv
-# undef eval_pv
-#endif
-#define eval_pv(a,b) DPPP_(my_eval_pv)(aTHX_ a,b)
-#define Perl_eval_pv DPPP_(my_eval_pv)
-
-#if defined(NEED_eval_pv) || defined(NEED_eval_pv_GLOBAL)
-
-SV*
-DPPP_(my_eval_pv)(char *p, I32 croak_on_error)
-{
- dSP;
- SV* sv = newSVpv(p, 0);
-
- PUSHMARK(sp);
- eval_sv(sv, G_SCALAR);
- SvREFCNT_dec(sv);
-
- SPAGAIN;
- sv = POPs;
- PUTBACK;
-
- if (croak_on_error && SvTRUE(GvSV(errgv)))
- croak("%s", SvPVx(GvSV(errgv), na));
-
- return sv;
-}
-
-#endif
-#endif
-
-#ifndef vload_module
-#if defined(NEED_vload_module)
-static void DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args);
-static
-#else
-extern void DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args);
-#endif
-
-#ifdef vload_module
-# undef vload_module
-#endif
-#define vload_module(a,b,c,d) DPPP_(my_vload_module)(aTHX_ a,b,c,d)
-#define Perl_vload_module DPPP_(my_vload_module)
-
-#if defined(NEED_vload_module) || defined(NEED_vload_module_GLOBAL)
-
-void
-DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args)
-{
- dTHR;
- dVAR;
- OP *veop, *imop;
-
- OP * const modname = newSVOP(OP_CONST, 0, name);
- /* 5.005 has a somewhat hacky force_normal that doesn't croak on
- SvREADONLY() if PL_compling is true. Current perls take care in
- ck_require() to correctly turn off SvREADONLY before calling
- force_normal_flags(). This seems a better fix than fudging PL_compling
- */
- SvREADONLY_off(((SVOP*)modname)->op_sv);
- modname->op_private |= OPpCONST_BARE;
- if (ver) {
- veop = newSVOP(OP_CONST, 0, ver);
- }
- else
- veop = NULL;
- if (flags & PERL_LOADMOD_NOIMPORT) {
- imop = sawparens(newNULLLIST());
- }
- else if (flags & PERL_LOADMOD_IMPORT_OPS) {
- imop = va_arg(*args, OP*);
- }
- else {
- SV *sv;
- imop = NULL;
- sv = va_arg(*args, SV*);
- while (sv) {
- imop = append_elem(OP_LIST, imop, newSVOP(OP_CONST, 0, sv));
- sv = va_arg(*args, SV*);
- }
- }
- {
- const line_t ocopline = PL_copline;
- COP * const ocurcop = PL_curcop;
- const int oexpect = PL_expect;
-
-#if (PERL_BCDVERSION >= 0x5004000)
- utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(FALSE, 0),
- veop, modname, imop);
-#elif (PERL_BCDVERSION > 0x5003000)
- utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(),
- veop, modname, imop);
-#else
- utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(),
- modname, imop);
-#endif
- PL_expect = oexpect;
- PL_copline = ocopline;
- PL_curcop = ocurcop;
- }
-}
-
-#endif
-#endif
-
-#ifndef load_module
-#if defined(NEED_load_module)
-static void DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...);
-static
-#else
-extern void DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...);
-#endif
-
-#ifdef load_module
-# undef load_module
-#endif
-#define load_module DPPP_(my_load_module)
-#define Perl_load_module DPPP_(my_load_module)
-
-#if defined(NEED_load_module) || defined(NEED_load_module_GLOBAL)
-
-void
-DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...)
-{
- va_list args;
- va_start(args, ver);
- vload_module(flags, name, ver, &args);
- va_end(args);
-}
-
-#endif
-#endif
-#ifndef newRV_inc
-# define newRV_inc(sv) newRV(sv) /* Replace */
-#endif
-
-#ifndef newRV_noinc
-#if defined(NEED_newRV_noinc)
-static SV * DPPP_(my_newRV_noinc)(SV *sv);
-static
-#else
-extern SV * DPPP_(my_newRV_noinc)(SV *sv);
-#endif
-
-#ifdef newRV_noinc
-# undef newRV_noinc
-#endif
-#define newRV_noinc(a) DPPP_(my_newRV_noinc)(aTHX_ a)
-#define Perl_newRV_noinc DPPP_(my_newRV_noinc)
-
-#if defined(NEED_newRV_noinc) || defined(NEED_newRV_noinc_GLOBAL)
-SV *
-DPPP_(my_newRV_noinc)(SV *sv)
-{
- SV *rv = (SV *)newRV(sv);
- SvREFCNT_dec(sv);
- return rv;
-}
-#endif
-#endif
-
-/* Hint: newCONSTSUB
- * Returns a CV* as of perl-5.7.1. This return value is not supported
- * by Devel::PPPort.
- */
-
-/* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */
-#if (PERL_BCDVERSION < 0x5004063) && (PERL_BCDVERSION != 0x5004005)
-#if defined(NEED_newCONSTSUB)
-static void DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv);
-static
-#else
-extern void DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv);
-#endif
-
-#ifdef newCONSTSUB
-# undef newCONSTSUB
-#endif
-#define newCONSTSUB(a,b,c) DPPP_(my_newCONSTSUB)(aTHX_ a,b,c)
-#define Perl_newCONSTSUB DPPP_(my_newCONSTSUB)
-
-#if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL)
-
-/* This is just a trick to avoid a dependency of newCONSTSUB on PL_parser */
-/* (There's no PL_parser in perl < 5.005, so this is completely safe) */
-#define D_PPP_PL_copline PL_copline
-
-void
-DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv)
-{
- U32 oldhints = PL_hints;
- HV *old_cop_stash = PL_curcop->cop_stash;
- HV *old_curstash = PL_curstash;
- line_t oldline = PL_curcop->cop_line;
- PL_curcop->cop_line = D_PPP_PL_copline;
-
- PL_hints &= ~HINT_BLOCK_SCOPE;
- if (stash)
- PL_curstash = PL_curcop->cop_stash = stash;
-
- newSUB(
-
-#if (PERL_BCDVERSION < 0x5003022)
- start_subparse(),
-#elif (PERL_BCDVERSION == 0x5003022)
- start_subparse(0),
-#else /* 5.003_23 onwards */
- start_subparse(FALSE, 0),
-#endif
-
- newSVOP(OP_CONST, 0, newSVpv((char *) name, 0)),
- newSVOP(OP_CONST, 0, &PL_sv_no), /* SvPV(&PL_sv_no) == "" -- GMB */
- newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
- );
-
- PL_hints = oldhints;
- PL_curcop->cop_stash = old_cop_stash;
- PL_curstash = old_curstash;
- PL_curcop->cop_line = oldline;
-}
-#endif
-#endif
-
-/*
- * Boilerplate macros for initializing and accessing interpreter-local
- * data from C. All statics in extensions should be reworked to use
- * this, if you want to make the extension thread-safe. See ext/re/re.xs
- * for an example of the use of these macros.
- *
- * Code that uses these macros is responsible for the following:
- * 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts"
- * 2. Declare a typedef named my_cxt_t that is a structure that contains
- * all the data that needs to be interpreter-local.
- * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t.
- * 4. Use the MY_CXT_INIT macro such that it is called exactly once
- * (typically put in the BOOT: section).
- * 5. Use the members of the my_cxt_t structure everywhere as
- * MY_CXT.member.
- * 6. Use the dMY_CXT macro (a declaration) in all the functions that
- * access MY_CXT.
- */
-
-#if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \
- defined(PERL_CAPI) || defined(PERL_IMPLICIT_CONTEXT)
-
-#ifndef START_MY_CXT
-
-/* This must appear in all extensions that define a my_cxt_t structure,
- * right after the definition (i.e. at file scope). The non-threads
- * case below uses it to declare the data as static. */
-#define START_MY_CXT
-
-#if (PERL_BCDVERSION < 0x5004068)
-/* Fetches the SV that keeps the per-interpreter data. */
-#define dMY_CXT_SV \
- SV *my_cxt_sv = get_sv(MY_CXT_KEY, FALSE)
-#else /* >= perl5.004_68 */
-#define dMY_CXT_SV \
- SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY, \
- sizeof(MY_CXT_KEY)-1, TRUE)
-#endif /* < perl5.004_68 */
-
-/* This declaration should be used within all functions that use the
- * interpreter-local data. */
-#define dMY_CXT \
- dMY_CXT_SV; \
- my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*,SvUV(my_cxt_sv))
-
-/* Creates and zeroes the per-interpreter data.
- * (We allocate my_cxtp in a Perl SV so that it will be released when
- * the interpreter goes away.) */
-#define MY_CXT_INIT \
- dMY_CXT_SV; \
- /* newSV() allocates one more than needed */ \
- my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
- Zero(my_cxtp, 1, my_cxt_t); \
- sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
-
-/* This macro must be used to access members of the my_cxt_t structure.
- * e.g. MYCXT.some_data */
-#define MY_CXT (*my_cxtp)
-
-/* Judicious use of these macros can reduce the number of times dMY_CXT
- * is used. Use is similar to pTHX, aTHX etc. */
-#define pMY_CXT my_cxt_t *my_cxtp
-#define pMY_CXT_ pMY_CXT,
-#define _pMY_CXT ,pMY_CXT
-#define aMY_CXT my_cxtp
-#define aMY_CXT_ aMY_CXT,
-#define _aMY_CXT ,aMY_CXT
-
-#endif /* START_MY_CXT */
-
-#ifndef MY_CXT_CLONE
-/* Clones the per-interpreter data. */
-#define MY_CXT_CLONE \
- dMY_CXT_SV; \
- my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
- Copy(INT2PTR(my_cxt_t*, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t);\
- sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
-#endif
-
-#else /* single interpreter */
-
-#ifndef START_MY_CXT
-
-#define START_MY_CXT static my_cxt_t my_cxt;
-#define dMY_CXT_SV dNOOP
-#define dMY_CXT dNOOP
-#define MY_CXT_INIT NOOP
-#define MY_CXT my_cxt
-
-#define pMY_CXT void
-#define pMY_CXT_
-#define _pMY_CXT
-#define aMY_CXT
-#define aMY_CXT_
-#define _aMY_CXT
-
-#endif /* START_MY_CXT */
-
-#ifndef MY_CXT_CLONE
-#define MY_CXT_CLONE NOOP
-#endif
-
-#endif
-
-#ifndef IVdf
-# if IVSIZE == LONGSIZE
-# define IVdf "ld"
-# define UVuf "lu"
-# define UVof "lo"
-# define UVxf "lx"
-# define UVXf "lX"
-# elif IVSIZE == INTSIZE
-# define IVdf "d"
-# define UVuf "u"
-# define UVof "o"
-# define UVxf "x"
-# define UVXf "X"
-# else
-# error "cannot define IV/UV formats"
-# endif
-#endif
-
-#ifndef NVef
-# if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \
- defined(PERL_PRIfldbl) && (PERL_BCDVERSION != 0x5006000)
- /* Not very likely, but let's try anyway. */
-# define NVef PERL_PRIeldbl
-# define NVff PERL_PRIfldbl
-# define NVgf PERL_PRIgldbl
-# else
-# define NVef "e"
-# define NVff "f"
-# define NVgf "g"
-# endif
-#endif
-
-#ifndef SvREFCNT_inc
-# ifdef PERL_USE_GCC_BRACE_GROUPS
-# define SvREFCNT_inc(sv) \
- ({ \
- SV * const _sv = (SV*)(sv); \
- if (_sv) \
- (SvREFCNT(_sv))++; \
- _sv; \
- })
-# else
-# define SvREFCNT_inc(sv) \
- ((PL_Sv=(SV*)(sv)) ? (++(SvREFCNT(PL_Sv)),PL_Sv) : NULL)
-# endif
-#endif
-
-#ifndef SvREFCNT_inc_simple
-# ifdef PERL_USE_GCC_BRACE_GROUPS
-# define SvREFCNT_inc_simple(sv) \
- ({ \
- if (sv) \
- (SvREFCNT(sv))++; \
- (SV *)(sv); \
- })
-# else
-# define SvREFCNT_inc_simple(sv) \
- ((sv) ? (SvREFCNT(sv)++,(SV*)(sv)) : NULL)
-# endif
-#endif
-
-#ifndef SvREFCNT_inc_NN
-# ifdef PERL_USE_GCC_BRACE_GROUPS
-# define SvREFCNT_inc_NN(sv) \
- ({ \
- SV * const _sv = (SV*)(sv); \
- SvREFCNT(_sv)++; \
- _sv; \
- })
-# else
-# define SvREFCNT_inc_NN(sv) \
- (PL_Sv=(SV*)(sv),++(SvREFCNT(PL_Sv)),PL_Sv)
-# endif
-#endif
-
-#ifndef SvREFCNT_inc_void
-# ifdef PERL_USE_GCC_BRACE_GROUPS
-# define SvREFCNT_inc_void(sv) \
- ({ \
- SV * const _sv = (SV*)(sv); \
- if (_sv) \
- (void)(SvREFCNT(_sv)++); \
- })
-# else
-# define SvREFCNT_inc_void(sv) \
- (void)((PL_Sv=(SV*)(sv)) ? ++(SvREFCNT(PL_Sv)) : 0)
-# endif
-#endif
-#ifndef SvREFCNT_inc_simple_void
-# define SvREFCNT_inc_simple_void(sv) STMT_START { if (sv) SvREFCNT(sv)++; } STMT_END
-#endif
-
-#ifndef SvREFCNT_inc_simple_NN
-# define SvREFCNT_inc_simple_NN(sv) (++SvREFCNT(sv), (SV*)(sv))
-#endif
-
-#ifndef SvREFCNT_inc_void_NN
-# define SvREFCNT_inc_void_NN(sv) (void)(++SvREFCNT((SV*)(sv)))
-#endif
-
-#ifndef SvREFCNT_inc_simple_void_NN
-# define SvREFCNT_inc_simple_void_NN(sv) (void)(++SvREFCNT((SV*)(sv)))
-#endif
-
-#ifndef newSV_type
-
-#if defined(NEED_newSV_type)
-static SV* DPPP_(my_newSV_type)(pTHX_ svtype const t);
-static
-#else
-extern SV* DPPP_(my_newSV_type)(pTHX_ svtype const t);
-#endif
-
-#ifdef newSV_type
-# undef newSV_type
-#endif
-#define newSV_type(a) DPPP_(my_newSV_type)(aTHX_ a)
-#define Perl_newSV_type DPPP_(my_newSV_type)
-
-#if defined(NEED_newSV_type) || defined(NEED_newSV_type_GLOBAL)
-
-SV*
-DPPP_(my_newSV_type)(pTHX_ svtype const t)
-{
- SV* const sv = newSV(0);
- sv_upgrade(sv, t);
- return sv;
-}
-
-#endif
-
-#endif
-
-#if (PERL_BCDVERSION < 0x5006000)
-# define D_PPP_CONSTPV_ARG(x) ((char *) (x))
-#else
-# define D_PPP_CONSTPV_ARG(x) (x)
-#endif
-#ifndef newSVpvn
-# define newSVpvn(data,len) ((data) \
- ? ((len) ? newSVpv((data), (len)) : newSVpv("", 0)) \
- : newSV(0))
-#endif
-#ifndef newSVpvn_utf8
-# define newSVpvn_utf8(s, len, u) newSVpvn_flags((s), (len), (u) ? SVf_UTF8 : 0)
-#endif
-#ifndef SVf_UTF8
-# define SVf_UTF8 0
-#endif
-
-#ifndef newSVpvn_flags
-
-#if defined(NEED_newSVpvn_flags)
-static SV * DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags);
-static
-#else
-extern SV * DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags);
-#endif
-
-#ifdef newSVpvn_flags
-# undef newSVpvn_flags
-#endif
-#define newSVpvn_flags(a,b,c) DPPP_(my_newSVpvn_flags)(aTHX_ a,b,c)
-#define Perl_newSVpvn_flags DPPP_(my_newSVpvn_flags)
-
-#if defined(NEED_newSVpvn_flags) || defined(NEED_newSVpvn_flags_GLOBAL)
-
-SV *
-DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags)
-{
- SV *sv = newSVpvn(D_PPP_CONSTPV_ARG(s), len);
- SvFLAGS(sv) |= (flags & SVf_UTF8);
- return (flags & SVs_TEMP) ? sv_2mortal(sv) : sv;
-}
-
-#endif
-
-#endif
-
-/* Backwards compatibility stuff... :-( */
-#if !defined(NEED_sv_2pv_flags) && defined(NEED_sv_2pv_nolen)
-# define NEED_sv_2pv_flags
-#endif
-#if !defined(NEED_sv_2pv_flags_GLOBAL) && defined(NEED_sv_2pv_nolen_GLOBAL)
-# define NEED_sv_2pv_flags_GLOBAL
-#endif
-
-/* Hint: sv_2pv_nolen
- * Use the SvPV_nolen() or SvPV_nolen_const() macros instead of sv_2pv_nolen().
- */
-#ifndef sv_2pv_nolen
-# define sv_2pv_nolen(sv) SvPV_nolen(sv)
-#endif
-
-#ifdef SvPVbyte
-
-/* Hint: SvPVbyte
- * Does not work in perl-5.6.1, ppport.h implements a version
- * borrowed from perl-5.7.3.
- */
-
-#if (PERL_BCDVERSION < 0x5007000)
-
-#if defined(NEED_sv_2pvbyte)
-static char * DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp);
-static
-#else
-extern char * DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp);
-#endif
-
-#ifdef sv_2pvbyte
-# undef sv_2pvbyte
-#endif
-#define sv_2pvbyte(a,b) DPPP_(my_sv_2pvbyte)(aTHX_ a,b)
-#define Perl_sv_2pvbyte DPPP_(my_sv_2pvbyte)
-
-#if defined(NEED_sv_2pvbyte) || defined(NEED_sv_2pvbyte_GLOBAL)
-
-char *
-DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp)
-{
- sv_utf8_downgrade(sv,0);
- return SvPV(sv,*lp);
-}
-
-#endif
-
-/* Hint: sv_2pvbyte
- * Use the SvPVbyte() macro instead of sv_2pvbyte().
- */
-
-#undef SvPVbyte
-
-#define SvPVbyte(sv, lp) \
- ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \
- ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte(sv, &lp))
-
-#endif
-
-#else
-
-# define SvPVbyte SvPV
-# define sv_2pvbyte sv_2pv
-
-#endif
-#ifndef sv_2pvbyte_nolen
-# define sv_2pvbyte_nolen(sv) sv_2pv_nolen(sv)
-#endif
-
-/* Hint: sv_pvn
- * Always use the SvPV() macro instead of sv_pvn().
- */
-
-/* Hint: sv_pvn_force
- * Always use the SvPV_force() macro instead of sv_pvn_force().
- */
-
-/* If these are undefined, they're not handled by the core anyway */
-#ifndef SV_IMMEDIATE_UNREF
-# define SV_IMMEDIATE_UNREF 0
-#endif
-
-#ifndef SV_GMAGIC
-# define SV_GMAGIC 0
-#endif
-
-#ifndef SV_COW_DROP_PV
-# define SV_COW_DROP_PV 0
-#endif
-
-#ifndef SV_UTF8_NO_ENCODING
-# define SV_UTF8_NO_ENCODING 0
-#endif
-
-#ifndef SV_NOSTEAL
-# define SV_NOSTEAL 0
-#endif
-
-#ifndef SV_CONST_RETURN
-# define SV_CONST_RETURN 0
-#endif
-
-#ifndef SV_MUTABLE_RETURN
-# define SV_MUTABLE_RETURN 0
-#endif
-
-#ifndef SV_SMAGIC
-# define SV_SMAGIC 0
-#endif
-
-#ifndef SV_HAS_TRAILING_NUL
-# define SV_HAS_TRAILING_NUL 0
-#endif
-
-#ifndef SV_COW_SHARED_HASH_KEYS
-# define SV_COW_SHARED_HASH_KEYS 0
-#endif
-
-#if (PERL_BCDVERSION < 0x5007002)
-
-#if defined(NEED_sv_2pv_flags)
-static char * DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
-static
-#else
-extern char * DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
-#endif
-
-#ifdef sv_2pv_flags
-# undef sv_2pv_flags
-#endif
-#define sv_2pv_flags(a,b,c) DPPP_(my_sv_2pv_flags)(aTHX_ a,b,c)
-#define Perl_sv_2pv_flags DPPP_(my_sv_2pv_flags)
-
-#if defined(NEED_sv_2pv_flags) || defined(NEED_sv_2pv_flags_GLOBAL)
-
-char *
-DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags)
-{
- STRLEN n_a = (STRLEN) flags;
- return sv_2pv(sv, lp ? lp : &n_a);
-}
-
-#endif
-
-#if defined(NEED_sv_pvn_force_flags)
-static char * DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
-static
-#else
-extern char * DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
-#endif
-
-#ifdef sv_pvn_force_flags
-# undef sv_pvn_force_flags
-#endif
-#define sv_pvn_force_flags(a,b,c) DPPP_(my_sv_pvn_force_flags)(aTHX_ a,b,c)
-#define Perl_sv_pvn_force_flags DPPP_(my_sv_pvn_force_flags)
-
-#if defined(NEED_sv_pvn_force_flags) || defined(NEED_sv_pvn_force_flags_GLOBAL)
-
-char *
-DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags)
-{
- STRLEN n_a = (STRLEN) flags;
- return sv_pvn_force(sv, lp ? lp : &n_a);
-}
-
-#endif
-
-#endif
-
-#if (PERL_BCDVERSION < 0x5008008) || ( (PERL_BCDVERSION >= 0x5009000) && (PERL_BCDVERSION < 0x5009003) )
-# define DPPP_SVPV_NOLEN_LP_ARG &PL_na
-#else
-# define DPPP_SVPV_NOLEN_LP_ARG 0
-#endif
-#ifndef SvPV_const
-# define SvPV_const(sv, lp) SvPV_flags_const(sv, lp, SV_GMAGIC)
-#endif
-
-#ifndef SvPV_mutable
-# define SvPV_mutable(sv, lp) SvPV_flags_mutable(sv, lp, SV_GMAGIC)
-#endif
-#ifndef SvPV_flags
-# define SvPV_flags(sv, lp, flags) \
- ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
- ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pv_flags(sv, &lp, flags))
-#endif
-#ifndef SvPV_flags_const
-# define SvPV_flags_const(sv, lp, flags) \
- ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
- ? ((lp = SvCUR(sv)), SvPVX_const(sv)) : \
- (const char*) sv_2pv_flags(sv, &lp, flags|SV_CONST_RETURN))
-#endif
-#ifndef SvPV_flags_const_nolen
-# define SvPV_flags_const_nolen(sv, flags) \
- ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
- ? SvPVX_const(sv) : \
- (const char*) sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, flags|SV_CONST_RETURN))
-#endif
-#ifndef SvPV_flags_mutable
-# define SvPV_flags_mutable(sv, lp, flags) \
- ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
- ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) : \
- sv_2pv_flags(sv, &lp, flags|SV_MUTABLE_RETURN))
-#endif
-#ifndef SvPV_force
-# define SvPV_force(sv, lp) SvPV_force_flags(sv, lp, SV_GMAGIC)
-#endif
-
-#ifndef SvPV_force_nolen
-# define SvPV_force_nolen(sv) SvPV_force_flags_nolen(sv, SV_GMAGIC)
-#endif
-
-#ifndef SvPV_force_mutable
-# define SvPV_force_mutable(sv, lp) SvPV_force_flags_mutable(sv, lp, SV_GMAGIC)
-#endif
-
-#ifndef SvPV_force_nomg
-# define SvPV_force_nomg(sv, lp) SvPV_force_flags(sv, lp, 0)
-#endif
-
-#ifndef SvPV_force_nomg_nolen
-# define SvPV_force_nomg_nolen(sv) SvPV_force_flags_nolen(sv, 0)
-#endif
-#ifndef SvPV_force_flags
-# define SvPV_force_flags(sv, lp, flags) \
- ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
- ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvn_force_flags(sv, &lp, flags))
-#endif
-#ifndef SvPV_force_flags_nolen
-# define SvPV_force_flags_nolen(sv, flags) \
- ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
- ? SvPVX(sv) : sv_pvn_force_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, flags))
-#endif
-#ifndef SvPV_force_flags_mutable
-# define SvPV_force_flags_mutable(sv, lp, flags) \
- ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
- ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) \
- : sv_pvn_force_flags(sv, &lp, flags|SV_MUTABLE_RETURN))
-#endif
-#ifndef SvPV_nolen
-# define SvPV_nolen(sv) \
- ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
- ? SvPVX(sv) : sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, SV_GMAGIC))
-#endif
-#ifndef SvPV_nolen_const
-# define SvPV_nolen_const(sv) \
- ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
- ? SvPVX_const(sv) : sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, SV_GMAGIC|SV_CONST_RETURN))
-#endif
-#ifndef SvPV_nomg
-# define SvPV_nomg(sv, lp) SvPV_flags(sv, lp, 0)
-#endif
-
-#ifndef SvPV_nomg_const
-# define SvPV_nomg_const(sv, lp) SvPV_flags_const(sv, lp, 0)
-#endif
-
-#ifndef SvPV_nomg_const_nolen
-# define SvPV_nomg_const_nolen(sv) SvPV_flags_const_nolen(sv, 0)
-#endif
-
-#ifndef SvPV_nomg_nolen
-# define SvPV_nomg_nolen(sv) ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
- ? SvPVX(sv) : sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, 0))
-#endif
-#ifndef SvPV_renew
-# define SvPV_renew(sv,n) STMT_START { SvLEN_set(sv, n); \
- SvPV_set((sv), (char *) saferealloc( \
- (Malloc_t)SvPVX(sv), (MEM_SIZE)((n)))); \
- } STMT_END
-#endif
-#ifndef SvMAGIC_set
-# define SvMAGIC_set(sv, val) \
- STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
- (((XPVMG*) SvANY(sv))->xmg_magic = (val)); } STMT_END
-#endif
-
-#if (PERL_BCDVERSION < 0x5009003)
-#ifndef SvPVX_const
-# define SvPVX_const(sv) ((const char*) (0 + SvPVX(sv)))
-#endif
-
-#ifndef SvPVX_mutable
-# define SvPVX_mutable(sv) (0 + SvPVX(sv))
-#endif
-#ifndef SvRV_set
-# define SvRV_set(sv, val) \
- STMT_START { assert(SvTYPE(sv) >= SVt_RV); \
- (((XRV*) SvANY(sv))->xrv_rv = (val)); } STMT_END
-#endif
-
-#else
-#ifndef SvPVX_const
-# define SvPVX_const(sv) ((const char*)((sv)->sv_u.svu_pv))
-#endif
-
-#ifndef SvPVX_mutable
-# define SvPVX_mutable(sv) ((sv)->sv_u.svu_pv)
-#endif
-#ifndef SvRV_set
-# define SvRV_set(sv, val) \
- STMT_START { assert(SvTYPE(sv) >= SVt_RV); \
- ((sv)->sv_u.svu_rv = (val)); } STMT_END
-#endif
-
-#endif
-#ifndef SvSTASH_set
-# define SvSTASH_set(sv, val) \
- STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
- (((XPVMG*) SvANY(sv))->xmg_stash = (val)); } STMT_END
-#endif
-
-#if (PERL_BCDVERSION < 0x5004000)
-#ifndef SvUV_set
-# define SvUV_set(sv, val) \
- STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
- (((XPVIV*) SvANY(sv))->xiv_iv = (IV) (val)); } STMT_END
-#endif
-
-#else
-#ifndef SvUV_set
-# define SvUV_set(sv, val) \
- STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
- (((XPVUV*) SvANY(sv))->xuv_uv = (val)); } STMT_END
-#endif
-
-#endif
-
-#if (PERL_BCDVERSION >= 0x5004000) && !defined(vnewSVpvf)
-#if defined(NEED_vnewSVpvf)
-static SV * DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args);
-static
-#else
-extern SV * DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args);
-#endif
-
-#ifdef vnewSVpvf
-# undef vnewSVpvf
-#endif
-#define vnewSVpvf(a,b) DPPP_(my_vnewSVpvf)(aTHX_ a,b)
-#define Perl_vnewSVpvf DPPP_(my_vnewSVpvf)
-
-#if defined(NEED_vnewSVpvf) || defined(NEED_vnewSVpvf_GLOBAL)
-
-SV *
-DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args)
-{
- register SV *sv = newSV(0);
- sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));
- return sv;
-}
-
-#endif
-#endif
-
-#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vcatpvf)
-# define sv_vcatpvf(sv, pat, args) sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
-#endif
-
-#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vsetpvf)
-# define sv_vsetpvf(sv, pat, args) sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
-#endif
-
-#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_catpvf_mg)
-#if defined(NEED_sv_catpvf_mg)
-static void DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
-static
-#else
-extern void DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
-#endif
-
-#define Perl_sv_catpvf_mg DPPP_(my_sv_catpvf_mg)
-
-#if defined(NEED_sv_catpvf_mg) || defined(NEED_sv_catpvf_mg_GLOBAL)
-
-void
-DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
-{
- va_list args;
- va_start(args, pat);
- sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
- SvSETMAGIC(sv);
- va_end(args);
-}
-
-#endif
-#endif
-
-#ifdef PERL_IMPLICIT_CONTEXT
-#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_catpvf_mg_nocontext)
-#if defined(NEED_sv_catpvf_mg_nocontext)
-static void DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...);
-static
-#else
-extern void DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...);
-#endif
-
-#define sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
-#define Perl_sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
-
-#if defined(NEED_sv_catpvf_mg_nocontext) || defined(NEED_sv_catpvf_mg_nocontext_GLOBAL)
-
-void
-DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...)
-{
- dTHX;
- va_list args;
- va_start(args, pat);
- sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
- SvSETMAGIC(sv);
- va_end(args);
-}
-
-#endif
-#endif
-#endif
-
-/* sv_catpvf_mg depends on sv_catpvf_mg_nocontext */
-#ifndef sv_catpvf_mg
-# ifdef PERL_IMPLICIT_CONTEXT
-# define sv_catpvf_mg Perl_sv_catpvf_mg_nocontext
-# else
-# define sv_catpvf_mg Perl_sv_catpvf_mg
-# endif
-#endif
-
-#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vcatpvf_mg)
-# define sv_vcatpvf_mg(sv, pat, args) \
- STMT_START { \
- sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
- SvSETMAGIC(sv); \
- } STMT_END
-#endif
-
-#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_setpvf_mg)
-#if defined(NEED_sv_setpvf_mg)
-static void DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
-static
-#else
-extern void DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
-#endif
-
-#define Perl_sv_setpvf_mg DPPP_(my_sv_setpvf_mg)
-
-#if defined(NEED_sv_setpvf_mg) || defined(NEED_sv_setpvf_mg_GLOBAL)
-
-void
-DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
-{
- va_list args;
- va_start(args, pat);
- sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
- SvSETMAGIC(sv);
- va_end(args);
-}
-
-#endif
-#endif
-
-#ifdef PERL_IMPLICIT_CONTEXT
-#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_setpvf_mg_nocontext)
-#if defined(NEED_sv_setpvf_mg_nocontext)
-static void DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...);
-static
-#else
-extern void DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...);
-#endif
-
-#define sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
-#define Perl_sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
-
-#if defined(NEED_sv_setpvf_mg_nocontext) || defined(NEED_sv_setpvf_mg_nocontext_GLOBAL)
-
-void
-DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...)
-{
- dTHX;
- va_list args;
- va_start(args, pat);
- sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
- SvSETMAGIC(sv);
- va_end(args);
-}
-
-#endif
-#endif
-#endif
-
-/* sv_setpvf_mg depends on sv_setpvf_mg_nocontext */
-#ifndef sv_setpvf_mg
-# ifdef PERL_IMPLICIT_CONTEXT
-# define sv_setpvf_mg Perl_sv_setpvf_mg_nocontext
-# else
-# define sv_setpvf_mg Perl_sv_setpvf_mg
-# endif
-#endif
-
-#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vsetpvf_mg)
-# define sv_vsetpvf_mg(sv, pat, args) \
- STMT_START { \
- sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
- SvSETMAGIC(sv); \
- } STMT_END
-#endif
-
-/* Hint: newSVpvn_share
- * The SVs created by this function only mimic the behaviour of
- * shared PVs without really being shared. Only use if you know
- * what you're doing.
- */
-
-#ifndef newSVpvn_share
-
-#if defined(NEED_newSVpvn_share)
-static SV * DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash);
-static
-#else
-extern SV * DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash);
-#endif
-
-#ifdef newSVpvn_share
-# undef newSVpvn_share
-#endif
-#define newSVpvn_share(a,b,c) DPPP_(my_newSVpvn_share)(aTHX_ a,b,c)
-#define Perl_newSVpvn_share DPPP_(my_newSVpvn_share)
-
-#if defined(NEED_newSVpvn_share) || defined(NEED_newSVpvn_share_GLOBAL)
-
-SV *
-DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash)
-{
- SV *sv;
- if (len < 0)
- len = -len;
- if (!hash)
- PERL_HASH(hash, (char*) src, len);
- sv = newSVpvn((char *) src, len);
- sv_upgrade(sv, SVt_PVIV);
- SvIVX(sv) = hash;
- SvREADONLY_on(sv);
- SvPOK_on(sv);
- return sv;
-}
-
-#endif
-
-#endif
-#ifndef SvSHARED_HASH
-# define SvSHARED_HASH(sv) (0 + SvUVX(sv))
-#endif
-#ifndef HvNAME_get
-# define HvNAME_get(hv) HvNAME(hv)
-#endif
-#ifndef HvNAMELEN_get
-# define HvNAMELEN_get(hv) (HvNAME_get(hv) ? (I32)strlen(HvNAME_get(hv)) : 0)
-#endif
-#ifndef GvSVn
-# define GvSVn(gv) GvSV(gv)
-#endif
-
-#ifndef isGV_with_GP
-# define isGV_with_GP(gv) isGV(gv)
-#endif
-
-#ifndef gv_fetchpvn_flags
-# define gv_fetchpvn_flags(name, len, flags, svt) gv_fetchpv(name, flags, svt)
-#endif
-
-#ifndef gv_fetchsv
-# define gv_fetchsv(name, flags, svt) gv_fetchpv(SvPV_nolen_const(name), flags, svt)
-#endif
-#ifndef get_cvn_flags
-# define get_cvn_flags(name, namelen, flags) get_cv(name, flags)
-#endif
-#ifndef WARN_ALL
-# define WARN_ALL 0
-#endif
-
-#ifndef WARN_CLOSURE
-# define WARN_CLOSURE 1
-#endif
-
-#ifndef WARN_DEPRECATED
-# define WARN_DEPRECATED 2
-#endif
-
-#ifndef WARN_EXITING
-# define WARN_EXITING 3
-#endif
-
-#ifndef WARN_GLOB
-# define WARN_GLOB 4
-#endif
-
-#ifndef WARN_IO
-# define WARN_IO 5
-#endif
-
-#ifndef WARN_CLOSED
-# define WARN_CLOSED 6
-#endif
-
-#ifndef WARN_EXEC
-# define WARN_EXEC 7
-#endif
-
-#ifndef WARN_LAYER
-# define WARN_LAYER 8
-#endif
-
-#ifndef WARN_NEWLINE
-# define WARN_NEWLINE 9
-#endif
-
-#ifndef WARN_PIPE
-# define WARN_PIPE 10
-#endif
-
-#ifndef WARN_UNOPENED
-# define WARN_UNOPENED 11
-#endif
-
-#ifndef WARN_MISC
-# define WARN_MISC 12
-#endif
-
-#ifndef WARN_NUMERIC
-# define WARN_NUMERIC 13
-#endif
-
-#ifndef WARN_ONCE
-# define WARN_ONCE 14
-#endif
-
-#ifndef WARN_OVERFLOW
-# define WARN_OVERFLOW 15
-#endif
-
-#ifndef WARN_PACK
-# define WARN_PACK 16
-#endif
-
-#ifndef WARN_PORTABLE
-# define WARN_PORTABLE 17
-#endif
-
-#ifndef WARN_RECURSION
-# define WARN_RECURSION 18
-#endif
-
-#ifndef WARN_REDEFINE
-# define WARN_REDEFINE 19
-#endif
-
-#ifndef WARN_REGEXP
-# define WARN_REGEXP 20
-#endif
-
-#ifndef WARN_SEVERE
-# define WARN_SEVERE 21
-#endif
-
-#ifndef WARN_DEBUGGING
-# define WARN_DEBUGGING 22
-#endif
-
-#ifndef WARN_INPLACE
-# define WARN_INPLACE 23
-#endif
-
-#ifndef WARN_INTERNAL
-# define WARN_INTERNAL 24
-#endif
-
-#ifndef WARN_MALLOC
-# define WARN_MALLOC 25
-#endif
-
-#ifndef WARN_SIGNAL
-# define WARN_SIGNAL 26
-#endif
-
-#ifndef WARN_SUBSTR
-# define WARN_SUBSTR 27
-#endif
-
-#ifndef WARN_SYNTAX
-# define WARN_SYNTAX 28
-#endif
-
-#ifndef WARN_AMBIGUOUS
-# define WARN_AMBIGUOUS 29
-#endif
-
-#ifndef WARN_BAREWORD
-# define WARN_BAREWORD 30
-#endif
-
-#ifndef WARN_DIGIT
-# define WARN_DIGIT 31
-#endif
-
-#ifndef WARN_PARENTHESIS
-# define WARN_PARENTHESIS 32
-#endif
-
-#ifndef WARN_PRECEDENCE
-# define WARN_PRECEDENCE 33
-#endif
-
-#ifndef WARN_PRINTF
-# define WARN_PRINTF 34
-#endif
-
-#ifndef WARN_PROTOTYPE
-# define WARN_PROTOTYPE 35
-#endif
-
-#ifndef WARN_QW
-# define WARN_QW 36
-#endif
-
-#ifndef WARN_RESERVED
-# define WARN_RESERVED 37
-#endif
-
-#ifndef WARN_SEMICOLON
-# define WARN_SEMICOLON 38
-#endif
-
-#ifndef WARN_TAINT
-# define WARN_TAINT 39
-#endif
-
-#ifndef WARN_THREADS
-# define WARN_THREADS 40
-#endif
-
-#ifndef WARN_UNINITIALIZED
-# define WARN_UNINITIALIZED 41
-#endif
-
-#ifndef WARN_UNPACK
-# define WARN_UNPACK 42
-#endif
-
-#ifndef WARN_UNTIE
-# define WARN_UNTIE 43
-#endif
-
-#ifndef WARN_UTF8
-# define WARN_UTF8 44
-#endif
-
-#ifndef WARN_VOID
-# define WARN_VOID 45
-#endif
-
-#ifndef WARN_ASSERTIONS
-# define WARN_ASSERTIONS 46
-#endif
-#ifndef packWARN
-# define packWARN(a) (a)
-#endif
-
-#ifndef ckWARN
-# ifdef G_WARN_ON
-# define ckWARN(a) (PL_dowarn & G_WARN_ON)
-# else
-# define ckWARN(a) PL_dowarn
-# endif
-#endif
-
-#if (PERL_BCDVERSION >= 0x5004000) && !defined(warner)
-#if defined(NEED_warner)
-static void DPPP_(my_warner)(U32 err, const char *pat, ...);
-static
-#else
-extern void DPPP_(my_warner)(U32 err, const char *pat, ...);
-#endif
-
-#define Perl_warner DPPP_(my_warner)
-
-#if defined(NEED_warner) || defined(NEED_warner_GLOBAL)
-
-void
-DPPP_(my_warner)(U32 err, const char *pat, ...)
-{
- SV *sv;
- va_list args;
-
- PERL_UNUSED_ARG(err);
-
- va_start(args, pat);
- sv = vnewSVpvf(pat, &args);
- va_end(args);
- sv_2mortal(sv);
- warn("%s", SvPV_nolen(sv));
-}
-
-#define warner Perl_warner
-
-#define Perl_warner_nocontext Perl_warner
-
-#endif
-#endif
-
-/* concatenating with "" ensures that only literal strings are accepted as argument
- * note that STR_WITH_LEN() can't be used as argument to macros or functions that
- * under some configurations might be macros
- */
-#ifndef STR_WITH_LEN
-# define STR_WITH_LEN(s) (s ""), (sizeof(s)-1)
-#endif
-#ifndef newSVpvs
-# define newSVpvs(str) newSVpvn(str "", sizeof(str) - 1)
-#endif
-
-#ifndef newSVpvs_flags
-# define newSVpvs_flags(str, flags) newSVpvn_flags(str "", sizeof(str) - 1, flags)
-#endif
-
-#ifndef newSVpvs_share
-# define newSVpvs_share(str) newSVpvn_share(str "", sizeof(str) - 1, 0)
-#endif
-
-#ifndef sv_catpvs
-# define sv_catpvs(sv, str) sv_catpvn(sv, str "", sizeof(str) - 1)
-#endif
-
-#ifndef sv_setpvs
-# define sv_setpvs(sv, str) sv_setpvn(sv, str "", sizeof(str) - 1)
-#endif
-
-#ifndef hv_fetchs
-# define hv_fetchs(hv, key, lval) hv_fetch(hv, key "", sizeof(key) - 1, lval)
-#endif
-
-#ifndef hv_stores
-# define hv_stores(hv, key, val) hv_store(hv, key "", sizeof(key) - 1, val, 0)
-#endif
-#ifndef gv_fetchpvs
-# define gv_fetchpvs(name, flags, svt) gv_fetchpvn_flags(name "", sizeof(name) - 1, flags, svt)
-#endif
-
-#ifndef gv_stashpvs
-# define gv_stashpvs(name, flags) gv_stashpvn(name "", sizeof(name) - 1, flags)
-#endif
-#ifndef get_cvs
-# define get_cvs(name, flags) get_cvn_flags(name "", sizeof(name)-1, flags)
-#endif
-#ifndef SvGETMAGIC
-# define SvGETMAGIC(x) STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END
-#endif
-
-/* Some random bits for sv_unmagicext. These should probably be pulled in for
- real and organized at some point */
-#ifndef HEf_SVKEY
-# define HEf_SVKEY -2
-#endif
-
-#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
-# define MUTABLE_PTR(p) ({ void *_p = (p); _p; })
-#else
-# define MUTABLE_PTR(p) ((void *) (p))
-#endif
-
-#define MUTABLE_SV(p) ((SV *)MUTABLE_PTR(p))
-
-/* end of random bits */
-#ifndef PERL_MAGIC_sv
-# define PERL_MAGIC_sv '\0'
-#endif
-
-#ifndef PERL_MAGIC_overload
-# define PERL_MAGIC_overload 'A'
-#endif
-
-#ifndef PERL_MAGIC_overload_elem
-# define PERL_MAGIC_overload_elem 'a'
-#endif
-
-#ifndef PERL_MAGIC_overload_table
-# define PERL_MAGIC_overload_table 'c'
-#endif
-
-#ifndef PERL_MAGIC_bm
-# define PERL_MAGIC_bm 'B'
-#endif
-
-#ifndef PERL_MAGIC_regdata
-# define PERL_MAGIC_regdata 'D'
-#endif
-
-#ifndef PERL_MAGIC_regdatum
-# define PERL_MAGIC_regdatum 'd'
-#endif
-
-#ifndef PERL_MAGIC_env
-# define PERL_MAGIC_env 'E'
-#endif
-
-#ifndef PERL_MAGIC_envelem
-# define PERL_MAGIC_envelem 'e'
-#endif
-
-#ifndef PERL_MAGIC_fm
-# define PERL_MAGIC_fm 'f'
-#endif
-
-#ifndef PERL_MAGIC_regex_global
-# define PERL_MAGIC_regex_global 'g'
-#endif
-
-#ifndef PERL_MAGIC_isa
-# define PERL_MAGIC_isa 'I'
-#endif
-
-#ifndef PERL_MAGIC_isaelem
-# define PERL_MAGIC_isaelem 'i'
-#endif
-
-#ifndef PERL_MAGIC_nkeys
-# define PERL_MAGIC_nkeys 'k'
-#endif
-
-#ifndef PERL_MAGIC_dbfile
-# define PERL_MAGIC_dbfile 'L'
-#endif
-
-#ifndef PERL_MAGIC_dbline
-# define PERL_MAGIC_dbline 'l'
-#endif
-
-#ifndef PERL_MAGIC_mutex
-# define PERL_MAGIC_mutex 'm'
-#endif
-
-#ifndef PERL_MAGIC_shared
-# define PERL_MAGIC_shared 'N'
-#endif
-
-#ifndef PERL_MAGIC_shared_scalar
-# define PERL_MAGIC_shared_scalar 'n'
-#endif
-
-#ifndef PERL_MAGIC_collxfrm
-# define PERL_MAGIC_collxfrm 'o'
-#endif
-
-#ifndef PERL_MAGIC_tied
-# define PERL_MAGIC_tied 'P'
-#endif
-
-#ifndef PERL_MAGIC_tiedelem
-# define PERL_MAGIC_tiedelem 'p'
-#endif
-
-#ifndef PERL_MAGIC_tiedscalar
-# define PERL_MAGIC_tiedscalar 'q'
-#endif
-
-#ifndef PERL_MAGIC_qr
-# define PERL_MAGIC_qr 'r'
-#endif
-
-#ifndef PERL_MAGIC_sig
-# define PERL_MAGIC_sig 'S'
-#endif
-
-#ifndef PERL_MAGIC_sigelem
-# define PERL_MAGIC_sigelem 's'
-#endif
-
-#ifndef PERL_MAGIC_taint
-# define PERL_MAGIC_taint 't'
-#endif
-
-#ifndef PERL_MAGIC_uvar
-# define PERL_MAGIC_uvar 'U'
-#endif
-
-#ifndef PERL_MAGIC_uvar_elem
-# define PERL_MAGIC_uvar_elem 'u'
-#endif
-
-#ifndef PERL_MAGIC_vstring
-# define PERL_MAGIC_vstring 'V'
-#endif
-
-#ifndef PERL_MAGIC_vec
-# define PERL_MAGIC_vec 'v'
-#endif
-
-#ifndef PERL_MAGIC_utf8
-# define PERL_MAGIC_utf8 'w'
-#endif
-
-#ifndef PERL_MAGIC_substr
-# define PERL_MAGIC_substr 'x'
-#endif
-
-#ifndef PERL_MAGIC_defelem
-# define PERL_MAGIC_defelem 'y'
-#endif
-
-#ifndef PERL_MAGIC_glob
-# define PERL_MAGIC_glob '*'
-#endif
-
-#ifndef PERL_MAGIC_arylen
-# define PERL_MAGIC_arylen '#'
-#endif
-
-#ifndef PERL_MAGIC_pos
-# define PERL_MAGIC_pos '.'
-#endif
-
-#ifndef PERL_MAGIC_backref
-# define PERL_MAGIC_backref '<'
-#endif
-
-#ifndef PERL_MAGIC_ext
-# define PERL_MAGIC_ext '~'
-#endif
-
-/* That's the best we can do... */
-#ifndef sv_catpvn_nomg
-# define sv_catpvn_nomg sv_catpvn
-#endif
-
-#ifndef sv_catsv_nomg
-# define sv_catsv_nomg sv_catsv
-#endif
-
-#ifndef sv_setsv_nomg
-# define sv_setsv_nomg sv_setsv
-#endif
-
-#ifndef sv_pvn_nomg
-# define sv_pvn_nomg sv_pvn
-#endif
-
-#ifndef SvIV_nomg
-# define SvIV_nomg SvIV
-#endif
-
-#ifndef SvUV_nomg
-# define SvUV_nomg SvUV
-#endif
-
-#ifndef sv_catpv_mg
-# define sv_catpv_mg(sv, ptr) \
- STMT_START { \
- SV *TeMpSv = sv; \
- sv_catpv(TeMpSv,ptr); \
- SvSETMAGIC(TeMpSv); \
- } STMT_END
-#endif
-
-#ifndef sv_catpvn_mg
-# define sv_catpvn_mg(sv, ptr, len) \
- STMT_START { \
- SV *TeMpSv = sv; \
- sv_catpvn(TeMpSv,ptr,len); \
- SvSETMAGIC(TeMpSv); \
- } STMT_END
-#endif
-
-#ifndef sv_catsv_mg
-# define sv_catsv_mg(dsv, ssv) \
- STMT_START { \
- SV *TeMpSv = dsv; \
- sv_catsv(TeMpSv,ssv); \
- SvSETMAGIC(TeMpSv); \
- } STMT_END
-#endif
-
-#ifndef sv_setiv_mg
-# define sv_setiv_mg(sv, i) \
- STMT_START { \
- SV *TeMpSv = sv; \
- sv_setiv(TeMpSv,i); \
- SvSETMAGIC(TeMpSv); \
- } STMT_END
-#endif
-
-#ifndef sv_setnv_mg
-# define sv_setnv_mg(sv, num) \
- STMT_START { \
- SV *TeMpSv = sv; \
- sv_setnv(TeMpSv,num); \
- SvSETMAGIC(TeMpSv); \
- } STMT_END
-#endif
-
-#ifndef sv_setpv_mg
-# define sv_setpv_mg(sv, ptr) \
- STMT_START { \
- SV *TeMpSv = sv; \
- sv_setpv(TeMpSv,ptr); \
- SvSETMAGIC(TeMpSv); \
- } STMT_END
-#endif
-
-#ifndef sv_setpvn_mg
-# define sv_setpvn_mg(sv, ptr, len) \
- STMT_START { \
- SV *TeMpSv = sv; \
- sv_setpvn(TeMpSv,ptr,len); \
- SvSETMAGIC(TeMpSv); \
- } STMT_END
-#endif
-
-#ifndef sv_setsv_mg
-# define sv_setsv_mg(dsv, ssv) \
- STMT_START { \
- SV *TeMpSv = dsv; \
- sv_setsv(TeMpSv,ssv); \
- SvSETMAGIC(TeMpSv); \
- } STMT_END
-#endif
-
-#ifndef sv_setuv_mg
-# define sv_setuv_mg(sv, i) \
- STMT_START { \
- SV *TeMpSv = sv; \
- sv_setuv(TeMpSv,i); \
- SvSETMAGIC(TeMpSv); \
- } STMT_END
-#endif
-
-#ifndef sv_usepvn_mg
-# define sv_usepvn_mg(sv, ptr, len) \
- STMT_START { \
- SV *TeMpSv = sv; \
- sv_usepvn(TeMpSv,ptr,len); \
- SvSETMAGIC(TeMpSv); \
- } STMT_END
-#endif
-#ifndef SvVSTRING_mg
-# define SvVSTRING_mg(sv) (SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_vstring) : NULL)
-#endif
-
-/* Hint: sv_magic_portable
- * This is a compatibility function that is only available with
- * Devel::PPPort. It is NOT in the perl core.
- * Its purpose is to mimic the 5.8.0 behaviour of sv_magic() when
- * it is being passed a name pointer with namlen == 0. In that
- * case, perl 5.8.0 and later store the pointer, not a copy of it.
- * The compatibility can be provided back to perl 5.004. With
- * earlier versions, the code will not compile.
- */
-
-#if (PERL_BCDVERSION < 0x5004000)
-
- /* code that uses sv_magic_portable will not compile */
-
-#elif (PERL_BCDVERSION < 0x5008000)
-
-# define sv_magic_portable(sv, obj, how, name, namlen) \
- STMT_START { \
- SV *SvMp_sv = (sv); \
- char *SvMp_name = (char *) (name); \
- I32 SvMp_namlen = (namlen); \
- if (SvMp_name && SvMp_namlen == 0) \
- { \
- MAGIC *mg; \
- sv_magic(SvMp_sv, obj, how, 0, 0); \
- mg = SvMAGIC(SvMp_sv); \
- mg->mg_len = -42; /* XXX: this is the tricky part */ \
- mg->mg_ptr = SvMp_name; \
- } \
- else \
- { \
- sv_magic(SvMp_sv, obj, how, SvMp_name, SvMp_namlen); \
- } \
- } STMT_END
-
-#else
-
-# define sv_magic_portable(a, b, c, d, e) sv_magic(a, b, c, d, e)
-
-#endif
-
-#if !defined(mg_findext)
-#if defined(NEED_mg_findext)
-static MAGIC * DPPP_(my_mg_findext)(SV * sv, int type, const MGVTBL *vtbl);
-static
-#else
-extern MAGIC * DPPP_(my_mg_findext)(SV * sv, int type, const MGVTBL *vtbl);
-#endif
-
-#define mg_findext DPPP_(my_mg_findext)
-#define Perl_mg_findext DPPP_(my_mg_findext)
-
-#if defined(NEED_mg_findext) || defined(NEED_mg_findext_GLOBAL)
-
-MAGIC *
-DPPP_(my_mg_findext)(SV * sv, int type, const MGVTBL *vtbl) {
- if (sv) {
- MAGIC *mg;
-
-#ifdef AvPAD_NAMELIST
- assert(!(SvTYPE(sv) == SVt_PVAV && AvPAD_NAMELIST(sv)));
-#endif
-
- for (mg = SvMAGIC (sv); mg; mg = mg->mg_moremagic) {
- if (mg->mg_type == type && mg->mg_virtual == vtbl)
- return mg;
- }
- }
-
- return NULL;
-}
-
-#endif
-#endif
-
-#if !defined(sv_unmagicext)
-#if defined(NEED_sv_unmagicext)
-static int DPPP_(my_sv_unmagicext)(pTHX_ SV * const sv, const int type, MGVTBL * vtbl);
-static
-#else
-extern int DPPP_(my_sv_unmagicext)(pTHX_ SV * const sv, const int type, MGVTBL * vtbl);
-#endif
-
-#ifdef sv_unmagicext
-# undef sv_unmagicext
-#endif
-#define sv_unmagicext(a,b,c) DPPP_(my_sv_unmagicext)(aTHX_ a,b,c)
-#define Perl_sv_unmagicext DPPP_(my_sv_unmagicext)
-
-#if defined(NEED_sv_unmagicext) || defined(NEED_sv_unmagicext_GLOBAL)
-
-int
-DPPP_(my_sv_unmagicext)(pTHX_ SV *const sv, const int type, MGVTBL *vtbl)
-{
- MAGIC* mg;
- MAGIC** mgp;
-
- if (SvTYPE(sv) < SVt_PVMG || !SvMAGIC(sv))
- return 0;
- mgp = &(SvMAGIC(sv));
- for (mg = *mgp; mg; mg = *mgp) {
- const MGVTBL* const virt = mg->mg_virtual;
- if (mg->mg_type == type && virt == vtbl) {
- *mgp = mg->mg_moremagic;
- if (virt && virt->svt_free)
- virt->svt_free(aTHX_ sv, mg);
- if (mg->mg_ptr && mg->mg_type != PERL_MAGIC_regex_global) {
- if (mg->mg_len > 0)
- Safefree(mg->mg_ptr);
- else if (mg->mg_len == HEf_SVKEY) /* Questionable on older perls... */
- SvREFCNT_dec(MUTABLE_SV(mg->mg_ptr));
- else if (mg->mg_type == PERL_MAGIC_utf8)
- Safefree(mg->mg_ptr);
- }
- if (mg->mg_flags & MGf_REFCOUNTED)
- SvREFCNT_dec(mg->mg_obj);
- Safefree(mg);
- }
- else
- mgp = &mg->mg_moremagic;
- }
- if (SvMAGIC(sv)) {
- if (SvMAGICAL(sv)) /* if we're under save_magic, wait for restore_magic; */
- mg_magical(sv); /* else fix the flags now */
- }
- else {
- SvMAGICAL_off(sv);
- SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
- }
- return 0;
-}
-
-#endif
-#endif
-
-#ifdef USE_ITHREADS
-#ifndef CopFILE
-# define CopFILE(c) ((c)->cop_file)
-#endif
-
-#ifndef CopFILEGV
-# define CopFILEGV(c) (CopFILE(c) ? gv_fetchfile(CopFILE(c)) : Nullgv)
-#endif
-
-#ifndef CopFILE_set
-# define CopFILE_set(c,pv) ((c)->cop_file = savepv(pv))
-#endif
-
-#ifndef CopFILESV
-# define CopFILESV(c) (CopFILE(c) ? GvSV(gv_fetchfile(CopFILE(c))) : Nullsv)
-#endif
-
-#ifndef CopFILEAV
-# define CopFILEAV(c) (CopFILE(c) ? GvAV(gv_fetchfile(CopFILE(c))) : Nullav)
-#endif
-
-#ifndef CopSTASHPV
-# define CopSTASHPV(c) ((c)->cop_stashpv)
-#endif
-
-#ifndef CopSTASHPV_set
-# define CopSTASHPV_set(c,pv) ((c)->cop_stashpv = ((pv) ? savepv(pv) : Nullch))
-#endif
-
-#ifndef CopSTASH
-# define CopSTASH(c) (CopSTASHPV(c) ? gv_stashpv(CopSTASHPV(c),GV_ADD) : Nullhv)
-#endif
-
-#ifndef CopSTASH_set
-# define CopSTASH_set(c,hv) CopSTASHPV_set(c, (hv) ? HvNAME(hv) : Nullch)
-#endif
-
-#ifndef CopSTASH_eq
-# define CopSTASH_eq(c,hv) ((hv) && (CopSTASHPV(c) == HvNAME(hv) \
- || (CopSTASHPV(c) && HvNAME(hv) \
- && strEQ(CopSTASHPV(c), HvNAME(hv)))))
-#endif
-
-#else
-#ifndef CopFILEGV
-# define CopFILEGV(c) ((c)->cop_filegv)
-#endif
-
-#ifndef CopFILEGV_set
-# define CopFILEGV_set(c,gv) ((c)->cop_filegv = (GV*)SvREFCNT_inc(gv))
-#endif
-
-#ifndef CopFILE_set
-# define CopFILE_set(c,pv) CopFILEGV_set((c), gv_fetchfile(pv))
-#endif
-
-#ifndef CopFILESV
-# define CopFILESV(c) (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : Nullsv)
-#endif
-
-#ifndef CopFILEAV
-# define CopFILEAV(c) (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : Nullav)
-#endif
-
-#ifndef CopFILE
-# define CopFILE(c) (CopFILESV(c) ? SvPVX(CopFILESV(c)) : Nullch)
-#endif
-
-#ifndef CopSTASH
-# define CopSTASH(c) ((c)->cop_stash)
-#endif
-
-#ifndef CopSTASH_set
-# define CopSTASH_set(c,hv) ((c)->cop_stash = (hv))
-#endif
-
-#ifndef CopSTASHPV
-# define CopSTASHPV(c) (CopSTASH(c) ? HvNAME(CopSTASH(c)) : Nullch)
-#endif
-
-#ifndef CopSTASHPV_set
-# define CopSTASHPV_set(c,pv) CopSTASH_set((c), gv_stashpv(pv,GV_ADD))
-#endif
-
-#ifndef CopSTASH_eq
-# define CopSTASH_eq(c,hv) (CopSTASH(c) == (hv))
-#endif
-
-#endif /* USE_ITHREADS */
-
-#if (PERL_BCDVERSION >= 0x5006000)
-#ifndef caller_cx
-
-# if defined(NEED_caller_cx) || defined(NEED_caller_cx_GLOBAL)
-static I32
-DPPP_dopoptosub_at(const PERL_CONTEXT *cxstk, I32 startingblock)
-{
- I32 i;
-
- for (i = startingblock; i >= 0; i--) {
- register const PERL_CONTEXT * const cx = &cxstk[i];
- switch (CxTYPE(cx)) {
- default:
- continue;
- case CXt_EVAL:
- case CXt_SUB:
- case CXt_FORMAT:
- return i;
- }
- }
- return i;
-}
-# endif
-
-# if defined(NEED_caller_cx)
-static const PERL_CONTEXT * DPPP_(my_caller_cx)(pTHX_ I32 count, const PERL_CONTEXT **dbcxp);
-static
-#else
-extern const PERL_CONTEXT * DPPP_(my_caller_cx)(pTHX_ I32 count, const PERL_CONTEXT **dbcxp);
-#endif
-
-#ifdef caller_cx
-# undef caller_cx
-#endif
-#define caller_cx(a,b) DPPP_(my_caller_cx)(aTHX_ a,b)
-#define Perl_caller_cx DPPP_(my_caller_cx)
-
-#if defined(NEED_caller_cx) || defined(NEED_caller_cx_GLOBAL)
-
-const PERL_CONTEXT *
-DPPP_(my_caller_cx)(pTHX_ I32 count, const PERL_CONTEXT **dbcxp)
-{
- register I32 cxix = DPPP_dopoptosub_at(cxstack, cxstack_ix);
- register const PERL_CONTEXT *cx;
- register const PERL_CONTEXT *ccstack = cxstack;
- const PERL_SI *top_si = PL_curstackinfo;
-
- for (;;) {
- /* we may be in a higher stacklevel, so dig down deeper */
- while (cxix < 0 && top_si->si_type != PERLSI_MAIN) {
- top_si = top_si->si_prev;
- ccstack = top_si->si_cxstack;
- cxix = DPPP_dopoptosub_at(ccstack, top_si->si_cxix);
- }
- if (cxix < 0)
- return NULL;
- /* caller() should not report the automatic calls to &DB::sub */
- if (PL_DBsub && GvCV(PL_DBsub) && cxix >= 0 &&
- ccstack[cxix].blk_sub.cv == GvCV(PL_DBsub))
- count++;
- if (!count--)
- break;
- cxix = DPPP_dopoptosub_at(ccstack, cxix - 1);
- }
-
- cx = &ccstack[cxix];
- if (dbcxp) *dbcxp = cx;
-
- if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT) {
- const I32 dbcxix = DPPP_dopoptosub_at(ccstack, cxix - 1);
- /* We expect that ccstack[dbcxix] is CXt_SUB, anyway, the
- field below is defined for any cx. */
- /* caller() should not report the automatic calls to &DB::sub */
- if (PL_DBsub && GvCV(PL_DBsub) && dbcxix >= 0 && ccstack[dbcxix].blk_sub.cv == GvCV(PL_DBsub))
- cx = &ccstack[dbcxix];
- }
-
- return cx;
-}
-
-# endif
-#endif /* caller_cx */
-#endif /* 5.6.0 */
-#ifndef IN_PERL_COMPILETIME
-# define IN_PERL_COMPILETIME (PL_curcop == &PL_compiling)
-#endif
-
-#ifndef IN_LOCALE_RUNTIME
-# define IN_LOCALE_RUNTIME (PL_curcop->op_private & HINT_LOCALE)
-#endif
-
-#ifndef IN_LOCALE_COMPILETIME
-# define IN_LOCALE_COMPILETIME (PL_hints & HINT_LOCALE)
-#endif
-
-#ifndef IN_LOCALE
-# define IN_LOCALE (IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME)
-#endif
-#ifndef IS_NUMBER_IN_UV
-# define IS_NUMBER_IN_UV 0x01
-#endif
-
-#ifndef IS_NUMBER_GREATER_THAN_UV_MAX
-# define IS_NUMBER_GREATER_THAN_UV_MAX 0x02
-#endif
-
-#ifndef IS_NUMBER_NOT_INT
-# define IS_NUMBER_NOT_INT 0x04
-#endif
-
-#ifndef IS_NUMBER_NEG
-# define IS_NUMBER_NEG 0x08
-#endif
-
-#ifndef IS_NUMBER_INFINITY
-# define IS_NUMBER_INFINITY 0x10
-#endif
-
-#ifndef IS_NUMBER_NAN
-# define IS_NUMBER_NAN 0x20
-#endif
-#ifndef GROK_NUMERIC_RADIX
-# define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(sp, send)
-#endif
-#ifndef PERL_SCAN_GREATER_THAN_UV_MAX
-# define PERL_SCAN_GREATER_THAN_UV_MAX 0x02
-#endif
-
-#ifndef PERL_SCAN_SILENT_ILLDIGIT
-# define PERL_SCAN_SILENT_ILLDIGIT 0x04
-#endif
-
-#ifndef PERL_SCAN_ALLOW_UNDERSCORES
-# define PERL_SCAN_ALLOW_UNDERSCORES 0x01
-#endif
-
-#ifndef PERL_SCAN_DISALLOW_PREFIX
-# define PERL_SCAN_DISALLOW_PREFIX 0x02
-#endif
-
-#ifndef grok_numeric_radix
-#if defined(NEED_grok_numeric_radix)
-static bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
-static
-#else
-extern bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
-#endif
-
-#ifdef grok_numeric_radix
-# undef grok_numeric_radix
-#endif
-#define grok_numeric_radix(a,b) DPPP_(my_grok_numeric_radix)(aTHX_ a,b)
-#define Perl_grok_numeric_radix DPPP_(my_grok_numeric_radix)
-
-#if defined(NEED_grok_numeric_radix) || defined(NEED_grok_numeric_radix_GLOBAL)
-bool
-DPPP_(my_grok_numeric_radix)(pTHX_ const char **sp, const char *send)
-{
-#ifdef USE_LOCALE_NUMERIC
-#ifdef PL_numeric_radix_sv
- if (PL_numeric_radix_sv && IN_LOCALE) {
- STRLEN len;
- char* radix = SvPV(PL_numeric_radix_sv, len);
- if (*sp + len <= send && memEQ(*sp, radix, len)) {
- *sp += len;
- return TRUE;
- }
- }
-#else
- /* older perls don't have PL_numeric_radix_sv so the radix
- * must manually be requested from locale.h
- */
-#include <locale.h>
- dTHR; /* needed for older threaded perls */
- struct lconv *lc = localeconv();
- char *radix = lc->decimal_point;
- if (radix && IN_LOCALE) {
- STRLEN len = strlen(radix);
- if (*sp + len <= send && memEQ(*sp, radix, len)) {
- *sp += len;
- return TRUE;
- }
- }
-#endif
-#endif /* USE_LOCALE_NUMERIC */
- /* always try "." if numeric radix didn't match because
- * we may have data from different locales mixed */
- if (*sp < send && **sp == '.') {
- ++*sp;
- return TRUE;
- }
- return FALSE;
-}
-#endif
-#endif
-
-#ifndef grok_number
-#if defined(NEED_grok_number)
-static int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
-static
-#else
-extern int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
-#endif
-
-#ifdef grok_number
-# undef grok_number
-#endif
-#define grok_number(a,b,c) DPPP_(my_grok_number)(aTHX_ a,b,c)
-#define Perl_grok_number DPPP_(my_grok_number)
-
-#if defined(NEED_grok_number) || defined(NEED_grok_number_GLOBAL)
-int
-DPPP_(my_grok_number)(pTHX_ const char *pv, STRLEN len, UV *valuep)
-{
- const char *s = pv;
- const char *send = pv + len;
- const UV max_div_10 = UV_MAX / 10;
- const char max_mod_10 = UV_MAX % 10;
- int numtype = 0;
- int sawinf = 0;
- int sawnan = 0;
-
- while (s < send && isSPACE(*s))
- s++;
- if (s == send) {
- return 0;
- } else if (*s == '-') {
- s++;
- numtype = IS_NUMBER_NEG;
- }
- else if (*s == '+')
- s++;
-
- if (s == send)
- return 0;
-
- /* next must be digit or the radix separator or beginning of infinity */
- if (isDIGIT(*s)) {
- /* UVs are at least 32 bits, so the first 9 decimal digits cannot
- overflow. */
- UV value = *s - '0';
- /* This construction seems to be more optimiser friendly.
- (without it gcc does the isDIGIT test and the *s - '0' separately)
- With it gcc on arm is managing 6 instructions (6 cycles) per digit.
- In theory the optimiser could deduce how far to unroll the loop
- before checking for overflow. */
- if (++s < send) {
- int digit = *s - '0';
- if (digit >= 0 && digit <= 9) {
- value = value * 10 + digit;
- if (++s < send) {
- digit = *s - '0';
- if (digit >= 0 && digit <= 9) {
- value = value * 10 + digit;
- if (++s < send) {
- digit = *s - '0';
- if (digit >= 0 && digit <= 9) {
- value = value * 10 + digit;
- if (++s < send) {
- digit = *s - '0';
- if (digit >= 0 && digit <= 9) {
- value = value * 10 + digit;
- if (++s < send) {
- digit = *s - '0';
- if (digit >= 0 && digit <= 9) {
- value = value * 10 + digit;
- if (++s < send) {
- digit = *s - '0';
- if (digit >= 0 && digit <= 9) {
- value = value * 10 + digit;
- if (++s < send) {
- digit = *s - '0';
- if (digit >= 0 && digit <= 9) {
- value = value * 10 + digit;
- if (++s < send) {
- digit = *s - '0';
- if (digit >= 0 && digit <= 9) {
- value = value * 10 + digit;
- if (++s < send) {
- /* Now got 9 digits, so need to check
- each time for overflow. */
- digit = *s - '0';
- while (digit >= 0 && digit <= 9
- && (value < max_div_10
- || (value == max_div_10
- && digit <= max_mod_10))) {
- value = value * 10 + digit;
- if (++s < send)
- digit = *s - '0';
- else
- break;
- }
- if (digit >= 0 && digit <= 9
- && (s < send)) {
- /* value overflowed.
- skip the remaining digits, don't
- worry about setting *valuep. */
- do {
- s++;
- } while (s < send && isDIGIT(*s));
- numtype |=
- IS_NUMBER_GREATER_THAN_UV_MAX;
- goto skip_value;
- }
- }
- }
- }
- }
- }
- }
- }
- }
- }
- }
- }
- }
- }
- }
- }
- }
- }
- numtype |= IS_NUMBER_IN_UV;
- if (valuep)
- *valuep = value;
-
- skip_value:
- if (GROK_NUMERIC_RADIX(&s, send)) {
- numtype |= IS_NUMBER_NOT_INT;
- while (s < send && isDIGIT(*s)) /* optional digits after the radix */
- s++;
- }
- }
- else if (GROK_NUMERIC_RADIX(&s, send)) {
- numtype |= IS_NUMBER_NOT_INT | IS_NUMBER_IN_UV; /* valuep assigned below */
- /* no digits before the radix means we need digits after it */
- if (s < send && isDIGIT(*s)) {
- do {
- s++;
- } while (s < send && isDIGIT(*s));
- if (valuep) {
- /* integer approximation is valid - it's 0. */
- *valuep = 0;
- }
- }
- else
- return 0;
- } else if (*s == 'I' || *s == 'i') {
- s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
- s++; if (s == send || (*s != 'F' && *s != 'f')) return 0;
- s++; if (s < send && (*s == 'I' || *s == 'i')) {
- s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
- s++; if (s == send || (*s != 'I' && *s != 'i')) return 0;
- s++; if (s == send || (*s != 'T' && *s != 't')) return 0;
- s++; if (s == send || (*s != 'Y' && *s != 'y')) return 0;
- s++;
- }
- sawinf = 1;
- } else if (*s == 'N' || *s == 'n') {
- /* XXX TODO: There are signaling NaNs and quiet NaNs. */
- s++; if (s == send || (*s != 'A' && *s != 'a')) return 0;
- s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
- s++;
- sawnan = 1;
- } else
- return 0;
-
- if (sawinf) {
- numtype &= IS_NUMBER_NEG; /* Keep track of sign */
- numtype |= IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT;
- } else if (sawnan) {
- numtype &= IS_NUMBER_NEG; /* Keep track of sign */
- numtype |= IS_NUMBER_NAN | IS_NUMBER_NOT_INT;
- } else if (s < send) {
- /* we can have an optional exponent part */
- if (*s == 'e' || *s == 'E') {
- /* The only flag we keep is sign. Blow away any "it's UV" */
- numtype &= IS_NUMBER_NEG;
- numtype |= IS_NUMBER_NOT_INT;
- s++;
- if (s < send && (*s == '-' || *s == '+'))
- s++;
- if (s < send && isDIGIT(*s)) {
- do {
- s++;
- } while (s < send && isDIGIT(*s));
- }
- else
- return 0;
- }
- }
- while (s < send && isSPACE(*s))
- s++;
- if (s >= send)
- return numtype;
- if (len == 10 && memEQ(pv, "0 but true", 10)) {
- if (valuep)
- *valuep = 0;
- return IS_NUMBER_IN_UV;
- }
- return 0;
-}
-#endif
-#endif
-
-/*
- * The grok_* routines have been modified to use warn() instead of
- * Perl_warner(). Also, 'hexdigit' was the former name of PL_hexdigit,
- * which is why the stack variable has been renamed to 'xdigit'.
- */
-
-#ifndef grok_bin
-#if defined(NEED_grok_bin)
-static UV DPPP_(my_grok_bin)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
-static
-#else
-extern UV DPPP_(my_grok_bin)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
-#endif
-
-#ifdef grok_bin
-# undef grok_bin
-#endif
-#define grok_bin(a,b,c,d) DPPP_(my_grok_bin)(aTHX_ a,b,c,d)
-#define Perl_grok_bin DPPP_(my_grok_bin)
-
-#if defined(NEED_grok_bin) || defined(NEED_grok_bin_GLOBAL)
-UV
-DPPP_(my_grok_bin)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
-{
- const char *s = start;
- STRLEN len = *len_p;
- UV value = 0;
- NV value_nv = 0;
-
- const UV max_div_2 = UV_MAX / 2;
- bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
- bool overflowed = FALSE;
-
- if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
- /* strip off leading b or 0b.
- for compatibility silently suffer "b" and "0b" as valid binary
- numbers. */
- if (len >= 1) {
- if (s[0] == 'b') {
- s++;
- len--;
- }
- else if (len >= 2 && s[0] == '0' && s[1] == 'b') {
- s+=2;
- len-=2;
- }
- }
- }
-
- for (; len-- && *s; s++) {
- char bit = *s;
- if (bit == '0' || bit == '1') {
- /* Write it in this wonky order with a goto to attempt to get the
- compiler to make the common case integer-only loop pretty tight.
- With gcc seems to be much straighter code than old scan_bin. */
- redo:
- if (!overflowed) {
- if (value <= max_div_2) {
- value = (value << 1) | (bit - '0');
- continue;
- }
- /* Bah. We're just overflowed. */
- warn("Integer overflow in binary number");
- overflowed = TRUE;
- value_nv = (NV) value;
- }
- value_nv *= 2.0;
- /* If an NV has not enough bits in its mantissa to
- * represent a UV this summing of small low-order numbers
- * is a waste of time (because the NV cannot preserve
- * the low-order bits anyway): we could just remember when
- * did we overflow and in the end just multiply value_nv by the
- * right amount. */
- value_nv += (NV)(bit - '0');
- continue;
- }
- if (bit == '_' && len && allow_underscores && (bit = s[1])
- && (bit == '0' || bit == '1'))
- {
- --len;
- ++s;
- goto redo;
- }
- if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
- warn("Illegal binary digit '%c' ignored", *s);
- break;
- }
-
- if ( ( overflowed && value_nv > 4294967295.0)
-#if UVSIZE > 4
- || (!overflowed && value > 0xffffffff )
-#endif
- ) {
- warn("Binary number > 0b11111111111111111111111111111111 non-portable");
- }
- *len_p = s - start;
- if (!overflowed) {
- *flags = 0;
- return value;
- }
- *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
- if (result)
- *result = value_nv;
- return UV_MAX;
-}
-#endif
-#endif
-
-#ifndef grok_hex
-#if defined(NEED_grok_hex)
-static UV DPPP_(my_grok_hex)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
-static
-#else
-extern UV DPPP_(my_grok_hex)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
-#endif
-
-#ifdef grok_hex
-# undef grok_hex
-#endif
-#define grok_hex(a,b,c,d) DPPP_(my_grok_hex)(aTHX_ a,b,c,d)
-#define Perl_grok_hex DPPP_(my_grok_hex)
-
-#if defined(NEED_grok_hex) || defined(NEED_grok_hex_GLOBAL)
-UV
-DPPP_(my_grok_hex)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
-{
- const char *s = start;
- STRLEN len = *len_p;
- UV value = 0;
- NV value_nv = 0;
-
- const UV max_div_16 = UV_MAX / 16;
- bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
- bool overflowed = FALSE;
- const char *xdigit;
-
- if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
- /* strip off leading x or 0x.
- for compatibility silently suffer "x" and "0x" as valid hex numbers.
- */
- if (len >= 1) {
- if (s[0] == 'x') {
- s++;
- len--;
- }
- else if (len >= 2 && s[0] == '0' && s[1] == 'x') {
- s+=2;
- len-=2;
- }
- }
- }
-
- for (; len-- && *s; s++) {
- xdigit = strchr((char *) PL_hexdigit, *s);
- if (xdigit) {
- /* Write it in this wonky order with a goto to attempt to get the
- compiler to make the common case integer-only loop pretty tight.
- With gcc seems to be much straighter code than old scan_hex. */
- redo:
- if (!overflowed) {
- if (value <= max_div_16) {
- value = (value << 4) | ((xdigit - PL_hexdigit) & 15);
- continue;
- }
- warn("Integer overflow in hexadecimal number");
- overflowed = TRUE;
- value_nv = (NV) value;
- }
- value_nv *= 16.0;
- /* If an NV has not enough bits in its mantissa to
- * represent a UV this summing of small low-order numbers
- * is a waste of time (because the NV cannot preserve
- * the low-order bits anyway): we could just remember when
- * did we overflow and in the end just multiply value_nv by the
- * right amount of 16-tuples. */
- value_nv += (NV)((xdigit - PL_hexdigit) & 15);
- continue;
- }
- if (*s == '_' && len && allow_underscores && s[1]
- && (xdigit = strchr((char *) PL_hexdigit, s[1])))
- {
- --len;
- ++s;
- goto redo;
- }
- if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
- warn("Illegal hexadecimal digit '%c' ignored", *s);
- break;
- }
-
- if ( ( overflowed && value_nv > 4294967295.0)
-#if UVSIZE > 4
- || (!overflowed && value > 0xffffffff )
-#endif
- ) {
- warn("Hexadecimal number > 0xffffffff non-portable");
- }
- *len_p = s - start;
- if (!overflowed) {
- *flags = 0;
- return value;
- }
- *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
- if (result)
- *result = value_nv;
- return UV_MAX;
-}
-#endif
-#endif
-
-#ifndef grok_oct
-#if defined(NEED_grok_oct)
-static UV DPPP_(my_grok_oct)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
-static
-#else
-extern UV DPPP_(my_grok_oct)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
-#endif
-
-#ifdef grok_oct
-# undef grok_oct
-#endif
-#define grok_oct(a,b,c,d) DPPP_(my_grok_oct)(aTHX_ a,b,c,d)
-#define Perl_grok_oct DPPP_(my_grok_oct)
-
-#if defined(NEED_grok_oct) || defined(NEED_grok_oct_GLOBAL)
-UV
-DPPP_(my_grok_oct)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
-{
- const char *s = start;
- STRLEN len = *len_p;
- UV value = 0;
- NV value_nv = 0;
-
- const UV max_div_8 = UV_MAX / 8;
- bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
- bool overflowed = FALSE;
-
- for (; len-- && *s; s++) {
- /* gcc 2.95 optimiser not smart enough to figure that this subtraction
- out front allows slicker code. */
- int digit = *s - '0';
- if (digit >= 0 && digit <= 7) {
- /* Write it in this wonky order with a goto to attempt to get the
- compiler to make the common case integer-only loop pretty tight.
- */
- redo:
- if (!overflowed) {
- if (value <= max_div_8) {
- value = (value << 3) | digit;
- continue;
- }
- /* Bah. We're just overflowed. */
- warn("Integer overflow in octal number");
- overflowed = TRUE;
- value_nv = (NV) value;
- }
- value_nv *= 8.0;
- /* If an NV has not enough bits in its mantissa to
- * represent a UV this summing of small low-order numbers
- * is a waste of time (because the NV cannot preserve
- * the low-order bits anyway): we could just remember when
- * did we overflow and in the end just multiply value_nv by the
- * right amount of 8-tuples. */
- value_nv += (NV)digit;
- continue;
- }
- if (digit == ('_' - '0') && len && allow_underscores
- && (digit = s[1] - '0') && (digit >= 0 && digit <= 7))
- {
- --len;
- ++s;
- goto redo;
- }
- /* Allow \octal to work the DWIM way (that is, stop scanning
- * as soon as non-octal characters are seen, complain only iff
- * someone seems to want to use the digits eight and nine). */
- if (digit == 8 || digit == 9) {
- if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
- warn("Illegal octal digit '%c' ignored", *s);
- }
- break;
- }
-
- if ( ( overflowed && value_nv > 4294967295.0)
-#if UVSIZE > 4
- || (!overflowed && value > 0xffffffff )
-#endif
- ) {
- warn("Octal number > 037777777777 non-portable");
- }
- *len_p = s - start;
- if (!overflowed) {
- *flags = 0;
- return value;
- }
- *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
- if (result)
- *result = value_nv;
- return UV_MAX;
-}
-#endif
-#endif
-
-#if !defined(my_snprintf)
-#if defined(NEED_my_snprintf)
-static int DPPP_(my_my_snprintf)(char * buffer, const Size_t len, const char * format, ...);
-static
-#else
-extern int DPPP_(my_my_snprintf)(char * buffer, const Size_t len, const char * format, ...);
-#endif
-
-#define my_snprintf DPPP_(my_my_snprintf)
-#define Perl_my_snprintf DPPP_(my_my_snprintf)
-
-#if defined(NEED_my_snprintf) || defined(NEED_my_snprintf_GLOBAL)
-
-int
-DPPP_(my_my_snprintf)(char *buffer, const Size_t len, const char *format, ...)
-{
- dTHX;
- int retval;
- va_list ap;
- va_start(ap, format);
-#ifdef HAS_VSNPRINTF
- retval = vsnprintf(buffer, len, format, ap);
-#else
- retval = vsprintf(buffer, format, ap);
-#endif
- va_end(ap);
- if (retval < 0 || (len > 0 && (Size_t)retval >= len))
- Perl_croak(aTHX_ "panic: my_snprintf buffer overflow");
- return retval;
-}
-
-#endif
-#endif
-
-#if !defined(my_sprintf)
-#if defined(NEED_my_sprintf)
-static int DPPP_(my_my_sprintf)(char * buffer, const char * pat, ...);
-static
-#else
-extern int DPPP_(my_my_sprintf)(char * buffer, const char * pat, ...);
-#endif
-
-#define my_sprintf DPPP_(my_my_sprintf)
-#define Perl_my_sprintf DPPP_(my_my_sprintf)
-
-#if defined(NEED_my_sprintf) || defined(NEED_my_sprintf_GLOBAL)
-
-int
-DPPP_(my_my_sprintf)(char *buffer, const char* pat, ...)
-{
- va_list args;
- va_start(args, pat);
- vsprintf(buffer, pat, args);
- va_end(args);
- return strlen(buffer);
-}
-
-#endif
-#endif
-
-#ifdef NO_XSLOCKS
-# ifdef dJMPENV
-# define dXCPT dJMPENV; int rEtV = 0
-# define XCPT_TRY_START JMPENV_PUSH(rEtV); if (rEtV == 0)
-# define XCPT_TRY_END JMPENV_POP;
-# define XCPT_CATCH if (rEtV != 0)
-# define XCPT_RETHROW JMPENV_JUMP(rEtV)
-# else
-# define dXCPT Sigjmp_buf oldTOP; int rEtV = 0
-# define XCPT_TRY_START Copy(top_env, oldTOP, 1, Sigjmp_buf); rEtV = Sigsetjmp(top_env, 1); if (rEtV == 0)
-# define XCPT_TRY_END Copy(oldTOP, top_env, 1, Sigjmp_buf);
-# define XCPT_CATCH if (rEtV != 0)
-# define XCPT_RETHROW Siglongjmp(top_env, rEtV)
-# endif
-#endif
-
-#if !defined(my_strlcat)
-#if defined(NEED_my_strlcat)
-static Size_t DPPP_(my_my_strlcat)(char * dst, const char * src, Size_t size);
-static
-#else
-extern Size_t DPPP_(my_my_strlcat)(char * dst, const char * src, Size_t size);
-#endif
-
-#define my_strlcat DPPP_(my_my_strlcat)
-#define Perl_my_strlcat DPPP_(my_my_strlcat)
-
-#if defined(NEED_my_strlcat) || defined(NEED_my_strlcat_GLOBAL)
-
-Size_t
-DPPP_(my_my_strlcat)(char *dst, const char *src, Size_t size)
-{
- Size_t used, length, copy;
-
- used = strlen(dst);
- length = strlen(src);
- if (size > 0 && used < size - 1) {
- copy = (length >= size - used) ? size - used - 1 : length;
- memcpy(dst + used, src, copy);
- dst[used + copy] = '\0';
- }
- return used + length;
-}
-#endif
-#endif
-
-#if !defined(my_strlcpy)
-#if defined(NEED_my_strlcpy)
-static Size_t DPPP_(my_my_strlcpy)(char * dst, const char * src, Size_t size);
-static
-#else
-extern Size_t DPPP_(my_my_strlcpy)(char * dst, const char * src, Size_t size);
-#endif
-
-#define my_strlcpy DPPP_(my_my_strlcpy)
-#define Perl_my_strlcpy DPPP_(my_my_strlcpy)
-
-#if defined(NEED_my_strlcpy) || defined(NEED_my_strlcpy_GLOBAL)
-
-Size_t
-DPPP_(my_my_strlcpy)(char *dst, const char *src, Size_t size)
-{
- Size_t length, copy;
-
- length = strlen(src);
- if (size > 0) {
- copy = (length >= size) ? size - 1 : length;
- memcpy(dst, src, copy);
- dst[copy] = '\0';
- }
- return length;
-}
-
-#endif
-#endif
-#ifndef PERL_PV_ESCAPE_QUOTE
-# define PERL_PV_ESCAPE_QUOTE 0x0001
-#endif
-
-#ifndef PERL_PV_PRETTY_QUOTE
-# define PERL_PV_PRETTY_QUOTE PERL_PV_ESCAPE_QUOTE
-#endif
-
-#ifndef PERL_PV_PRETTY_ELLIPSES
-# define PERL_PV_PRETTY_ELLIPSES 0x0002
-#endif
-
-#ifndef PERL_PV_PRETTY_LTGT
-# define PERL_PV_PRETTY_LTGT 0x0004
-#endif
-
-#ifndef PERL_PV_ESCAPE_FIRSTCHAR
-# define PERL_PV_ESCAPE_FIRSTCHAR 0x0008
-#endif
-
-#ifndef PERL_PV_ESCAPE_UNI
-# define PERL_PV_ESCAPE_UNI 0x0100
-#endif
-
-#ifndef PERL_PV_ESCAPE_UNI_DETECT
-# define PERL_PV_ESCAPE_UNI_DETECT 0x0200
-#endif
-
-#ifndef PERL_PV_ESCAPE_ALL
-# define PERL_PV_ESCAPE_ALL 0x1000
-#endif
-
-#ifndef PERL_PV_ESCAPE_NOBACKSLASH
-# define PERL_PV_ESCAPE_NOBACKSLASH 0x2000
-#endif
-
-#ifndef PERL_PV_ESCAPE_NOCLEAR
-# define PERL_PV_ESCAPE_NOCLEAR 0x4000
-#endif
-
-#ifndef PERL_PV_ESCAPE_RE
-# define PERL_PV_ESCAPE_RE 0x8000
-#endif
-
-#ifndef PERL_PV_PRETTY_NOCLEAR
-# define PERL_PV_PRETTY_NOCLEAR PERL_PV_ESCAPE_NOCLEAR
-#endif
-#ifndef PERL_PV_PRETTY_DUMP
-# define PERL_PV_PRETTY_DUMP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_QUOTE
-#endif
-
-#ifndef PERL_PV_PRETTY_REGPROP
-# define PERL_PV_PRETTY_REGPROP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_LTGT|PERL_PV_ESCAPE_RE
-#endif
-
-/* Hint: pv_escape
- * Note that unicode functionality is only backported to
- * those perl versions that support it. For older perl
- * versions, the implementation will fall back to bytes.
- */
-
-#ifndef pv_escape
-#if defined(NEED_pv_escape)
-static char * DPPP_(my_pv_escape)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, STRLEN * const escaped, const U32 flags);
-static
-#else
-extern char * DPPP_(my_pv_escape)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, STRLEN * const escaped, const U32 flags);
-#endif
-
-#ifdef pv_escape
-# undef pv_escape
-#endif
-#define pv_escape(a,b,c,d,e,f) DPPP_(my_pv_escape)(aTHX_ a,b,c,d,e,f)
-#define Perl_pv_escape DPPP_(my_pv_escape)
-
-#if defined(NEED_pv_escape) || defined(NEED_pv_escape_GLOBAL)
-
-char *
-DPPP_(my_pv_escape)(pTHX_ SV *dsv, char const * const str,
- const STRLEN count, const STRLEN max,
- STRLEN * const escaped, const U32 flags)
-{
- const char esc = flags & PERL_PV_ESCAPE_RE ? '%' : '\\';
- const char dq = flags & PERL_PV_ESCAPE_QUOTE ? '"' : esc;
- char octbuf[32] = "%123456789ABCDF";
- STRLEN wrote = 0;
- STRLEN chsize = 0;
- STRLEN readsize = 1;
-#if defined(is_utf8_string) && defined(utf8_to_uvchr)
- bool isuni = flags & PERL_PV_ESCAPE_UNI ? 1 : 0;
-#endif
- const char *pv = str;
- const char * const end = pv + count;
- octbuf[0] = esc;
-
- if (!(flags & PERL_PV_ESCAPE_NOCLEAR))
- sv_setpvs(dsv, "");
-
-#if defined(is_utf8_string) && defined(utf8_to_uvchr)
- if ((flags & PERL_PV_ESCAPE_UNI_DETECT) && is_utf8_string((U8*)pv, count))
- isuni = 1;
-#endif
-
- for (; pv < end && (!max || wrote < max) ; pv += readsize) {
- const UV u =
-#if defined(is_utf8_string) && defined(utf8_to_uvchr)
- isuni ? utf8_to_uvchr((U8*)pv, &readsize) :
-#endif
- (U8)*pv;
- const U8 c = (U8)u & 0xFF;
-
- if (u > 255 || (flags & PERL_PV_ESCAPE_ALL)) {
- if (flags & PERL_PV_ESCAPE_FIRSTCHAR)
- chsize = my_snprintf(octbuf, sizeof octbuf,
- "%" UVxf, u);
- else
- chsize = my_snprintf(octbuf, sizeof octbuf,
- "%cx{%" UVxf "}", esc, u);
- } else if (flags & PERL_PV_ESCAPE_NOBACKSLASH) {
- chsize = 1;
- } else {
- if (c == dq || c == esc || !isPRINT(c)) {
- chsize = 2;
- switch (c) {
- case '\\' : /* fallthrough */
- case '%' : if (c == esc)
- octbuf[1] = esc;
- else
- chsize = 1;
- break;
- case '\v' : octbuf[1] = 'v'; break;
- case '\t' : octbuf[1] = 't'; break;
- case '\r' : octbuf[1] = 'r'; break;
- case '\n' : octbuf[1] = 'n'; break;
- case '\f' : octbuf[1] = 'f'; break;
- case '"' : if (dq == '"')
- octbuf[1] = '"';
- else
- chsize = 1;
- break;
- default: chsize = my_snprintf(octbuf, sizeof octbuf,
- pv < end && isDIGIT((U8)*(pv+readsize))
- ? "%c%03o" : "%c%o", esc, c);
- }
- } else {
- chsize = 1;
- }
- }
- if (max && wrote + chsize > max) {
- break;
- } else if (chsize > 1) {
- sv_catpvn(dsv, octbuf, chsize);
- wrote += chsize;
- } else {
- char tmp[2];
- my_snprintf(tmp, sizeof tmp, "%c", c);
- sv_catpvn(dsv, tmp, 1);
- wrote++;
- }
- if (flags & PERL_PV_ESCAPE_FIRSTCHAR)
- break;
- }
- if (escaped != NULL)
- *escaped= pv - str;
- return SvPVX(dsv);
-}
-
-#endif
-#endif
-
-#ifndef pv_pretty
-#if defined(NEED_pv_pretty)
-static char * DPPP_(my_pv_pretty)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, char const * const start_color, char const * const end_color, const U32 flags);
-static
-#else
-extern char * DPPP_(my_pv_pretty)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, char const * const start_color, char const * const end_color, const U32 flags);
-#endif
-
-#ifdef pv_pretty
-# undef pv_pretty
-#endif
-#define pv_pretty(a,b,c,d,e,f,g) DPPP_(my_pv_pretty)(aTHX_ a,b,c,d,e,f,g)
-#define Perl_pv_pretty DPPP_(my_pv_pretty)
-
-#if defined(NEED_pv_pretty) || defined(NEED_pv_pretty_GLOBAL)
-
-char *
-DPPP_(my_pv_pretty)(pTHX_ SV *dsv, char const * const str, const STRLEN count,
- const STRLEN max, char const * const start_color, char const * const end_color,
- const U32 flags)
-{
- const U8 dq = (flags & PERL_PV_PRETTY_QUOTE) ? '"' : '%';
- STRLEN escaped;
-
- if (!(flags & PERL_PV_PRETTY_NOCLEAR))
- sv_setpvs(dsv, "");
-
- if (dq == '"')
- sv_catpvs(dsv, "\"");
- else if (flags & PERL_PV_PRETTY_LTGT)
- sv_catpvs(dsv, "<");
-
- if (start_color != NULL)
- sv_catpv(dsv, D_PPP_CONSTPV_ARG(start_color));
-
- pv_escape(dsv, str, count, max, &escaped, flags | PERL_PV_ESCAPE_NOCLEAR);
-
- if (end_color != NULL)
- sv_catpv(dsv, D_PPP_CONSTPV_ARG(end_color));
-
- if (dq == '"')
- sv_catpvs(dsv, "\"");
- else if (flags & PERL_PV_PRETTY_LTGT)
- sv_catpvs(dsv, ">");
-
- if ((flags & PERL_PV_PRETTY_ELLIPSES) && escaped < count)
- sv_catpvs(dsv, "...");
-
- return SvPVX(dsv);
-}
-
-#endif
-#endif
-
-#ifndef pv_display
-#if defined(NEED_pv_display)
-static char * DPPP_(my_pv_display)(pTHX_ SV * dsv, const char * pv, STRLEN cur, STRLEN len, STRLEN pvlim);
-static
-#else
-extern char * DPPP_(my_pv_display)(pTHX_ SV * dsv, const char * pv, STRLEN cur, STRLEN len, STRLEN pvlim);
-#endif
-
-#ifdef pv_display
-# undef pv_display
-#endif
-#define pv_display(a,b,c,d,e) DPPP_(my_pv_display)(aTHX_ a,b,c,d,e)
-#define Perl_pv_display DPPP_(my_pv_display)
-
-#if defined(NEED_pv_display) || defined(NEED_pv_display_GLOBAL)
-
-char *
-DPPP_(my_pv_display)(pTHX_ SV *dsv, const char *pv, STRLEN cur, STRLEN len, STRLEN pvlim)
-{
- pv_pretty(dsv, pv, cur, pvlim, NULL, NULL, PERL_PV_PRETTY_DUMP);
- if (len > cur && pv[cur] == '\0')
- sv_catpvs(dsv, "\\0");
- return SvPVX(dsv);
-}
-
-#endif
-#endif
-
-#endif /* _P_P_PORTABILITY_H_ */
-
-/* End of File ppport.h */
+++ /dev/null
-#!/usr/bin/perl
-
-use strict;
-
-my $VERSION = sprintf("1.%06d", q$Revision$ =~ /(\d+)/o);
-
-use Data::Dumper;
-use DBI::ProfileData;
-use Getopt::Long;
-
-# default options
-my $number = 10;
-my $sort = 'total';
-my $filename = 'dbi.prof';
-my $reverse = 0;
-my $case_sensitive = 0;
-my (%match, %exclude);
-
-# get options from command line
-GetOptions(
- 'version' => sub { die "dbiprof $VERSION\n" },
- 'help' => sub { exit usage() },
- 'number=i' => \$number,
- 'sort=s' => \$sort,
- 'dumpnodes!' => \my $dumpnodes,
- 'reverse' => \$reverse,
- 'match=s' => \%match,
- 'exclude=s' => \%exclude,
- 'case-sensitive' => \$case_sensitive,
- 'delete!' => \my $opt_delete,
-) or exit usage();
-
-sub usage {
- print <<EOS;
-dbiprof [options] [files]
-
-Reads and merges DBI profile data from files and prints a summary.
-
-files: defaults to $filename
-
-options:
-
- -number=N show top N, defaults to $number
- -sort=S sort by S, defaults to $sort
- -reverse reverse the sort
- -match=K=V for filtering, see docs
- -exclude=K=V for filtering, see docs
- -case_sensitive for -match and -exclude
- -delete rename files before reading then delete afterwards
- -version print version number and exit
- -help print this help
-
-EOS
- return 1;
-}
-
-# list of files defaults to dbi.prof
-my @files = @ARGV ? @ARGV : ('dbi.prof');
-
-
-# instantiate ProfileData object
-my $prof = eval {
- DBI::ProfileData->new(
- Files => \@files,
- DeleteFiles => $opt_delete,
- );
-};
-die "Unable to load profile data: $@\n" if $@;
-
-if (%match) { # handle matches
- while (my ($key, $val) = each %match) {
- if ($val =~ m!^/(.+)/$!) {
- $val = $case_sensitive ? qr/$1/ : qr/$1/i;
- }
- $prof->match($key, $val, case_sensitive => $case_sensitive);
- }
-}
-
-if (%exclude) { # handle excludes
- while (my ($key, $val) = each %exclude) {
- if ($val =~ m!^/(.+)/$!) {
- $val = $case_sensitive ? qr/$1/ : qr/$1/i;
- }
- $prof->exclude($key, $val, case_sensitive => $case_sensitive);
- }
-}
-
-# sort the data
-$prof->sort(field => $sort, reverse => $reverse);
-
-# all done, print it out
-if ($dumpnodes) {
- $Data::Dumper::Indent = 1;
- $Data::Dumper::Terse = 1;
- $Data::Dumper::Useqq = 1;
- $Data::Dumper::Deparse = 0;
- print Dumper($prof->nodes);
-}
-else {
- print $prof->report(number => $number);
-}
-exit 0;
-
-__END__
-
-=head1 NAME
-
-dbiprof - command-line client for DBI::ProfileData
-
-=head1 SYNOPSIS
-
-See a report of the ten queries with the longest total runtime in the
-profile dump file F<prof1.out>:
-
- dbiprof prof1.out
-
-See the top 10 most frequently run queries in the profile file
-F<dbi.prof> (the default):
-
- dbiprof --sort count
-
-See the same report with 15 entries:
-
- dbiprof --sort count --number 15
-
-=head1 DESCRIPTION
-
-This tool is a command-line client for the DBI::ProfileData. It
-allows you to analyze the profile data file produced by
-DBI::ProfileDumper and produce various useful reports.
-
-=head1 OPTIONS
-
-This program accepts the following options:
-
-=over 4
-
-=item --number N
-
-Produce this many items in the report. Defaults to 10. If set to
-"all" then all results are shown.
-
-=item --sort field
-
-Sort results by the given field. Sorting by multiple fields isn't currently
-supported (patches welcome). The available sort fields are:
-
-=over 4
-
-=item total
-
-Sorts by total time run time across all runs. This is the default
-sort.
-
-=item longest
-
-Sorts by the longest single run.
-
-=item count
-
-Sorts by total number of runs.
-
-=item first
-
-Sorts by the time taken in the first run.
-
-=item shortest
-
-Sorts by the shortest single run.
-
-=item key1
-
-Sorts by the value of the first element in the Path, which should be numeric.
-You can also sort by C<key2> and C<key3>.
-
-=back
-
-=item --reverse
-
-Reverses the selected sort. For example, to see a report of the
-shortest overall time:
-
- dbiprof --sort total --reverse
-
-=item --match keyN=value
-
-Consider only items where the specified key matches the given value.
-Keys are numbered from 1. For example, let's say you used a
-DBI::Profile Path of:
-
- [ DBIprofile_Statement, DBIprofile_Methodname ]
-
-And called dbiprof as in:
-
- dbiprof --match key2=execute
-
-Your report would only show execute queries, leaving out prepares,
-fetches, etc.
-
-If the value given starts and ends with slashes (C</>) then it will be
-treated as a regular expression. For example, to only include SELECT
-queries where key1 is the statement:
-
- dbiprof --match key1=/^SELECT/
-
-By default the match expression is matched case-insensitively, but
-this can be changed with the --case-sensitive option.
-
-=item --exclude keyN=value
-
-Remove items for where the specified key matches the given value. For
-example, to exclude all prepare entries where key2 is the method name:
-
- dbiprof --exclude key2=prepare
-
-Like C<--match>, If the value given starts and ends with slashes
-(C</>) then it will be treated as a regular expression. For example,
-to exclude UPDATE queries where key1 is the statement:
-
- dbiprof --match key1=/^UPDATE/
-
-By default the exclude expression is matched case-insensitively, but
-this can be changed with the --case-sensitive option.
-
-=item --case-sensitive
-
-Using this option causes --match and --exclude to work
-case-sensitively. Defaults to off.
-
-=item --delete
-
-Sets the C<DeleteFiles> option to L<DBI::ProfileData> which causes the
-files to be deleted after reading. See L<DBI::ProfileData> for more details.
-
-=item --dumpnodes
-
-Print the list of nodes in the form of a perl data structure.
-Use the C<-sort> option if you want the list sorted.
-
-=item --version
-
-Print the dbiprof version number and exit.
-
-=back
-
-=head1 AUTHOR
-
-Sam Tregar <sam@tregar.com>
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright (C) 2002 Sam Tregar
-
-This program is free software; you can redistribute it and/or modify
-it under the same terms as Perl 5 itself.
-
-=head1 SEE ALSO
-
-L<DBI::ProfileDumper|DBI::ProfileDumper>,
-L<DBI::Profile|DBI::Profile>, L<DBI|DBI>.
-
-=cut
-
+++ /dev/null
-# -*- perl -*-
-
-my $file = $ARGV[0] || 'dbiprof';
-
-my $script = <<'SCRIPT';
-~startperl~
-
-use strict;
-
-my $VERSION = sprintf("1.%06d", q$Revision$ =~ /(\d+)/o);
-
-use Data::Dumper;
-use DBI::ProfileData;
-use Getopt::Long;
-
-# default options
-my $number = 10;
-my $sort = 'total';
-my $filename = 'dbi.prof';
-my $reverse = 0;
-my $case_sensitive = 0;
-my (%match, %exclude);
-
-# get options from command line
-GetOptions(
- 'version' => sub { die "dbiprof $VERSION\n" },
- 'help' => sub { exit usage() },
- 'number=i' => \$number,
- 'sort=s' => \$sort,
- 'dumpnodes!' => \my $dumpnodes,
- 'reverse' => \$reverse,
- 'match=s' => \%match,
- 'exclude=s' => \%exclude,
- 'case-sensitive' => \$case_sensitive,
- 'delete!' => \my $opt_delete,
-) or exit usage();
-
-sub usage {
- print <<EOS;
-dbiprof [options] [files]
-
-Reads and merges DBI profile data from files and prints a summary.
-
-files: defaults to $filename
-
-options:
-
- -number=N show top N, defaults to $number
- -sort=S sort by S, defaults to $sort
- -reverse reverse the sort
- -match=K=V for filtering, see docs
- -exclude=K=V for filtering, see docs
- -case_sensitive for -match and -exclude
- -delete rename files before reading then delete afterwards
- -version print version number and exit
- -help print this help
-
-EOS
- return 1;
-}
-
-# list of files defaults to dbi.prof
-my @files = @ARGV ? @ARGV : ('dbi.prof');
-
-
-# instantiate ProfileData object
-my $prof = eval {
- DBI::ProfileData->new(
- Files => \@files,
- DeleteFiles => $opt_delete,
- );
-};
-die "Unable to load profile data: $@\n" if $@;
-
-if (%match) { # handle matches
- while (my ($key, $val) = each %match) {
- if ($val =~ m!^/(.+)/$!) {
- $val = $case_sensitive ? qr/$1/ : qr/$1/i;
- }
- $prof->match($key, $val, case_sensitive => $case_sensitive);
- }
-}
-
-if (%exclude) { # handle excludes
- while (my ($key, $val) = each %exclude) {
- if ($val =~ m!^/(.+)/$!) {
- $val = $case_sensitive ? qr/$1/ : qr/$1/i;
- }
- $prof->exclude($key, $val, case_sensitive => $case_sensitive);
- }
-}
-
-# sort the data
-$prof->sort(field => $sort, reverse => $reverse);
-
-# all done, print it out
-if ($dumpnodes) {
- $Data::Dumper::Indent = 1;
- $Data::Dumper::Terse = 1;
- $Data::Dumper::Useqq = 1;
- $Data::Dumper::Deparse = 0;
- print Dumper($prof->nodes);
-}
-else {
- print $prof->report(number => $number);
-}
-exit 0;
-
-__END__
-
-=head1 NAME
-
-dbiprof - command-line client for DBI::ProfileData
-
-=head1 SYNOPSIS
-
-See a report of the ten queries with the longest total runtime in the
-profile dump file F<prof1.out>:
-
- dbiprof prof1.out
-
-See the top 10 most frequently run queries in the profile file
-F<dbi.prof> (the default):
-
- dbiprof --sort count
-
-See the same report with 15 entries:
-
- dbiprof --sort count --number 15
-
-=head1 DESCRIPTION
-
-This tool is a command-line client for the DBI::ProfileData. It
-allows you to analyze the profile data file produced by
-DBI::ProfileDumper and produce various useful reports.
-
-=head1 OPTIONS
-
-This program accepts the following options:
-
-=over 4
-
-=item --number N
-
-Produce this many items in the report. Defaults to 10. If set to
-"all" then all results are shown.
-
-=item --sort field
-
-Sort results by the given field. Sorting by multiple fields isn't currently
-supported (patches welcome). The available sort fields are:
-
-=over 4
-
-=item total
-
-Sorts by total time run time across all runs. This is the default
-sort.
-
-=item longest
-
-Sorts by the longest single run.
-
-=item count
-
-Sorts by total number of runs.
-
-=item first
-
-Sorts by the time taken in the first run.
-
-=item shortest
-
-Sorts by the shortest single run.
-
-=item key1
-
-Sorts by the value of the first element in the Path, which should be numeric.
-You can also sort by C<key2> and C<key3>.
-
-=back
-
-=item --reverse
-
-Reverses the selected sort. For example, to see a report of the
-shortest overall time:
-
- dbiprof --sort total --reverse
-
-=item --match keyN=value
-
-Consider only items where the specified key matches the given value.
-Keys are numbered from 1. For example, let's say you used a
-DBI::Profile Path of:
-
- [ DBIprofile_Statement, DBIprofile_Methodname ]
-
-And called dbiprof as in:
-
- dbiprof --match key2=execute
-
-Your report would only show execute queries, leaving out prepares,
-fetches, etc.
-
-If the value given starts and ends with slashes (C</>) then it will be
-treated as a regular expression. For example, to only include SELECT
-queries where key1 is the statement:
-
- dbiprof --match key1=/^SELECT/
-
-By default the match expression is matched case-insensitively, but
-this can be changed with the --case-sensitive option.
-
-=item --exclude keyN=value
-
-Remove items for where the specified key matches the given value. For
-example, to exclude all prepare entries where key2 is the method name:
-
- dbiprof --exclude key2=prepare
-
-Like C<--match>, If the value given starts and ends with slashes
-(C</>) then it will be treated as a regular expression. For example,
-to exclude UPDATE queries where key1 is the statement:
-
- dbiprof --match key1=/^UPDATE/
-
-By default the exclude expression is matched case-insensitively, but
-this can be changed with the --case-sensitive option.
-
-=item --case-sensitive
-
-Using this option causes --match and --exclude to work
-case-sensitively. Defaults to off.
-
-=item --delete
-
-Sets the C<DeleteFiles> option to L<DBI::ProfileData> which causes the
-files to be deleted after reading. See L<DBI::ProfileData> for more details.
-
-=item --dumpnodes
-
-Print the list of nodes in the form of a perl data structure.
-Use the C<-sort> option if you want the list sorted.
-
-=item --version
-
-Print the dbiprof version number and exit.
-
-=back
-
-=head1 AUTHOR
-
-Sam Tregar <sam@tregar.com>
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright (C) 2002 Sam Tregar
-
-This program is free software; you can redistribute it and/or modify
-it under the same terms as Perl 5 itself.
-
-=head1 SEE ALSO
-
-L<DBI::ProfileDumper|DBI::ProfileDumper>,
-L<DBI::Profile|DBI::Profile>, L<DBI|DBI>.
-
-=cut
-
-SCRIPT
-
-
-require Config;
-my $config = {};
-$config->{'startperl'} = $Config::Config{'startperl'};
-
-$script =~ s/\~(\w+)\~/$config->{$1}/eg;
-if (!(open(FILE, ">$file")) ||
- !(print FILE $script) ||
- !(close(FILE))) {
- die "Error while writing $file: $!\n";
-}
-chmod 0755, $file;
-print "Extracted $file from ",__FILE__," with variable substitutions.\n";
-
-# syntax check resulting file, but only for developers
-exit 1 if -d ".svn"|| -d ".git" and system($^X, '-wc', '-Mblib', $file) != 0;
-
+++ /dev/null
-#!/usr/bin/perl
-
-use strict;
-
-my $VERSION = sprintf("1.%06d", q$Revision$ =~ /(\d+)/o);
-
-my $arg_test = shift(@ARGV) if $ARGV[0] eq '--test';
-$ENV{DBI_TRACE} = shift(@ARGV) || 2 if $ARGV[0] =~ s/^--dbitrace=?//;
-
-require DBI::ProxyServer;
-
-# XXX these should probably be moved into DBI::ProxyServer
-delete $ENV{IFS};
-delete $ENV{CDPATH};
-delete $ENV{ENV};
-delete $ENV{BASH_ENV};
-
-if ($arg_test) {
- require RPC::PlServer::Test;
- @DBI::ProxyServer::ISA = qw(RPC::PlServer::Test DBI);
-}
-
-DBI::ProxyServer::main(@ARGV);
-
-exit(0);
-
-
-__END__
-
-=head1 NAME
-
-dbiproxy - A proxy server for the DBD::Proxy driver
-
-=head1 SYNOPSIS
-
- dbiproxy <options> --localport=<port>
-
-
-=head1 DESCRIPTION
-
-This tool is just a front end for the DBI::ProxyServer package. All it
-does is picking options from the command line and calling
-DBI::ProxyServer::main(). See L<DBI::ProxyServer> for details.
-
-Available options include:
-
-=over 4
-
-=item B<--chroot=dir>
-
-(UNIX only) After doing a bind(), change root directory to the given
-directory by doing a chroot(). This is useful for security, but it
-restricts the environment a lot. For example, you need to load DBI
-drivers in the config file or you have to create hard links to Unix
-sockets, if your drivers are using them. For example, with MySQL, a
-config file might contain the following lines:
-
- my $rootdir = '/var/dbiproxy';
- my $unixsockdir = '/tmp';
- my $unixsockfile = 'mysql.sock';
- foreach $dir ($rootdir, "$rootdir$unixsockdir") {
- mkdir 0755, $dir;
- }
- link("$unixsockdir/$unixsockfile",
- "$rootdir$unixsockdir/$unixsockfile");
- require DBD::mysql;
-
- {
- 'chroot' => $rootdir,
- ...
- }
-
-If you don't know chroot(), think of an FTP server where you can see a
-certain directory tree only after logging in. See also the --group and
---user options.
-
-=item B<--configfile=file>
-
-Config files are assumed to return a single hash ref that overrides the
-arguments of the new method. However, command line arguments in turn take
-precedence over the config file. See the "CONFIGURATION FILE" section
-in the L<DBI::ProxyServer> documentation for details on the config file.
-
-=item B<--debug>
-
-Turn debugging mode on. Mainly this asserts that logging messages of
-level "debug" are created.
-
-=item B<--facility=mode>
-
-(UNIX only) Facility to use for L<Sys::Syslog>. The default is
-B<daemon>.
-
-=item B<--group=gid>
-
-After doing a bind(), change the real and effective GID to the given.
-This is useful, if you want your server to bind to a privileged port
-(<1024), but don't want the server to execute as root. See also
-the --user option.
-
-GID's can be passed as group names or numeric values.
-
-=item B<--localaddr=ip>
-
-By default a daemon is listening to any IP number that a machine
-has. This attribute allows one to restrict the server to the given
-IP number.
-
-=item B<--localport=port>
-
-This attribute sets the port on which the daemon is listening. It
-must be given somehow, as there's no default.
-
-=item B<--logfile=file>
-
-Be default logging messages will be written to the syslog (Unix) or
-to the event log (Windows NT). On other operating systems you need to
-specify a log file. The special value "STDERR" forces logging to
-stderr. See L<Net::Daemon::Log> for details.
-
-=item B<--mode=modename>
-
-The server can run in three different modes, depending on the environment.
-
-If you are running Perl 5.005 and did compile it for threads, then the
-server will create a new thread for each connection. The thread will
-execute the server's Run() method and then terminate. This mode is the
-default, you can force it with "--mode=threads".
-
-If threads are not available, but you have a working fork(), then the
-server will behave similar by creating a new process for each connection.
-This mode will be used automatically in the absence of threads or if
-you use the "--mode=fork" option.
-
-Finally there's a single-connection mode: If the server has accepted a
-connection, he will enter the Run() method. No other connections are
-accepted until the Run() method returns (if the client disconnects).
-This operation mode is useful if you have neither threads nor fork(),
-for example on the Macintosh. For debugging purposes you can force this
-mode with "--mode=single".
-
-=item B<--pidfile=file>
-
-(UNIX only) If this option is present, a PID file will be created at the
-given location. Default is to not create a pidfile.
-
-=item B<--user=uid>
-
-After doing a bind(), change the real and effective UID to the given.
-This is useful, if you want your server to bind to a privileged port
-(<1024), but don't want the server to execute as root. See also
-the --group and the --chroot options.
-
-UID's can be passed as group names or numeric values.
-
-=item B<--version>
-
-Suppresses startup of the server; instead the version string will
-be printed and the program exits immediately.
-
-=back
-
-
-=head1 AUTHOR
-
- Copyright (c) 1997 Jochen Wiedmann
- Am Eisteich 9
- 72555 Metzingen
- Germany
-
- Email: joe@ispsoft.de
- Phone: +49 7123 14881
-
-The DBI::ProxyServer module is free software; you can redistribute it
-and/or modify it under the same terms as Perl itself. In particular
-permission is granted to Tim Bunce for distributing this as a part of
-the DBI.
-
-
-=head1 SEE ALSO
-
-L<DBI::ProxyServer>, L<DBD::Proxy>, L<DBI>
-
-=cut
+++ /dev/null
-# -*- perl -*-
-
-my $file = $ARGV[0] || 'dbiproxy';
-
-my $script = <<'SCRIPT';
-~startperl~
-
-use strict;
-
-my $VERSION = sprintf("1.%06d", q$Revision$ =~ /(\d+)/o);
-
-my $arg_test = shift(@ARGV) if $ARGV[0] eq '--test';
-$ENV{DBI_TRACE} = shift(@ARGV) || 2 if $ARGV[0] =~ s/^--dbitrace=?//;
-
-require DBI::ProxyServer;
-
-# XXX these should probably be moved into DBI::ProxyServer
-delete $ENV{IFS};
-delete $ENV{CDPATH};
-delete $ENV{ENV};
-delete $ENV{BASH_ENV};
-
-if ($arg_test) {
- require RPC::PlServer::Test;
- @DBI::ProxyServer::ISA = qw(RPC::PlServer::Test DBI);
-}
-
-DBI::ProxyServer::main(@ARGV);
-
-exit(0);
-
-
-__END__
-
-=head1 NAME
-
-dbiproxy - A proxy server for the DBD::Proxy driver
-
-=head1 SYNOPSIS
-
- dbiproxy <options> --localport=<port>
-
-
-=head1 DESCRIPTION
-
-This tool is just a front end for the DBI::ProxyServer package. All it
-does is picking options from the command line and calling
-DBI::ProxyServer::main(). See L<DBI::ProxyServer> for details.
-
-Available options include:
-
-=over 4
-
-=item B<--chroot=dir>
-
-(UNIX only) After doing a bind(), change root directory to the given
-directory by doing a chroot(). This is useful for security, but it
-restricts the environment a lot. For example, you need to load DBI
-drivers in the config file or you have to create hard links to Unix
-sockets, if your drivers are using them. For example, with MySQL, a
-config file might contain the following lines:
-
- my $rootdir = '/var/dbiproxy';
- my $unixsockdir = '/tmp';
- my $unixsockfile = 'mysql.sock';
- foreach $dir ($rootdir, "$rootdir$unixsockdir") {
- mkdir 0755, $dir;
- }
- link("$unixsockdir/$unixsockfile",
- "$rootdir$unixsockdir/$unixsockfile");
- require DBD::mysql;
-
- {
- 'chroot' => $rootdir,
- ...
- }
-
-If you don't know chroot(), think of an FTP server where you can see a
-certain directory tree only after logging in. See also the --group and
---user options.
-
-=item B<--configfile=file>
-
-Config files are assumed to return a single hash ref that overrides the
-arguments of the new method. However, command line arguments in turn take
-precedence over the config file. See the "CONFIGURATION FILE" section
-in the L<DBI::ProxyServer> documentation for details on the config file.
-
-=item B<--debug>
-
-Turn debugging mode on. Mainly this asserts that logging messages of
-level "debug" are created.
-
-=item B<--facility=mode>
-
-(UNIX only) Facility to use for L<Sys::Syslog>. The default is
-B<daemon>.
-
-=item B<--group=gid>
-
-After doing a bind(), change the real and effective GID to the given.
-This is useful, if you want your server to bind to a privileged port
-(<1024), but don't want the server to execute as root. See also
-the --user option.
-
-GID's can be passed as group names or numeric values.
-
-=item B<--localaddr=ip>
-
-By default a daemon is listening to any IP number that a machine
-has. This attribute allows one to restrict the server to the given
-IP number.
-
-=item B<--localport=port>
-
-This attribute sets the port on which the daemon is listening. It
-must be given somehow, as there's no default.
-
-=item B<--logfile=file>
-
-Be default logging messages will be written to the syslog (Unix) or
-to the event log (Windows NT). On other operating systems you need to
-specify a log file. The special value "STDERR" forces logging to
-stderr. See L<Net::Daemon::Log> for details.
-
-=item B<--mode=modename>
-
-The server can run in three different modes, depending on the environment.
-
-If you are running Perl 5.005 and did compile it for threads, then the
-server will create a new thread for each connection. The thread will
-execute the server's Run() method and then terminate. This mode is the
-default, you can force it with "--mode=threads".
-
-If threads are not available, but you have a working fork(), then the
-server will behave similar by creating a new process for each connection.
-This mode will be used automatically in the absence of threads or if
-you use the "--mode=fork" option.
-
-Finally there's a single-connection mode: If the server has accepted a
-connection, he will enter the Run() method. No other connections are
-accepted until the Run() method returns (if the client disconnects).
-This operation mode is useful if you have neither threads nor fork(),
-for example on the Macintosh. For debugging purposes you can force this
-mode with "--mode=single".
-
-=item B<--pidfile=file>
-
-(UNIX only) If this option is present, a PID file will be created at the
-given location. Default is to not create a pidfile.
-
-=item B<--user=uid>
-
-After doing a bind(), change the real and effective UID to the given.
-This is useful, if you want your server to bind to a privileged port
-(<1024), but don't want the server to execute as root. See also
-the --group and the --chroot options.
-
-UID's can be passed as group names or numeric values.
-
-=item B<--version>
-
-Suppresses startup of the server; instead the version string will
-be printed and the program exits immediately.
-
-=back
-
-
-=head1 AUTHOR
-
- Copyright (c) 1997 Jochen Wiedmann
- Am Eisteich 9
- 72555 Metzingen
- Germany
-
- Email: joe@ispsoft.de
- Phone: +49 7123 14881
-
-The DBI::ProxyServer module is free software; you can redistribute it
-and/or modify it under the same terms as Perl itself. In particular
-permission is granted to Tim Bunce for distributing this as a part of
-the DBI.
-
-
-=head1 SEE ALSO
-
-L<DBI::ProxyServer>, L<DBD::Proxy>, L<DBI>
-
-=cut
-SCRIPT
-
-
-require Config;
-my $config = {};
-$config->{'startperl'} = $Config::Config{'startperl'};
-
-$script =~ s/\~(\w+)\~/$config->{$1}/eg;
-if (!(open(FILE, ">$file")) ||
- !(print FILE $script) ||
- !(close(FILE))) {
- die "Error while writing $file: $!\n";
-}
-chmod 0755, $file;
-print "Extracted $file from ",__FILE__," with variable substitutions.\n";
-
-# syntax check resulting file, but only for developers
-exit 1 if -d ".svn" || -d ".git" and system($^X, '-wc', '-Mblib', $file) != 0;
-
+++ /dev/null
-/* dbivport.h
-
- Provides macros that enable greater portability between DBI versions.
-
- This file should be *copied* and included in driver distributions
- and #included into the source, after #include DBIXS.h
-
- New driver releases should include an updated copy of dbivport.h
- from the most recent DBI release.
-*/
-
-#ifndef DBI_VPORT_H
-#define DBI_VPORT_H
-
-#ifndef DBIh_SET_ERR_CHAR
-/* Emulate DBIh_SET_ERR_CHAR
- Only uses the err_i, errstr and state parameters.
-*/
-#define DBIh_SET_ERR_CHAR(h, imp_xxh, err_c, err_i, errstr, state, method) \
- sv_setiv(DBIc_ERR(imp_xxh), err_i); \
- (state) ? (void)sv_setpv(DBIc_STATE(imp_xxh), state) : (void)SvOK_off(DBIc_STATE(imp_xxh)); \
- sv_setpv(DBIc_ERRSTR(imp_xxh), errstr)
-#endif
-
-#ifndef DBIcf_Executed
-#define DBIcf_Executed 0x080000
-#endif
-
-#ifndef DBIc_TRACE_LEVEL_MASK
-#define DBIc_TRACE_LEVEL_MASK 0x0000000F
-#define DBIc_TRACE_FLAGS_MASK 0xFFFFFF00
-#define DBIc_TRACE_SETTINGS(imp) (DBIc_DBISTATE(imp)->debug)
-#define DBIc_TRACE_LEVEL(imp) (DBIc_TRACE_SETTINGS(imp) & DBIc_TRACE_LEVEL_MASK)
-#define DBIc_TRACE_FLAGS(imp) (DBIc_TRACE_SETTINGS(imp) & DBIc_TRACE_FLAGS_MASK)
-/* DBIc_TRACE_MATCHES - true if s1 'matches' s2 (c.f. trace_msg())
- DBIc_TRACE_MATCHES(foo, DBIc_TRACE_SETTINGS(imp))
-*/
-#define DBIc_TRACE_MATCHES(s1, s2) \
- ( ((s1 & DBIc_TRACE_LEVEL_MASK) >= (s2 & DBIc_TRACE_LEVEL_MASK)) \
- || ((s1 & DBIc_TRACE_FLAGS_MASK) & (s2 & DBIc_TRACE_FLAGS_MASK)) )
-/* DBIc_TRACE - true if flags match & DBI level>=flaglevel, or if DBI level>level
- DBIc_TRACE(imp, 0, 0, 4) = if level >= 4
- DBIc_TRACE(imp, DBDtf_FOO, 2, 4) = if tracing DBDtf_FOO & level>=2 or level>=4
- DBIc_TRACE(imp, DBDtf_FOO, 2, 0) = as above but never trace just due to level
-*/
-#define DBIc_TRACE(imp, flags, flaglevel, level) \
- ( (flags && (DBIc_TRACE_FLAGS(imp) & flags) && (DBIc_TRACE_LEVEL(imp) >= flaglevel)) \
- || (level && DBIc_TRACE_LEVEL(imp) >= level) )
-#endif
-
-
-#endif /* !DBI_VPORT_H */
+++ /dev/null
-/* Fri Jul 13 13:32:02 2012 */
-/* Mixed revision working copy (15349:15353) */
-#define DBIXS_REVISION 15349
+++ /dev/null
-#!perl -w
-use strict;
-
-my $dbixs_rev_file = "dbixs_rev.h";
-
-my $is_make_dist;
-my $svnversion;
-
-if (is_dbi_svn_dir(".")) {
- $svnversion = `svnversion -n`;
-}
-elsif (is_dbi_svn_dir("..")) {
- # presumably we're in a subdirectory because the user is doing a 'make dist'
- $svnversion = `svnversion -n ..`;
- $is_make_dist = 1;
-}
-else {
- # presumably we're being run by an end-user because their file timestamps
- # got messed up
- print "Skipping regeneration of $dbixs_rev_file\n";
- utime(time(), time(), $dbixs_rev_file); # update modification time
- exit 0;
-}
-
-my @warn;
-die "Neither current directory nor parent directory are an svn working copy\n"
- unless $svnversion and $svnversion =~ m/^\d+/;
-push @warn, "Mixed revision working copy ($svnversion:$1)"
- if $svnversion =~ s/:(\d+)//;
-push @warn, "Code modified since last checkin"
- if $svnversion =~ s/[MS]+$//;
-warn "$dbixs_rev_file warning: $_\n" for @warn;
-die "$0 failed\n" if $is_make_dist && @warn;
-
-write_header($dbixs_rev_file, DBIXS_REVISION => $svnversion, \@warn);
-
-sub write_header {
- my ($file, $macro, $version, $comments_ref) = @_;
- open my $fh, ">$file" or die "Can't open $file: $!\n";
- unshift @$comments_ref, scalar localtime(time);
- print $fh "/* $_ */\n" for @$comments_ref;
- print $fh "#define $macro $version\n";
- close $fh or die "Error closing $file: $!\n";
- print "Wrote $macro $version to $file\n";
-}
-
-sub is_dbi_svn_dir {
- my ($dir) = @_;
- return (-d "$dir/.svn" && -f "$dir/MANIFEST.SKIP");
-}
-
+++ /dev/null
-#!perl
-
-use strict;
-use warnings;
-use Time::HiRes qw(time);
-
-BEGIN { $ENV{PERL_ANYEVENT_STRICT} = 1; $ENV{PERL_ANYEVENT_VERBOSE} = 1; }
-
-use AnyEvent;
-
-BEGIN { $ENV{DBI_TRACE} = 0; $ENV{DBI_PUREPERL} = 0; $ENV{DBI_GOFER_TRACE} = 0; $ENV{DBD_GOFER_TRACE} = 0; };
-
-use DBI;
-
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=corostream';
-
-my $ticker = AnyEvent->timer( after => 0, interval => 0.1, cb => sub {
- warn sprintf "-tick- %.2f\n", time
-} );
-
-warn "connecting...\n";
-my $dbh = DBI->connect("dbi:NullP:");
-warn "...connected\n";
-
-for (1..5) {
- warn "entering DBI...\n";
- $dbh->do("sleep 0.3"); # pseudo-sql understood by the DBD::NullP driver
- warn "...returned\n";
-}
-
-warn "done.";
-
+++ /dev/null
-#! /usr/bin/perl -w
-
-# This script checks which style of WHERE clause(s) will support both
-# null and non-null values. Refer to the NULL Values sub-section
-# of the "Placeholders and Bind Values" section in the DBI
-# documention for more information on this issue. The clause styles
-# and their numbering (0-6) map directly to the examples in the
-# documentation.
-#
-# To use this script:
-#
-# 1) If you are not using the DBI_DSN env variable, then update the
-# connect method arguments to support your database engine and
-# database, and remove the nearby check for DBI_DSN.
-# 2) Set PrintError to 1 in the connect method if you want see the
-# engine's reason WHY your engine won't support a particular
-# style.
-# 3) If your database does not support NULL columns by default
-# (e.g. Sybase) find and edit the CREATE TABLE statement
-# accordingly.
-# 4) To properly test style #5, you need the capability to create the
-# stored procedure SP_ISNULL that acts as a function: it tests its
-# argument and returns 1 if it is null, 0 otherwise. For example,
-# using Informix IDS engine, a definition would look like:
-#
-# CREATE PROCEDURE SP_ISNULL (arg VARCHAR(32)) RETURNING INTEGER;
-# IF arg IS NULL THEN RETURN 1;
-# ELSE RETURN 0;
-# END IF;
-# END PROCEDURE;
-#
-# Warning: This script will attempt to create a table named by the
-# $tablename variable (default dbi__null_test_tmp) and WILL DESTROY
-# any pre-existing table so named.
-
-use strict;
-use DBI;
-
-# The array represents the values that will be stored in the char column of our table.
-# One array element per row.
-# We expect the non-null test to return row 3 (Marge)
-# and the null test to return rows 2 and 4 (the undefs).
-
-my $homer = "Homer";
-my $marge = "Marge";
-
-my @char_column_values = (
- $homer, # 1
- undef, # 2
- $marge, # 3
- undef, # 4
-);
-
-# Define the SQL statements with the various WHERE clause styles we want to test
-# and the parameters we'll substitute.
-
-my @select_clauses =
-(
- {clause=>qq{WHERE mycol = ?}, nonnull=>[$marge], null=>[undef]},
- {clause=>qq{WHERE NVL(mycol, '-') = NVL(?, '-')}, nonnull=>[$marge], null=>[undef]},
- {clause=>qq{WHERE ISNULL(mycol, '-') = ISNULL(?, '-')}, nonnull=>[$marge], null=>[undef]},
- {clause=>qq{WHERE DECODE(mycol, ?, 1, 0) = 1}, nonnull=>[$marge], null=>[undef]},
- {clause=>qq{WHERE mycol = ? OR (mycol IS NULL AND ? IS NULL)}, nonnull=>[$marge,$marge], null=>[undef,undef]},
- {clause=>qq{WHERE mycol = ? OR (mycol IS NULL AND SP_ISNULL(?) = 1)}, nonnull=>[$marge,$marge], null=>[undef,undef]},
- {clause=>qq{WHERE mycol = ? OR (mycol IS NULL AND ? = 1)}, nonnull=>[$marge,0], null=>[undef,1]},
-);
-
-# This is the table we'll create and use for these tests.
-# If it exists, we'll DESTROY it too. So the name must be obscure.
-
-my $tablename = "dbi__null_test_tmp";
-
-# Remove this if you are not using the DBI_DSN env variable,
-# and update the connect statement below.
-
-die "DBI_DSN environment variable not defined"
- unless $ENV{DBI_DSN};
-
-my $dbh = DBI->connect(undef, undef, undef,
- {
- RaiseError => 0,
- PrintError => 1
- }
-) || die DBI->errstr;
-
-printf "Using %s, db version: %s\n", $ENV{DBI_DSN} || "connect arguments", $dbh->get_info(18) || "(unknown)";
-
-my $sth;
-my @ok;
-
-print "=> Drop table '$tablename', if it already exists...\n";
-do { local $dbh->{PrintError}=0; $dbh->do("DROP TABLE $tablename"); };
-
-print "=> Create table '$tablename'...\n";
-$dbh->do("CREATE TABLE $tablename (myid int NOT NULL, mycol char(5))");
-# Use this if your database does not support NULL columns by default:
-#$dbh->do("CREATE TABLE $tablename (myid int NOT NULL, mycol char(5) NULL)");
-
-print "=> Insert 4 rows into the table...\n";
-
-$sth = $dbh->prepare("INSERT INTO $tablename (myid, mycol) VALUES (?,?)");
-for my $i (0..$#char_column_values)
-{
- my $val = $char_column_values[$i];
- printf " Inserting values (%d, %s)\n", $i+1, $dbh->quote($val);
- $sth->execute($i+1, $val);
-}
-print "(Driver bug: statement handle should not be Active after an INSERT.)\n"
- if $sth->{Active};
-
-# Run the tests...
-
-for my $i (0..$#select_clauses)
-{
- my $sel = $select_clauses[$i];
- print "\n=> Testing clause style $i: ".$sel->{clause}."...\n";
-
- $sth = $dbh->prepare("SELECT myid,mycol FROM $tablename ".$sel->{clause})
- or next;
-
- print " Selecting row with $marge\n";
- $sth->execute(@{$sel->{nonnull}})
- or next;
- my $r1 = $sth->fetchall_arrayref();
- my $n1_rows = $sth->rows;
- my $n1 = @$r1;
-
- print " Selecting rows with NULL\n";
- $sth->execute(@{$sel->{null}})
- or next;
- my $r2 = $sth->fetchall_arrayref();
- my $n2_rows = $sth->rows;
- my $n2 = @$r2;
-
- # Complain a bit...
-
- print "\n=>Your DBD driver doesn't support the 'rows' method very well.\n\n"
- unless ($n1_rows == $n1 && $n2_rows == $n2);
-
- # Did we get back the expected "n"umber of rows?
- # Did we get back the specific "r"ows we expected as identifed by the myid column?
-
- if ( $n1 == 1 # one row for Marge
- && $n2 == 2 # two rows for nulls
- && $r1->[0][0] == 3 # Marge is myid 3
- && $r2->[0][0] == 2 # NULL for myid 2
- && $r2->[1][0] == 4 # NULL for myid 4
- ) {
- print "=> WHERE clause style $i is supported.\n";
- push @ok, "\tStyle $i: ".$sel->{clause};
- }
- else
- {
- print "=> WHERE clause style $i returned incorrect results.\n";
- if ($n1 > 0 || $n2 > 0)
- {
- print " Non-NULL test rows returned these row ids: ".
- join(", ", map { $r1->[$_][0] } (0..$#{$r1}))."\n";
- print " The NULL test rows returned these row ids: ".
- join(", ", map { $r2->[$_][0] } (0..$#{$r2}))."\n";
- }
- }
-}
-
-$dbh->disconnect();
-print "\n";
-print "-" x 72, "\n";
-printf "%d styles are supported:\n", scalar @ok;
-print "$_\n" for @ok;
-print "-" x 72, "\n";
-print "\n";
-print "If these results don't match what's in the 'Placeholders and Bind Values'\n";
-print "section of the DBI documentation, or are for a database that not already\n";
-print "listed, please email the results to dbi-users\@perl.org. Thank you.\n";
-
-exit 0;
+++ /dev/null
-#!/usr/bin/perl -w
-
-use DBI;
-
-$dbh = DBI->connect('dbi:SQLite:dbname=ex_profile.db', '', '', { RaiseError => 1 });
-
-$dbh->do("DROP TABLE IF EXISTS ex_profile");
-$dbh->do("CREATE TABLE ex_profile (a int)");
-
- $dbh->do("INSERT INTO ex_profile (a) VALUES ($_)", undef) for 1..100;
-#$dbh->do("INSERT INTO ex_profile (a) VALUES (?)", undef, $_) for 1..100;
-
-my $select_sql = "SELECT a FROM ex_profile";
-
-$dbh->selectall_arrayref($select_sql);
-
-$dbh->selectall_hashref($select_sql, 'a');
-
-my $sth = $dbh->prepare($select_sql);
-$sth->execute;
-while ( @row = $sth->fetchrow_array ) {
-}
-
-
-__DATA__
+++ /dev/null
-# -*- perl -*-
-
-package Bundle::DBI;
-
-use strict;
-our $VERSION = "12.008696";
-
-1;
-
-__END__
-
-=head1 NAME
-
-Bundle::DBI - A bundle to install DBI and required modules.
-
-=head1 SYNOPSIS
-
- perl -MCPAN -e 'install Bundle::DBI'
-
-=head1 CONTENTS
-
-DBI - for to get to know thyself
-
-DBI::Shell 11.91 - the DBI command line shell
-
-Storable 2.06 - for DBD::Proxy, DBI::ProxyServer, DBD::Forward
-
-Net::Daemon 0.37 - for DBD::Proxy and DBI::ProxyServer
-
-RPC::PlServer 0.2016 - for DBD::Proxy and DBI::ProxyServer
-
-DBD::Multiplex 1.19 - treat multiple db handles as one
-
-=head1 DESCRIPTION
-
-This bundle includes all the modules used by the Perl Database
-Interface (DBI) module, created by Tim Bunce.
-
-A I<Bundle> is a module that simply defines a collection of other
-modules. It is used by the L<CPAN> module to automate the fetching,
-building and installing of modules from the CPAN ftp archive sites.
-
-This bundle does not deal with the various database drivers (e.g.
-DBD::Informix, DBD::Oracle etc), most of which require software from
-sources other than CPAN. You'll need to fetch and build those drivers
-yourself.
-
-=head1 AUTHORS
-
-Jonathan Leffler, Jochen Wiedmann and Tim Bunce.
-
-=cut
+++ /dev/null
-#######################################################################
-#
-# DBD::DBM - a DBI driver for DBM files
-#
-# Copyright (c) 2004 by Jeff Zucker < jzucker AT cpan.org >
-# Copyright (c) 2010-2013 by Jens Rehsack & H.Merijn Brand
-#
-# All rights reserved.
-#
-# You may freely distribute and/or modify this module under the terms
-# of either the GNU General Public License (GPL) or the Artistic License,
-# as specified in the Perl README file.
-#
-# USERS - see the pod at the bottom of this file
-#
-# DBD AUTHORS - see the comments in the code
-#
-#######################################################################
-require 5.008;
-use strict;
-
-#################
-package DBD::DBM;
-#################
-use base qw( DBD::File );
-use vars qw($VERSION $ATTRIBUTION $drh $methods_already_installed);
-$VERSION = '0.08';
-$ATTRIBUTION = 'DBD::DBM by Jens Rehsack';
-
-# no need to have driver() unless you need private methods
-#
-sub driver ($;$)
-{
- my ( $class, $attr ) = @_;
- return $drh if ($drh);
-
- # do the real work in DBD::File
- #
- $attr->{Attribution} = 'DBD::DBM by Jens Rehsack';
- $drh = $class->SUPER::driver($attr);
-
- # install private methods
- #
- # this requires that dbm_ (or foo_) be a registered prefix
- # but you can write private methods before official registration
- # by hacking the $dbd_prefix_registry in a private copy of DBI.pm
- #
- unless ( $methods_already_installed++ )
- {
- DBD::DBM::st->install_method('dbm_schema');
- }
-
- return $drh;
-}
-
-sub CLONE
-{
- undef $drh;
-}
-
-#####################
-package DBD::DBM::dr;
-#####################
-$DBD::DBM::dr::imp_data_size = 0;
-@DBD::DBM::dr::ISA = qw(DBD::File::dr);
-
-# you could put some :dr private methods here
-
-# you may need to over-ride some DBD::File::dr methods here
-# but you can probably get away with just letting it do the work
-# in most cases
-
-#####################
-package DBD::DBM::db;
-#####################
-$DBD::DBM::db::imp_data_size = 0;
-@DBD::DBM::db::ISA = qw(DBD::File::db);
-
-use Carp qw/carp/;
-
-sub validate_STORE_attr
-{
- my ( $dbh, $attrib, $value ) = @_;
-
- if ( $attrib eq "dbm_ext" or $attrib eq "dbm_lockfile" )
- {
- ( my $newattrib = $attrib ) =~ s/^dbm_/f_/g;
- carp "Attribute '$attrib' is depreciated, use '$newattrib' instead" if ($^W);
- $attrib = $newattrib;
- }
-
- return $dbh->SUPER::validate_STORE_attr( $attrib, $value );
-}
-
-sub validate_FETCH_attr
-{
- my ( $dbh, $attrib ) = @_;
-
- if ( $attrib eq "dbm_ext" or $attrib eq "dbm_lockfile" )
- {
- ( my $newattrib = $attrib ) =~ s/^dbm_/f_/g;
- carp "Attribute '$attrib' is depreciated, use '$newattrib' instead" if ($^W);
- $attrib = $newattrib;
- }
-
- return $dbh->SUPER::validate_FETCH_attr($attrib);
-}
-
-sub set_versions
-{
- my $this = $_[0];
- $this->{dbm_version} = $DBD::DBM::VERSION;
- return $this->SUPER::set_versions();
-}
-
-sub init_valid_attributes
-{
- my $dbh = shift;
-
- # define valid private attributes
- #
- # attempts to set non-valid attrs in connect() or
- # with $dbh->{attr} will throw errors
- #
- # the attrs here *must* start with dbm_ or foo_
- #
- # see the STORE methods below for how to check these attrs
- #
- $dbh->{dbm_valid_attrs} = {
- dbm_type => 1, # the global DBM type e.g. SDBM_File
- dbm_mldbm => 1, # the global MLDBM serializer
- dbm_cols => 1, # the global column names
- dbm_version => 1, # verbose DBD::DBM version
- dbm_store_metadata => 1, # column names, etc.
- dbm_berkeley_flags => 1, # for BerkeleyDB
- dbm_valid_attrs => 1, # DBD::DBM::db valid attrs
- dbm_readonly_attrs => 1, # DBD::DBM::db r/o attrs
- dbm_meta => 1, # DBD::DBM public access for f_meta
- dbm_tables => 1, # DBD::DBM public access for f_meta
- };
- $dbh->{dbm_readonly_attrs} = {
- dbm_version => 1, # verbose DBD::DBM version
- dbm_valid_attrs => 1, # DBD::DBM::db valid attrs
- dbm_readonly_attrs => 1, # DBD::DBM::db r/o attrs
- dbm_meta => 1, # DBD::DBM public access for f_meta
- };
-
- $dbh->{dbm_meta} = "dbm_tables";
-
- return $dbh->SUPER::init_valid_attributes();
-}
-
-sub init_default_attributes
-{
- my ( $dbh, $phase ) = @_;
-
- $dbh->SUPER::init_default_attributes($phase);
- $dbh->{f_lockfile} = '.lck';
-
- return $dbh;
-}
-
-sub get_dbm_versions
-{
- my ( $dbh, $table ) = @_;
- $table ||= '';
-
- my $meta;
- my $class = $dbh->{ImplementorClass};
- $class =~ s/::db$/::Table/;
- $table and ( undef, $meta ) = $class->get_table_meta( $dbh, $table, 1 );
- $meta or ( $meta = {} and $class->bootstrap_table_meta( $dbh, $meta, $table ) );
-
- my $dver;
- my $dtype = $meta->{dbm_type};
- eval {
- $dver = $meta->{dbm_type}->VERSION();
-
- # *) when we're still alive here, everything went ok - no need to check for $@
- $dtype .= " ($dver)";
- };
- if ( $meta->{dbm_mldbm} )
- {
- $dtype .= ' + MLDBM';
- eval {
- $dver = MLDBM->VERSION();
- $dtype .= " ($dver)"; # (*)
- };
- eval {
- my $ser_class = "MLDBM::Serializer::" . $meta->{dbm_mldbm};
- my $ser_mod = $ser_class;
- $ser_mod =~ s|::|/|g;
- $ser_mod .= ".pm";
- require $ser_mod;
- $dver = $ser_class->VERSION();
- $dtype .= ' + ' . $ser_class; # (*)
- $dver and $dtype .= " ($dver)"; # (*)
- };
- }
- return sprintf( "%s using %s", $dbh->{dbm_version}, $dtype );
-}
-
-# you may need to over-ride some DBD::File::db methods here
-# but you can probably get away with just letting it do the work
-# in most cases
-
-#####################
-package DBD::DBM::st;
-#####################
-$DBD::DBM::st::imp_data_size = 0;
-@DBD::DBM::st::ISA = qw(DBD::File::st);
-
-sub FETCH
-{
- my ( $sth, $attr ) = @_;
-
- if ( $attr eq "NULLABLE" )
- {
- my @colnames = $sth->sql_get_colnames();
-
- # XXX only BerkeleyDB fails having NULL values for non-MLDBM databases,
- # none accept it for key - but it requires more knowledge between
- # queries and tables storage to return fully correct information
- $attr eq "NULLABLE" and return [ map { 0 } @colnames ];
- }
-
- return $sth->SUPER::FETCH($attr);
-} # FETCH
-
-sub dbm_schema
-{
- my ( $sth, $tname ) = @_;
- return $sth->set_err( $DBI::stderr, 'No table name supplied!' ) unless $tname;
- my $tbl_meta = $sth->{Database}->func( $tname, "f_schema", "get_sql_engine_meta" )
- or return $sth->set_err( $sth->{Database}->err(), $sth->{Database}->errstr() );
- return $tbl_meta->{$tname}->{f_schema};
-}
-# you could put some :st private methods here
-
-# you may need to over-ride some DBD::File::st methods here
-# but you can probably get away with just letting it do the work
-# in most cases
-
-############################
-package DBD::DBM::Statement;
-############################
-
-@DBD::DBM::Statement::ISA = qw(DBD::File::Statement);
-
-########################
-package DBD::DBM::Table;
-########################
-use Carp;
-use Fcntl;
-
-@DBD::DBM::Table::ISA = qw(DBD::File::Table);
-
-my $dirfext = $^O eq 'VMS' ? '.sdbm_dir' : '.dir';
-
-my %reset_on_modify = (
- dbm_type => "dbm_tietype",
- dbm_mldbm => "dbm_tietype",
- );
-__PACKAGE__->register_reset_on_modify( \%reset_on_modify );
-
-my %compat_map = (
- ( map { $_ => "dbm_$_" } qw(type mldbm store_metadata) ),
- dbm_ext => 'f_ext',
- dbm_file => 'f_file',
- dbm_lockfile => ' f_lockfile',
- );
-__PACKAGE__->register_compat_map( \%compat_map );
-
-sub bootstrap_table_meta
-{
- my ( $self, $dbh, $meta, $table ) = @_;
-
- $meta->{dbm_type} ||= $dbh->{dbm_type} || 'SDBM_File';
- $meta->{dbm_mldbm} ||= $dbh->{dbm_mldbm} if ( $dbh->{dbm_mldbm} );
- $meta->{dbm_berkeley_flags} ||= $dbh->{dbm_berkeley_flags};
-
- defined $meta->{f_ext}
- or $meta->{f_ext} = $dbh->{f_ext};
- unless ( defined( $meta->{f_ext} ) )
- {
- my $ext;
- if ( $meta->{dbm_type} eq 'SDBM_File' or $meta->{dbm_type} eq 'ODBM_File' )
- {
- $ext = '.pag/r';
- }
- elsif ( $meta->{dbm_type} eq 'NDBM_File' )
- {
- # XXX NDBM_File on FreeBSD (and elsewhere?) may actually be Berkeley
- # behind the scenes and so create a single .db file.
- if ( $^O =~ /bsd/i or lc($^O) eq 'darwin' )
- {
- $ext = '.db/r';
- }
- elsif ( $^O eq 'SunOS' or $^O eq 'Solaris' or $^O eq 'AIX' )
- {
- $ext = '.pag/r'; # here it's implemented like dbm - just a bit improved
- }
- # else wrapped GDBM
- }
- defined($ext) and $meta->{f_ext} = $ext;
- }
-
- $self->SUPER::bootstrap_table_meta( $dbh, $meta, $table );
-}
-
-sub init_table_meta
-{
- my ( $self, $dbh, $meta, $table ) = @_;
-
- $meta->{f_dontopen} = 1;
-
- unless ( defined( $meta->{dbm_tietype} ) )
- {
- my $tie_type = $meta->{dbm_type};
- $INC{"$tie_type.pm"} or require "$tie_type.pm";
- $tie_type eq 'BerkeleyDB' and $tie_type = 'BerkeleyDB::Hash';
-
- if ( $meta->{dbm_mldbm} )
- {
- $INC{"MLDBM.pm"} or require "MLDBM.pm";
- $meta->{dbm_usedb} = $tie_type;
- $tie_type = 'MLDBM';
- }
-
- $meta->{dbm_tietype} = $tie_type;
- }
-
- unless ( defined( $meta->{dbm_store_metadata} ) )
- {
- my $store = $dbh->{dbm_store_metadata};
- defined($store) or $store = 1;
- $meta->{dbm_store_metadata} = $store;
- }
-
- unless ( defined( $meta->{col_names} ) )
- {
- defined( $dbh->{dbm_cols} ) and $meta->{col_names} = $dbh->{dbm_cols};
- }
-
- $self->SUPER::init_table_meta( $dbh, $meta, $table );
-}
-
-sub open_data
-{
- my ( $className, $meta, $attrs, $flags ) = @_;
- $className->SUPER::open_data( $meta, $attrs, $flags );
-
- unless ( $flags->{dropMode} )
- {
- # TIEING
- #
- # XXX allow users to pass in a pre-created tied object
- #
- my @tie_args;
- if ( $meta->{dbm_type} eq 'BerkeleyDB' )
- {
- my $DB_CREATE = BerkeleyDB::DB_CREATE();
- my $DB_RDONLY = BerkeleyDB::DB_RDONLY();
- my %tie_flags;
- if ( my $f = $meta->{dbm_berkeley_flags} )
- {
- defined( $f->{DB_CREATE} ) and $DB_CREATE = delete $f->{DB_CREATE};
- defined( $f->{DB_RDONLY} ) and $DB_RDONLY = delete $f->{DB_RDONLY};
- %tie_flags = %$f;
- }
- my $open_mode = $flags->{lockMode} || $flags->{createMode} ? $DB_CREATE : $DB_RDONLY;
- @tie_args = (
- -Filename => $meta->{f_fqbn},
- -Flags => $open_mode,
- %tie_flags
- );
- }
- else
- {
- my $open_mode = O_RDONLY;
- $flags->{lockMode} and $open_mode = O_RDWR;
- $flags->{createMode} and $open_mode = O_RDWR | O_CREAT | O_TRUNC;
-
- @tie_args = ( $meta->{f_fqbn}, $open_mode, 0666 );
- }
-
- if ( $meta->{dbm_mldbm} )
- {
- $MLDBM::UseDB = $meta->{dbm_usedb};
- $MLDBM::Serializer = $meta->{dbm_mldbm};
- }
-
- $meta->{hash} = {};
- my $tie_class = $meta->{dbm_tietype};
- eval { tie %{ $meta->{hash} }, $tie_class, @tie_args };
- $@ and croak "Cannot tie(\%h $tie_class @tie_args): $@";
- -f $meta->{f_fqfn} or croak( "No such file: '" . $meta->{f_fqfn} . "'" );
- }
-
- unless ( $flags->{createMode} )
- {
- my ( $meta_data, $schema, $col_names );
- if ( $meta->{dbm_store_metadata} )
- {
- $meta_data = $col_names = $meta->{hash}->{"_metadata \0"};
- if ( $meta_data and $meta_data =~ m~<dbd_metadata>(.+)</dbd_metadata>~is )
- {
- $schema = $col_names = $1;
- $schema =~ s~.*<schema>(.+)</schema>.*~$1~is;
- $col_names =~ s~.*<col_names>(.+)</col_names>.*~$1~is;
- }
- }
- $col_names ||= $meta->{col_names} || [ 'k', 'v' ];
- $col_names = [ split /,/, $col_names ] if ( ref $col_names ne 'ARRAY' );
- if ( $meta->{dbm_store_metadata} and not $meta->{hash}->{"_metadata \0"} )
- {
- $schema or $schema = '';
- $meta->{hash}->{"_metadata \0"} =
- "<dbd_metadata>"
- . "<schema>$schema</schema>"
- . "<col_names>"
- . join( ",", @{$col_names} )
- . "</col_names>"
- . "</dbd_metadata>";
- }
-
- $meta->{schema} = $schema;
- $meta->{col_names} = $col_names;
- }
-}
-
-# you must define drop
-# it is called from execute of a SQL DROP statement
-#
-sub drop ($$)
-{
- my ( $self, $data ) = @_;
- my $meta = $self->{meta};
- $meta->{hash} and untie %{ $meta->{hash} };
- $self->SUPER::drop($data);
- # XXX extra_files
- -f $meta->{f_fqbn} . $dirfext
- and $meta->{f_ext} eq '.pag/r'
- and unlink( $meta->{f_fqbn} . $dirfext );
- return 1;
-}
-
-# you must define fetch_row, it is called on all fetches;
-# it MUST return undef when no rows are left to fetch;
-# checking for $ary[0] is specific to hashes so you'll
-# probably need some other kind of check for nothing-left.
-# as Janis might say: "undef's just another word for
-# nothing left to fetch" :-)
-#
-sub fetch_row ($$)
-{
- my ( $self, $data ) = @_;
- my $meta = $self->{meta};
- # fetch with %each
- #
- my @ary = each %{ $meta->{hash} };
- $meta->{dbm_store_metadata}
- and $ary[0]
- and $ary[0] eq "_metadata \0"
- and @ary = each %{ $meta->{hash} };
-
- my ( $key, $val ) = @ary;
- unless ($key)
- {
- delete $self->{row};
- return;
- }
- my @row = ( ref($val) eq 'ARRAY' ) ? ( $key, @$val ) : ( $key, $val );
- $self->{row} = @row ? \@row : undef;
- return wantarray ? @row : \@row;
-}
-
-# you must define push_row except insert_new_row and update_specific_row is defined
-# it is called on inserts and updates as primitive
-#
-sub insert_new_row ($$$)
-{
- my ( $self, $data, $row_aryref ) = @_;
- my $meta = $self->{meta};
- my $ncols = scalar( @{ $meta->{col_names} } );
- my $nitems = scalar( @{$row_aryref} );
- $ncols == $nitems
- or croak "You tried to insert $nitems, but table is created with $ncols columns";
-
- my $key = shift @$row_aryref;
- my $exists;
- eval { $exists = exists( $meta->{hash}->{$key} ); };
- $exists and croak "Row with PK '$key' already exists";
-
- $meta->{hash}->{$key} = $meta->{dbm_mldbm} ? $row_aryref : $row_aryref->[0];
-
- return 1;
-}
-
-# this is where you grab the column names from a CREATE statement
-# if you don't need to do that, it must be defined but can be empty
-#
-sub push_names ($$$)
-{
- my ( $self, $data, $row_aryref ) = @_;
- my $meta = $self->{meta};
-
- # some sanity checks ...
- my $ncols = scalar(@$row_aryref);
- $ncols < 2 and croak "At least 2 columns are required for DBD::DBM tables ...";
- !$meta->{dbm_mldbm}
- and $ncols > 2
- and croak "Without serializing with MLDBM only 2 columns are supported, you give $ncols";
- $meta->{col_names} = $row_aryref;
- return unless $meta->{dbm_store_metadata};
-
- my $stmt = $data->{sql_stmt};
- my $col_names = join( ',', @{$row_aryref} );
- my $schema = $data->{Database}->{Statement};
- $schema =~ s/^[^\(]+\((.+)\)$/$1/s;
- $schema = $stmt->schema_str() if ( $stmt->can('schema_str') );
- $meta->{hash}->{"_metadata \0"} =
- "<dbd_metadata>"
- . "<schema>$schema</schema>"
- . "<col_names>$col_names</col_names>"
- . "</dbd_metadata>";
-}
-
-# fetch_one_row, delete_one_row, update_one_row
-# are optimized for hash-style lookup without looping;
-# if you don't need them, omit them, they're optional
-# but, in that case you may need to define
-# truncate() and seek(), see below
-#
-sub fetch_one_row ($$;$)
-{
- my ( $self, $key_only, $key ) = @_;
- my $meta = $self->{meta};
- $key_only and return $meta->{col_names}->[0];
- exists $meta->{hash}->{$key} or return;
- my $val = $meta->{hash}->{$key};
- $val = ( ref($val) eq 'ARRAY' ) ? $val : [$val];
- my $row = [ $key, @$val ];
- return wantarray ? @{$row} : $row;
-}
-
-sub delete_one_row ($$$)
-{
- my ( $self, $data, $aryref ) = @_;
- my $meta = $self->{meta};
- delete $meta->{hash}->{ $aryref->[0] };
-}
-
-sub update_one_row ($$$)
-{
- my ( $self, $data, $aryref ) = @_;
- my $meta = $self->{meta};
- my $key = shift @$aryref;
- defined $key or return;
- my $row = ( ref($aryref) eq 'ARRAY' ) ? $aryref : [$aryref];
- $meta->{hash}->{$key} = $meta->{dbm_mldbm} ? $row : $row->[0];
-}
-
-sub update_specific_row ($$$$)
-{
- my ( $self, $data, $aryref, $origary ) = @_;
- my $meta = $self->{meta};
- my $key = shift @$origary;
- my $newkey = shift @$aryref;
- return unless ( defined $key );
- $key eq $newkey or delete $meta->{hash}->{$key};
- my $row = ( ref($aryref) eq 'ARRAY' ) ? $aryref : [$aryref];
- $meta->{hash}->{$newkey} = $meta->{dbm_mldbm} ? $row : $row->[0];
-}
-
-# you may not need to explicitly DESTROY the ::Table
-# put cleanup code to run when the execute is done
-#
-sub DESTROY ($)
-{
- my $self = shift;
- my $meta = $self->{meta};
- $meta->{hash} and untie %{ $meta->{hash} };
-
- $self->SUPER::DESTROY();
-}
-
-# truncate() and seek() must be defined to satisfy DBI::SQL::Nano
-# *IF* you define the *_one_row methods above, truncate() and
-# seek() can be empty or you can use them without actually
-# truncating or seeking anything but if you don't define the
-# *_one_row methods, you may need to define these
-
-# if you need to do something after a series of
-# deletes or updates, you can put it in truncate()
-# which is called at the end of executing
-#
-sub truncate ($$)
-{
- # my ( $self, $data ) = @_;
- return 1;
-}
-
-# seek() is only needed if you use IO::File
-# though it could be used for other non-file operations
-# that you need to do before "writes" or truncate()
-#
-sub seek ($$$$)
-{
- # my ( $self, $data, $pos, $whence ) = @_;
- return 1;
-}
-
-# Th, th, th, that's all folks! See DBD::File and DBD::CSV for other
-# examples of creating pure perl DBDs. I hope this helped.
-# Now it's time to go forth and create your own DBD!
-# Remember to check in with dbi-dev@perl.org before you get too far.
-# We may be able to make suggestions or point you to other related
-# projects.
-
-1;
-__END__
-
-=pod
-
-=head1 NAME
-
-DBD::DBM - a DBI driver for DBM & MLDBM files
-
-=head1 SYNOPSIS
-
- use DBI;
- $dbh = DBI->connect('dbi:DBM:'); # defaults to SDBM_File
- $dbh = DBI->connect('DBI:DBM(RaiseError=1):'); # defaults to SDBM_File
- $dbh = DBI->connect('dbi:DBM:dbm_type=DB_File'); # defaults to DB_File
- $dbh = DBI->connect('dbi:DBM:dbm_mldbm=Storable'); # MLDBM with SDBM_File
-
- # or
- $dbh = DBI->connect('dbi:DBM:', undef, undef);
- $dbh = DBI->connect('dbi:DBM:', undef, undef, {
- f_ext => '.db/r',
- f_dir => '/path/to/dbfiles/',
- f_lockfile => '.lck',
- dbm_type => 'BerkeleyDB',
- dbm_mldbm => 'FreezeThaw',
- dbm_store_metadata => 1,
- dbm_berkeley_flags => {
- '-Cachesize' => 1000, # set a ::Hash flag
- },
- });
-
-and other variations on connect() as shown in the L<DBI> docs,
-L<DBD::File metadata|DBD::File/Metadata> and L</Metadata>
-shown below.
-
-Use standard DBI prepare, execute, fetch, placeholders, etc.,
-see L<QUICK START> for an example.
-
-=head1 DESCRIPTION
-
-DBD::DBM is a database management system that works right out of the
-box. If you have a standard installation of Perl and DBI you can
-begin creating, accessing, and modifying simple database tables
-without any further modules. You can add other modules (e.g.,
-SQL::Statement, DB_File etc) for improved functionality.
-
-The module uses a DBM file storage layer. DBM file storage is common on
-many platforms and files can be created with it in many programming
-languages using different APIs. That means, in addition to creating
-files with DBI/SQL, you can also use DBI/SQL to access and modify files
-created by other DBM modules and programs and vice versa. B<Note> that
-in those cases it might be necessary to use a common subset of the
-provided features.
-
-DBM files are stored in binary format optimized for quick retrieval
-when using a key field. That optimization can be used advantageously
-to make DBD::DBM SQL operations that use key fields very fast. There
-are several different "flavors" of DBM which use different storage
-formats supported by perl modules such as SDBM_File and MLDBM. This
-module supports all of the flavors that perl supports and, when used
-with MLDBM, supports tables with any number of columns and insertion
-of Perl objects into tables.
-
-DBD::DBM has been tested with the following DBM types: SDBM_File,
-NDBM_File, ODBM_File, GDBM_File, DB_File, BerkeleyDB. Each type was
-tested both with and without MLDBM and with the Data::Dumper,
-Storable, FreezeThaw, YAML and JSON serializers using the DBI::SQL::Nano
-or the SQL::Statement engines.
-
-=head1 QUICK START
-
-DBD::DBM operates like all other DBD drivers - it's basic syntax and
-operation is specified by DBI. If you're not familiar with DBI, you should
-start by reading L<DBI> and the documents it points to and then come back
-and read this file. If you are familiar with DBI, you already know most of
-what you need to know to operate this module. Just jump in and create a
-test script something like the one shown below.
-
-You should be aware that there are several options for the SQL engine
-underlying DBD::DBM, see L<Supported SQL syntax>. There are also many
-options for DBM support, see especially the section on L<Adding
-multi-column support with MLDBM>.
-
-But here's a sample to get you started.
-
- use DBI;
- my $dbh = DBI->connect('dbi:DBM:');
- $dbh->{RaiseError} = 1;
- for my $sql( split /;\n+/,"
- CREATE TABLE user ( user_name TEXT, phone TEXT );
- INSERT INTO user VALUES ('Fred Bloggs','233-7777');
- INSERT INTO user VALUES ('Sanjay Patel','777-3333');
- INSERT INTO user VALUES ('Junk','xxx-xxxx');
- DELETE FROM user WHERE user_name = 'Junk';
- UPDATE user SET phone = '999-4444' WHERE user_name = 'Sanjay Patel';
- SELECT * FROM user
- "){
- my $sth = $dbh->prepare($sql);
- $sth->execute;
- $sth->dump_results if $sth->{NUM_OF_FIELDS};
- }
- $dbh->disconnect;
-
-=head1 USAGE
-
-This section will explain some usage cases in more detail. To get an
-overview about the available attributes, see L</Metadata>.
-
-=head2 Specifying Files and Directories
-
-DBD::DBM will automatically supply an appropriate file extension for the
-type of DBM you are using. For example, if you use SDBM_File, a table
-called "fruit" will be stored in two files called "fruit.pag" and
-"fruit.dir". You should B<never> specify the file extensions in your SQL
-statements.
-
-DBD::DBM recognizes following default extensions for following types:
-
-=over 4
-
-=item .pag/r
-
-Chosen for dbm_type C<< SDBM_File >>, C<< ODBM_File >> and C<< NDBM_File >>
-when an implementation is detected which wraps C<< -ldbm >> for
-C<< NDBM_File >> (e.g. Solaris, AIX, ...).
-
-For those types, the C<< .dir >> extension is recognized, too (for being
-deleted when dropping a table).
-
-=item .db/r
-
-Chosen for dbm_type C<< NDBM_File >> when an implementation is detected
-which wraps BerkeleyDB 1.x for C<< NDBM_File >> (typically BSD's, Darwin).
-
-=back
-
-C<< GDBM_File >>, C<< DB_File >> and C<< BerkeleyDB >> don't usually
-use a file extension.
-
-If your DBM type uses an extension other than one of the recognized
-types of extensions, you should set the I<f_ext> attribute to the
-extension B<and> file a bug report as described in DBI with the name
-of the implementation and extension so we can add it to DBD::DBM.
-Thanks in advance for that :-).
-
- $dbh = DBI->connect('dbi:DBM:f_ext=.db'); # .db extension is used
- $dbh = DBI->connect('dbi:DBM:f_ext='); # no extension is used
-
- # or
- $dbh->{f_ext}='.db'; # global setting
- $dbh->{f_meta}->{'qux'}->{f_ext}='.db'; # setting for table 'qux'
-
-By default files are assumed to be in the current working directory.
-To use other directories specify the I<f_dir> attribute in either the
-connect string or by setting the database handle attribute.
-
-For example, this will look for the file /foo/bar/fruit (or
-/foo/bar/fruit.pag for DBM types that use that extension)
-
- my $dbh = DBI->connect('dbi:DBM:f_dir=/foo/bar');
- # and this will too:
- my $dbh = DBI->connect('dbi:DBM:');
- $dbh->{f_dir} = '/foo/bar';
- # but this is recommended
- my $dbh = DBI->connect('dbi:DBM:', undef, undef, { f_dir => '/foo/bar' } );
-
- # now you can do
- my $ary = $dbh->selectall_arrayref(q{ SELECT x FROM fruit });
-
-You can also use delimited identifiers to specify paths directly in SQL
-statements. This looks in the same place as the two examples above but
-without setting I<f_dir>:
-
- my $dbh = DBI->connect('dbi:DBM:');
- my $ary = $dbh->selectall_arrayref(q{
- SELECT x FROM "/foo/bar/fruit"
- });
-
-You can also tell DBD::DBM to use a specified path for a specific table:
-
- $dbh->{dbm_tables}->{f}->{file} = q(/foo/bar/fruit);
-
-Please be aware that you cannot specify this during connection.
-
-If you have SQL::Statement installed, you can use table aliases:
-
- my $dbh = DBI->connect('dbi:DBM:');
- my $ary = $dbh->selectall_arrayref(q{
- SELECT f.x FROM "/foo/bar/fruit" AS f
- });
-
-See the L<GOTCHAS AND WARNINGS> for using DROP on tables.
-
-=head2 Table locking and flock()
-
-Table locking is accomplished using a lockfile which has the same
-basename as the table's file but with the file extension '.lck' (or a
-lockfile extension that you supply, see below). This lock file is
-created with the table during a CREATE and removed during a DROP.
-Every time the table itself is opened, the lockfile is flocked(). For
-SELECT, this is a shared lock. For all other operations, it is an
-exclusive lock (except when you specify something different using the
-I<f_lock> attribute).
-
-Since the locking depends on flock(), it only works on operating
-systems that support flock(). In cases where flock() is not
-implemented, DBD::DBM will simply behave as if the flock() had
-occurred although no actual locking will happen. Read the
-documentation for flock() for more information.
-
-Even on those systems that do support flock(), locking is only
-advisory - as is always the case with flock(). This means that if
-another program tries to access the table file while DBD::DBM has the
-table locked, that other program will *succeed* at opening unless
-it is also using flock on the '.lck' file. As a result DBD::DBM's
-locking only really applies to other programs using DBD::DBM or other
-program written to cooperate with DBD::DBM locking.
-
-=head2 Specifying the DBM type
-
-Each "flavor" of DBM stores its files in a different format and has
-different capabilities and limitations. See L<AnyDBM_File> for a
-comparison of DBM types.
-
-By default, DBD::DBM uses the C<< SDBM_File >> type of storage since
-C<< SDBM_File >> comes with Perl itself. If you have other types of
-DBM storage available, you can use any of them with DBD::DBM. It is
-strongly recommended to use at least C<< DB_File >>, because C<<
-SDBM_File >> has quirks and limitations and C<< ODBM_file >>, C<<
-NDBM_File >> and C<< GDBM_File >> are not always available.
-
-You can specify the DBM type using the I<dbm_type> attribute which can
-be set in the connection string or with C<< $dbh->{dbm_type} >> and
-C<< $dbh->{f_meta}->{$table_name}->{type} >> for per-table settings in
-cases where a single script is accessing more than one kind of DBM
-file.
-
-In the connection string, just set C<< dbm_type=TYPENAME >> where
-C<< TYPENAME >> is any DBM type such as GDBM_File, DB_File, etc. Do I<not>
-use MLDBM as your I<dbm_type> as that is set differently, see below.
-
- my $dbh=DBI->connect('dbi:DBM:'); # uses the default SDBM_File
- my $dbh=DBI->connect('dbi:DBM:dbm_type=GDBM_File'); # uses the GDBM_File
-
- # You can also use $dbh->{dbm_type} to set the DBM type for the connection:
- $dbh->{dbm_type} = 'DB_File'; # set the global DBM type
- print $dbh->{dbm_type}; # display the global DBM type
-
-If you have several tables in your script that use different DBM
-types, you can use the $dbh->{dbm_tables} hash to store different
-settings for the various tables. You can even use this to perform
-joins on files that have completely different storage mechanisms.
-
- # sets global default of GDBM_File
- my $dbh->('dbi:DBM:type=GDBM_File');
-
- # overrides the global setting, but only for the tables called
- # I<foo> and I<bar>
- my $dbh->{f_meta}->{foo}->{dbm_type} = 'DB_File';
- my $dbh->{f_meta}->{bar}->{dbm_type} = 'BerkeleyDB';
-
- # prints the dbm_type for the table "foo"
- print $dbh->{f_meta}->{foo}->{dbm_type};
-
-B<Note> that you must change the I<dbm_type> of a table before you access
-it for first time.
-
-=head2 Adding multi-column support with MLDBM
-
-Most of the DBM types only support two columns and even if it would
-support more, DBD::DBM would only use two. However a CPAN module
-called MLDBM overcomes this limitation by allowing more than two
-columns. MLDBM does this by serializing the data - basically it puts
-a reference to an array into the second column. It can also put almost
-any kind of Perl object or even B<Perl coderefs> into columns.
-
-If you want more than two columns, you B<must> install MLDBM. It's available
-for many platforms and is easy to install.
-
-MLDBM is by default distributed with three serializers - Data::Dumper,
-Storable, and FreezeThaw. Data::Dumper is the default and Storable is the
-fastest. MLDBM can also make use of user-defined serialization methods or
-other serialization modules (e.g. L<YAML::MLDBM> or
-L<MLDBM::Serializer::JSON>. You select the serializer using the
-I<dbm_mldbm> attribute.
-
-Some examples:
-
- $dbh=DBI->connect('dbi:DBM:dbm_mldbm=Storable'); # use MLDBM with Storable
- $dbh=DBI->connect(
- 'dbi:DBM:dbm_mldbm=MySerializer' # use MLDBM with a user defined module
- );
- $dbh=DBI->connect('dbi::dbm:', undef,
- undef, { dbm_mldbm => 'YAML' }); # use 3rd party serializer
- $dbh->{dbm_mldbm} = 'YAML'; # same as above
- print $dbh->{dbm_mldbm} # show the MLDBM serializer
- $dbh->{f_meta}->{foo}->{dbm_mldbm}='Data::Dumper'; # set Data::Dumper for table "foo"
- print $dbh->{f_meta}->{foo}->{mldbm}; # show serializer for table "foo"
-
-MLDBM works on top of other DBM modules so you can also set a DBM type
-along with setting dbm_mldbm. The examples above would default to using
-SDBM_File with MLDBM. If you wanted GDBM_File instead, here's how:
-
- # uses DB_File with MLDBM and Storable
- $dbh = DBI->connect('dbi:DBM:', undef, undef, {
- dbm_type => 'DB_File',
- dbm_mldbm => 'Storable',
- });
-
-SDBM_File, the default I<dbm_type> is quite limited, so if you are going to
-use MLDBM, you should probably use a different type, see L<AnyDBM_File>.
-
-See below for some L<GOTCHAS AND WARNINGS> about MLDBM.
-
-=head2 Support for Berkeley DB
-
-The Berkeley DB storage type is supported through two different Perl
-modules - DB_File (which supports only features in old versions of Berkeley
-DB) and BerkeleyDB (which supports all versions). DBD::DBM supports
-specifying either "DB_File" or "BerkeleyDB" as a I<dbm_type>, with or
-without MLDBM support.
-
-The "BerkeleyDB" dbm_type is experimental and it's interface is likely to
-change. It currently defaults to BerkeleyDB::Hash and does not currently
-support ::Btree or ::Recno.
-
-With BerkeleyDB, you can specify initialization flags by setting them in
-your script like this:
-
- use BerkeleyDB;
- my $env = new BerkeleyDB::Env -Home => $dir; # and/or other Env flags
- $dbh = DBI->connect('dbi:DBM:', undef, undef, {
- dbm_type => 'BerkeleyDB',
- dbm_mldbm => 'Storable',
- dbm_berkeley_flags => {
- 'DB_CREATE' => DB_CREATE, # pass in constants
- 'DB_RDONLY' => DB_RDONLY, # pass in constants
- '-Cachesize' => 1000, # set a ::Hash flag
- '-Env' => $env, # pass in an environment
- },
- });
-
-Do I<not> set the -Flags or -Filename flags as those are determined and
-overwritten by the SQL (e.g. -Flags => DB_RDONLY is set automatically
-when you issue a SELECT statement).
-
-Time has not permitted us to provide support in this release of DBD::DBM
-for further Berkeley DB features such as transactions, concurrency,
-locking, etc. We will be working on these in the future and would value
-suggestions, patches, etc.
-
-See L<DB_File> and L<BerkeleyDB> for further details.
-
-=head2 Optimizing the use of key fields
-
-Most "flavors" of DBM have only two physical columns (but can contain
-multiple logical columns as explained above in
-L<Adding multi-column support with MLDBM>). They work similarly to a
-Perl hash with the first column serving as the key. Like a Perl hash, DBM
-files permit you to do quick lookups by specifying the key and thus avoid
-looping through all records (supported by DBI::SQL::Nano only). Also like
-a Perl hash, the keys must be unique. It is impossible to create two
-records with the same key. To put this more simply and in SQL terms,
-the key column functions as the I<PRIMARY KEY> or UNIQUE INDEX.
-
-In DBD::DBM, you can take advantage of the speed of keyed lookups by using
-DBI::SQL::Nano and a WHERE clause with a single equal comparison on the key
-field. For example, the following SQL statements are optimized for keyed
-lookup:
-
- CREATE TABLE user ( user_name TEXT, phone TEXT);
- INSERT INTO user VALUES ('Fred Bloggs','233-7777');
- # ... many more inserts
- SELECT phone FROM user WHERE user_name='Fred Bloggs';
-
-The "user_name" column is the key column since it is the first
-column. The SELECT statement uses the key column in a single equal
-comparison - "user_name='Fred Bloggs'" - so the search will find it
-very quickly without having to loop through all the names which were
-inserted into the table.
-
-In contrast, these searches on the same table are not optimized:
-
- 1. SELECT phone FROM user WHERE user_name < 'Fred';
- 2. SELECT user_name FROM user WHERE phone = '233-7777';
-
-In #1, the operation uses a less-than (<) comparison rather than an equals
-comparison, so it will not be optimized for key searching. In #2, the key
-field "user_name" is not specified in the WHERE clause, and therefore the
-search will need to loop through all rows to find the requested row(s).
-
-B<Note> that the underlying DBM storage needs to loop over all I<key/value>
-pairs when the optimized fetch is used. SQL::Statement has a massively
-improved where clause evaluation which costs around 15% of the evaluation
-in DBI::SQL::Nano - combined with the loop in the DBM storage the speed
-improvement isn't so impressive.
-
-Even if lookups are faster by around 50%, DBI::SQL::Nano and
-SQL::Statement can benefit from the key field optimizations on
-updating and deleting rows - and here the improved where clause
-evaluation of SQL::Statement might beat DBI::SQL::Nano every time the
-where clause contains not only the key field (or more than one).
-
-=head2 Supported SQL syntax
-
-DBD::DBM uses a subset of SQL. The robustness of that subset depends on
-what other modules you have installed. Both options support basic SQL
-operations including CREATE TABLE, DROP TABLE, INSERT, DELETE, UPDATE, and
-SELECT.
-
-B<Option #1:> By default, this module inherits its SQL support from
-DBI::SQL::Nano that comes with DBI. Nano is, as its name implies, a *very*
-small SQL engine. Although limited in scope, it is faster than option #2
-for some operations (especially single I<primary key> lookups). See
-L<DBI::SQL::Nano> for a description of the SQL it supports and comparisons
-of it with option #2.
-
-B<Option #2:> If you install the pure Perl CPAN module SQL::Statement,
-DBD::DBM will use it instead of Nano. This adds support for table aliases,
-functions, joins, and much more. If you're going to use DBD::DBM
-for anything other than very simple tables and queries, you should install
-SQL::Statement. You don't have to change DBD::DBM or your scripts in any
-way, simply installing SQL::Statement will give you the more robust SQL
-capabilities without breaking scripts written for DBI::SQL::Nano. See
-L<SQL::Statement> for a description of the SQL it supports.
-
-To find out which SQL module is working in a given script, you can use the
-dbm_versions() method or, if you don't need the full output and version
-numbers, just do this:
-
- print $dbh->{sql_handler}, "\n";
-
-That will print out either "SQL::Statement" or "DBI::SQL::Nano".
-
-Baring the section about optimized access to the DBM storage in mind,
-comparing the benefits of both engines:
-
- # DBI::SQL::Nano is faster
- $sth = $dbh->prepare( "update foo set value='new' where key=15" );
- $sth->execute();
- $sth = $dbh->prepare( "delete from foo where key=27" );
- $sth->execute();
- $sth = $dbh->prepare( "select * from foo where key='abc'" );
-
- # SQL::Statement might faster (depending on DB size)
- $sth = $dbh->prepare( "update foo set value='new' where key=?" );
- $sth->execute(15);
- $sth = $dbh->prepare( "update foo set value=? where key=15" );
- $sth->execute('new');
- $sth = $dbh->prepare( "delete from foo where key=?" );
- $sth->execute(27);
-
- # SQL::Statement is faster
- $sth = $dbh->prepare( "update foo set value='new' where value='old'" );
- $sth->execute();
- # must be expressed using "where key = 15 or key = 27 or key = 42 or key = 'abc'"
- # in DBI::SQL::Nano
- $sth = $dbh->prepare( "delete from foo where key in (15,27,42,'abc')" );
- $sth->execute();
- # must be expressed using "where key > 10 and key < 90" in DBI::SQL::Nano
- $sth = $dbh->prepare( "select * from foo where key between (10,90)" );
- $sth->execute();
-
- # only SQL::Statement can handle
- $sth->prepare( "select * from foo,bar where foo.name = bar.name" );
- $sth->execute();
- $sth->prepare( "insert into foo values ( 1, 'foo' ), ( 2, 'bar' )" );
- $sth->execute();
-
-=head2 Specifying Column Names
-
-DBM files don't have a standard way to store column names. DBD::DBM gets
-around this issue with a DBD::DBM specific way of storing the column names.
-B<If you are working only with DBD::DBM and not using files created by or
-accessed with other DBM programs, you can ignore this section.>
-
-DBD::DBM stores column names as a row in the file with the key I<_metadata
-\0>. So this code
-
- my $dbh = DBI->connect('dbi:DBM:');
- $dbh->do("CREATE TABLE baz (foo CHAR(10), bar INTEGER)");
- $dbh->do("INSERT INTO baz (foo,bar) VALUES ('zippy',1)");
-
-Will create a file that has a structure something like this:
-
- _metadata \0 | <dbd_metadata><schema></schema><col_names>foo,bar</col_names></dbd_metadata>
- zippy | 1
-
-The next time you access this table with DBD::DBM, it will treat the
-I<_metadata \0> row as a header rather than as data and will pull the column
-names from there. However, if you access the file with something other
-than DBD::DBM, the row will be treated as a regular data row.
-
-If you do not want the column names stored as a data row in the table you
-can set the I<dbm_store_metadata> attribute to 0.
-
- my $dbh = DBI->connect('dbi:DBM:', undef, undef, { dbm_store_metadata => 0 });
-
- # or
- $dbh->{dbm_store_metadata} = 0;
-
- # or for per-table setting
- $dbh->{f_meta}->{qux}->{dbm_store_metadata} = 0;
-
-By default, DBD::DBM assumes that you have two columns named "k" and "v"
-(short for "key" and "value"). So if you have I<dbm_store_metadata> set to
-1 and you want to use alternate column names, you need to specify the
-column names like this:
-
- my $dbh = DBI->connect('dbi:DBM:', undef, undef, {
- dbm_store_metadata => 0,
- dbm_cols => [ qw(foo bar) ],
- });
-
- # or
- $dbh->{dbm_store_metadata} = 0;
- $dbh->{dbm_cols} = 'foo,bar';
-
- # or to set the column names on per-table basis, do this:
- # sets the column names only for table "qux"
- $dbh->{f_meta}->{qux}->{dbm_store_metadata} = 0;
- $dbh->{f_meta}->{qux}->{col_names} = [qw(foo bar)];
-
-If you have a file that was created by another DBM program or created with
-I<dbm_store_metadata> set to zero and you want to convert it to using
-DBD::DBM's column name storage, just use one of the methods above to name
-the columns but *without* specifying I<dbm_store_metadata> as zero. You
-only have to do that once - thereafter you can get by without setting
-either I<dbm_store_metadata> or setting I<dbm_cols> because the names will
-be stored in the file.
-
-=head1 DBI database handle attributes
-
-=head2 Metadata
-
-=head3 Statement handle ($sth) attributes and methods
-
-Most statement handle attributes such as NAME, NUM_OF_FIELDS, etc. are
-available only after an execute. The same is true of $sth->rows which is
-available after the execute but does I<not> require a fetch.
-
-=head3 Driver handle ($dbh) attributes
-
-It is not supported anymore to use dbm-attributes without the dbm_-prefix.
-Currently, if an DBD::DBM private attribute is accessed without an
-underscore in it's name, dbm_ is prepended to that attribute and it's
-processed further. If the resulting attribute name is invalid, an error is
-thrown.
-
-=head4 dbm_cols
-
-Contains a comma separated list of column names or an array reference to
-the column names.
-
-=head4 dbm_type
-
-Contains the DBM storage type. Currently known supported type are
-C<< ODBM_File >>, C<< NDBM_File >>, C<< SDBM_File >>, C<< GDBM_File >>,
-C<< DB_File >> and C<< BerkeleyDB >>. It is not recommended to use one
-of the first three types - even if C<< SDBM_File >> is the most commonly
-available I<dbm_type>.
-
-=head4 dbm_mldbm
-
-Contains the serializer for DBM storage (value column). Requires the
-CPAN module L<MLDBM> installed. Currently known supported serializers
-are:
-
-=over 8
-
-=item Data::Dumper
-
-Default serializer. Deployed with Perl core.
-
-=item Storable
-
-Faster serializer. Deployed with Perl core.
-
-=item FreezeThaw
-
-Pure Perl serializer, requires L<FreezeThaw> to be installed.
-
-=item YAML
-
-Portable serializer (between languages but not architectures).
-Requires L<YAML::MLDBM> installation.
-
-=item JSON
-
-Portable, fast serializer (between languages but not architectures).
-Requires L<MLDBM::Serializer::JSON> installation.
-
-=back
-
-=head4 dbm_store_metadata
-
-Boolean value which determines if the metadata in DBM is stored or not.
-
-=head4 dbm_berkeley_flags
-
-Hash reference with additional flags for BerkeleyDB::Hash instantiation.
-
-=head4 dbm_version
-
-Readonly attribute containing the version of DBD::DBM.
-
-=head4 f_meta
-
-In addition to the attributes L<DBD::File> recognizes, DBD::DBM knows
-about the (public) attributes C<col_names> (B<Note> not I<dbm_cols>
-here!), C<dbm_type>, C<dbm_mldbm>, C<dbm_store_metadata> and
-C<dbm_berkeley_flags>. As in DBD::File, there are undocumented,
-internal attributes in DBD::DBM. Be very careful when modifying
-attributes you do not know; the consequence might a destroyed or
-corrupted table.
-
-=head4 dbm_tables
-
-This attribute provides restricted access to the table meta data. See
-L<f_meta> and L<DBD::File/f_meta> for attribute details.
-
-dbm_tables is a tied hash providing the internal table names as keys
-(accessing unknown tables might create an entry) and their meta
-data as another tied hash. The table meta storage is obtained via
-the C<get_table_meta> method from the table implementation (see
-L<DBD::File::Developers>). Attribute setting and getting within the
-table meta data is handled via the methods C<set_table_meta_attr> and
-C<get_table_meta_attr>.
-
-=head3 Following attributes are no longer handled by DBD::DBM:
-
-=head4 dbm_ext
-
-This attribute is silently mapped to DBD::File's attribute I<f_ext>.
-Later versions of DBI might show a depreciated warning when this attribute
-is used and eventually it will be removed.
-
-=head4 dbm_lockfile
-
-This attribute is silently mapped to DBD::File's attribute I<f_lockfile>.
-Later versions of DBI might show a depreciated warning when this attribute
-is used and eventually it will be removed.
-
-=head1 DBI database handle methods
-
-=head2 The $dbh->dbm_versions() method
-
-The private method dbm_versions() returns a summary of what other modules
-are being used at any given time. DBD::DBM can work with or without many
-other modules - it can use either SQL::Statement or DBI::SQL::Nano as its
-SQL engine, it can be run with DBI or DBI::PurePerl, it can use many kinds
-of DBM modules, and many kinds of serializers when run with MLDBM. The
-dbm_versions() method reports all of that and more.
-
- print $dbh->dbm_versions; # displays global settings
- print $dbh->dbm_versions($table_name); # displays per table settings
-
-An important thing to note about this method is that when it called
-with no arguments, it displays the *global* settings. If you override
-these by setting per-table attributes, these will I<not> be shown
-unless you specify a table name as an argument to the method call.
-
-=head2 Storing Objects
-
-If you are using MLDBM, you can use DBD::DBM to take advantage of its
-serializing abilities to serialize any Perl object that MLDBM can handle.
-To store objects in columns, you should (but don't absolutely need to)
-declare it as a column of type BLOB (the type is *currently* ignored by
-the SQL engine, but it's good form).
-
-=head1 EXTENSIBILITY
-
-=over 8
-
-=item C<SQL::Statement>
-
-Improved SQL engine compared to the built-in DBI::SQL::Nano - see
-L<Supported SQL syntax>.
-
-=item C<DB_File>
-
-Berkeley DB version 1. This database library is available on many
-systems without additional installation and most systems are
-supported.
-
-=item C<GDBM_File>
-
-Simple dbm type (comparable to C<DB_File>) under the GNU license.
-Typically not available (or requires extra installation) on non-GNU
-operating systems.
-
-=item C<BerkeleyDB>
-
-Berkeley DB version up to v4 (and maybe higher) - requires additional
-installation but is easier than GDBM_File on non-GNU systems.
-
-db4 comes with a many tools which allow repairing and migrating
-databases. This is the B<recommended> dbm type for production use.
-
-=item C<MLDBM>
-
-Serializer wrapper to support more than one column for the files.
-Comes with serializers using C<Data::Dumper>, C<FreezeThaw> and
-C<Storable>.
-
-=item C<YAML::MLDBM>
-
-Additional serializer for MLDBM. YAML is very portable between languages.
-
-=item C<MLDBM::Serializer::JSON>
-
-Additional serializer for MLDBM. JSON is very portable between languages,
-probably more than YAML.
-
-=back
-
-=head1 GOTCHAS AND WARNINGS
-
-Using the SQL DROP command will remove any file that has the name specified
-in the command with either '.pag' and '.dir', '.db' or your {f_ext} appended
-to it. So this be dangerous if you aren't sure what file it refers to:
-
- $dbh->do(qq{DROP TABLE "/path/to/any/file"});
-
-Each DBM type has limitations. SDBM_File, for example, can only store
-values of less than 1,000 characters. *You* as the script author must
-ensure that you don't exceed those bounds. If you try to insert a value
-that is larger than DBM can store, the results will be unpredictable.
-See the documentation for whatever DBM you are using for details.
-
-Different DBM implementations return records in different orders.
-That means that you I<should not> rely on the order of records unless
-you use an ORDER BY statement.
-
-DBM data files are platform-specific. To move them from one platform to
-another, you'll need to do something along the lines of dumping your data
-to CSV on platform #1 and then dumping from CSV to DBM on platform #2.
-DBD::AnyData and DBD::CSV can help with that. There may also be DBM
-conversion tools for your platforms which would probably be quicker.
-
-When using MLDBM, there is a very powerful serializer - it will allow
-you to store Perl code or objects in database columns. When these get
-de-serialized, they may be eval'ed - in other words MLDBM (or actually
-Data::Dumper when used by MLDBM) may take the values and try to
-execute them in Perl. Obviously, this can present dangers, so if you
-do not know what is in a file, be careful before you access it with
-MLDBM turned on!
-
-See the entire section on L<Table locking and flock()> for gotchas and
-warnings about the use of flock().
-
-=head1 BUGS AND LIMITATIONS
-
-This module uses hash interfaces of two column file databases. While
-none of supported SQL engines have support for indices, the following
-statements really do the same (even if they mean something completely
-different) for each dbm type which lacks C<EXISTS> support:
-
- $sth->do( "insert into foo values (1, 'hello')" );
-
- # this statement does ...
- $sth->do( "update foo set v='world' where k=1" );
- # ... the same as this statement
- $sth->do( "insert into foo values (1, 'world')" );
-
-This is considered to be a bug and might change in a future release.
-
-Known affected dbm types are C<ODBM_File> and C<NDBM_File>. We highly
-recommended you use a more modern dbm type such as C<DB_File>.
-
-=head1 GETTING HELP, MAKING SUGGESTIONS, AND REPORTING BUGS
-
-If you need help installing or using DBD::DBM, please write to the DBI
-users mailing list at dbi-users@perl.org or to the
-comp.lang.perl.modules newsgroup on usenet. I cannot always answer
-every question quickly but there are many on the mailing list or in
-the newsgroup who can.
-
-DBD developers for DBD's which rely on DBD::File or DBD::DBM or use
-one of them as an example are suggested to join the DBI developers
-mailing list at dbi-dev@perl.org and strongly encouraged to join our
-IRC channel at L<irc://irc.perl.org/dbi>.
-
-If you have suggestions, ideas for improvements, or bugs to report, please
-report a bug as described in DBI. Do not mail any of the authors directly,
-you might not get an answer.
-
-When reporting bugs, please send the output of $dbh->dbm_versions($table)
-for a table that exhibits the bug and as small a sample as you can make of
-the code that produces the bug. And of course, patches are welcome, too
-:-).
-
-If you need enhancements quickly, you can get commercial support as
-described at L<http://dbi.perl.org/support/> or you can contact Jens Rehsack
-at rehsack@cpan.org for commercial support in Germany.
-
-Please don't bother Jochen Wiedmann or Jeff Zucker for support - they
-handed over further maintenance to H.Merijn Brand and Jens Rehsack.
-
-=head1 ACKNOWLEDGEMENTS
-
-Many, many thanks to Tim Bunce for prodding me to write this, and for
-copious, wise, and patient suggestions all along the way. (Jeff Zucker)
-
-I send my thanks and acknowledgements to H.Merijn Brand for his
-initial refactoring of DBD::File and his strong and ongoing support of
-SQL::Statement. Without him, the current progress would never have
-been made. And I have to name Martin J. Evans for each laugh (and
-correction) of all those funny word creations I (as non-native
-speaker) made to the documentation. And - of course - I have to thank
-all those unnamed contributors and testers from the Perl
-community. (Jens Rehsack)
-
-=head1 AUTHOR AND COPYRIGHT
-
-This module is written by Jeff Zucker < jzucker AT cpan.org >, who also
-maintained it till 2007. After that, in 2010, Jens Rehsack & H.Merijn Brand
-took over maintenance.
-
- Copyright (c) 2004 by Jeff Zucker, all rights reserved.
- Copyright (c) 2010-2013 by Jens Rehsack & H.Merijn Brand, all rights reserved.
-
-You may freely distribute and/or modify this module under the terms of
-either the GNU General Public License (GPL) or the Artistic License, as
-specified in the Perl README file.
-
-=head1 SEE ALSO
-
-L<DBI>,
-L<SQL::Statement>, L<DBI::SQL::Nano>,
-L<AnyDBM_File>, L<DB_File>, L<BerkeleyDB>,
-L<MLDBM>, L<YAML::MLDBM>, L<MLDBM::Serializer::JSON>
-
-=cut
+++ /dev/null
-{
- package DBD::ExampleP;
-
- use strict;
- use Symbol;
-
- use DBI qw(:sql_types);
-
- require File::Spec;
-
- our (@EXPORT,$VERSION,@statnames,%statnames,@stattypes,%stattypes,
- @statprec,%statprec,$drh,);
-
- @EXPORT = qw(); # Do NOT @EXPORT anything.
- $VERSION = "12.014311";
-
-# $Id: ExampleP.pm 14310 2010-08-02 06:35:25Z Jens $
-#
-# Copyright (c) 1994,1997,1998 Tim Bunce
-#
-# You may distribute under the terms of either the GNU General Public
-# License or the Artistic License, as specified in the Perl README file.
-
- @statnames = qw(dev ino mode nlink
- uid gid rdev size
- atime mtime ctime
- blksize blocks name);
- @statnames{@statnames} = (0 .. @statnames-1);
-
- @stattypes = (SQL_INTEGER, SQL_INTEGER, SQL_INTEGER, SQL_INTEGER,
- SQL_INTEGER, SQL_INTEGER, SQL_INTEGER, SQL_INTEGER,
- SQL_INTEGER, SQL_INTEGER, SQL_INTEGER,
- SQL_INTEGER, SQL_INTEGER, SQL_VARCHAR);
- @stattypes{@statnames} = @stattypes;
- @statprec = ((10) x (@statnames-1), 1024);
- @statprec{@statnames} = @statprec;
- die unless @statnames == @stattypes;
- die unless @statprec == @stattypes;
-
- $drh = undef; # holds driver handle once initialised
- #$gensym = "SYM000"; # used by st::execute() for filehandles
-
- sub driver{
- return $drh if $drh;
- my($class, $attr) = @_;
- $class .= "::dr";
- ($drh) = DBI::_new_drh($class, {
- 'Name' => 'ExampleP',
- 'Version' => $VERSION,
- 'Attribution' => 'DBD Example Perl stub by Tim Bunce',
- }, ['example implementors private data '.__PACKAGE__]);
- $drh;
- }
-
- sub CLONE {
- undef $drh;
- }
-}
-
-
-{ package DBD::ExampleP::dr; # ====== DRIVER ======
- $imp_data_size = 0;
- use strict;
-
- sub connect { # normally overridden, but a handy default
- my($drh, $dbname, $user, $auth)= @_;
- my ($outer, $dbh) = DBI::_new_dbh($drh, {
- Name => $dbname,
- examplep_private_dbh_attrib => 42, # an example, for testing
- });
- $dbh->{examplep_get_info} = {
- 29 => '"', # SQL_IDENTIFIER_QUOTE_CHAR
- 41 => '.', # SQL_CATALOG_NAME_SEPARATOR
- 114 => 1, # SQL_CATALOG_LOCATION
- };
- #$dbh->{Name} = $dbname;
- $dbh->STORE('Active', 1);
- return $outer;
- }
-
- sub data_sources {
- return ("dbi:ExampleP:dir=."); # possibly usefully meaningless
- }
-
-}
-
-
-{ package DBD::ExampleP::db; # ====== DATABASE ======
- $imp_data_size = 0;
- use strict;
-
- sub prepare {
- my($dbh, $statement)= @_;
- my @fields;
- my($fields, $dir) = $statement =~ m/^\s*select\s+(.*?)\s+from\s+(\S*)/i;
-
- if (defined $fields and defined $dir) {
- @fields = ($fields eq '*')
- ? keys %DBD::ExampleP::statnames
- : split(/\s*,\s*/, $fields);
- }
- else {
- return $dbh->set_err($DBI::stderr, "Syntax error in select statement (\"$statement\")")
- unless $statement =~ m/^\s*set\s+/;
- # the SET syntax is just a hack so the ExampleP driver can
- # be used to test non-select statements.
- # Now we have DBI::DBM etc., ExampleP should be deprecated
- }
-
- my ($outer, $sth) = DBI::_new_sth($dbh, {
- 'Statement' => $statement,
- examplep_private_sth_attrib => 24, # an example, for testing
- }, ['example implementors private data '.__PACKAGE__]);
-
- my @bad = map {
- defined $DBD::ExampleP::statnames{$_} ? () : $_
- } @fields;
- return $dbh->set_err($DBI::stderr, "Unknown field names: @bad")
- if @bad;
-
- $outer->STORE('NUM_OF_FIELDS' => scalar(@fields));
-
- $sth->{examplep_ex_dir} = $dir if defined($dir) && $dir !~ /\?/;
- $outer->STORE('NUM_OF_PARAMS' => ($dir) ? $dir =~ tr/?/?/ : 0);
-
- if (@fields) {
- $outer->STORE('NAME' => \@fields);
- $outer->STORE('NULLABLE' => [ (0) x @fields ]);
- $outer->STORE('SCALE' => [ (0) x @fields ]);
- }
-
- $outer;
- }
-
-
- sub table_info {
- my $dbh = shift;
- my ($catalog, $schema, $table, $type) = @_;
-
- my @types = split(/["']*,["']/, $type || 'TABLE');
- my %types = map { $_=>$_ } @types;
-
- # Return a list of all subdirectories
- my $dh = Symbol::gensym(); # "DBD::ExampleP::".++$DBD::ExampleP::gensym;
- my $dir = $catalog || File::Spec->curdir();
- my @list;
- if ($types{VIEW}) { # for use by test harness
- push @list, [ undef, "schema", "table", 'VIEW', undef ];
- push @list, [ undef, "sch-ema", "table", 'VIEW', undef ];
- push @list, [ undef, "schema", "ta-ble", 'VIEW', undef ];
- push @list, [ undef, "sch ema", "table", 'VIEW', undef ];
- push @list, [ undef, "schema", "ta ble", 'VIEW', undef ];
- }
- if ($types{TABLE}) {
- no strict 'refs';
- opendir($dh, $dir)
- or return $dbh->set_err(int($!), "Failed to open directory $dir: $!");
- while (defined(my $item = readdir($dh))) {
- if ($^O eq 'VMS') {
- # if on VMS then avoid warnings from catdir if you use a file
- # (not a dir) as the item below
- next if $item !~ /\.dir$/oi;
- }
- my $file = File::Spec->catdir($dir,$item);
- next unless -d $file;
- my($dev, $ino, $mode, $nlink, $uid) = lstat($file);
- my $pwnam = undef; # eval { scalar(getpwnam($uid)) } || $uid;
- push @list, [ $dir, $pwnam, $item, 'TABLE', undef ];
- }
- close($dh);
- }
- # We would like to simply do a DBI->connect() here. However,
- # this is wrong if we are in a subclass like DBI::ProxyServer.
- $dbh->{'dbd_sponge_dbh'} ||= DBI->connect("DBI:Sponge:", '','')
- or return $dbh->set_err($DBI::err,
- "Failed to connect to DBI::Sponge: $DBI::errstr");
-
- my $attr = {
- 'rows' => \@list,
- 'NUM_OF_FIELDS' => 5,
- 'NAME' => ['TABLE_CAT', 'TABLE_SCHEM', 'TABLE_NAME',
- 'TABLE_TYPE', 'REMARKS'],
- 'TYPE' => [DBI::SQL_VARCHAR(), DBI::SQL_VARCHAR(),
- DBI::SQL_VARCHAR(), DBI::SQL_VARCHAR(), DBI::SQL_VARCHAR() ],
- 'NULLABLE' => [1, 1, 1, 1, 1]
- };
- my $sdbh = $dbh->{'dbd_sponge_dbh'};
- my $sth = $sdbh->prepare("SHOW TABLES FROM $dir", $attr)
- or return $dbh->set_err($sdbh->err(), $sdbh->errstr());
- $sth;
- }
-
-
- sub type_info_all {
- my ($dbh) = @_;
- my $ti = [
- { TYPE_NAME => 0,
- DATA_TYPE => 1,
- COLUMN_SIZE => 2,
- LITERAL_PREFIX => 3,
- LITERAL_SUFFIX => 4,
- CREATE_PARAMS => 5,
- NULLABLE => 6,
- CASE_SENSITIVE => 7,
- SEARCHABLE => 8,
- UNSIGNED_ATTRIBUTE=> 9,
- FIXED_PREC_SCALE=> 10,
- AUTO_UNIQUE_VALUE => 11,
- LOCAL_TYPE_NAME => 12,
- MINIMUM_SCALE => 13,
- MAXIMUM_SCALE => 14,
- },
- [ 'VARCHAR', DBI::SQL_VARCHAR, 1024, "'","'", undef, 0, 1, 1, 0, 0,0,undef,0,0 ],
- [ 'INTEGER', DBI::SQL_INTEGER, 10, "","", undef, 0, 0, 1, 0, 0,0,undef,0,0 ],
- ];
- return $ti;
- }
-
-
- sub ping {
- (shift->FETCH('Active')) ? 2 : 0; # the value 2 is checked for by t/80proxy.t
- }
-
-
- sub disconnect {
- shift->STORE(Active => 0);
- return 1;
- }
-
-
- sub get_info {
- my ($dbh, $info_type) = @_;
- return $dbh->{examplep_get_info}->{$info_type};
- }
-
-
- sub FETCH {
- my ($dbh, $attrib) = @_;
- # In reality this would interrogate the database engine to
- # either return dynamic values that cannot be precomputed
- # or fetch and cache attribute values too expensive to prefetch.
- # else pass up to DBI to handle
- return $INC{"DBD/ExampleP.pm"} if $attrib eq 'example_driver_path';
- return $dbh->SUPER::FETCH($attrib);
- }
-
-
- sub STORE {
- my ($dbh, $attrib, $value) = @_;
- # store only known attributes else pass up to DBI to handle
- if ($attrib eq 'examplep_set_err') {
- # a fake attribute to enable a test case where STORE issues a warning
- $dbh->set_err($value, $value);
- return;
- }
- if ($attrib eq 'AutoCommit') {
- # convert AutoCommit values to magic ones to let DBI
- # know that the driver has 'handled' the AutoCommit attribute
- $value = ($value) ? -901 : -900;
- }
- return $dbh->{$attrib} = $value if $attrib =~ /^examplep_/;
- return $dbh->SUPER::STORE($attrib, $value);
- }
-
- sub DESTROY {
- my $dbh = shift;
- $dbh->disconnect if $dbh->FETCH('Active');
- undef
- }
-
-
- # This is an example to demonstrate the use of driver-specific
- # methods via $dbh->func().
- # Use it as follows:
- # my @tables = $dbh->func($re, 'examplep_tables');
- #
- # Returns all the tables that match the regular expression $re.
- sub examplep_tables {
- my $dbh = shift; my $re = shift;
- grep { $_ =~ /$re/ } $dbh->tables();
- }
-
- sub parse_trace_flag {
- my ($h, $name) = @_;
- return 0x01000000 if $name eq 'foo';
- return 0x02000000 if $name eq 'bar';
- return 0x04000000 if $name eq 'baz';
- return 0x08000000 if $name eq 'boo';
- return 0x10000000 if $name eq 'bop';
- return $h->SUPER::parse_trace_flag($name);
- }
-
- sub private_attribute_info {
- return { example_driver_path => undef };
- }
-}
-
-
-{ package DBD::ExampleP::st; # ====== STATEMENT ======
- $imp_data_size = 0;
- use strict; no strict 'refs'; # cause problems with filehandles
-
- sub bind_param {
- my($sth, $param, $value, $attribs) = @_;
- $sth->{'dbd_param'}->[$param-1] = $value;
- return 1;
- }
-
-
- sub execute {
- my($sth, @dir) = @_;
- my $dir;
-
- if (@dir) {
- $sth->bind_param($_, $dir[$_-1]) or return
- foreach (1..@dir);
- }
-
- my $dbd_param = $sth->{'dbd_param'} || [];
- return $sth->set_err(2, @$dbd_param." values bound when $sth->{NUM_OF_PARAMS} expected")
- unless @$dbd_param == $sth->{NUM_OF_PARAMS};
-
- return 0 unless $sth->{NUM_OF_FIELDS}; # not a select
-
- $dir = $dbd_param->[0] || $sth->{examplep_ex_dir};
- return $sth->set_err(2, "No bind parameter supplied")
- unless defined $dir;
-
- $sth->finish;
-
- #
- # If the users asks for directory "long_list_4532", then we fake a
- # directory with files "file4351", "file4350", ..., "file0".
- # This is a special case used for testing, especially DBD::Proxy.
- #
- if ($dir =~ /^long_list_(\d+)$/) {
- $sth->{dbd_dir} = [ $1 ]; # array ref indicates special mode
- $sth->{dbd_datahandle} = undef;
- }
- else {
- $sth->{dbd_dir} = $dir;
- my $sym = Symbol::gensym(); # "DBD::ExampleP::".++$DBD::ExampleP::gensym;
- opendir($sym, $dir)
- or return $sth->set_err(2, "opendir($dir): $!");
- $sth->{dbd_datahandle} = $sym;
- }
- $sth->STORE(Active => 1);
- return 1;
- }
-
-
- sub fetch {
- my $sth = shift;
- my $dir = $sth->{dbd_dir};
- my %s;
-
- if (ref $dir) { # special fake-data test mode
- my $num = $dir->[0]--;
- unless ($num > 0) {
- $sth->finish();
- return;
- }
- my $time = time;
- @s{@DBD::ExampleP::statnames} =
- ( 2051, 1000+$num, 0644, 2, $>, $), 0, 1024,
- $time, $time, $time, 512, 2, "file$num")
- }
- else { # normal mode
- my $dh = $sth->{dbd_datahandle}
- or return $sth->set_err($DBI::stderr, "fetch without successful execute");
- my $f = readdir($dh);
- unless ($f) {
- $sth->finish;
- return;
- }
- # untaint $f so that we can use this for DBI taint tests
- ($f) = ($f =~ m/^(.*)$/);
- my $file = File::Spec->catfile($dir, $f);
- # put in all the data fields
- @s{ @DBD::ExampleP::statnames } = (lstat($file), $f);
- }
-
- # return just what fields the query asks for
- my @new = @s{ @{$sth->{NAME}} };
-
- return $sth->_set_fbav(\@new);
- }
- *fetchrow_arrayref = \&fetch;
-
-
- sub finish {
- my $sth = shift;
- closedir($sth->{dbd_datahandle}) if $sth->{dbd_datahandle};
- $sth->{dbd_datahandle} = undef;
- $sth->{dbd_dir} = undef;
- $sth->SUPER::finish();
- return 1;
- }
-
-
- sub FETCH {
- my ($sth, $attrib) = @_;
- # In reality this would interrogate the database engine to
- # either return dynamic values that cannot be precomputed
- # or fetch and cache attribute values too expensive to prefetch.
- if ($attrib eq 'TYPE'){
- return [ @DBD::ExampleP::stattypes{ @{ $sth->FETCH(q{NAME_lc}) } } ];
- }
- elsif ($attrib eq 'PRECISION'){
- return [ @DBD::ExampleP::statprec{ @{ $sth->FETCH(q{NAME_lc}) } } ];
- }
- elsif ($attrib eq 'ParamValues') {
- my $dbd_param = $sth->{dbd_param} || [];
- my %pv = map { $_ => $dbd_param->[$_-1] } 1..@$dbd_param;
- return \%pv;
- }
- # else pass up to DBI to handle
- return $sth->SUPER::FETCH($attrib);
- }
-
-
- sub STORE {
- my ($sth, $attrib, $value) = @_;
- # would normally validate and only store known attributes
- # else pass up to DBI to handle
- return $sth->{$attrib} = $value
- if $attrib eq 'NAME' or $attrib eq 'NULLABLE' or $attrib eq 'SCALE' or $attrib eq 'PRECISION';
- return $sth->SUPER::STORE($attrib, $value);
- }
-
- *parse_trace_flag = \&DBD::ExampleP::db::parse_trace_flag;
-}
-
-1;
-# vim: sw=4:ts=8
+++ /dev/null
-# -*- perl -*-
-#
-# DBD::File - A base class for implementing DBI drivers that
-# act on plain files
-#
-# This module is currently maintained by
-#
-# H.Merijn Brand & Jens Rehsack
-#
-# The original author is Jochen Wiedmann.
-#
-# Copyright (C) 2009-2013 by H.Merijn Brand & Jens Rehsack
-# Copyright (C) 2004 by Jeff Zucker
-# Copyright (C) 1998 by Jochen Wiedmann
-#
-# All rights reserved.
-#
-# You may distribute this module under the terms of either the GNU
-# General Public License or the Artistic License, as specified in
-# the Perl README file.
-
-require 5.008;
-
-use strict;
-use warnings;
-
-use DBI ();
-
-package DBD::File;
-
-use strict;
-use warnings;
-
-use base qw( DBI::DBD::SqlEngine );
-use Carp;
-use vars qw( @ISA $VERSION $drh );
-
-$VERSION = "0.44";
-
-$drh = undef; # holds driver handle(s) once initialized
-
-sub driver ($;$)
-{
- my ($class, $attr) = @_;
-
- # Drivers typically use a singleton object for the $drh
- # We use a hash here to have one singleton per subclass.
- # (Otherwise DBD::CSV and DBD::DBM, for example, would
- # share the same driver object which would cause problems.)
- # An alternative would be to not cache the $drh here at all
- # and require that subclasses do that. Subclasses should do
- # their own caching, so caching here just provides extra safety.
- $drh->{$class} and return $drh->{$class};
-
- $attr ||= {};
- { no strict "refs";
- unless ($attr->{Attribution}) {
- $class eq "DBD::File" and
- $attr->{Attribution} = "$class by Jeff Zucker";
- $attr->{Attribution} ||= ${$class . "::ATTRIBUTION"} ||
- "oops the author of $class forgot to define this";
- }
- $attr->{Version} ||= ${$class . "::VERSION"};
- $attr->{Name} or ($attr->{Name} = $class) =~ s/^DBD\:\://;
- }
-
- $drh->{$class} = $class->SUPER::driver ($attr);
-
- # XXX inject DBD::XXX::Statement unless exists
-
- return $drh->{$class};
- } # driver
-
-sub CLONE
-{
- undef $drh;
- } # CLONE
-
-# ====== DRIVER ================================================================
-
-package DBD::File::dr;
-
-use strict;
-use warnings;
-
-use vars qw( @ISA $imp_data_size );
-
-use Carp;
-
-@DBD::File::dr::ISA = qw( DBI::DBD::SqlEngine::dr );
-$DBD::File::dr::imp_data_size = 0;
-
-sub dsn_quote
-{
- my $str = shift;
- ref $str and return "";
- defined $str or return "";
- $str =~ s/([;:\\])/\\$1/g;
- return $str;
- } # dsn_quote
-
-# XXX rewrite using TableConfig ...
-sub default_table_source { "DBD::File::TableSource::FileSystem" }
-
-sub connect
-{
- my ($drh, $dbname, $user, $auth, $attr) = @_;
-
- # We do not (yet) care about conflicting attributes here
- # my $dbh = DBI->connect ("dbi:CSV:f_dir=test", undef, undef, { f_dir => "text" });
- # will test here that both test and text should exist
- if (my $attr_hash = (DBI->parse_dsn ($dbname))[3]) {
- if (defined $attr_hash->{f_dir} && ! -d $attr_hash->{f_dir}) {
- my $msg = "No such directory '$attr_hash->{f_dir}";
- $drh->set_err (2, $msg);
- $attr_hash->{RaiseError} and croak $msg;
- return;
- }
- }
- if ($attr and defined $attr->{f_dir} && ! -d $attr->{f_dir}) {
- my $msg = "No such directory '$attr->{f_dir}";
- $drh->set_err (2, $msg);
- $attr->{RaiseError} and croak $msg;
- return;
- }
-
- return $drh->SUPER::connect ($dbname, $user, $auth, $attr);
- } # connect
-
-sub disconnect_all
-{
- } # disconnect_all
-
-sub DESTROY
-{
- undef;
- } # DESTROY
-
-# ====== DATABASE ==============================================================
-
-package DBD::File::db;
-
-use strict;
-use warnings;
-
-use vars qw( @ISA $imp_data_size );
-
-use Carp;
-require File::Spec;
-require Cwd;
-use Scalar::Util qw( refaddr ); # in CORE since 5.7.3
-
-@DBD::File::db::ISA = qw( DBI::DBD::SqlEngine::db );
-$DBD::File::db::imp_data_size = 0;
-
-sub data_sources
-{
- my ($dbh, $attr, @other) = @_;
- ref ($attr) eq "HASH" or $attr = {};
- exists $attr->{f_dir} or $attr->{f_dir} = $dbh->{f_dir};
- exists $attr->{f_dir_search} or $attr->{f_dir_search} = $dbh->{f_dir_search};
- return $dbh->SUPER::data_sources ($attr, @other);
- } # data_source
-
-sub set_versions
-{
- my $dbh = shift;
- $dbh->{f_version} = $DBD::File::VERSION;
-
- return $dbh->SUPER::set_versions ();
- } # set_versions
-
-sub init_valid_attributes
-{
- my $dbh = shift;
-
- $dbh->{f_valid_attrs} = {
- f_version => 1, # DBD::File version
- f_dir => 1, # base directory
- f_dir_search => 1, # extended search directories
- f_ext => 1, # file extension
- f_schema => 1, # schema name
- f_lock => 1, # Table locking mode
- f_lockfile => 1, # Table lockfile extension
- f_encoding => 1, # Encoding of the file
- f_valid_attrs => 1, # File valid attributes
- f_readonly_attrs => 1, # File readonly attributes
- };
- $dbh->{f_readonly_attrs} = {
- f_version => 1, # DBD::File version
- f_valid_attrs => 1, # File valid attributes
- f_readonly_attrs => 1, # File readonly attributes
- };
-
- return $dbh->SUPER::init_valid_attributes ();
- } # init_valid_attributes
-
-sub init_default_attributes
-{
- my ($dbh, $phase) = @_;
-
- # must be done first, because setting flags implicitly calls $dbdname::db->STORE
- $dbh->SUPER::init_default_attributes ($phase);
-
- # DBI::BD::SqlEngine::dr::connect will detect old-style drivers and
- # don't call twice
- unless (defined $phase) {
- # we have an "old" driver here
- $phase = defined $dbh->{sql_init_phase};
- $phase and $phase = $dbh->{sql_init_phase};
- }
-
- if (0 == $phase) {
- # f_ext should not be initialized
- # f_map is deprecated (but might return)
- $dbh->{f_dir} = Cwd::abs_path (File::Spec->curdir ());
-
- push @{$dbh->{sql_init_order}{90}}, "f_meta";
-
- # complete derived attributes, if required
- (my $drv_class = $dbh->{ImplementorClass}) =~ s/::db$//;
- my $drv_prefix = DBI->driver_prefix ($drv_class);
- if (exists $dbh->{$drv_prefix . "meta"} and !$dbh->{sql_engine_in_gofer}) {
- my $attr = $dbh->{$drv_prefix . "meta"};
- defined $dbh->{f_valid_attrs}{f_meta}
- and $dbh->{f_valid_attrs}{f_meta} = 1;
-
- $dbh->{f_meta} = $dbh->{$attr};
- }
- }
-
- return $dbh;
- } # init_default_attributes
-
-sub validate_FETCH_attr
-{
- my ($dbh, $attrib) = @_;
-
- $attrib eq "f_meta" and $dbh->{sql_engine_in_gofer} and $attrib = "sql_meta";
-
- return $dbh->SUPER::validate_FETCH_attr ($attrib);
- } # validate_FETCH_attr
-
-sub validate_STORE_attr
-{
- my ($dbh, $attrib, $value) = @_;
-
- if ($attrib eq "f_dir" && defined $value) {
- -d $value or
- return $dbh->set_err ($DBI::stderr, "No such directory '$value'");
- File::Spec->file_name_is_absolute ($value) or
- $value = Cwd::abs_path ($value);
- }
-
- if ($attrib eq "f_ext") {
- $value eq "" || $value =~ m{^\.\w+(?:/[rR]*)?$} or
- carp "'$value' doesn't look like a valid file extension attribute\n";
- }
-
- $attrib eq "f_meta" and $dbh->{sql_engine_in_gofer} and $attrib = "sql_meta";
-
- return $dbh->SUPER::validate_STORE_attr ($attrib, $value);
- } # validate_STORE_attr
-
-sub get_f_versions
-{
- my ($dbh, $table) = @_;
-
- my $class = $dbh->{ImplementorClass};
- $class =~ s/::db$/::Table/;
- my $dver;
- my $dtype = "IO::File";
- eval {
- $dver = IO::File->VERSION ();
-
- # when we're still alive here, everything went ok - no need to check for $@
- $dtype .= " ($dver)";
- };
-
- my $f_encoding;
- if ($table) {
- my $meta;
- $table and (undef, $meta) = $class->get_table_meta ($dbh, $table, 1);
- $meta and $meta->{f_encoding} and $f_encoding = $meta->{f_encoding};
- } # if ($table)
- $f_encoding ||= $dbh->{f_encoding};
-
- $f_encoding and $dtype .= " + " . $f_encoding . " encoding";
-
- return sprintf "%s using %s", $dbh->{f_version}, $dtype;
- } # get_f_versions
-
-# ====== STATEMENT =============================================================
-
-package DBD::File::st;
-
-use strict;
-use warnings;
-
-use vars qw( @ISA $imp_data_size );
-
-@DBD::File::st::ISA = qw( DBI::DBD::SqlEngine::st );
-$DBD::File::st::imp_data_size = 0;
-
-my %supported_attrs = (
- TYPE => 1,
- PRECISION => 1,
- NULLABLE => 1,
- );
-
-sub FETCH
-{
- my ($sth, $attr) = @_;
-
- if ($supported_attrs{$attr}) {
- my $stmt = $sth->{sql_stmt};
-
- if (exists $sth->{ImplementorClass} &&
- exists $sth->{sql_stmt} &&
- $sth->{sql_stmt}->isa ("SQL::Statement")) {
-
- # fill overall_defs unless we know
- unless (exists $sth->{f_overall_defs} && ref $sth->{f_overall_defs}) {
- my $types = $sth->{Database}{Types};
- unless ($types) { # Fetch types only once per database
- if (my $t = $sth->{Database}->type_info_all ()) {
- foreach my $i (1 .. $#$t) {
- $types->{uc $t->[$i][0]} = $t->[$i][1];
- $types->{$t->[$i][1]} ||= uc $t->[$i][0];
- }
- }
- # sane defaults
- for ([ 0, "" ],
- [ 1, "CHAR" ],
- [ 4, "INTEGER" ],
- [ 12, "VARCHAR" ],
- ) {
- $types->{$_->[0]} ||= $_->[1];
- $types->{$_->[1]} ||= $_->[0];
- }
- $sth->{Database}{Types} = $types;
- }
- my $all_meta =
- $sth->{Database}->func ("*", "table_defs", "get_sql_engine_meta");
- foreach my $tbl (keys %$all_meta) {
- my $meta = $all_meta->{$tbl};
- exists $meta->{table_defs} && ref $meta->{table_defs} or next;
- foreach (keys %{$meta->{table_defs}{columns}}) {
- my $field_info = $meta->{table_defs}{columns}{$_};
- if (defined $field_info->{data_type} &&
- $field_info->{data_type} !~ m/^[0-9]+$/) {
- $field_info->{type_name} = uc $field_info->{data_type};
- $field_info->{data_type} = $types->{$field_info->{type_name}} || 0;
- }
- $field_info->{type_name} ||= $types->{$field_info->{data_type}} || "CHAR";
- $sth->{f_overall_defs}{$_} = $field_info;
- }
- }
- }
-
- my @colnames = $sth->sql_get_colnames ();
-
- $attr eq "TYPE" and
- return [ map { $sth->{f_overall_defs}{$_}{data_type} || 12 }
- @colnames ];
-
- $attr eq "TYPE_NAME" and
- return [ map { $sth->{f_overall_defs}{$_}{type_name} || "VARCHAR" }
- @colnames ];
-
- $attr eq "PRECISION" and
- return [ map { $sth->{f_overall_defs}{$_}{data_length} || 0 }
- @colnames ];
-
- $attr eq "NULLABLE" and
- return [ map { ( grep { $_ eq "NOT NULL" }
- @{ $sth->{f_overall_defs}{$_}{constraints} || [] })
- ? 0 : 1 }
- @colnames ];
- }
- }
-
- return $sth->SUPER::FETCH ($attr);
- } # FETCH
-
-# ====== TableSource ===========================================================
-
-package DBD::File::TableSource::FileSystem;
-
-use strict;
-use warnings;
-
-use IO::Dir;
-
-@DBD::File::TableSource::FileSystem::ISA = "DBI::DBD::SqlEngine::TableSource";
-
-sub data_sources
-{
- my ($class, $drh, $attr) = @_;
- my $dir = $attr && exists $attr->{f_dir}
- ? $attr->{f_dir}
- : File::Spec->curdir ();
- defined $dir or return; # Stream-based databases do not have f_dir
- unless (-d $dir && -r $dir && -x $dir) {
- $drh->set_err ($DBI::stderr, "Cannot use directory $dir from f_dir");
- return;
- }
- my %attrs;
- $attr and %attrs = %$attr;
- delete $attrs{f_dir};
- my $dsn_quote = $drh->{ImplementorClass}->can ("dsn_quote");
- my $dsnextra = join ";", map { $_ . "=" . &{$dsn_quote} ($attrs{$_}) } keys %attrs;
- my @dir = ($dir);
- $attr->{f_dir_search} && ref $attr->{f_dir_search} eq "ARRAY" and
- push @dir, grep { -d $_ } @{$attr->{f_dir_search}};
- my @dsns;
- foreach $dir (@dir) {
- my $dirh = IO::Dir->new ($dir);
- unless (defined $dirh) {
- $drh->set_err ($DBI::stderr, "Cannot open directory $dir: $!");
- return;
- }
-
- my ($file, %names, $driver);
- $driver = $drh->{ImplementorClass} =~ m/^dbd\:\:([^\:]+)\:\:/i ? $1 : "File";
-
- while (defined ($file = $dirh->read ())) {
- my $d = File::Spec->catdir ($dir, $file);
- # allow current dir ... it can be a data_source too
- $file ne File::Spec->updir () && -d $d and
- push @dsns, "DBI:$driver:f_dir=" . &{$dsn_quote} ($d) . ($dsnextra ? ";$dsnextra" : "");
- }
- }
- return @dsns;
- } # data_sources
-
-sub avail_tables
-{
- my ($self, $dbh) = @_;
-
- my $dir = $dbh->{f_dir};
- defined $dir or return; # Stream based db's cannot be queried for tables
-
- my %seen;
- my @tables;
- my @dir = ($dir);
- $dbh->{f_dir_search} && ref $dbh->{f_dir_search} eq "ARRAY" and
- push @dir, grep { -d $_ } @{$dbh->{f_dir_search}};
- foreach $dir (@dir) {
- my $dirh = IO::Dir->new ($dir);
-
- unless (defined $dirh) {
- $dbh->set_err ($DBI::stderr, "Cannot open directory $dir: $!");
- return;
- }
-
- my $class = $dbh->FETCH ("ImplementorClass");
- $class =~ s/::db$/::Table/;
- my ($file, %names);
- my $schema = exists $dbh->{f_schema}
- ? defined $dbh->{f_schema} && $dbh->{f_schema} ne ""
- ? $dbh->{f_schema} : undef
- : eval { getpwuid ((stat $dir)[4]) }; # XXX Win32::pwent
- while (defined ($file = $dirh->read ())) {
- my ($tbl, $meta) = $class->get_table_meta ($dbh, $file, 0, 0) or next; # XXX
- # $tbl && $meta && -f $meta->{f_fqfn} or next;
- $seen{defined $schema ? $schema : "\0"}{$dir}{$tbl}++ or
- push @tables, [ undef, $schema, $tbl, "TABLE", "FILE" ];
- }
- $dirh->close () or
- $dbh->set_err ($DBI::stderr, "Cannot close directory $dir: $!");
- }
-
- return @tables;
- } # avail_tables
-
-# ====== DataSource ============================================================
-
-package DBD::File::DataSource::Stream;
-
-use strict;
-use warnings;
-
-use Carp;
-
-@DBD::File::DataSource::Stream::ISA = "DBI::DBD::SqlEngine::DataSource";
-
-# We may have a working flock () built-in but that doesn't mean that locking
-# will work on NFS (flock () may hang hard)
-my $locking = eval {
- my $fh;
- my $nulldevice = File::Spec->devnull ();
- open $fh, ">", $nulldevice or croak "Can't open $nulldevice: $!";
- flock $fh, 0;
- close $fh;
- 1;
- };
-
-sub complete_table_name
-{
- my ($self, $meta, $file, $respect_case) = @_;
-
- my $tbl = $file;
- if (!$respect_case and $meta->{sql_identifier_case} == 1) { # XXX SQL_IC_UPPER
- $tbl = uc $tbl;
- }
- elsif (!$respect_case and $meta->{sql_identifier_case} == 2) { # XXX SQL_IC_LOWER
- $tbl = lc $tbl;
- }
-
- $meta->{f_fqfn} = undef;
- $meta->{f_fqbn} = undef;
- $meta->{f_fqln} = undef;
-
- $meta->{table_name} = $tbl;
-
- return $tbl;
- } # complete_table_name
-
-sub apply_encoding
-{
- my ($self, $meta, $fn) = @_;
- defined $fn or $fn = "file handle " . fileno ($meta->{fh});
- if (my $enc = $meta->{f_encoding}) {
- binmode $meta->{fh}, ":encoding($enc)" or
- croak "Failed to set encoding layer '$enc' on $fn: $!";
- }
- else {
- binmode $meta->{fh} or croak "Failed to set binary mode on $fn: $!";
- }
- } # apply_encoding
-
-sub open_data
-{
- my ($self, $meta, $attrs, $flags) = @_;
-
- $flags->{dropMode} and croak "Can't drop a table in stream";
- my $fn = "file handle " . fileno ($meta->{f_file});
-
- if ($flags->{createMode} || $flags->{lockMode}) {
- $meta->{fh} = IO::Handle->new_from_fd (fileno ($meta->{f_file}), "w+") or
- croak "Cannot open $fn for writing: $! (" . ($!+0) . ")";
- }
- else {
- $meta->{fh} = IO::Handle->new_from_fd (fileno ($meta->{f_file}), "r") or
- croak "Cannot open $fn for reading: $! (" . ($!+0) . ")";
- }
-
- if ($meta->{fh}) {
- $self->apply_encoding ($meta, $fn);
- } # have $meta->{$fh}
-
- if ($self->can_flock && $meta->{fh}) {
- my $lm = defined $flags->{f_lock}
- && $flags->{f_lock} =~ m/^[012]$/
- ? $flags->{f_lock}
- : $flags->{lockMode} ? 2 : 1;
- if ($lm == 2) {
- flock $meta->{fh}, 2 or croak "Cannot obtain exclusive lock on $fn: $!";
- }
- elsif ($lm == 1) {
- flock $meta->{fh}, 1 or croak "Cannot obtain shared lock on $fn: $!";
- }
- # $lm = 0 is forced no locking at all
- }
- } # open_data
-
-sub can_flock { $locking }
-
-package DBD::File::DataSource::File;
-
-use strict;
-use warnings;
-
-@DBD::File::DataSource::File::ISA = "DBD::File::DataSource::Stream";
-
-use Carp;
-
-my $fn_any_ext_regex = qr/\.[^.]*/;
-
-sub complete_table_name
-{
- my ($self, $meta, $file, $respect_case, $file_is_table) = @_;
-
- $file eq "." || $file eq ".." and return; # XXX would break a possible DBD::Dir
-
- # XXX now called without proving f_fqfn first ...
- my ($ext, $req) = ("", 0);
- if ($meta->{f_ext}) {
- ($ext, my $opt) = split m{/}, $meta->{f_ext};
- if ($ext && $opt) {
- $opt =~ m/r/i and $req = 1;
- }
- }
-
- # (my $tbl = $file) =~ s/\Q$ext\E$//i;
- my ($tbl, $basename, $dir, $fn_ext, $user_spec_file, $searchdir);
- if ($file_is_table and defined $meta->{f_file}) {
- $tbl = $file;
- ($basename, $dir, $fn_ext) = File::Basename::fileparse ($meta->{f_file}, $fn_any_ext_regex);
- $file = $basename . $fn_ext;
- $user_spec_file = 1;
- }
- else {
- ($basename, $dir, undef) = File::Basename::fileparse ($file, qr{\Q$ext\E});
- # $dir is returned with trailing (back)slash. We just need to check
- # if it is ".", "./", or ".\" or "[]" (VMS)
- if ($dir =~ m{^(?:[.][/\\]?|\[\])$} && ref $meta->{f_dir_search} eq "ARRAY") {
- foreach my $d ($meta->{f_dir}, @{$meta->{f_dir_search}}) {
- my $f = File::Spec->catdir ($d, $file);
- -f $f or next;
- $searchdir = Cwd::abs_path ($d);
- $dir = "";
- last;
- }
- }
- $file = $tbl = $basename;
- $user_spec_file = 0;
- }
-
- if (!$respect_case and $meta->{sql_identifier_case} == 1) { # XXX SQL_IC_UPPER
- $basename = uc $basename;
- $tbl = uc $tbl;
- }
- elsif (!$respect_case and $meta->{sql_identifier_case} == 2) { # XXX SQL_IC_LOWER
- $basename = lc $basename;
- $tbl = lc $tbl;
- }
-
- unless (defined $searchdir) {
- $searchdir = File::Spec->file_name_is_absolute ($dir)
- ? ($dir =~ s{/$}{}, $dir)
- : Cwd::abs_path (File::Spec->catdir ($meta->{f_dir}, $dir));
- }
- -d $searchdir or
- croak "-d $searchdir: $!";
-
- $searchdir eq $meta->{f_dir} and
- $dir = "";
-
- unless ($user_spec_file) {
- $file_is_table and $file = "$basename$ext";
-
- # Fully Qualified File Name
- my $cmpsub;
- if ($respect_case) {
- $cmpsub = sub {
- my ($fn, undef, $sfx) = File::Basename::fileparse ($_, $fn_any_ext_regex);
- $^O eq "VMS" && $sfx eq "." and
- $sfx = ""; # no extension turns up as a dot
- $fn eq $basename and
- return (lc $sfx eq lc $ext or !$req && !$sfx);
- return 0;
- }
- }
- else {
- $cmpsub = sub {
- my ($fn, undef, $sfx) = File::Basename::fileparse ($_, $fn_any_ext_regex);
- $^O eq "VMS" && $sfx eq "." and
- $sfx = ""; # no extension turns up as a dot
- lc $fn eq lc $basename and
- return (lc $sfx eq lc $ext or !$req && !$sfx);
- return 0;
- }
- }
-
- my @f;
- { my $dh = IO::Dir->new ($searchdir) or croak "Can't open '$searchdir': $!";
- @f = sort { length $b <=> length $a }
- grep { &$cmpsub ($_) }
- $dh->read ();
- $dh->close () or croak "Can't close '$searchdir': $!";
- }
- @f > 0 && @f <= 2 and $file = $f[0];
- !$respect_case && $meta->{sql_identifier_case} == 4 and # XXX SQL_IC_MIXED
- ($tbl = $file) =~ s/\Q$ext\E$//i;
-
- my $tmpfn = $file;
- if ($ext && $req) {
- # File extension required
- $tmpfn =~ s/\Q$ext\E$//i or return;
- }
- }
-
- my $fqfn = File::Spec->catfile ($searchdir, $file);
- my $fqbn = File::Spec->catfile ($searchdir, $basename);
-
- $meta->{f_fqfn} = $fqfn;
- $meta->{f_fqbn} = $fqbn;
- defined $meta->{f_lockfile} && $meta->{f_lockfile} and
- $meta->{f_fqln} = $meta->{f_fqbn} . $meta->{f_lockfile};
-
- $dir && !$user_spec_file and $tbl = File::Spec->catfile ($dir, $tbl);
- $meta->{table_name} = $tbl;
-
- return $tbl;
- } # complete_table_name
-
-sub open_data
-{
- my ($self, $meta, $attrs, $flags) = @_;
-
- defined $meta->{f_fqfn} && $meta->{f_fqfn} ne "" or croak "No filename given";
-
- my ($fh, $fn);
- unless ($meta->{f_dontopen}) {
- $fn = $meta->{f_fqfn};
- if ($flags->{createMode}) {
- -f $meta->{f_fqfn} and
- croak "Cannot create table $attrs->{table}: Already exists";
- $fh = IO::File->new ($fn, "a+") or
- croak "Cannot open $fn for writing: $! (" . ($!+0) . ")";
- }
- else {
- unless ($fh = IO::File->new ($fn, ($flags->{lockMode} ? "r+" : "r"))) {
- croak "Cannot open $fn: $! (" . ($!+0) . ")";
- }
- }
-
- $meta->{fh} = $fh;
-
- if ($fh) {
- $fh->seek (0, 0) or
- croak "Error while seeking back: $!";
-
- $self->apply_encoding ($meta);
- }
- }
- if ($meta->{f_fqln}) {
- $fn = $meta->{f_fqln};
- if ($flags->{createMode}) {
- -f $fn and
- croak "Cannot create table lock at '$fn' for $attrs->{table}: Already exists";
- $fh = IO::File->new ($fn, "a+") or
- croak "Cannot open $fn for writing: $! (" . ($!+0) . ")";
- }
- else {
- unless ($fh = IO::File->new ($fn, ($flags->{lockMode} ? "r+" : "r"))) {
- croak "Cannot open $fn: $! (" . ($!+0) . ")";
- }
- }
-
- $meta->{lockfh} = $fh;
- }
-
- if ($self->can_flock && $fh) {
- my $lm = defined $flags->{f_lock}
- && $flags->{f_lock} =~ m/^[012]$/
- ? $flags->{f_lock}
- : $flags->{lockMode} ? 2 : 1;
- if ($lm == 2) {
- flock $fh, 2 or croak "Cannot obtain exclusive lock on $fn: $!";
- }
- elsif ($lm == 1) {
- flock $fh, 1 or croak "Cannot obtain shared lock on $fn: $!";
- }
- # $lm = 0 is forced no locking at all
- }
- } # open_data
-
-# ====== SQL::STATEMENT ========================================================
-
-package DBD::File::Statement;
-
-use strict;
-use warnings;
-
-@DBD::File::Statement::ISA = qw( DBI::DBD::SqlEngine::Statement );
-
-# ====== SQL::TABLE ============================================================
-
-package DBD::File::Table;
-
-use strict;
-use warnings;
-
-use Carp;
-require IO::File;
-require File::Basename;
-require File::Spec;
-require Cwd;
-require Scalar::Util;
-
-@DBD::File::Table::ISA = qw( DBI::DBD::SqlEngine::Table );
-
-# ====== UTILITIES ============================================================
-
-if (eval { require Params::Util; }) {
- Params::Util->import ("_HANDLE");
- }
-else {
- # taken but modified from Params::Util ...
- *_HANDLE = sub {
- # It has to be defined, of course
- defined $_[0] or return;
-
- # Normal globs are considered to be file handles
- ref $_[0] eq "GLOB" and return $_[0];
-
- # Check for a normal tied filehandle
- # Side Note: 5.5.4's tied () and can () doesn't like getting undef
- tied ($_[0]) and tied ($_[0])->can ("TIEHANDLE") and return $_[0];
-
- # There are no other non-object handles that we support
- Scalar::Util::blessed ($_[0]) or return;
-
- # Check for a common base classes for conventional IO::Handle object
- $_[0]->isa ("IO::Handle") and return $_[0];
-
- # Check for tied file handles using Tie::Handle
- $_[0]->isa ("Tie::Handle") and return $_[0];
-
- # IO::Scalar is not a proper seekable, but it is valid is a
- # regular file handle
- $_[0]->isa ("IO::Scalar") and return $_[0];
-
- # Yet another special case for IO::String, which refuses (for now
- # anyway) to become a subclass of IO::Handle.
- $_[0]->isa ("IO::String") and return $_[0];
-
- # This is not any sort of object we know about
- return;
- };
- }
-
-# ====== FLYWEIGHT SUPPORT =====================================================
-
-# Flyweight support for table_info
-# The functions file2table, init_table_meta, default_table_meta and
-# get_table_meta are using $self arguments for polymorphism only. The
-# must not rely on an instantiated DBD::File::Table
-sub file2table
-{
- my ($self, $meta, $file, $file_is_table, $respect_case) = @_;
-
- return $meta->{sql_data_source}->complete_table_name ($meta, $file, $respect_case, $file_is_table);
- } # file2table
-
-sub bootstrap_table_meta
-{
- my ($self, $dbh, $meta, $table, @other) = @_;
-
- $self->SUPER::bootstrap_table_meta ($dbh, $meta, $table, @other);
-
- exists $meta->{f_dir} or $meta->{f_dir} = $dbh->{f_dir};
- exists $meta->{f_dir_search} or $meta->{f_dir_search} = $dbh->{f_dir_search};
- defined $meta->{f_ext} or $meta->{f_ext} = $dbh->{f_ext};
- defined $meta->{f_encoding} or $meta->{f_encoding} = $dbh->{f_encoding};
- exists $meta->{f_lock} or $meta->{f_lock} = $dbh->{f_lock};
- exists $meta->{f_lockfile} or $meta->{f_lockfile} = $dbh->{f_lockfile};
- defined $meta->{f_schema} or $meta->{f_schema} = $dbh->{f_schema};
-
- defined $meta->{f_open_file_needed} or
- $meta->{f_open_file_needed} = $self->can ("open_file") != DBD::File::Table->can ("open_file");
-
- defined ($meta->{sql_data_source}) or
- $meta->{sql_data_source} = _HANDLE ($meta->{f_file})
- ? "DBD::File::DataSource::Stream"
- : "DBD::File::DataSource::File";
- } # bootstrap_table_meta
-
-sub get_table_meta ($$$$;$)
-{
- my ($self, $dbh, $table, $file_is_table, $respect_case) = @_;
-
- my $meta = $self->SUPER::get_table_meta ($dbh, $table, $respect_case, $file_is_table);
- $table = $meta->{table_name};
- return unless $table;
-
- return ($table, $meta);
- } # get_table_meta
-
-my %reset_on_modify = (
- f_file => [ "f_fqfn", "sql_data_source" ],
- f_dir => "f_fqfn",
- f_dir_search => [],
- f_ext => "f_fqfn",
- f_lockfile => "f_fqfn", # forces new file2table call
- );
-
-__PACKAGE__->register_reset_on_modify (\%reset_on_modify);
-
-my %compat_map = map { $_ => "f_$_" } qw( file ext lock lockfile );
-
-__PACKAGE__->register_compat_map (\%compat_map);
-
-# ====== DBD::File <= 0.40 compat stuff ========================================
-
-# compat to 0.38 .. 0.40 API
-sub open_file
-{
- my ($className, $meta, $attrs, $flags) = @_;
-
- return $className->SUPER::open_data ($meta, $attrs, $flags);
- } # open_file
-
-sub open_data
-{
- my ($className, $meta, $attrs, $flags) = @_;
-
- # compat to 0.38 .. 0.40 API
- $meta->{f_open_file_needed}
- ? $className->open_file ($meta, $attrs, $flags)
- : $className->SUPER::open_data ($meta, $attrs, $flags);
-
- return;
- } # open_data
-
-# ====== SQL::Eval API =========================================================
-
-sub drop ($)
-{
- my ($self, $data) = @_;
- my $meta = $self->{meta};
- # We have to close the file before unlinking it: Some OS'es will
- # refuse the unlink otherwise.
- $meta->{fh} and $meta->{fh}->close ();
- $meta->{lockfh} and $meta->{lockfh}->close ();
- undef $meta->{fh};
- undef $meta->{lockfh};
- $meta->{f_fqfn} and unlink $meta->{f_fqfn}; # XXX ==> sql_data_source
- $meta->{f_fqln} and unlink $meta->{f_fqln}; # XXX ==> sql_data_source
- delete $data->{Database}{sql_meta}{$self->{table}};
- return 1;
- } # drop
-
-sub seek ($$$$)
-{
- my ($self, $data, $pos, $whence) = @_;
- my $meta = $self->{meta};
- if ($whence == 0 && $pos == 0) {
- $pos = defined $meta->{first_row_pos} ? $meta->{first_row_pos} : 0;
- }
- elsif ($whence != 2 || $pos != 0) {
- croak "Illegal seek position: pos = $pos, whence = $whence";
- }
-
- $meta->{fh}->seek ($pos, $whence) or
- croak "Error while seeking in " . $meta->{f_fqfn} . ": $!";
- } # seek
-
-sub truncate ($$)
-{
- my ($self, $data) = @_;
- my $meta = $self->{meta};
- $meta->{fh}->truncate ($meta->{fh}->tell ()) or
- croak "Error while truncating " . $meta->{f_fqfn} . ": $!";
- return 1;
- } # truncate
-
-sub DESTROY
-{
- my $self = shift;
- my $meta = $self->{meta};
- $meta->{fh} and $meta->{fh}->close ();
- $meta->{lockfh} and $meta->{lockfh}->close ();
- undef $meta->{fh};
- undef $meta->{lockfh};
-
- $self->SUPER::DESTROY();
- } # DESTROY
-
-1;
-
-__END__
-
-=head1 NAME
-
-DBD::File - Base class for writing file based DBI drivers
-
-=head1 SYNOPSIS
-
-This module is a base class for writing other L<DBD|DBI::DBD>s.
-It is not intended to function as a DBD itself (though it is possible).
-If you want to access flat files, use L<DBD::AnyData|DBD::AnyData>, or
-L<DBD::CSV|DBD::CSV> (both of which are subclasses of DBD::File).
-
-=head1 DESCRIPTION
-
-The DBD::File module is not a true L<DBI|DBI> driver, but an abstract
-base class for deriving concrete DBI drivers from it. The implication
-is, that these drivers work with plain files, for example CSV files or
-INI files. The module is based on the L<SQL::Statement|SQL::Statement>
-module, a simple SQL engine.
-
-See L<DBI|DBI> for details on DBI, L<SQL::Statement|SQL::Statement> for
-details on SQL::Statement and L<DBD::CSV|DBD::CSV>, L<DBD::DBM|DBD::DBM>
-or L<DBD::AnyData|DBD::AnyData> for example drivers.
-
-=head2 Metadata
-
-The following attributes are handled by DBI itself and not by DBD::File,
-thus they all work as expected:
-
- Active
- ActiveKids
- CachedKids
- CompatMode (Not used)
- InactiveDestroy
- AutoInactiveDestroy
- Kids
- PrintError
- RaiseError
- Warn (Not used)
-
-=head3 The following DBI attributes are handled by DBD::File:
-
-=head4 AutoCommit
-
-Always on.
-
-=head4 ChopBlanks
-
-Works.
-
-=head4 NUM_OF_FIELDS
-
-Valid after C<< $sth->execute >>.
-
-=head4 NUM_OF_PARAMS
-
-Valid after C<< $sth->prepare >>.
-
-=head4 NAME
-
-Valid after C<< $sth->execute >>; undef for Non-Select statements.
-
-=head4 NULLABLE
-
-Not really working, always returns an array ref of ones, except the
-affected table has been created in this session. Valid after
-C<< $sth->execute >>; undef for non-select statements.
-
-=head3 Unsupported DBI attributes and methods
-
-=head4 bind_param_inout
-
-=head4 CursorName
-
-=head4 LongReadLen
-
-=head4 LongTruncOk
-
-=head3 DBD::File specific attributes
-
-In addition to the DBI attributes, you can use the following dbh
-attributes:
-
-=head4 f_dir
-
-This attribute is used for setting the directory where the files are
-opened and it defaults to the current directory (F<.>). Usually you set
-it on the dbh but it may be overridden per table (see L<f_meta>).
-
-When the value for C<f_dir> is a relative path, it is converted into
-the appropriate absolute path name (based on the current working
-directory) when the dbh attribute is set.
-
- f_dir => "/data/foo/csv",
-
-See L<KNOWN BUGS AND LIMITATIONS>.
-
-=head4 f_dir_search
-
-This optional attribute can be set to pass a list of folders to also
-find existing tables. It will B<not> be used to create new files.
-
- f_dir_search => [ "/data/bar/csv", "/dump/blargh/data" ],
-
-=head4 f_ext
-
-This attribute is used for setting the file extension. The format is:
-
- extension{/flag}
-
-where the /flag is optional and the extension is case-insensitive.
-C<f_ext> allows you to specify an extension which:
-
- f_ext => ".csv/r",
-
-=over
-
-=item *
-
-makes DBD::File prefer F<table.extension> over F<table>.
-
-=item *
-
-makes the table name the filename minus the extension.
-
-=back
-
- DBI:CSV:f_dir=data;f_ext=.csv
-
-In the above example and when C<f_dir> contains both F<table.csv> and
-F<table>, DBD::File will open F<table.csv> and the table will be
-named "table". If F<table.csv> does not exist but F<table> does
-that file is opened and the table is also called "table".
-
-If C<f_ext> is not specified and F<table.csv> exists it will be opened
-and the table will be called "table.csv" which is probably not what
-you want.
-
-NOTE: even though extensions are case-insensitive, table names are
-not.
-
- DBI:CSV:f_dir=data;f_ext=.csv/r
-
-The C<r> flag means the file extension is required and any filename
-that does not match the extension is ignored.
-
-Usually you set it on the dbh but it may be overridden per table
-(see L<f_meta>).
-
-=head4 f_schema
-
-This will set the schema name and defaults to the owner of the
-directory in which the table file resides. You can set C<f_schema> to
-C<undef>.
-
- my $dbh = DBI->connect ("dbi:CSV:", "", "", {
- f_schema => undef,
- f_dir => "data",
- f_ext => ".csv/r",
- }) or die $DBI::errstr;
-
-By setting the schema you affect the results from the tables call:
-
- my @tables = $dbh->tables ();
-
- # no f_schema
- "merijn".foo
- "merijn".bar
-
- # f_schema => "dbi"
- "dbi".foo
- "dbi".bar
-
- # f_schema => undef
- foo
- bar
-
-Defining C<f_schema> to the empty string is equal to setting it to C<undef>
-so the DSN can be C<"dbi:CSV:f_schema=;f_dir=.">.
-
-=head4 f_lock
-
-The C<f_lock> attribute is used to set the locking mode on the opened
-table files. Note that not all platforms support locking. By default,
-tables are opened with a shared lock for reading, and with an
-exclusive lock for writing. The supported modes are:
-
- 0: No locking at all.
-
- 1: Shared locks will be used.
-
- 2: Exclusive locks will be used.
-
-But see L<KNOWN BUGS|/"KNOWN BUGS AND LIMITATIONS"> below.
-
-=head4 f_lockfile
-
-If you wish to use a lockfile extension other than C<.lck>, simply specify
-the C<f_lockfile> attribute:
-
- $dbh = DBI->connect ("dbi:DBM:f_lockfile=.foo");
- $dbh->{f_lockfile} = ".foo";
- $dbh->{dbm_tables}{qux}{f_lockfile} = ".foo";
-
-If you wish to disable locking, set the C<f_lockfile> to C<0>.
-
- $dbh = DBI->connect ("dbi:DBM:f_lockfile=0");
- $dbh->{f_lockfile} = 0;
- $dbh->{dbm_tables}{qux}{f_lockfile} = 0;
-
-=head4 f_encoding
-
-With this attribute, you can set the encoding in which the file is opened.
-This is implemented using C<< binmode $fh, ":encoding(<f_encoding>)" >>.
-
-=head4 f_meta
-
-Private data area aliasing L<DBI::DBD::SqlEngine/sql_meta> which
-contains information about the tables this module handles. Table meta
-data might not be available until the table has been accessed for the
-first time e.g., by issuing a select on it however it is possible to
-pre-initialize attributes for each table you use.
-
-DBD::File recognizes the (public) attributes C<f_ext>, C<f_dir>,
-C<f_file>, C<f_encoding>, C<f_lock>, C<f_lockfile>, C<f_schema>,
-in addition to the attributes L<DBI::DBD::SqlEngine/sql_meta> already
-supports. Be very careful when modifying attributes you do not know,
-the consequence might be a destroyed or corrupted table.
-
-C<f_file> is an attribute applicable to table meta data only and you
-will not find a corresponding attribute in the dbh. Whilst it may be
-reasonable to have several tables with the same column names, it is
-not for the same file name. If you need access to the same file using
-different table names, use C<SQL::Statement> as the SQL engine and the
-C<AS> keyword:
-
- SELECT * FROM tbl AS t1, tbl AS t2 WHERE t1.id = t2.id
-
-C<f_file> can be an absolute path name or a relative path name but if
-it is relative, it is interpreted as being relative to the C<f_dir>
-attribute of the table meta data. When C<f_file> is set DBD::File will
-use C<f_file> as specified and will not attempt to work out an
-alternative for C<f_file> using the C<table name> and C<f_ext>
-attribute.
-
-While C<f_meta> is a private and readonly attribute (which means, you
-cannot modify it's values), derived drivers might provide restricted
-write access through another attribute. Well known accessors are
-C<csv_tables> for L<DBD::CSV>, C<ad_tables> for L<DBD::AnyData> and
-C<dbm_tables> for L<DBD::DBM>.
-
-=head3 New opportunities for attributes from DBI::DBD::SqlEngine
-
-=head4 sql_table_source
-
-C<< $dbh->{sql_table_source} >> can be set to
-I<DBD::File::TableSource::FileSystem> (and is the default setting
-of DBD::File). This provides usual behaviour of previous DBD::File
-releases on
-
- @ary = DBI->data_sources ($driver);
- @ary = DBI->data_sources ($driver, \%attr);
-
- @ary = $dbh->data_sources ();
- @ary = $dbh->data_sources (\%attr);
-
- @names = $dbh->tables ($catalog, $schema, $table, $type);
-
- $sth = $dbh->table_info ($catalog, $schema, $table, $type);
- $sth = $dbh->table_info ($catalog, $schema, $table, $type, \%attr);
-
- $dbh->func ("list_tables");
-
-=head4 sql_data_source
-
-C<< $dbh->{sql_data_source} >> can be set to either
-I<DBD::File::DataSource::File>, which is default and provides the
-well known behavior of DBD::File releases prior to 0.41, or
-I<DBD::File::DataSource::Stream>, which reuses already opened
-file-handle for operations.
-
-=head3 Internally private attributes to deal with SQL backends
-
-Do not modify any of these private attributes unless you understand
-the implications of doing so. The behavior of DBD::File and derived
-DBDs might be unpredictable when one or more of those attributes are
-modified.
-
-=head4 sql_nano_version
-
-Contains the version of loaded DBI::SQL::Nano.
-
-=head4 sql_statement_version
-
-Contains the version of loaded SQL::Statement.
-
-=head4 sql_handler
-
-Contains either the text 'SQL::Statement' or 'DBI::SQL::Nano'.
-
-=head4 sql_ram_tables
-
-Contains optionally temporary tables.
-
-=head4 sql_flags
-
-Contains optional flags to instantiate the SQL::Parser parsing engine
-when SQL::Statement is used as SQL engine. See L<SQL::Parser> for valid
-flags.
-
-=head2 Driver private methods
-
-=head3 Default DBI methods
-
-=head4 data_sources
-
-The C<data_sources> method returns a list of subdirectories of the current
-directory in the form "dbi:CSV:f_dir=$dirname".
-
-If you want to read the subdirectories of another directory, use
-
- my ($drh) = DBI->install_driver ("CSV");
- my (@list) = $drh->data_sources (f_dir => "/usr/local/csv_data");
-
-=head3 Additional methods
-
-The following methods are only available via their documented name when
-DBD::File is used directly. Because this is only reasonable for testing
-purposes, the real names must be used instead. Those names can be computed
-by replacing the C<f_> in the method name with the driver prefix.
-
-=head4 f_versions
-
-Signature:
-
- sub f_versions (;$)
- {
- my ($table_name) = @_;
- $table_name ||= ".";
- ...
- }
-
-Returns the versions of the driver, including the DBI version, the Perl
-version, DBI::PurePerl version (if DBI::PurePerl is active) and the version
-of the SQL engine in use.
-
- my $dbh = DBI->connect ("dbi:File:");
- my $f_versions = $dbh->func ("f_versions");
- print "$f_versions\n";
- __END__
- # DBD::File 0.41 using IO::File (1.16)
- # DBI::DBD::SqlEngine 0.05 using SQL::Statement 1.406
- # DBI 1.623
- # OS darwin (12.2.1)
- # Perl 5.017006 (darwin-thread-multi-ld-2level)
-
-Called in list context, f_versions will return an array containing each
-line as single entry.
-
-Some drivers might use the optional (table name) argument and modify
-version information related to the table (e.g. DBD::DBM provides storage
-backend information for the requested table, when it has a table name).
-
-=head1 KNOWN BUGS AND LIMITATIONS
-
-=over 4
-
-=item *
-
-This module uses flock () internally but flock is not available on all
-platforms. On MacOS and Windows 95 there is no locking at all (perhaps
-not so important on MacOS and Windows 95, as there is only a single
-user).
-
-=item *
-
-The module stores details about the handled tables in a private area
-of the driver handle (C<$drh>). This data area is not shared between
-different driver instances, so several C<< DBI->connect () >> calls will
-cause different table instances and private data areas.
-
-This data area is filled for the first time when a table is accessed,
-either via an SQL statement or via C<table_info> and is not
-destroyed until the table is dropped or the driver handle is released.
-Manual destruction is possible via L<f_clear_meta>.
-
-The following attributes are preserved in the data area and will
-evaluated instead of driver globals:
-
-=over 8
-
-=item f_ext
-
-=item f_dir
-
-=item f_dir_search
-
-=item f_lock
-
-=item f_lockfile
-
-=item f_encoding
-
-=item f_schema
-
-=item col_names
-
-=item sql_identifier_case
-
-=back
-
-The following attributes are preserved in the data area only and
-cannot be set globally.
-
-=over 8
-
-=item f_file
-
-=back
-
-The following attributes are preserved in the data area only and are
-computed when initializing the data area:
-
-=over 8
-
-=item f_fqfn
-
-=item f_fqbn
-
-=item f_fqln
-
-=item table_name
-
-=back
-
-For DBD::CSV tables this means, once opened "foo.csv" as table named "foo",
-another table named "foo" accessing the file "foo.txt" cannot be opened.
-Accessing "foo" will always access the file "foo.csv" in memorized
-C<f_dir>, locking C<f_lockfile> via memorized C<f_lock>.
-
-You can use L<f_clear_meta> or the C<f_file> attribute for a specific table
-to work around this.
-
-=item *
-
-When used with SQL::Statement and temporary tables e.g.,
-
- CREATE TEMP TABLE ...
-
-the table data processing bypasses DBD::File::Table. No file system
-calls will be made and there are no clashes with existing (file based)
-tables with the same name. Temporary tables are chosen over file
-tables, but they will not covered by C<table_info>.
-
-=back
-
-=head1 AUTHOR
-
-This module is currently maintained by
-
-H.Merijn Brand < h.m.brand at xs4all.nl > and
-Jens Rehsack < rehsack at googlemail.com >
-
-The original author is Jochen Wiedmann.
-
-=head1 COPYRIGHT AND LICENSE
-
- Copyright (C) 2009-2013 by H.Merijn Brand & Jens Rehsack
- Copyright (C) 2004-2009 by Jeff Zucker
- Copyright (C) 1998-2004 by Jochen Wiedmann
-
-All rights reserved.
-
-You may freely distribute and/or modify this module under the terms of
-either the GNU General Public License (GPL) or the Artistic License, as
-specified in the Perl README file.
-
-=head1 SEE ALSO
-
-L<DBI|DBI>, L<DBD::DBM|DBD::DBM>, L<DBD::CSV|DBD::CSV>, L<Text::CSV|Text::CSV>,
-L<Text::CSV_XS|Text::CSV_XS>, L<SQL::Statement|SQL::Statement>, and
-L<DBI::SQL::Nano|DBI::SQL::Nano>
-
-=cut
+++ /dev/null
-=head1 NAME
-
-DBD::File::Developers - Developers documentation for DBD::File
-
-=head1 SYNOPSIS
-
- package DBD::myDriver;
-
- use base qw( DBD::File );
-
- sub driver
- {
- ...
- my $drh = $proto->SUPER::driver ($attr);
- ...
- return $drh->{class};
- }
-
- sub CLONE { ... }
-
- package DBD::myDriver::dr;
-
- @ISA = qw( DBD::File::dr );
-
- sub data_sources { ... }
- ...
-
- package DBD::myDriver::db;
-
- @ISA = qw( DBD::File::db );
-
- sub init_valid_attributes { ... }
- sub init_default_attributes { ... }
- sub set_versions { ... }
- sub validate_STORE_attr { my ($dbh, $attrib, $value) = @_; ... }
- sub validate_FETCH_attr { my ($dbh, $attrib) = @_; ... }
- sub get_myd_versions { ... }
-
- package DBD::myDriver::st;
-
- @ISA = qw( DBD::File::st );
-
- sub FETCH { ... }
- sub STORE { ... }
-
- package DBD::myDriver::Statement;
-
- @ISA = qw( DBD::File::Statement );
-
- package DBD::myDriver::Table;
-
- @ISA = qw( DBD::File::Table );
-
- my %reset_on_modify = (
- myd_abc => "myd_foo",
- myd_mno => "myd_bar",
- );
- __PACKAGE__->register_reset_on_modify (\%reset_on_modify);
- my %compat_map = (
- abc => 'foo_abc',
- xyz => 'foo_xyz',
- );
- __PACKAGE__->register_compat_map (\%compat_map);
-
- sub bootstrap_table_meta { ... }
- sub init_table_meta { ... }
- sub table_meta_attr_changed { ... }
- sub open_data { ... }
-
- sub fetch_row { ... }
- sub push_row { ... }
- sub push_names { ... }
-
- # optimize the SQL engine by add one or more of
- sub update_current_row { ... }
- # or
- sub update_specific_row { ... }
- # or
- sub update_one_row { ... }
- # or
- sub insert_new_row { ... }
- # or
- sub delete_current_row { ... }
- # or
- sub delete_one_row { ... }
-
-=head1 DESCRIPTION
-
-This document describes how DBD developers can write DBD::File based DBI
-drivers. It supplements L<DBI::DBD> and L<DBI::DBD::SqlEngine::Developers>,
-which you should read first.
-
-=head1 CLASSES
-
-Each DBI driver must provide a package global C<driver> method and three
-DBI related classes:
-
-=over 4
-
-=item DBD::File::dr
-
-Driver package, contains the methods DBI calls indirectly via DBI
-interface:
-
- DBI->connect ('DBI:DBM:', undef, undef, {})
-
- # invokes
- package DBD::DBM::dr;
- @DBD::DBM::dr::ISA = qw( DBD::File::dr );
-
- sub connect ($$;$$$)
- {
- ...
- }
-
-Similar for C<< data_sources >> and C<< disconnect_all >>.
-
-Pure Perl DBI drivers derived from DBD::File do not usually need to
-override any of the methods provided through the DBD::XXX::dr package
-however if you need additional initialization in the connect method
-you may need to.
-
-=item DBD::File::db
-
-Contains the methods which are called through DBI database handles
-(C<< $dbh >>). e.g.,
-
- $sth = $dbh->prepare ("select * from foo");
- # returns the f_encoding setting for table foo
- $dbh->csv_get_meta ("foo", "f_encoding");
-
-DBD::File provides the typical methods required here. Developers who
-write DBI drivers based on DBD::File need to override the methods C<<
-set_versions >> and C<< init_valid_attributes >>.
-
-=item DBD::File::st
-
-Contains the methods to deal with prepared statement handles. e.g.,
-
- $sth->execute () or die $sth->errstr;
-
-=back
-
-=head2 DBD::File
-
-This is the main package containing the routines to initialize
-DBD::File based DBI drivers. Primarily the C<< DBD::File::driver >>
-method is invoked, either directly from DBI when the driver is
-initialized or from the derived class.
-
- package DBD::DBM;
-
- use base qw( DBD::File );
-
- sub driver
- {
- my ($class, $attr) = @_;
- ...
- my $drh = $class->SUPER::driver ($attr);
- ...
- return $drh;
- }
-
-It is not necessary to implement your own driver method as long as
-additional initialization (e.g. installing more private driver
-methods) is not required. You do not need to call C<< setup_driver >>
-as DBD::File takes care of it.
-
-=head2 DBD::File::dr
-
-The driver package contains the methods DBI calls indirectly via the DBI
-interface (see L<DBI/DBI Class Methods>).
-
-DBD::File based DBI drivers usually do not need to implement anything here,
-it is enough to do the basic initialization:
-
- package DBD:XXX::dr;
-
- @DBD::XXX::dr::ISA = qw (DBD::File::dr);
- $DBD::XXX::dr::imp_data_size = 0;
- $DBD::XXX::dr::data_sources_attr = undef;
- $DBD::XXX::ATTRIBUTION = "DBD::XXX $DBD::XXX::VERSION by Hans Mustermann";
-
-=head2 DBD::File::db
-
-This package defines the database methods, which are called via the DBI
-database handle C<< $dbh >>.
-
-Methods provided by DBD::File:
-
-=over 4
-
-=item ping
-
-Simply returns the content of the C<< Active >> attribute. Override
-when your driver needs more complicated actions here.
-
-=item prepare
-
-Prepares a new SQL statement to execute. Returns a statement handle,
-C<< $sth >> - instance of the DBD:XXX::st. It is neither required nor
-recommended to override this method.
-
-=item FETCH
-
-Fetches an attribute of a DBI database object. Private handle attributes
-must have a prefix (this is mandatory). If a requested attribute is
-detected as a private attribute without a valid prefix, the driver prefix
-(written as C<$drv_prefix>) is added.
-
-The driver prefix is extracted from the attribute name and verified against
-C<< $dbh->{$drv_prefix . "valid_attrs"} >> (when it exists). If the
-requested attribute value is not listed as a valid attribute, this method
-croaks. If the attribute is valid and readonly (listed in C<< $dbh->{
-$drv_prefix . "readonly_attrs" } >> when it exists), a real copy of the
-attribute value is returned. So it's not possible to modify
-C<f_valid_attrs> from outside of DBD::File::db or a derived class.
-
-=item STORE
-
-Stores a database private attribute. Private handle attributes must have a
-prefix (this is mandatory). If a requested attribute is detected as a private
-attribute without a valid prefix, the driver prefix (written as
-C<$drv_prefix>) is added. If the database handle has an attribute
-C<${drv_prefix}_valid_attrs> - for attribute names which are not listed in
-that hash, this method croaks. If the database handle has an attribute
-C<${drv_prefix}_readonly_attrs>, only attributes which are not listed there
-can be stored (once they are initialized). Trying to overwrite such an
-immutable attribute forces this method to croak.
-
-An example of a valid attributes list can be found in
-C<< DBD::File::db::init_valid_attributes >>.
-
-=item set_versions
-
-This method sets the attribute C<f_version> with the version of DBD::File.
-
-This method is called at the begin of the C<connect ()> phase.
-
-When overriding this method, do not forget to invoke the superior one.
-
-=item init_valid_attributes
-
-This method is called after the database handle is instantiated as the
-first attribute initialization.
-
-C<< DBD::File::db::init_valid_attributes >> initializes the attributes
-C<f_valid_attrs> and C<f_readonly_attrs>.
-
-When overriding this method, do not forget to invoke the superior one,
-preferably before doing anything else. Compatibility table attribute
-access must be initialized here to allow DBD::File to instantiate the
-map tie:
-
- # for DBD::CSV
- $dbh->{csv_meta} = "csv_tables";
- # for DBD::DBM
- $dbh->{dbm_meta} = "dbm_tables";
- # for DBD::AnyData
- $dbh->{ad_meta} = "ad_tables";
-
-=item init_default_attributes
-
-This method is called after the database handle is instantiated to
-initialize the default attributes.
-
-C<< DBD::File::db::init_default_attributes >> initializes the attributes
-C<f_dir>, C<f_meta>, C<f_meta_map>, C<f_version>.
-
-When the derived implementor class provides the attribute to validate
-attributes (e.g. C<< $dbh->{dbm_valid_attrs} = {...}; >>) or the attribute
-containing the immutable attributes (e.g.
-C<< $dbh->{dbm_readonly_attrs} = {...}; >>), the attributes
-C<drv_valid_attrs>, C<drv_readonly_attrs>, C<drv_version> and C<drv_meta>
-are added (when available) to the list of valid and immutable attributes
-(where C<drv_> is interpreted as the driver prefix).
-
-If C<drv_meta> is set, an attribute with the name in C<drv_meta> is
-initialized providing restricted read/write access to the meta data of the
-tables using C<DBD::File::TieTables> in the first (table) level and
-C<DBD::File::TieMeta> for the meta attribute level. C<DBD::File::TieTables>
-uses C<DBD::DRV::Table::get_table_meta> to initialize the second level
-tied hash on FETCH/STORE. The C<DBD::File::TieMeta> class uses
-C<DBD::DRV::Table::get_table_meta_attr> to FETCH attribute values and
-C<DBD::DRV::Table::set_table_meta_attr> to STORE attribute values. This
-allows it to map meta attributes for compatibility reasons.
-
-=item get_single_table_meta
-
-=item get_file_meta
-
-Retrieve an attribute from a table's meta information. The method
-signature is C<< get_file_meta ($dbh, $table, $attr) >>. This method
-is called by the injected db handle method C<< ${drv_prefix}get_meta >>.
-
-While get_file_meta allows C<$table> or C<$attr> to be a list of tables or
-attributes to retrieve, get_single_table_meta allows only one table name
-and only one attribute name. A table name of C<'.'> (single dot) is
-interpreted as the default table and this will retrieve the appropriate
-attribute globally from the dbh. This has the same restrictions as
-C<< $dbh->{$attrib} >>.
-
-get_file_meta allows C<'+'> and C<'*'> as wildcards for table names and
-C<$table> being a regular expression matching against the table names
-(evaluated without the default table). The table name C<'*'> is
-I<all currently known tables, including the default one>. The table
-name C<'+'> is I<all table names which conform to
-ANSI file name restrictions> (/^[_A-Za-z0-9]+$/).
-
-The table meta information is retrieved using the get_table_meta and
-get_table_meta_attr methods of the table class of the implementation.
-
-=item set_single_table_meta
-
-=item set_file_meta
-
-Sets an attribute in a table's meta information. The method signature is
-C<< set_file_meta ($dbh, $table, $attr, $value) >>. This method is called
-by the injected db handle method C<< ${drv_prefix}set_meta >>.
-
-While set_file_meta allows C<$table> to be a list of tables and C<$attr>
-to be a hash of several attributes to set, set_single_table_meta allows
-only one table name and only one attribute name/value pair.
-
-The wildcard characters for the table name are the same as for
-get_file_meta.
-
-The table meta information is updated using the get_table_meta and
-set_table_meta_attr methods of the table class of the implementation.
-
-=item clear_file_meta
-
-Clears all meta information cached about a table. The method signature is
-C<< clear_file_meta ($dbh, $table) >>. This method is called
-by the injected db handle method C<< ${drv_prefix}clear_meta >>.
-
-=back
-
-=head2 DBD::File::st
-
-Contains the methods to deal with prepared statement handles:
-
-=over 4
-
-=item FETCH
-
-Fetches statement handle attributes. Supported attributes (for full overview
-see L<DBI/Statement Handle Attributes>) are C<NAME>, C<TYPE>, C<PRECISION>
-and C<NULLABLE> in case that SQL::Statement is used as SQL execution engine
-and a statement is successful prepared. When SQL::Statement has additional
-information about a table, those information are returned. Otherwise, the
-same defaults as in L<DBI::DBD::SqlEngine> are used.
-
-This method usually requires extending in a derived implementation.
-See L<DBD::CSV> or L<DBD::DBM> for some example.
-
-=back
-
-=head2 DBD::File::TableSource::FileSystem
-
-Provides data sources and table information on database driver and database
-handle level.
-
- package DBD::File::TableSource::FileSystem;
-
- sub data_sources ($;$)
- {
- my ($class, $drh, $attrs) = @_;
- ...
- }
-
- sub avail_tables
- {
- my ($class, $drh) = @_;
- ...
- }
-
-The C<data_sources> method is called when the user invokes any of the
-following:
-
- @ary = DBI->data_sources ($driver);
- @ary = DBI->data_sources ($driver, \%attr);
-
- @ary = $dbh->data_sources ();
- @ary = $dbh->data_sources (\%attr);
-
-The C<avail_tables> method is called when the user invokes any of the
-following:
-
- @names = $dbh->tables ($catalog, $schema, $table, $type);
-
- $sth = $dbh->table_info ($catalog, $schema, $table, $type);
- $sth = $dbh->table_info ($catalog, $schema, $table, $type, \%attr);
-
- $dbh->func ("list_tables");
-
-Every time where an C<\%attr> argument can be specified, this C<\%attr>
-object's C<sql_table_source> attribute is preferred over the C<$dbh>
-attribute or the driver default.
-
-=head2 DBD::File::DataSource::Stream
-
- package DBD::File::DataSource::Stream;
-
- @DBD::File::DataSource::Stream::ISA = 'DBI::DBD::SqlEngine::DataSource';
-
- sub complete_table_name
- {
- my ($self, $meta, $file, $respect_case) = @_;
- ...
- }
-
-Clears all meta attributes identifying a file: C<f_fqfn>, C<f_fqbn> and
-C<f_fqln>. The table name is set according to C<$respect_case> and
-C<< $meta->{sql_identifier_case} >> (SQL_IC_LOWER, SQL_IC_UPPER).
-
- package DBD::File::DataSource::Stream;
-
- sub apply_encoding
- {
- my ($self, $meta, $fn) = @_;
- ...
- }
-
-Applies the encoding from I<meta information> (C<< $meta->{f_encoding} >>)
-to the file handled opened in C<open_data>.
-
- package DBD::File::DataSource::Stream;
-
- sub open_data
- {
- my ($self, $meta, $attrs, $flags) = @_;
- ...
- }
-
-Opens (C<dup (2)>) the file handle provided in C<< $meta->{f_file} >>.
-
- package DBD::File::DataSource::Stream;
-
- sub can_flock { ... }
-
-Returns whether C<flock (2)> is available or not (avoids retesting in
-subclasses).
-
-=head2 DBD::File::DataSource::File
-
- package DBD::File::DataSource::File;
-
- sub complete_table_name ($$;$)
- {
- my ($self, $meta, $table, $respect_case) = @_;
- ...
- }
-
-The method C<complete_table_name> tries to map a filename to the associated
-table name. It is called with a partially filled meta structure for the
-resulting table containing at least the following attributes:
-C<< f_ext >>, C<< f_dir >>, C<< f_lockfile >> and C<< sql_identifier_case >>.
-
-If a file/table map can be found then this method sets the C<< f_fqfn
->>, C<< f_fqbn >>, C<< f_fqln >> and C<< table_name >> attributes in
-the meta structure. If a map cannot be found the table name will be
-undef.
-
- package DBD::File::DataSource::File;
-
- sub open_data ($)
- {
- my ($self, $meta, $attrs, $flags) = @_;
- ...
- }
-
-Depending on the attributes set in the table's meta data, the
-following steps are performed. Unless C<< f_dontopen >> is set to a
-true value, C<< f_fqfn >> must contain the full qualified file name
-for the table to work on (file2table ensures this). The encoding in
-C<< f_encoding >> is applied if set and the file is opened. If
-C<<f_fqln >> (full qualified lock name) is set, this file is opened,
-too. Depending on the value in C<< f_lock >>, the appropriate lock is
-set on the opened data file or lock file.
-
-=head2 DBD::File::Statement
-
-Derives from DBI::SQL::Nano::Statement to provide following method:
-
-=over 4
-
-=item open_table
-
-Implements the open_table method required by L<SQL::Statement> and
-L<DBI::SQL::Nano>. All the work for opening the file(s) belonging to the
-table is handled and parametrized in DBD::File::Table. Unless you intend
-to add anything to the following implementation, an empty DBD::XXX::Statement
-package satisfies DBD::File.
-
- sub open_table ($$$$$)
- {
- my ($self, $data, $table, $createMode, $lockMode) = @_;
-
- my $class = ref $self;
- $class =~ s/::Statement/::Table/;
-
- my $flags = {
- createMode => $createMode,
- lockMode => $lockMode,
- };
- $self->{command} eq "DROP" and $flags->{dropMode} = 1;
-
- return $class->new ($data, { table => $table }, $flags);
- } # open_table
-
-=back
-
-=head2 DBD::File::Table
-
-Derives from DBI::SQL::Nano::Table and provides physical file access for
-the table data which are stored in the files.
-
-=over 4
-
-=item bootstrap_table_meta
-
-Initializes a table meta structure. Can be safely overridden in a
-derived class, as long as the C<< SUPER >> method is called at the end
-of the overridden method.
-
-It copies the following attributes from the database into the table meta data
-C<< f_dir >>, C<< f_ext >>, C<< f_encoding >>, C<< f_lock >>, C<< f_schema >>
-and C<< f_lockfile >> and makes them sticky to the table.
-
-This method should be called before you attempt to map between file
-name and table name to ensure the correct directory, extension etc. are
-used.
-
-=item init_table_meta
-
-Initializes more attributes of the table meta data - usually more
-expensive ones (e.g. those which require class instantiations) - when
-the file name and the table name could mapped.
-
-=item get_table_meta
-
-Returns the table meta data. If there are none for the required
-table, a new one is initialized. When it fails, nothing is
-returned. On success, the name of the table and the meta data
-structure is returned.
-
-=item get_table_meta_attr
-
-Returns a single attribute from the table meta data. If the attribute
-name appears in C<%compat_map>, the attribute name is updated from
-there.
-
-=item set_table_meta_attr
-
-Sets a single attribute in the table meta data. If the attribute
-name appears in C<%compat_map>, the attribute name is updated from
-there.
-
-=item table_meta_attr_changed
-
-Called when an attribute of the meta data is modified.
-
-If the modified attribute requires to reset a calculated attribute, the
-calculated attribute is reset (deleted from meta data structure) and
-the I<initialized> flag is removed, too. The decision is made based on
-C<%register_reset_on_modify>.
-
-=item register_reset_on_modify
-
-Allows C<set_table_meta_attr> to reset meta attributes when special
-attributes are modified. For DBD::File, modifying one of C<f_file>, C<f_dir>,
-C<f_ext> or C<f_lockfile> will reset C<f_fqfn>. DBD::DBM extends the
-list for C<dbm_type> and C<dbm_mldbm> to reset the value of C<dbm_tietype>.
-
-If your DBD has calculated values in the meta data area, then call
-C<register_reset_on_modify>:
-
- my %reset_on_modify = (xxx_foo => "xxx_bar");
- __PACKAGE__->register_reset_on_modify (\%reset_on_modify);
-
-=item register_compat_map
-
-Allows C<get_table_meta_attr> and C<set_table_meta_attr> to update the
-attribute name to the current favored one:
-
- # from DBD::DBM
- my %compat_map = (dbm_ext => "f_ext");
- __PACKAGE__->register_compat_map (\%compat_map);
-
-=item open_file
-
-Called to open the table's data file.
-
-Depending on the attributes set in the table's meta data, the
-following steps are performed. Unless C<< f_dontopen >> is set to a
-true value, C<< f_fqfn >> must contain the full qualified file name
-for the table to work on (file2table ensures this). The encoding in
-C<< f_encoding >> is applied if set and the file is opened. If
-C<<f_fqln >> (full qualified lock name) is set, this file is opened,
-too. Depending on the value in C<< f_lock >>, the appropriate lock is
-set on the opened data file or lock file.
-
-After this is done, a derived class might add more steps in an overridden
-C<< open_file >> method.
-
-=item new
-
-Instantiates the table. This is done in 3 steps:
-
- 1. get the table meta data
- 2. open the data file
- 3. bless the table data structure using inherited constructor new
-
-It is not recommended to override the constructor of the table class.
-Find a reasonable place to add you extensions in one of the above four
-methods.
-
-=item drop
-
-Implements the abstract table method for the C<< DROP >>
-command. Discards table meta data after all files belonging to the
-table are closed and unlinked.
-
-Overriding this method might be reasonable in very rare cases.
-
-=item seek
-
-Implements the abstract table method used when accessing the table from the
-engine. C<< seek >> is called every time the engine uses dumb algorithms
-for iterating over the table content.
-
-=item truncate
-
-Implements the abstract table method used when dumb table algorithms
-for C<< UPDATE >> or C<< DELETE >> need to truncate the table storage
-after the last written row.
-
-=back
-
-You should consult the documentation of C<< SQL::Eval::Table >> (see
-L<SQL::Eval>) to get more information about the abstract methods of the
-table's base class you have to override and a description of the table
-meta information expected by the SQL engines.
-
-=head1 AUTHOR
-
-The module DBD::File is currently maintained by
-
-H.Merijn Brand < h.m.brand at xs4all.nl > and
-Jens Rehsack < rehsack at googlemail.com >
-
-The original author is Jochen Wiedmann.
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright (C) 2010-2013 by H.Merijn Brand & Jens Rehsack
-
-All rights reserved.
-
-You may freely distribute and/or modify this module under the terms of
-either the GNU General Public License (GPL) or the Artistic License, as
-specified in the Perl README file.
-
-=cut
+++ /dev/null
-=head1 NAME
-
-DBD::File::HowTo - Guide to create DBD::File based driver
-
-=head1 SYNOPSIS
-
- perldoc DBD::File::HowTo
- perldoc DBI
- perldoc DBI::DBD
- perldoc DBD::File::Developers
- perldoc DBI::DBD::SqlEngine::Developers
- perldoc DBI::DBD::SqlEngine
- perldoc SQL::Eval
- perldoc DBI::DBD::SqlEngine::HowTo
- perldoc SQL::Statement::Embed
- perldoc DBD::File
- perldoc DBD::File::HowTo
- perldoc DBD::File::Developers
-
-=head1 DESCRIPTION
-
-This document provides a step-by-step guide, how to create a new
-C<DBD::File> based DBD. It expects that you carefully read the L<DBI>
-documentation and that you're familiar with L<DBI::DBD> and had read and
-understood L<DBD::ExampleP>.
-
-This document addresses experienced developers who are really sure that
-they need to invest time when writing a new DBI Driver. Writing a DBI
-Driver is neither a weekend project nor an easy job for hobby coders
-after work. Expect one or two man-month of time for the first start.
-
-Those who are still reading, should be able to sing the rules of
-L<DBI::DBD/CREATING A NEW DRIVER>.
-
-Of course, DBD::File is a DBI::DBD::SqlEngine and you surely read
-L<DBI::DBD::SqlEngine::HowTo> before continuing here.
-
-=head1 CREATING DRIVER CLASSES
-
-Do you have an entry in DBI's DBD registry? For this guide, a prefix of
-C<foo_> is assumed.
-
-=head2 Sample Skeleton
-
- package DBD::Foo;
-
- use strict;
- use warnings;
- use vars qw(@ISA $VERSION);
- use base qw(DBD::File);
-
- use DBI ();
-
- $VERSION = "0.001";
-
- package DBD::Foo::dr;
-
- use vars qw(@ISA $imp_data_size);
-
- @ISA = qw(DBD::File::dr);
- $imp_data_size = 0;
-
- package DBD::Foo::db;
-
- use vars qw(@ISA $imp_data_size);
-
- @ISA = qw(DBD::File::db);
- $imp_data_size = 0;
-
- package DBD::Foo::st;
-
- use vars qw(@ISA $imp_data_size);
-
- @ISA = qw(DBD::File::st);
- $imp_data_size = 0;
-
- package DBD::Foo::Statement;
-
- use vars qw(@ISA);
-
- @ISA = qw(DBD::File::Statement);
-
- package DBD::Foo::Table;
-
- use vars qw(@ISA);
-
- @ISA = qw(DBD::File::Table);
-
- 1;
-
-Tiny, eh? And all you have now is a DBD named foo which will is able to
-deal with temporary tables, as long as you use L<SQL::Statement>. In
-L<DBI::SQL::Nano> environments, this DBD can do nothing.
-
-=head2 Start over
-
-Based on L<DBI::DBD::SqlEngine::HowTo>, we're now having a driver which
-could do basic things. Of course, it should now derive from DBD::File
-instead of DBI::DBD::SqlEngine, shouldn't it?
-
-DBD::File extends DBI::DBD::SqlEngine to deal with any kind of files.
-In principle, the only extensions required are to the table class:
-
- package DBD::Foo::Table;
-
- sub bootstrap_table_meta
- {
- my ( $self, $dbh, $meta, $table ) = @_;
-
- # initialize all $meta attributes which might be relevant for
- # file2table
-
- return $self->SUPER::bootstrap_table_meta($dbh, $meta, $table);
- }
-
- sub init_table_meta
- {
- my ( $self, $dbh, $meta, $table ) = @_;
-
- # called after $meta contains the results from file2table
- # initialize all missing $meta attributes
-
- $self->SUPER::init_table_meta( $dbh, $meta, $table );
- }
-
-In case C<DBD::File::Table::open_file> doesn't open the files as the driver
-needs that, override it!
-
- sub open_file
- {
- my ( $self, $meta, $attrs, $flags ) = @_;
- # ensure that $meta->{f_dontopen} is set
- $self->SUPER::open_file( $meta, $attrs, $flags );
- # now do what ever needs to be done
- }
-
-Combined with the methods implemented using the L<SQL::Statement::Embed>
-guide, the table is full working and you could try a start over.
-
-=head2 User comfort
-
-C<DBD::File> since C<0.39> consolidates all persistent meta data of a table
-into a single structure stored in C<< $dbh->{f_meta} >>. With C<DBD::File>
-version C<0.41> and C<DBI::DBD::SqlEngine> version C<0.05>, this
-consolidation moves to L<DBI::DBD::SqlEngine>. It's still the
-C<< $dbh->{$drv_prefix . "_meta"} >> attribute which cares, so what you
-learned at this place before, is still valid.
-
- sub init_valid_attributes
- {
- my $dbh = $_[0];
-
- $dbh->SUPER::init_valid_attributes ();
-
- $dbh->{foo_valid_attrs} = { ... };
- $dbh->{foo_readonly_attrs} = { ... };
-
- $dbh->{foo_meta} = "foo_tables";
-
- return $dbh;
- }
-
-See updates at L<DBI::DBD::SqlEngine::HowTo/User comfort>.
-
-=head2 Testing
-
-Now you should have your own DBD::File based driver. Was easy, wasn't it?
-But does it work well? Prove it by writing tests and remember to use
-dbd_edit_mm_attribs from L<DBI::DBD> to ensure testing even rare cases.
-
-=head1 AUTHOR
-
-This guide is written by Jens Rehsack. DBD::File is written by Jochen
-Wiedmann and Jeff Zucker.
-
-The module DBD::File is currently maintained by
-
-H.Merijn Brand < h.m.brand at xs4all.nl > and
-Jens Rehsack < rehsack at googlemail.com >
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright (C) 2010 by H.Merijn Brand & Jens Rehsack
-
-All rights reserved.
-
-You may freely distribute and/or modify this module under the terms of
-either the GNU General Public License (GPL) or the Artistic License, as
-specified in the Perl README file.
-
-=cut
+++ /dev/null
-=head1 NAME
-
-DBD::File::Roadmap - Planned Enhancements for DBD::File and pure Perl DBD's
-
-Jens Rehsack - May 2010
-
-=head1 SYNOPSIS
-
-This document gives a high level overview of the future of the DBD::File DBI
-driver and groundwork for pure Perl DBI drivers.
-
-The planned enhancements cover features, testing, performance, reliability,
-extensibility and more.
-
-=head1 CHANGES AND ENHANCEMENTS
-
-=head2 Features
-
-There are some features missing we would like to add, but there is
-no time plan:
-
-=over 4
-
-=item LOCK TABLE
-
-The newly implemented internal common table meta storage area would allow
-us to implement LOCK TABLE support based on file system C<flock ()>
-support.
-
-=item Transaction support
-
-While DBD::AnyData recommends explicitly committing by importing and
-exporting tables, DBD::File might be enhanced in a future version to allow
-transparent transactions using the temporary tables of SQL::Statement as
-shadow (dirty) tables.
-
-Transaction support will heavily rely on lock table support.
-
-=item Data Dictionary Persistence
-
-SQL::Statement provides dictionary information when a "CREATE TABLE ..."
-statement is executed. This dictionary is preserved for some statement
-handle attribute fetches (as C<NULLABLE> or C<PRECISION>).
-
-It is planned to extend DBD::File to support data dictionaries to work
-on the tables in it. It is not planned to support one table in different
-dictionaries, but you can have several dictionaries in one directory.
-
-=item SQL Engine selecting on connect
-
-Currently the SQL engine selected is chosen during the loading of the module
-L<DBI::SQL::Nano>. Ideally end users should be able to select the engine
-used in C<< DBI->connect () >> with a special DBD::File attribute.
-
-=back
-
-Other points of view to the planned features (and more features for the
-SQL::Statement engine) are shown in L<SQL::Statement::Roadmap>.
-
-=head2 Testing
-
-DBD::File and the dependent DBD::DBM requires a lot more automated tests
-covering API stability and compatibility with optional modules
-like SQL::Statement.
-
-=head2 Performance
-
-Several arguments for support of features like indexes on columns
-and cursors are made for DBD::CSV (which is a DBD::File based driver,
-too). Similar arguments could be made for DBD::DBM, DBD::AnyData,
-DBD::RAM or DBD::PO etc.
-
-To improve the performance of the underlying SQL engines, a clean
-re-implementation seems to be required. Currently both engines are
-prematurely optimized and therefore it is not trivial to provide
-further optimization without the risk of breaking existing features.
-
-Join the DBI developers IRC channel at L<irc://irc.perl.org/dbi> to
-participate or post to the DBI Developers Mailing List.
-
-=head2 Reliability
-
-DBD::File currently lacks the following points:
-
-=over 4
-
-=item duplicate table names
-
-It is currently possible to access a table quoted with a relative path
-(a) and additionally using an absolute path (b). If (a) and (b) are
-the same file that is not recognized (except for
-flock protection handled by the Operating System) and two independent
-tables are handled.
-
-=item invalid table names
-
-The current implementation does not prevent someone choosing a
-directory name as a physical file name for the table to open.
-
-=back
-
-=head2 Extensibility
-
-I (Jens Rehsack) have some (partially for example only) DBD's in mind:
-
-=over 4
-
-=item DBD::Sys
-
-Derive DBD::Sys from a common code base shared with DBD::File which handles
-all the emulation DBI needs (as getinfo, SQL engine handling, ...)
-
-=item DBD::Dir
-
-Provide a DBD::File derived to work with fixed table definitions through the
-file system to demonstrate how DBI / Pure Perl DBDs could handle databases
-with hierarchical structures.
-
-=item DBD::Join
-
-Provide a DBI driver which is able to manage multiple connections to other
-Databases (as DBD::Multiplex), but allow them to point to different data
-sources and allow joins between the tables of them:
-
- # Example
- # Let table 'lsof' being a table in DBD::Sys giving a list of open files using lsof utility
- # Let table 'dir' being a atable from DBD::Dir
- $sth = $dbh->prepare( "select * from dir,lsof where path='/documents' and dir.entry = lsof.filename" )
- $sth->execute(); # gives all open files in '/documents'
- ...
-
- # Let table 'filesys' a DBD::Sys table of known file systems on current host
- # Let table 'applications' a table of your Configuration Management Database
- # where current applications (relocatable, with mountpoints for filesystems)
- # are stored
- $sth = dbh->prepare( "select * from applications,filesys where " .
- "application.mountpoint = filesys.mountpoint and ".
- "filesys.mounted is true" );
- $sth->execute(); # gives all currently mounted applications on this host
-
-=back
-
-=head1 PRIORITIES
-
-Our priorities are focused on current issues. Initially many new test
-cases for DBD::File and DBD::DBM should be added to the DBI test
-suite. After that some additional documentation on how to use the
-DBD::File API will be provided.
-
-Any additional priorities will come later and can be modified by (paying)
-users.
-
-=head1 RESOURCES AND CONTRIBUTIONS
-
-See L<http://dbi.perl.org/contributing> for I<how you can help>.
-
-If your company has benefited from DBI, please consider if
-it could make a donation to The Perl Foundation "DBI Development"
-fund at L<http://dbi.perl.org/donate> to secure future development.
-
-Alternatively, if your company would benefit from a specific new
-DBI feature, please consider sponsoring it's development through
-the options listed in the section "Commercial Support from the Author"
-on L<http://dbi.perl.org/support/>.
-
-Using such targeted financing allows you to contribute to DBI
-development and rapidly get something specific and directly valuable
-to you in return.
-
-My company also offers annual support contracts for the DBI, which
-provide another way to support the DBI and get something specific
-in return. Contact me for details.
-
-Thank you.
-
-=cut
+++ /dev/null
-{
- package DBD::Gofer;
-
- use strict;
-
- require DBI;
- require DBI::Gofer::Request;
- require DBI::Gofer::Response;
- require Carp;
-
- our $VERSION = "0.015327";
-
-# $Id: Gofer.pm 15326 2012-06-06 16:32:38Z Tim $
-#
-# Copyright (c) 2007, Tim Bunce, Ireland
-#
-# You may distribute under the terms of either the GNU General Public
-# License or the Artistic License, as specified in the Perl README file.
-
-
-
- # attributes we'll allow local STORE
- our %xxh_local_store_attrib = map { $_=>1 } qw(
- Active
- CachedKids
- Callbacks
- DbTypeSubclass
- ErrCount Executed
- FetchHashKeyName
- HandleError HandleSetErr
- InactiveDestroy
- AutoInactiveDestroy
- PrintError PrintWarn
- Profile
- RaiseError
- RootClass
- ShowErrorStatement
- Taint TaintIn TaintOut
- TraceLevel
- Warn
- dbi_quote_identifier_cache
- dbi_connect_closure
- dbi_go_execute_unique
- );
- our %xxh_local_store_attrib_if_same_value = map { $_=>1 } qw(
- Username
- dbi_connect_method
- );
-
- our $drh = undef; # holds driver handle once initialized
- our $methods_already_installed;
-
- sub driver{
- return $drh if $drh;
-
- DBI->setup_driver('DBD::Gofer');
-
- unless ($methods_already_installed++) {
- my $opts = { O=> 0x0004 }; # IMA_KEEP_ERR
- DBD::Gofer::db->install_method('go_dbh_method', $opts);
- DBD::Gofer::st->install_method('go_sth_method', $opts);
- DBD::Gofer::st->install_method('go_clone_sth', $opts);
- DBD::Gofer::db->install_method('go_cache', $opts);
- DBD::Gofer::st->install_method('go_cache', $opts);
- }
-
- my($class, $attr) = @_;
- $class .= "::dr";
- ($drh) = DBI::_new_drh($class, {
- 'Name' => 'Gofer',
- 'Version' => $VERSION,
- 'Attribution' => 'DBD Gofer by Tim Bunce',
- });
-
- $drh;
- }
-
-
- sub CLONE {
- undef $drh;
- }
-
-
- sub go_cache {
- my $h = shift;
- $h->{go_cache} = shift if @_;
- # return handle's override go_cache, if it has one
- return $h->{go_cache} if defined $h->{go_cache};
- # or else the transports default go_cache
- return $h->{go_transport}->{go_cache};
- }
-
-
- sub set_err_from_response { # set error/warn/info and propagate warnings
- my $h = shift;
- my $response = shift;
- if (my $warnings = $response->warnings) {
- warn $_ for @$warnings;
- }
- my ($err, $errstr, $state) = $response->err_errstr_state;
- # Only set_err() if there's an error else leave the current values
- # (The current values will normally be set undef by the DBI dispatcher
- # except for methods marked KEEPERR such as ping.)
- $h->set_err($err, $errstr, $state) if defined $err;
- return undef;
- }
-
-
- sub install_methods_proxy {
- my ($installed_methods) = @_;
- while ( my ($full_method, $attr) = each %$installed_methods ) {
- # need to install both a DBI dispatch stub and a proxy stub
- # (the dispatch stub may be already here due to local driver use)
-
- DBI->_install_method($full_method, "", $attr||{})
- unless defined &{$full_method};
-
- # now install proxy stubs on the driver side
- $full_method =~ m/^DBI::(\w\w)::(\w+)$/
- or die "Invalid method name '$full_method' for install_method";
- my ($type, $method) = ($1, $2);
- my $driver_method = "DBD::Gofer::${type}::${method}";
- next if defined &{$driver_method};
- my $sub;
- if ($type eq 'db') {
- $sub = sub { return shift->go_dbh_method(undef, $method, @_) };
- }
- else {
- $sub = sub { shift->set_err($DBI::stderr, "Can't call \$${type}h->$method when using DBD::Gofer"); return; };
- }
- no strict 'refs';
- *$driver_method = $sub;
- }
- }
-}
-
-
-{ package DBD::Gofer::dr; # ====== DRIVER ======
-
- $imp_data_size = 0;
- use strict;
-
- sub connect_cached {
- my ($drh, $dsn, $user, $auth, $attr)= @_;
- $attr ||= {};
- return $drh->SUPER::connect_cached($dsn, $user, $auth, {
- (%$attr),
- go_connect_method => $attr->{go_connect_method} || 'connect_cached',
- });
- }
-
-
- sub connect {
- my($drh, $dsn, $user, $auth, $attr)= @_;
- my $orig_dsn = $dsn;
-
- # first remove dsn= and everything after it
- my $remote_dsn = ($dsn =~ s/;?\bdsn=(.*)$// && $1)
- or return $drh->set_err($DBI::stderr, "No dsn= argument in '$orig_dsn'");
-
- if ($attr->{go_bypass}) { # don't use DBD::Gofer for this connection
- # useful for testing with DBI_AUTOPROXY, e.g., t/03handle.t
- return DBI->connect($remote_dsn, $user, $auth, $attr);
- }
-
- my %go_attr;
- # extract any go_ attributes from the connect() attr arg
- for my $k (grep { /^go_/ } keys %$attr) {
- $go_attr{$k} = delete $attr->{$k};
- }
- # then override those with any attributes embedded in our dsn (not remote_dsn)
- for my $kv (grep /=/, split /;/, $dsn, -1) {
- my ($k, $v) = split /=/, $kv, 2;
- $go_attr{ "go_$k" } = $v;
- }
-
- if (not ref $go_attr{go_policy}) { # if not a policy object already
- my $policy_class = $go_attr{go_policy} || 'classic';
- $policy_class = "DBD::Gofer::Policy::$policy_class"
- unless $policy_class =~ /::/;
- _load_class($policy_class)
- or return $drh->set_err($DBI::stderr, "Can't load $policy_class: $@");
- # replace policy name in %go_attr with policy object
- $go_attr{go_policy} = eval { $policy_class->new(\%go_attr) }
- or return $drh->set_err($DBI::stderr, "Can't instanciate $policy_class: $@");
- }
- # policy object is left in $go_attr{go_policy} so transport can see it
- my $go_policy = $go_attr{go_policy};
-
- if ($go_attr{go_cache} and not ref $go_attr{go_cache}) { # if not a cache object already
- my $cache_class = $go_attr{go_cache};
- $cache_class = "DBI::Util::CacheMemory" if $cache_class eq '1';
- _load_class($cache_class)
- or return $drh->set_err($DBI::stderr, "Can't load $cache_class $@");
- $go_attr{go_cache} = eval { $cache_class->new() }
- or $drh->set_err(0, "Can't instanciate $cache_class: $@"); # warning
- }
-
- # delete any other attributes that don't apply to transport
- my $go_connect_method = delete $go_attr{go_connect_method};
-
- my $transport_class = delete $go_attr{go_transport}
- or return $drh->set_err($DBI::stderr, "No transport= argument in '$orig_dsn'");
- $transport_class = "DBD::Gofer::Transport::$transport_class"
- unless $transport_class =~ /::/;
- _load_class($transport_class)
- or return $drh->set_err($DBI::stderr, "Can't load $transport_class: $@");
- my $go_transport = eval { $transport_class->new(\%go_attr) }
- or return $drh->set_err($DBI::stderr, "Can't instanciate $transport_class: $@");
-
- my $request_class = "DBI::Gofer::Request";
- my $go_request = eval {
- my $go_attr = { %$attr };
- # XXX user/pass of fwd server vs db server ? also impact of autoproxy
- if ($user) {
- $go_attr->{Username} = $user;
- $go_attr->{Password} = $auth;
- }
- # delete any attributes we can't serialize (or don't want to)
- delete @{$go_attr}{qw(Profile HandleError HandleSetErr Callbacks)};
- # delete any attributes that should only apply to the client-side
- delete @{$go_attr}{qw(RootClass DbTypeSubclass)};
-
- $go_connect_method ||= $go_policy->connect_method($remote_dsn, $go_attr) || 'connect';
- $request_class->new({
- dbh_connect_call => [ $go_connect_method, $remote_dsn, $user, $auth, $go_attr ],
- })
- } or return $drh->set_err($DBI::stderr, "Can't instanciate $request_class: $@");
-
- my ($dbh, $dbh_inner) = DBI::_new_dbh($drh, {
- 'Name' => $dsn,
- 'USER' => $user,
- go_transport => $go_transport,
- go_request => $go_request,
- go_policy => $go_policy,
- });
-
- # mark as inactive temporarily for STORE. Active not set until connected() called.
- $dbh->STORE(Active => 0);
-
- # should we ping to check the connection
- # and fetch dbh attributes
- my $skip_connect_check = $go_policy->skip_connect_check($attr, $dbh);
- if (not $skip_connect_check) {
- if (not $dbh->go_dbh_method(undef, 'ping')) {
- return undef if $dbh->err; # error already recorded, typically
- return $dbh->set_err($DBI::stderr, "ping failed");
- }
- }
-
- return $dbh;
- }
-
- sub _load_class { # return true or false+$@
- my $class = shift;
- (my $pm = $class) =~ s{::}{/}g;
- $pm .= ".pm";
- return 1 if eval { require $pm };
- delete $INC{$pm}; # shouldn't be needed (perl bug?) and assigning undef isn't enough
- undef; # error in $@
- }
-
-}
-
-
-{ package DBD::Gofer::db; # ====== DATABASE ======
- $imp_data_size = 0;
- use strict;
- use Carp qw(carp croak);
-
- my %dbh_local_store_attrib = %DBD::Gofer::xxh_local_store_attrib;
-
- sub connected {
- shift->STORE(Active => 1);
- }
-
- sub go_dbh_method {
- my $dbh = shift;
- my $meta = shift;
- # @_ now contains ($method_name, @args)
-
- my $request = $dbh->{go_request};
- $request->init_request([ wantarray, @_ ], $dbh);
- ++$dbh->{go_request_count};
-
- my $go_policy = $dbh->{go_policy};
- my $dbh_attribute_update = $go_policy->dbh_attribute_update();
- $request->dbh_attributes( $go_policy->dbh_attribute_list() )
- if $dbh_attribute_update eq 'every'
- or $dbh->{go_request_count}==1;
-
- $request->dbh_last_insert_id_args($meta->{go_last_insert_id_args})
- if $meta->{go_last_insert_id_args};
-
- my $transport = $dbh->{go_transport}
- or return $dbh->set_err($DBI::stderr, "Not connected (no transport)");
-
- local $transport->{go_cache} = $dbh->{go_cache}
- if defined $dbh->{go_cache};
-
- my ($response, $retransmit_sub) = $transport->transmit_request($request);
- $response ||= $transport->receive_response($request, $retransmit_sub);
- $dbh->{go_response} = $response
- or die "No response object returned by $transport";
-
- die "response '$response' returned by $transport is not a response object"
- unless UNIVERSAL::isa($response,"DBI::Gofer::Response");
-
- if (my $dbh_attributes = $response->dbh_attributes) {
-
- # XXX installed_methods piggybacks on dbh_attributes for now
- if (my $installed_methods = delete $dbh_attributes->{dbi_installed_methods}) {
- DBD::Gofer::install_methods_proxy($installed_methods)
- if $dbh->{go_request_count}==1;
- }
-
- # XXX we don't STORE here, we just stuff the value into the attribute cache
- $dbh->{$_} = $dbh_attributes->{$_}
- for keys %$dbh_attributes;
- }
-
- my $rv = $response->rv;
- if (my $resultset_list = $response->sth_resultsets) {
- # dbh method call returned one or more resultsets
- # (was probably a metadata method like table_info)
- #
- # setup an sth but don't execute/forward it
- my $sth = $dbh->prepare(undef, { go_skip_prepare_check => 1 });
- # set the sth response to our dbh response
- (tied %$sth)->{go_response} = $response;
- # setup the sth with the results in our response
- $sth->more_results;
- # and return that new sth as if it came from original request
- $rv = [ $sth ];
- }
- elsif (!$rv) { # should only occur for major transport-level error
- #carp("no rv in response { @{[ %$response ]} }");
- $rv = [ ];
- }
-
- DBD::Gofer::set_err_from_response($dbh, $response);
-
- return (wantarray) ? @$rv : $rv->[0];
- }
-
-
- # Methods that should be forwarded but can be cached
- for my $method (qw(
- tables table_info column_info primary_key_info foreign_key_info statistics_info
- data_sources type_info_all get_info
- parse_trace_flags parse_trace_flag
- func
- )) {
- my $policy_name = "cache_$method";
- my $super_name = "SUPER::$method";
- my $sub = sub {
- my $dbh = shift;
- my $rv;
-
- # if we know the remote side doesn't override the DBI's default method
- # then we might as well just call the DBI's default method on the client
- # (which may, in turn, call other methods that are forwarded, like get_info)
- if ($dbh->{dbi_default_methods}{$method} && $dbh->{go_policy}->skip_default_methods()) {
- $dbh->trace_msg(" !! $method: using local default as remote method is also default\n");
- return $dbh->$super_name(@_);
- }
-
- my $cache;
- my $cache_key;
- if (my $cache_it = $dbh->{go_policy}->$policy_name(undef, $dbh, @_)) {
- $cache = $dbh->{go_meta_cache} ||= {}; # keep separate from go_cache
- $cache_key = sprintf "%s_wa%d(%s)", $policy_name, wantarray||0,
- join(",\t", map { # XXX basic but sufficient for now
- !ref($_) ? DBI::neat($_,1e6)
- : ref($_) eq 'ARRAY' ? DBI::neat_list($_,1e6,",\001")
- : ref($_) eq 'HASH' ? do { my @k = sort keys %$_; DBI::neat_list([@k,@{$_}{@k}],1e6,",\002") }
- : do { warn "unhandled argument type ($_)"; $_ }
- } @_);
- if ($rv = $cache->{$cache_key}) {
- $dbh->trace_msg("$method(@_) returning previously cached value ($cache_key)\n",4);
- my @cache_rv = @$rv;
- # if it's an sth we have to clone it
- $cache_rv[0] = $cache_rv[0]->go_clone_sth if UNIVERSAL::isa($cache_rv[0],'DBI::st');
- return (wantarray) ? @cache_rv : $cache_rv[0];
- }
- }
-
- $rv = [ (wantarray)
- ? ($dbh->go_dbh_method(undef, $method, @_))
- : scalar $dbh->go_dbh_method(undef, $method, @_)
- ];
-
- if ($cache) {
- $dbh->trace_msg("$method(@_) caching return value ($cache_key)\n",4);
- my @cache_rv = @$rv;
- # if it's an sth we have to clone it
- #$cache_rv[0] = $cache_rv[0]->go_clone_sth
- # if UNIVERSAL::isa($cache_rv[0],'DBI::st');
- $cache->{$cache_key} = \@cache_rv
- unless UNIVERSAL::isa($cache_rv[0],'DBI::st'); # XXX cloning sth not yet done
- }
-
- return (wantarray) ? @$rv : $rv->[0];
- };
- no strict 'refs';
- *$method = $sub;
- }
-
-
- # Methods that can use the DBI defaults for some situations/drivers
- for my $method (qw(
- quote quote_identifier
- )) { # XXX keep DBD::Gofer::Policy::Base in sync
- my $policy_name = "locally_$method";
- my $super_name = "SUPER::$method";
- my $sub = sub {
- my $dbh = shift;
-
- # if we know the remote side doesn't override the DBI's default method
- # then we might as well just call the DBI's default method on the client
- # (which may, in turn, call other methods that are forwarded, like get_info)
- if ($dbh->{dbi_default_methods}{$method} && $dbh->{go_policy}->skip_default_methods()) {
- $dbh->trace_msg(" !! $method: using local default as remote method is also default\n");
- return $dbh->$super_name(@_);
- }
-
- # false: use remote gofer
- # 1: use local DBI default method
- # code ref: use the code ref
- my $locally = $dbh->{go_policy}->$policy_name($dbh, @_);
- if ($locally) {
- return $locally->($dbh, @_) if ref $locally eq 'CODE';
- return $dbh->$super_name(@_);
- }
- return $dbh->go_dbh_method(undef, $method, @_); # propagate context
- };
- no strict 'refs';
- *$method = $sub;
- }
-
-
- # Methods that should always fail
- for my $method (qw(
- begin_work commit rollback
- )) {
- no strict 'refs';
- *$method = sub { return shift->set_err($DBI::stderr, "$method not available with DBD::Gofer") }
- }
-
-
- sub do {
- my ($dbh, $sql, $attr, @args) = @_;
- delete $dbh->{Statement}; # avoid "Modification of non-creatable hash value attempted"
- $dbh->{Statement} = $sql; # for profiling and ShowErrorStatement
- my $meta = { go_last_insert_id_args => $attr->{go_last_insert_id_args} };
- return $dbh->go_dbh_method($meta, 'do', $sql, $attr, @args);
- }
-
- sub ping {
- my $dbh = shift;
- return $dbh->set_err('', "can't ping while not connected") # info
- unless $dbh->SUPER::FETCH('Active');
- my $skip_ping = $dbh->{go_policy}->skip_ping();
- return ($skip_ping) ? 1 : $dbh->go_dbh_method(undef, 'ping', @_);
- }
-
- sub last_insert_id {
- my $dbh = shift;
- my $response = $dbh->{go_response} or return undef;
- return $response->last_insert_id;
- }
-
- sub FETCH {
- my ($dbh, $attrib) = @_;
-
- # FETCH is effectively already cached because the DBI checks the
- # attribute cache in the handle before calling FETCH
- # and this FETCH copies the value into the attribute cache
-
- # forward driver-private attributes (except ours)
- if ($attrib =~ m/^[a-z]/ && $attrib !~ /^go_/) {
- my $value = $dbh->go_dbh_method(undef, 'FETCH', $attrib);
- $dbh->{$attrib} = $value; # XXX forces caching by DBI
- return $dbh->{$attrib} = $value;
- }
-
- # else pass up to DBI to handle
- return $dbh->SUPER::FETCH($attrib);
- }
-
- sub STORE {
- my ($dbh, $attrib, $value) = @_;
- if ($attrib eq 'AutoCommit') {
- croak "Can't enable transactions when using DBD::Gofer" if !$value;
- return $dbh->SUPER::STORE($attrib => ($value) ? -901 : -900);
- }
- return $dbh->SUPER::STORE($attrib => $value)
- # we handle this attribute locally
- if $dbh_local_store_attrib{$attrib}
- # or it's a private_ (application) attribute
- or $attrib =~ /^private_/
- # or not yet connected (ie being called by DBI->connect)
- or not $dbh->FETCH('Active');
-
- return $dbh->SUPER::STORE($attrib => $value)
- if $DBD::Gofer::xxh_local_store_attrib_if_same_value{$attrib}
- && do { # values are the same
- my $crnt = $dbh->FETCH($attrib);
- local $^W;
- (defined($value) ^ defined($crnt))
- ? 0 # definedness differs
- : $value eq $crnt;
- };
-
- # dbh attributes are set at connect-time - see connect()
- carp("Can't alter \$dbh->{$attrib} after handle created with DBD::Gofer") if $dbh->FETCH('Warn');
- return $dbh->set_err($DBI::stderr, "Can't alter \$dbh->{$attrib} after handle created with DBD::Gofer");
- }
-
- sub disconnect {
- my $dbh = shift;
- $dbh->{go_transport} = undef;
- $dbh->STORE(Active => 0);
- }
-
- sub prepare {
- my ($dbh, $statement, $attr)= @_;
-
- return $dbh->set_err($DBI::stderr, "Can't prepare when disconnected")
- unless $dbh->FETCH('Active');
-
- $attr = { %$attr } if $attr; # copy so we can edit
-
- my $policy = delete($attr->{go_policy}) || $dbh->{go_policy};
- my $lii_args = delete $attr->{go_last_insert_id_args};
- my $go_prepare = delete($attr->{go_prepare_method})
- || $dbh->{go_prepare_method}
- || $policy->prepare_method($dbh, $statement, $attr)
- || 'prepare'; # e.g. for code not using placeholders
- my $go_cache = delete $attr->{go_cache};
- # set to undef if there are no attributes left for the actual prepare call
- $attr = undef if $attr and not %$attr;
-
- my ($sth, $sth_inner) = DBI::_new_sth($dbh, {
- Statement => $statement,
- go_prepare_call => [ 0, $go_prepare, $statement, $attr ],
- # go_method_calls => [], # autovivs if needed
- go_request => $dbh->{go_request},
- go_transport => $dbh->{go_transport},
- go_policy => $policy,
- go_last_insert_id_args => $lii_args,
- go_cache => $go_cache,
- });
- $sth->STORE(Active => 0); # XXX needed? It should be the default
-
- my $skip_prepare_check = $policy->skip_prepare_check($attr, $dbh, $statement, $attr, $sth);
- if (not $skip_prepare_check) {
- $sth->go_sth_method() or return undef;
- }
-
- return $sth;
- }
-
- sub prepare_cached {
- my ($dbh, $sql, $attr, $if_active)= @_;
- $attr ||= {};
- return $dbh->SUPER::prepare_cached($sql, {
- %$attr,
- go_prepare_method => $attr->{go_prepare_method} || 'prepare_cached',
- }, $if_active);
- }
-
- *go_cache = \&DBD::Gofer::go_cache;
-}
-
-
-{ package DBD::Gofer::st; # ====== STATEMENT ======
- $imp_data_size = 0;
- use strict;
-
- my %sth_local_store_attrib = (%DBD::Gofer::xxh_local_store_attrib, NUM_OF_FIELDS => 1);
-
- sub go_sth_method {
- my ($sth, $meta) = @_;
-
- if (my $ParamValues = $sth->{ParamValues}) {
- my $ParamAttr = $sth->{ParamAttr};
- # XXX the sort here is a hack to work around a DBD::Sybase bug
- # but only works properly for params 1..9
- # (reverse because of the unshift)
- my @params = reverse sort keys %$ParamValues;
- if (@params > 9 && ($sth->{Database}{go_dsn}||'') =~ /dbi:Sybase/) {
- # if more than 9 then we need to do a proper numeric sort
- # also warn to alert user of this issue
- warn "Sybase param binding order hack in use";
- @params = sort { $b <=> $a } @params;
- }
- for my $p (@params) {
- # unshift to put binds before execute call
- unshift @{ $sth->{go_method_calls} },
- [ 'bind_param', $p, $ParamValues->{$p}, $ParamAttr->{$p} ];
- }
- }
-
- my $dbh = $sth->{Database} or die "panic";
- ++$dbh->{go_request_count};
-
- my $request = $sth->{go_request};
- $request->init_request($sth->{go_prepare_call}, $sth);
- $request->sth_method_calls(delete $sth->{go_method_calls})
- if $sth->{go_method_calls};
- $request->sth_result_attr({}); # (currently) also indicates this is an sth request
-
- $request->dbh_last_insert_id_args($meta->{go_last_insert_id_args})
- if $meta->{go_last_insert_id_args};
-
- my $go_policy = $sth->{go_policy};
- my $dbh_attribute_update = $go_policy->dbh_attribute_update();
- $request->dbh_attributes( $go_policy->dbh_attribute_list() )
- if $dbh_attribute_update eq 'every'
- or $dbh->{go_request_count}==1;
-
- my $transport = $sth->{go_transport}
- or return $sth->set_err($DBI::stderr, "Not connected (no transport)");
-
- local $transport->{go_cache} = $sth->{go_cache}
- if defined $sth->{go_cache};
-
- my ($response, $retransmit_sub) = $transport->transmit_request($request);
- $response ||= $transport->receive_response($request, $retransmit_sub);
- $sth->{go_response} = $response
- or die "No response object returned by $transport";
- $dbh->{go_response} = $response; # mainly for last_insert_id
-
- if (my $dbh_attributes = $response->dbh_attributes) {
- # XXX we don't STORE here, we just stuff the value into the attribute cache
- $dbh->{$_} = $dbh_attributes->{$_}
- for keys %$dbh_attributes;
- # record the values returned, so we know that we have fetched
- # values are which we have fetched (see dbh->FETCH method)
- $dbh->{go_dbh_attributes_fetched} = $dbh_attributes;
- }
-
- my $rv = $response->rv; # may be undef on error
- if ($response->sth_resultsets) {
- # setup first resultset - including sth attributes
- $sth->more_results;
- }
- else {
- $sth->STORE(Active => 0);
- $sth->{go_rows} = $rv;
- }
- # set error/warn/info (after more_results as that'll clear err)
- DBD::Gofer::set_err_from_response($sth, $response);
-
- return $rv;
- }
-
-
- sub bind_param {
- my ($sth, $param, $value, $attr) = @_;
- $sth->{ParamValues}{$param} = $value;
- $sth->{ParamAttr}{$param} = $attr
- if defined $attr; # attr is sticky if not explicitly set
- return 1;
- }
-
-
- sub execute {
- my $sth = shift;
- $sth->bind_param($_, $_[$_-1]) for (1..@_);
- push @{ $sth->{go_method_calls} }, [ 'execute' ];
- my $meta = { go_last_insert_id_args => $sth->{go_last_insert_id_args} };
- return $sth->go_sth_method($meta);
- }
-
-
- sub more_results {
- my $sth = shift;
-
- $sth->finish;
-
- my $response = $sth->{go_response} or do {
- # e.g., we haven't sent a request yet (ie prepare then more_results)
- $sth->trace_msg(" No response object present", 3);
- return;
- };
-
- my $resultset_list = $response->sth_resultsets
- or return $sth->set_err($DBI::stderr, "No sth_resultsets");
-
- my $meta = shift @$resultset_list
- or return undef; # no more result sets
- #warn "more_results: ".Data::Dumper::Dumper($meta);
-
- # pull out the special non-attributes first
- my ($rowset, $err, $errstr, $state)
- = delete @{$meta}{qw(rowset err errstr state)};
-
- # copy meta attributes into attribute cache
- my $NUM_OF_FIELDS = delete $meta->{NUM_OF_FIELDS};
- $sth->STORE('NUM_OF_FIELDS', $NUM_OF_FIELDS);
- # XXX need to use STORE for some?
- $sth->{$_} = $meta->{$_} for keys %$meta;
-
- if (($NUM_OF_FIELDS||0) > 0) {
- $sth->{go_rows} = ($rowset) ? @$rowset : -1;
- $sth->{go_current_rowset} = $rowset;
- $sth->{go_current_rowset_err} = [ $err, $errstr, $state ]
- if defined $err;
- $sth->STORE(Active => 1) if $rowset;
- }
-
- return $sth;
- }
-
-
- sub go_clone_sth {
- my ($sth1) = @_;
- # clone an (un-fetched-from) sth - effectively undoes the initial more_results
- # not 100% so just for use in caching returned sth e.g. table_info
- my $sth2 = $sth1->{Database}->prepare($sth1->{Statement}, { go_skip_prepare_check => 1 });
- $sth2->STORE($_, $sth1->{$_}) for qw(NUM_OF_FIELDS Active);
- my $sth2_inner = tied %$sth2;
- $sth2_inner->{$_} = $sth1->{$_} for qw(NUM_OF_PARAMS FetchHashKeyName);
- die "not fully implemented yet";
- return $sth2;
- }
-
-
- sub fetchrow_arrayref {
- my ($sth) = @_;
- my $resultset = $sth->{go_current_rowset} || do {
- # should only happen if fetch called after execute failed
- my $rowset_err = $sth->{go_current_rowset_err}
- || [ 1, 'no result set (did execute fail)' ];
- return $sth->set_err( @$rowset_err );
- };
- return $sth->_set_fbav(shift @$resultset) if @$resultset;
- $sth->finish; # no more data so finish
- return undef;
- }
- *fetch = \&fetchrow_arrayref; # alias
-
-
- sub fetchall_arrayref {
- my ($sth, $slice, $max_rows) = @_;
- my $resultset = $sth->{go_current_rowset} || do {
- # should only happen if fetch called after execute failed
- my $rowset_err = $sth->{go_current_rowset_err}
- || [ 1, 'no result set (did execute fail)' ];
- return $sth->set_err( @$rowset_err );
- };
- my $mode = ref($slice) || 'ARRAY';
- return $sth->SUPER::fetchall_arrayref($slice, $max_rows)
- if ref($slice) or defined $max_rows;
- $sth->finish; # no more data after this so finish
- return $resultset;
- }
-
-
- sub rows {
- return shift->{go_rows};
- }
-
-
- sub STORE {
- my ($sth, $attrib, $value) = @_;
-
- return $sth->SUPER::STORE($attrib => $value)
- if $sth_local_store_attrib{$attrib} # handle locally
- # or it's a private_ (application) attribute
- or $attrib =~ /^private_/;
-
- # otherwise warn but do it anyway
- # this will probably need refining later
- my $msg = "Altering \$sth->{$attrib} won't affect proxied handle";
- Carp::carp($msg) if $sth->FETCH('Warn');
-
- # XXX could perhaps do
- # push @{ $sth->{go_method_calls} }, [ 'STORE', $attrib, $value ]
- # if not $sth->FETCH('Executed');
- # but how to handle repeat executions? How to we know when an
- # attribute is being set to affect the current resultset or the
- # next execution?
- # Could just always use go_method_calls I guess.
-
- # do the store locally anyway, just in case
- $sth->SUPER::STORE($attrib => $value);
-
- return $sth->set_err($DBI::stderr, $msg);
- }
-
- # sub bind_param_array
- # we use DBI's default, which sets $sth->{ParamArrays}{$param} = $value
- # and calls bind_param($param, undef, $attr) if $attr.
-
- sub execute_array {
- my $sth = shift;
- my $attr = shift;
- $sth->bind_param_array($_, $_[$_-1]) for (1..@_);
- push @{ $sth->{go_method_calls} }, [ 'execute_array', $attr ];
- return $sth->go_sth_method($attr);
- }
-
- *go_cache = \&DBD::Gofer::go_cache;
-}
-
-1;
-
-__END__
-
-=head1 NAME
-
-DBD::Gofer - A stateless-proxy driver for communicating with a remote DBI
-
-=head1 SYNOPSIS
-
- use DBI;
-
- $original_dsn = "dbi:..."; # your original DBI Data Source Name
-
- $dbh = DBI->connect("dbi:Gofer:transport=$transport;...;dsn=$original_dsn",
- $user, $passwd, \%attributes);
-
- ... use $dbh as if it was connected to $original_dsn ...
-
-
-The C<transport=$transport> part specifies the name of the module to use to
-transport the requests to the remote DBI. If $transport doesn't contain any
-double colons then it's prefixed with C<DBD::Gofer::Transport::>.
-
-The C<dsn=$original_dsn> part I<must be the last element> of the DSN because
-everything after C<dsn=> is assumed to be the DSN that the remote DBI should
-use.
-
-The C<...> represents attributes that influence the operation of the Gofer
-driver or transport. These are described below or in the documentation of the
-transport module being used.
-
-=encoding ISO8859-1
-
-=head1 DESCRIPTION
-
-DBD::Gofer is a DBI database driver that forwards requests to another DBI
-driver, usually in a separate process, often on a separate machine. It tries to
-be as transparent as possible so it appears that you are using the remote
-driver directly.
-
-DBD::Gofer is very similar to DBD::Proxy. The major difference is that with
-DBD::Gofer no state is maintained on the remote end. That means every
-request contains all the information needed to create the required state. (So,
-for example, every request includes the DSN to connect to.) Each request can be
-sent to any available server. The server executes the request and returns a
-single response that includes all the data.
-
-This is very similar to the way http works as a stateless protocol for the web.
-Each request from your web browser can be handled by a different web server process.
-
-=head2 Use Cases
-
-This may seem like pointless overhead but there are situations where this is a
-very good thing. Let's consider a specific case.
-
-Imagine using DBD::Gofer with an http transport. Your application calls
-connect(), prepare("select * from table where foo=?"), bind_param(), and execute().
-At this point DBD::Gofer builds a request containing all the information
-about the method calls. It then uses the httpd transport to send that request
-to an apache web server.
-
-This 'dbi execute' web server executes the request (using DBI::Gofer::Execute
-and related modules) and builds a response that contains all the rows of data,
-if the statement returned any, along with all the attributes that describe the
-results, such as $sth->{NAME}. This response is sent back to DBD::Gofer which
-unpacks it and presents it to the application as if it had executed the
-statement itself.
-
-=head2 Advantages
-
-Okay, but you still don't see the point? Well let's consider what we've gained:
-
-=head3 Connection Pooling and Throttling
-
-The 'dbi execute' web server leverages all the functionality of web
-infrastructure in terms of load balancing, high-availability, firewalls, access
-management, proxying, caching.
-
-At its most basic level you get a configurable pool of persistent database connections.
-
-=head3 Simple Scaling
-
-Got thousands of processes all trying to connect to the database? You can use
-DBD::Gofer to connect them to your smaller pool of 'dbi execute' web servers instead.
-
-=head3 Caching
-
-Client-side caching is as simple as adding "C<cache=1>" to the DSN.
-This feature alone can be worth using DBD::Gofer for.
-
-=head3 Fewer Network Round-trips
-
-DBD::Gofer sends as few requests as possible (dependent on the policy being used).
-
-=head3 Thin Clients / Unsupported Platforms
-
-You no longer need drivers for your database on every system. DBD::Gofer is pure perl.
-
-=head1 CONSTRAINTS
-
-There are some natural constraints imposed by the DBD::Gofer 'stateless' approach.
-But not many:
-
-=head2 You can't change database handle attributes after connect()
-
-You can't change database handle attributes after you've connected.
-Use the connect() call to specify all the attribute settings you want.
-
-This is because it's critical that when a request is complete the database
-handle is left in the same state it was when first connected.
-
-An exception is made for attributes with names starting "C<private_>":
-They can be set after connect() but the change is only applied locally.
-
-=head2 You can't change statement handle attributes after prepare()
-
-You can't change statement handle attributes after prepare.
-
-An exception is made for attributes with names starting "C<private_>":
-They can be set after prepare() but the change is only applied locally.
-
-=head2 You can't use transactions
-
-AutoCommit only. Transactions aren't supported.
-
-(In theory transactions could be supported when using a transport that
-maintains a connection, like C<stream> does. If you're interested in this
-please get in touch via dbi-dev@perl.org)
-
-=head2 You can't call driver-private sth methods
-
-But that's rarely needed anyway.
-
-=head1 GENERAL CAVEATS
-
-A few important things to keep in mind when using DBD::Gofer:
-
-=head2 Temporary tables, locks, and other per-connection persistent state
-
-You shouldn't expect any per-session state to persist between requests.
-This includes locks and temporary tables.
-
-Because the server-side may execute your requests via a different
-database connections, you can't rely on any per-connection persistent state,
-such as temporary tables, being available from one request to the next.
-
-This is an easy trap to fall into. A good way to check for this is to test your
-code with a Gofer policy package that sets the C<connect_method> policy to
-'connect' to force a new connection for each request. The C<pedantic> policy does this.
-
-=head2 Driver-private Database Handle Attributes
-
-Some driver-private dbh attributes may not be available if the driver has not
-implemented the private_attribute_info() method (added in DBI 1.54).
-
-=head2 Driver-private Statement Handle Attributes
-
-Driver-private sth attributes can be set in the prepare() call. TODO
-
-Some driver-private sth attributes may not be available if the driver has not
-implemented the private_attribute_info() method (added in DBI 1.54).
-
-=head2 Multiple Resultsets
-
-Multiple resultsets are supported only if the driver supports the more_results() method
-(an exception is made for DBD::Sybase).
-
-=head2 Statement activity that also updates dbh attributes
-
-Some drivers may update one or more dbh attributes after performing activity on
-a child sth. For example, DBD::mysql provides $dbh->{mysql_insertid} in addition to
-$sth->{mysql_insertid}. Currently mysql_insertid is supported via a hack but a
-more general mechanism is needed for other drivers to use.
-
-=head2 Methods that report an error always return undef
-
-With DBD::Gofer, a method that sets an error always return an undef or empty list.
-That shouldn't be a problem in practice because the DBI doesn't define any
-methods that return meaningful values while also reporting an error.
-
-=head2 Subclassing only applies to client-side
-
-The RootClass and DbTypeSubclass attributes are not passed to the Gofer server.
-
-=head1 CAVEATS FOR SPECIFIC METHODS
-
-=head2 last_insert_id
-
-To enable use of last_insert_id you need to indicate to DBD::Gofer that you'd
-like to use it. You do that my adding a C<go_last_insert_id_args> attribute to
-the do() or prepare() method calls. For example:
-
- $dbh->do($sql, { go_last_insert_id_args => [...] });
-
-or
-
- $sth = $dbh->prepare($sql, { go_last_insert_id_args => [...] });
-
-The array reference should contains the args that you want passed to the
-last_insert_id() method.
-
-=head2 execute_for_fetch
-
-The array methods bind_param_array() and execute_array() are supported.
-When execute_array() is called the data is serialized and executed in a single
-round-trip to the Gofer server. This makes it very fast, but requires enough
-memory to store all the serialized data.
-
-The execute_for_fetch() method currently isn't optimised, it uses the DBI
-fallback behaviour of executing each tuple individually.
-(It could be implemented as a wrapper for execute_array() - patches welcome.)
-
-=head1 TRANSPORTS
-
-DBD::Gofer doesn't concern itself with transporting requests and responses to and fro.
-For that it uses special Gofer transport modules.
-
-Gofer transport modules usually come in pairs: one for the 'client' DBD::Gofer
-driver to use and one for the remote 'server' end. They have very similar names:
-
- DBD::Gofer::Transport::<foo>
- DBI::Gofer::Transport::<foo>
-
-Sometimes the transports on the DBD and DBI sides may have different names. For
-example DBD::Gofer::Transport::http is typically used with DBI::Gofer::Transport::mod_perl
-(DBD::Gofer::Transport::http and DBI::Gofer::Transport::mod_perl modules are
-part of the GoferTransport-http distribution).
-
-=head2 Bundled Transports
-
-Several transport modules are provided with DBD::Gofer:
-
-=head3 null
-
-The null transport is the simplest of them all. It doesn't actually transport the request anywhere.
-It just serializes (freezes) the request into a string, then thaws it back into
-a data structure before passing it to DBI::Gofer::Execute to execute. The same
-freeze and thaw is applied to the results.
-
-The null transport is the best way to test if your application will work with Gofer.
-Just set the DBI_AUTOPROXY environment variable to "C<dbi:Gofer:transport=null;policy=pedantic>"
-(see L</Using DBI_AUTOPROXY> below) and run your application, or ideally its test suite, as usual.
-
-It doesn't take any parameters.
-
-=head3 pipeone
-
-The pipeone transport launches a subprocess for each request. It passes in the
-request and reads the response.
-
-The fact that a new subprocess is started for each request ensures that the
-server side is truly stateless. While this does make the transport I<very> slow,
-it is useful as a way to test that your application doesn't depend on
-per-connection state, such as temporary tables, persisting between requests.
-
-It's also useful both as a proof of concept and as a base class for the stream
-driver.
-
-=head3 stream
-
-The stream driver also launches a subprocess and writes requests and reads
-responses, like the pipeone transport. In this case, however, the subprocess
-is expected to handle more that one request. (Though it will be automatically
-restarted if it exits.)
-
-This is the first transport that is truly useful because it can launch the
-subprocess on a remote machine using C<ssh>. This means you can now use DBD::Gofer
-to easily access any databases that's accessible from any system you can login to.
-You also get all the benefits of ssh, including encryption and optional compression.
-
-See L</Using DBI_AUTOPROXY> below for an example.
-
-=head2 Other Transports
-
-Implementing a Gofer transport is I<very> simple, and more transports are very welcome.
-Just take a look at any existing transports that are similar to your needs.
-
-=head3 http
-
-See the GoferTransport-http distribution on CPAN: http://search.cpan.org/dist/GoferTransport-http/
-
-=head3 Gearman
-
-I know Ask Bjørn Hansen has implemented a transport for the C<gearman> distributed
-job system, though it's not on CPAN at the time of writing this.
-
-=head1 CONNECTING
-
-Simply prefix your existing DSN with "C<dbi:Gofer:transport=$transport;dsn=>"
-where $transport is the name of the Gofer transport you want to use (see L</TRANSPORTS>).
-The C<transport> and C<dsn> attributes must be specified and the C<dsn> attributes must be last.
-
-Other attributes can be specified in the DSN to configure DBD::Gofer and/or the
-Gofer transport module being used. The main attributes after C<transport>, are
-C<url> and C<policy>. These and other attributes are described below.
-
-=head2 Using DBI_AUTOPROXY
-
-The simplest way to try out DBD::Gofer is to set the DBI_AUTOPROXY environment variable.
-In this case you don't include the C<dsn=> part. For example:
-
- export DBI_AUTOPROXY="dbi:Gofer:transport=null"
-
-or, for a more useful example, try:
-
- export DBI_AUTOPROXY="dbi:Gofer:transport=stream;url=ssh:user@example.com"
-
-=head2 Connection Attributes
-
-These attributes can be specified in the DSN. They can also be passed in the
-\%attr parameter of the DBI connect method by adding a "C<go_>" prefix to the name.
-
-=head3 transport
-
-Specifies the Gofer transport class to use. Required. See L</TRANSPORTS> above.
-
-If the value does not include C<::> then "C<DBD::Gofer::Transport::>" is prefixed.
-
-The transport object can be accessed via $h->{go_transport}.
-
-=head3 dsn
-
-Specifies the DSN for the remote side to connect to. Required, and must be last.
-
-=head3 url
-
-Used to tell the transport where to connect to. The exact form of the value depends on the transport used.
-
-=head3 policy
-
-Specifies the policy to use. See L</CONFIGURING BEHAVIOUR POLICY>.
-
-If the value does not include C<::> then "C<DBD::Gofer::Policy>" is prefixed.
-
-The policy object can be accessed via $h->{go_policy}.
-
-=head3 timeout
-
-Specifies a timeout, in seconds, to use when waiting for responses from the server side.
-
-=head3 retry_limit
-
-Specifies the number of times a failed request will be retried. Default is 0.
-
-=head3 retry_hook
-
-Specifies a code reference to be called to decide if a failed request should be retried.
-The code reference is called like this:
-
- $transport = $h->{go_transport};
- $retry = $transport->go_retry_hook->($request, $response, $transport);
-
-If it returns true then the request will be retried, up to the C<retry_limit>.
-If it returns a false but defined value then the request will not be retried.
-If it returns undef then the default behaviour will be used, as if C<retry_hook>
-had not been specified.
-
-The default behaviour is to retry requests where $request->is_idempotent is true,
-or the error message matches C</induced by DBI_GOFER_RANDOM/>.
-
-=head3 cache
-
-Specifies that client-side caching should be performed. The value is the name
-of a cache class to use.
-
-Any class implementing get($key) and set($key, $value) methods can be used.
-That includes a great many powerful caching classes on CPAN, including the
-Cache and Cache::Cache distributions.
-
-You can use "C<cache=1>" is a shortcut for "C<cache=DBI::Util::CacheMemory>".
-See L<DBI::Util::CacheMemory> for a description of this simple fast default cache.
-
-The cache object can be accessed via $h->go_cache. For example:
-
- $dbh->go_cache->clear; # free up memory being used by the cache
-
-The cache keys are the frozen (serialized) requests, and the values are the
-frozen responses.
-
-The default behaviour is to only use the cache for requests where
-$request->is_idempotent is true (i.e., the dbh has the ReadOnly attribute set
-or the SQL statement is obviously a SELECT without a FOR UPDATE clause.)
-
-For even more control you can use the C<go_cache> attribute to pass in an
-instantiated cache object. Individual methods, including prepare(), can also
-specify alternative caches via the C<go_cache> attribute. For example, to
-specify no caching for a particular query, you could use
-
- $sth = $dbh->prepare( $sql, { go_cache => 0 } );
-
-This can be used to implement different caching policies for different statements.
-
-It's interesting to note that DBD::Gofer can be used to add client-side caching
-to any (gofer compatible) application, with no code changes and no need for a
-gofer server. Just set the DBI_AUTOPROXY environment variable like this:
-
- DBI_AUTOPROXY='dbi:Gofer:transport=null;cache=1'
-
-=head1 CONFIGURING BEHAVIOUR POLICY
-
-DBD::Gofer supports a 'policy' mechanism that allows you to fine-tune the number of round-trips to the Gofer server.
-The policies are grouped into classes (which may be subclassed) and referenced by the name of the class.
-
-The L<DBD::Gofer::Policy::Base> class is the base class for all the policy
-packages and describes all the available policies.
-
-Three policy packages are supplied with DBD::Gofer:
-
-L<DBD::Gofer::Policy::pedantic> is most 'transparent' but slowest because it
-makes more round-trips to the Gofer server.
-
-L<DBD::Gofer::Policy::classic> is a reasonable compromise - it's the default policy.
-
-L<DBD::Gofer::Policy::rush> is fastest, but may require code changes in your applications.
-
-Generally the default C<classic> policy is fine. When first testing an existing
-application with Gofer it is a good idea to start with the C<pedantic> policy
-first and then switch to C<classic> or a custom policy, for final testing.
-
-
-=head1 AUTHOR
-
-Tim Bunce, L<http://www.tim.bunce.name>
-
-=head1 LICENCE AND COPYRIGHT
-
-Copyright (c) 2007, Tim Bunce, Ireland. All rights reserved.
-
-This module is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself. See L<perlartistic>.
-
-=head1 ACKNOWLEDGEMENTS
-
-The development of DBD::Gofer and related modules was sponsored by
-Shopzilla.com (L<http://Shopzilla.com>), where I currently work.
-
-=head1 SEE ALSO
-
-L<DBI::Gofer::Request>, L<DBI::Gofer::Response>, L<DBI::Gofer::Execute>.
-
-L<DBI::Gofer::Transport::Base>, L<DBD::Gofer::Policy::Base>.
-
-L<DBI>
-
-=head1 Caveats for specific drivers
-
-This section aims to record issues to be aware of when using Gofer with specific drivers.
-It usually only documents issues that are not natural consequences of the limitations
-of the Gofer approach - as documented above.
-
-=head1 TODO
-
-This is just a random brain dump... (There's more in the source of the Changes file, not the pod)
-
-Document policy mechanism
-
-Add mechanism for transports to list config params and for Gofer to apply any that match (and warn if any left over?)
-
-Driver-private sth attributes - set via prepare() - change DBI spec
-
-add hooks into transport base class for checking & updating a result set cache
- ie via a standard cache interface such as:
- http://search.cpan.org/~robm/Cache-FastMmap/FastMmap.pm
- http://search.cpan.org/~bradfitz/Cache-Memcached/lib/Cache/Memcached.pm
- http://search.cpan.org/~dclinton/Cache-Cache/
- http://search.cpan.org/~cleishman/Cache/
-Also caching instructions could be passed through the httpd transport layer
-in such a way that appropriate http cache headers are added to the results
-so that web caches (squid etc) could be used to implement the caching.
-(MUST require the use of GET rather than POST requests.)
-
-Rework handling of installed_methods to not piggyback on dbh_attributes?
-
-Perhaps support transactions for transports where it's possible (ie null and stream)?
-Would make stream transport (ie ssh) more useful to more people.
-
-Make sth_result_attr more like dbh_attributes (using '*' etc)
-
-Add @val = FETCH_many(@names) to DBI in C and use in Gofer/Execute?
-
-Implement _new_sth in C.
-
-=cut
+++ /dev/null
-package DBD::Gofer::Policy::Base;
-
-# $Id: Base.pm 10087 2007-10-16 12:42:37Z Tim $
-#
-# Copyright (c) 2007, Tim Bunce, Ireland
-#
-# You may distribute under the terms of either the GNU General Public
-# License or the Artistic License, as specified in the Perl README file.
-
-use strict;
-use warnings;
-use Carp;
-
-our $VERSION = "0.010088";
-our $AUTOLOAD;
-
-my %policy_defaults = (
- # force connect method (unless overridden by go_connect_method=>'...' attribute)
- # if false: call same method on client as on server
- connect_method => 'connect',
- # force prepare method (unless overridden by go_prepare_method=>'...' attribute)
- # if false: call same method on client as on server
- prepare_method => 'prepare',
- skip_connect_check => 0,
- skip_default_methods => 0,
- skip_prepare_check => 0,
- skip_ping => 0,
- dbh_attribute_update => 'every',
- dbh_attribute_list => ['*'],
- locally_quote => 0,
- locally_quote_identifier => 0,
- cache_parse_trace_flags => 1,
- cache_parse_trace_flag => 1,
- cache_data_sources => 1,
- cache_type_info_all => 1,
- cache_tables => 0,
- cache_table_info => 0,
- cache_column_info => 0,
- cache_primary_key_info => 0,
- cache_foreign_key_info => 0,
- cache_statistics_info => 0,
- cache_get_info => 0,
- cache_func => 0,
-);
-
-my $base_policy_file = $INC{"DBD/Gofer/Policy/Base.pm"};
-
-__PACKAGE__->create_policy_subs(\%policy_defaults);
-
-sub create_policy_subs {
- my ($class, $policy_defaults) = @_;
-
- while ( my ($policy_name, $policy_default) = each %$policy_defaults) {
- my $policy_attr_name = "go_$policy_name";
- my $sub = sub {
- # $policy->foo($attr, ...)
- #carp "$policy_name($_[1],...)";
- # return the policy default value unless an attribute overrides it
- return (ref $_[1] && exists $_[1]->{$policy_attr_name})
- ? $_[1]->{$policy_attr_name}
- : $policy_default;
- };
- no strict 'refs';
- *{$class . '::' . $policy_name} = $sub;
- }
-}
-
-sub AUTOLOAD {
- carp "Unknown policy name $AUTOLOAD used";
- # only warn once
- no strict 'refs';
- *$AUTOLOAD = sub { undef };
- return undef;
-}
-
-sub new {
- my ($class, $args) = @_;
- my $policy = {};
- bless $policy, $class;
-}
-
-sub DESTROY { };
-
-1;
-
-=head1 NAME
-
-DBD::Gofer::Policy::Base - Base class for DBD::Gofer policies
-
-=head1 SYNOPSIS
-
- $dbh = DBI->connect("dbi:Gofer:transport=...;policy=...", ...)
-
-=head1 DESCRIPTION
-
-DBD::Gofer can be configured via a 'policy' mechanism that allows you to
-fine-tune the number of round-trips to the Gofer server. The policies are
-grouped into classes (which may be subclassed) and referenced by the name of
-the class.
-
-The L<DBD::Gofer::Policy::Base> class is the base class for all the policy
-classes and describes all the individual policy items.
-
-The Base policy is not used directly. You should use a policy class derived from it.
-
-=head1 POLICY CLASSES
-
-Three policy classes are supplied with DBD::Gofer:
-
-L<DBD::Gofer::Policy::pedantic> is most 'transparent' but slowest because it
-makes more round-trips to the Gofer server.
-
-L<DBD::Gofer::Policy::classic> is a reasonable compromise - it's the default policy.
-
-L<DBD::Gofer::Policy::rush> is fastest, but may require code changes in your applications.
-
-Generally the default C<classic> policy is fine. When first testing an existing
-application with Gofer it is a good idea to start with the C<pedantic> policy
-first and then switch to C<classic> or a custom policy, for final testing.
-
-=head1 POLICY ITEMS
-
-These are temporary docs: See the source code for list of policies and their defaults.
-
-In a future version the policies and their defaults will be defined in the pod and parsed out at load-time.
-
-See the source code to this module for more details.
-
-=head1 POLICY CUSTOMIZATION
-
-XXX This area of DBD::Gofer is subject to change.
-
-There are three ways to customize policies:
-
-Policy classes are designed to influence the overall behaviour of DBD::Gofer
-with existing, unaltered programs, so they work in a reasonably optimal way
-without requiring code changes. You can implement new policy classes as
-subclasses of existing policies.
-
-In many cases individual policy items can be overridden on a case-by-case basis
-within your application code. You do this by passing a corresponding
-C<<go_<policy_name>>> attribute into DBI methods by your application code.
-This let's you fine-tune the behaviour for special cases.
-
-The policy items are implemented as methods. In many cases the methods are
-passed parameters relating to the DBD::Gofer code being executed. This means
-the policy can implement dynamic behaviour that varies depending on the
-particular circumstances, such as the particular statement being executed.
-
-=head1 AUTHOR
-
-Tim Bunce, L<http://www.tim.bunce.name>
-
-=head1 LICENCE AND COPYRIGHT
-
-Copyright (c) 2007, Tim Bunce, Ireland. All rights reserved.
-
-This module is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself. See L<perlartistic>.
-
-=cut
-
+++ /dev/null
-package DBD::Gofer::Policy::classic;
-
-# $Id: classic.pm 10087 2007-10-16 12:42:37Z Tim $
-#
-# Copyright (c) 2007, Tim Bunce, Ireland
-#
-# You may distribute under the terms of either the GNU General Public
-# License or the Artistic License, as specified in the Perl README file.
-
-use strict;
-use warnings;
-
-our $VERSION = "0.010088";
-
-use base qw(DBD::Gofer::Policy::Base);
-
-__PACKAGE__->create_policy_subs({
-
- # always use connect_cached on server
- connect_method => 'connect_cached',
-
- # use same methods on server as is called on client
- prepare_method => '',
-
- # don't skip the connect check since that also sets dbh attributes
- # although this makes connect more expensive, that's partly offset
- # by skip_ping=>1 below, which makes connect_cached very fast.
- skip_connect_check => 0,
-
- # most code doesn't rely on sth attributes being set after prepare
- skip_prepare_check => 1,
-
- # we're happy to use local method if that's the same as the remote
- skip_default_methods => 1,
-
- # ping is not important for DBD::Gofer and most transports
- skip_ping => 1,
-
- # only update dbh attributes on first contact with server
- dbh_attribute_update => 'first',
-
- # we'd like to set locally_* but can't because drivers differ
-
- # get_info results usually don't change
- cache_get_info => 1,
-});
-
-
-1;
-
-=head1 NAME
-
-DBD::Gofer::Policy::classic - The 'classic' policy for DBD::Gofer
-
-=head1 SYNOPSIS
-
- $dbh = DBI->connect("dbi:Gofer:transport=...;policy=classic", ...)
-
-The C<classic> policy is the default DBD::Gofer policy, so need not be included in the DSN.
-
-=head1 DESCRIPTION
-
-Temporary docs: See the source code for list of policies and their defaults.
-
-In a future version the policies and their defaults will be defined in the pod and parsed out at load-time.
-
-=head1 AUTHOR
-
-Tim Bunce, L<http://www.tim.bunce.name>
-
-=head1 LICENCE AND COPYRIGHT
-
-Copyright (c) 2007, Tim Bunce, Ireland. All rights reserved.
-
-This module is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself. See L<perlartistic>.
-
-=cut
-
+++ /dev/null
-package DBD::Gofer::Policy::pedantic;
-
-# $Id: pedantic.pm 10087 2007-10-16 12:42:37Z Tim $
-#
-# Copyright (c) 2007, Tim Bunce, Ireland
-#
-# You may distribute under the terms of either the GNU General Public
-# License or the Artistic License, as specified in the Perl README file.
-
-use strict;
-use warnings;
-
-our $VERSION = "0.010088";
-
-use base qw(DBD::Gofer::Policy::Base);
-
-# the 'pedantic' policy is the same as the Base policy
-
-1;
-
-=head1 NAME
-
-DBD::Gofer::Policy::pedantic - The 'pedantic' policy for DBD::Gofer
-
-=head1 SYNOPSIS
-
- $dbh = DBI->connect("dbi:Gofer:transport=...;policy=pedantic", ...)
-
-=head1 DESCRIPTION
-
-The C<pedantic> policy tries to be as transparent as possible. To do this it
-makes round-trips to the server for almost every DBI method call.
-
-This is the best policy to use when first testing existing code with Gofer.
-Once it's working well you should consider moving to the C<classic> policy or defining your own policy class.
-
-Temporary docs: See the source code for list of policies and their defaults.
-
-In a future version the policies and their defaults will be defined in the pod and parsed out at load-time.
-
-=head1 AUTHOR
-
-Tim Bunce, L<http://www.tim.bunce.name>
-
-=head1 LICENCE AND COPYRIGHT
-
-Copyright (c) 2007, Tim Bunce, Ireland. All rights reserved.
-
-This module is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself. See L<perlartistic>.
-
-=cut
-
+++ /dev/null
-package DBD::Gofer::Policy::rush;
-
-# $Id: rush.pm 10087 2007-10-16 12:42:37Z Tim $
-#
-# Copyright (c) 2007, Tim Bunce, Ireland
-#
-# You may distribute under the terms of either the GNU General Public
-# License or the Artistic License, as specified in the Perl README file.
-
-use strict;
-use warnings;
-
-our $VERSION = "0.010088";
-
-use base qw(DBD::Gofer::Policy::Base);
-
-__PACKAGE__->create_policy_subs({
-
- # always use connect_cached on server
- connect_method => 'connect_cached',
-
- # use same methods on server as is called on client
- # (because code not using placeholders would bloat the sth cache)
- prepare_method => '',
-
- # Skipping the connect check is fast, but it also skips
- # fetching the remote dbh attributes!
- # Make sure that your application doesn't need access to dbh attributes.
- skip_connect_check => 1,
-
- # most code doesn't rely on sth attributes being set after prepare
- skip_prepare_check => 1,
-
- # we're happy to use local method if that's the same as the remote
- skip_default_methods => 1,
-
- # ping is almost meaningless for DBD::Gofer and most transports anyway
- skip_ping => 1,
-
- # don't update dbh attributes at all
- # XXX actually we currently need dbh_attribute_update for skip_default_methods to work
- # and skip_default_methods is more valuable to us than the cost of dbh_attribute_update
- dbh_attribute_update => 'none', # actually means 'first' currently
- #dbh_attribute_list => undef,
-
- # we'd like to set locally_* but can't because drivers differ
-
- # in a rush assume metadata doesn't change
- cache_tables => 1,
- cache_table_info => 1,
- cache_column_info => 1,
- cache_primary_key_info => 1,
- cache_foreign_key_info => 1,
- cache_statistics_info => 1,
- cache_get_info => 1,
-});
-
-
-1;
-
-=head1 NAME
-
-DBD::Gofer::Policy::rush - The 'rush' policy for DBD::Gofer
-
-=head1 SYNOPSIS
-
- $dbh = DBI->connect("dbi:Gofer:transport=...;policy=rush", ...)
-
-=head1 DESCRIPTION
-
-The C<rush> policy tries to make as few round-trips as possible.
-It's the opposite end of the policy spectrum to the C<pedantic> policy.
-
-Temporary docs: See the source code for list of policies and their defaults.
-
-In a future version the policies and their defaults will be defined in the pod and parsed out at load-time.
-
-=head1 AUTHOR
-
-Tim Bunce, L<http://www.tim.bunce.name>
-
-=head1 LICENCE AND COPYRIGHT
-
-Copyright (c) 2007, Tim Bunce, Ireland. All rights reserved.
-
-This module is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself. See L<perlartistic>.
-
-=cut
-
+++ /dev/null
-package DBD::Gofer::Transport::Base;
-
-# $Id: Base.pm 14120 2010-06-07 19:52:19Z H.Merijn $
-#
-# Copyright (c) 2007, Tim Bunce, Ireland
-#
-# You may distribute under the terms of either the GNU General Public
-# License or the Artistic License, as specified in the Perl README file.
-
-use strict;
-use warnings;
-
-use base qw(DBI::Gofer::Transport::Base);
-
-our $VERSION = "0.014121";
-
-__PACKAGE__->mk_accessors(qw(
- trace
- go_dsn
- go_url
- go_policy
- go_timeout
- go_retry_hook
- go_retry_limit
- go_cache
- cache_hit
- cache_miss
- cache_store
-));
-__PACKAGE__->mk_accessors_using(make_accessor_autoviv_hashref => qw(
- meta
-));
-
-
-sub new {
- my ($class, $args) = @_;
- $args->{$_} = 0 for (qw(cache_hit cache_miss cache_store));
- $args->{keep_meta_frozen} ||= 1 if $args->{go_cache};
- #warn "args @{[ %$args ]}\n";
- return $class->SUPER::new($args);
-}
-
-
-sub _init_trace { $ENV{DBD_GOFER_TRACE} || 0 }
-
-
-sub new_response {
- my $self = shift;
- return DBI::Gofer::Response->new(@_);
-}
-
-
-sub transmit_request {
- my ($self, $request) = @_;
- my $trace = $self->trace;
- my $response;
-
- my ($go_cache, $request_cache_key);
- if ($go_cache = $self->{go_cache}) {
- $request_cache_key
- = $request->{meta}{request_cache_key}
- = $self->get_cache_key_for_request($request);
- if ($request_cache_key) {
- my $frozen_response = eval { $go_cache->get($request_cache_key) };
- if ($frozen_response) {
- $self->_dump("cached response found for ".ref($request), $request)
- if $trace;
- $response = $self->thaw_response($frozen_response);
- $self->trace_msg("transmit_request is returning a response from cache $go_cache\n")
- if $trace;
- ++$self->{cache_hit};
- return $response;
- }
- warn $@ if $@;
- ++$self->{cache_miss};
- $self->trace_msg("transmit_request cache miss\n")
- if $trace;
- }
- }
-
- my $to = $self->go_timeout;
- my $transmit_sub = sub {
- $self->trace_msg("transmit_request\n") if $trace;
- local $SIG{ALRM} = sub { die "TIMEOUT\n" } if $to;
-
- my $response = eval {
- local $SIG{PIPE} = sub {
- my $extra = ($! eq "Broken pipe") ? "" : " ($!)";
- die "Unable to send request: Broken pipe$extra\n";
- };
- alarm($to) if $to;
- $self->transmit_request_by_transport($request);
- };
- alarm(0) if $to;
-
- if ($@) {
- return $self->transport_timedout("transmit_request", $to)
- if $@ eq "TIMEOUT\n";
- return $self->new_response({ err => 1, errstr => $@ });
- }
-
- return $response;
- };
-
- $response = $self->_transmit_request_with_retries($request, $transmit_sub);
-
- if ($response) {
- my $frozen_response = delete $response->{meta}{frozen};
- $self->_store_response_in_cache($frozen_response, $request_cache_key)
- if $request_cache_key;
- }
-
- $self->trace_msg("transmit_request is returning a response itself\n")
- if $trace && $response;
-
- return $response unless wantarray;
- return ($response, $transmit_sub);
-}
-
-
-sub _transmit_request_with_retries {
- my ($self, $request, $transmit_sub) = @_;
- my $response;
- do {
- $response = $transmit_sub->();
- } while ( $response && $self->response_needs_retransmit($request, $response) );
- return $response;
-}
-
-
-sub receive_response {
- my ($self, $request, $retransmit_sub) = @_;
- my $to = $self->go_timeout;
-
- my $receive_sub = sub {
- $self->trace_msg("receive_response\n");
- local $SIG{ALRM} = sub { die "TIMEOUT\n" } if $to;
-
- my $response = eval {
- alarm($to) if $to;
- $self->receive_response_by_transport($request);
- };
- alarm(0) if $to;
-
- if ($@) {
- return $self->transport_timedout("receive_response", $to)
- if $@ eq "TIMEOUT\n";
- return $self->new_response({ err => 1, errstr => $@ });
- }
- return $response;
- };
-
- my $response;
- do {
- $response = $receive_sub->();
- if ($self->response_needs_retransmit($request, $response)) {
- $response = $self->_transmit_request_with_retries($request, $retransmit_sub);
- $response ||= $receive_sub->();
- }
- } while ( $self->response_needs_retransmit($request, $response) );
-
- if ($response) {
- my $frozen_response = delete $response->{meta}{frozen};
- my $request_cache_key = $request->{meta}{request_cache_key};
- $self->_store_response_in_cache($frozen_response, $request_cache_key)
- if $request_cache_key && $self->{go_cache};
- }
-
- return $response;
-}
-
-
-sub response_retry_preference {
- my ($self, $request, $response) = @_;
-
- # give the user a chance to express a preference (or undef for default)
- if (my $go_retry_hook = $self->go_retry_hook) {
- my $retry = $go_retry_hook->($request, $response, $self);
- $self->trace_msg(sprintf "go_retry_hook returned %s\n",
- (defined $retry) ? $retry : 'undef');
- return $retry if defined $retry;
- }
-
- # This is the main decision point. We don't retry requests that got
- # as far as executing because the error is probably from the database
- # (not transport) so retrying is unlikely to help. But note that any
- # severe transport error occurring after execute is likely to return
- # a new response object that doesn't have the execute flag set. Beware!
- return 0 if $response->executed_flag_set;
-
- return 1 if ($response->errstr || '') =~ m/induced by DBI_GOFER_RANDOM/;
-
- return 1 if $request->is_idempotent; # i.e. is SELECT or ReadOnly was set
-
- return undef; # we couldn't make up our mind
-}
-
-
-sub response_needs_retransmit {
- my ($self, $request, $response) = @_;
-
- my $err = $response->err
- or return 0; # nothing went wrong
-
- my $retry = $self->response_retry_preference($request, $response);
-
- if (!$retry) { # false or undef
- $self->trace_msg("response_needs_retransmit: response not suitable for retry\n");
- return 0;
- }
-
- # we'd like to retry but have we retried too much already?
-
- my $retry_limit = $self->go_retry_limit;
- if (!$retry_limit) {
- $self->trace_msg("response_needs_retransmit: retries disabled (retry_limit not set)\n");
- return 0;
- }
-
- my $request_meta = $request->meta;
- my $retry_count = $request_meta->{retry_count} || 0;
- if ($retry_count >= $retry_limit) {
- $self->trace_msg("response_needs_retransmit: $retry_count is too many retries\n");
- # XXX should be possible to disable altering the err
- $response->errstr(sprintf "%s (after %d retries by gofer)", $response->errstr, $retry_count);
- return 0;
- }
-
- # will retry now, do the admin
- ++$retry_count;
- $self->trace_msg("response_needs_retransmit: retry $retry_count\n");
-
- # hook so response_retry_preference can defer some code execution
- # until we've checked retry_count and retry_limit.
- if (ref $retry eq 'CODE') {
- $retry->($retry_count, $retry_limit)
- and warn "should return false"; # protect future use
- }
-
- ++$request_meta->{retry_count}; # update count for this request object
- ++$self->meta->{request_retry_count}; # update cumulative transport stats
-
- return 1;
-}
-
-
-sub transport_timedout {
- my ($self, $method, $timeout) = @_;
- $timeout ||= $self->go_timeout;
- return $self->new_response({ err => 1, errstr => "DBD::Gofer $method timed-out after $timeout seconds" });
-}
-
-
-# return undef if we don't want to cache this request
-# subclasses may use more specialized rules
-sub get_cache_key_for_request {
- my ($self, $request) = @_;
-
- # we only want to cache idempotent requests
- # is_idempotent() is true if GOf_REQUEST_IDEMPOTENT or GOf_REQUEST_READONLY set
- return undef if not $request->is_idempotent;
-
- # XXX would be nice to avoid the extra freeze here
- my $key = $self->freeze_request($request, undef, 1);
-
- #use Digest::MD5; warn "get_cache_key_for_request: ".Digest::MD5::md5_base64($key)."\n";
-
- return $key;
-}
-
-
-sub _store_response_in_cache {
- my ($self, $frozen_response, $request_cache_key) = @_;
- my $go_cache = $self->{go_cache}
- or return;
-
- # new() ensures that enabling go_cache also enables keep_meta_frozen
- warn "No meta frozen in response" if !$frozen_response;
- warn "No request_cache_key" if !$request_cache_key;
-
- if ($frozen_response && $request_cache_key) {
- $self->trace_msg("receive_response added response to cache $go_cache\n");
- eval { $go_cache->set($request_cache_key, $frozen_response) };
- warn $@ if $@;
- ++$self->{cache_store};
- }
-}
-
-1;
-
-__END__
-
-=head1 NAME
-
-DBD::Gofer::Transport::Base - base class for DBD::Gofer client transports
-
-=head1 SYNOPSIS
-
- my $remote_dsn = "..."
- DBI->connect("dbi:Gofer:transport=...;url=...;timeout=...;retry_limit=...;dsn=$remote_dsn",...)
-
-or, enable by setting the DBI_AUTOPROXY environment variable:
-
- export DBI_AUTOPROXY='dbi:Gofer:transport=...;url=...'
-
-which will force I<all> DBI connections to be made via that Gofer server.
-
-=head1 DESCRIPTION
-
-This is the base class for all DBD::Gofer client transports.
-
-=head1 ATTRIBUTES
-
-Gofer transport attributes can be specified either in the attributes parameter
-of the connect() method call, or in the DSN string. When used in the DSN
-string, attribute names don't have the C<go_> prefix.
-
-=head2 go_dsn
-
-The full DBI DSN that the Gofer server should connect to on your behalf.
-
-When used in the DSN it must be the last element in the DSN string.
-
-=head2 go_timeout
-
-A time limit for sending a request and receiving a response. Some drivers may
-implement sending and receiving as separate steps, in which case (currently)
-the timeout applies to each separately.
-
-If a request needs to be resent then the timeout is restarted for each sending
-of a request and receiving of a response.
-
-=head2 go_retry_limit
-
-The maximum number of times an request may be retried. The default is 2.
-
-=head2 go_retry_hook
-
-This subroutine reference is called, if defined, for each response received where $response->err is true.
-
-The subroutine is pass three parameters: the request object, the response object, and the transport object.
-
-If it returns an undefined value then the default retry behaviour is used. See L</RETRY ON ERROR> below.
-
-If it returns a defined but false value then the request is not resent.
-
-If it returns true value then the request is resent, so long as the number of retries does not exceed C<go_retry_limit>.
-
-=head1 RETRY ON ERROR
-
-The default retry on error behaviour is:
-
- - Retry if the error was due to DBI_GOFER_RANDOM. See L<DBI::Gofer::Execute>.
-
- - Retry if $request->is_idempotent returns true. See L<DBI::Gofer::Request>.
-
-A retry won't be allowed if the number of previous retries has reached C<go_retry_limit>.
-
-=head1 TRACING
-
-Tracing of gofer requests and responses can be enabled by setting the
-C<DBD_GOFER_TRACE> environment variable. A value of 1 gives a reasonably
-compact summary of each request and response. A value of 2 or more gives a
-detailed, and voluminous, dump.
-
-The trace is written using DBI->trace_msg() and so is written to the default
-DBI trace output, which is usually STDERR.
-
-=head1 METHODS
-
-I<This section is currently far from complete.>
-
-=head2 response_retry_preference
-
- $retry = $transport->response_retry_preference($request, $response);
-
-The response_retry_preference is called by DBD::Gofer when considering if a
-request should be retried after an error.
-
-Returns true (would like to retry), false (must not retry), undef (no preference).
-
-If a true value is returned in the form of a CODE ref then, if DBD::Gofer does
-decide to retry the request, it calls the code ref passing $retry_count, $retry_limit.
-Can be used for logging and/or to implement exponential backoff behaviour.
-Currently the called code must return using C<return;> to allow for future extensions.
-
-=head1 AUTHOR
-
-Tim Bunce, L<http://www.tim.bunce.name>
-
-=head1 LICENCE AND COPYRIGHT
-
-Copyright (c) 2007-2008, Tim Bunce, Ireland. All rights reserved.
-
-This module is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself. See L<perlartistic>.
-
-=head1 SEE ALSO
-
-L<DBD::Gofer>, L<DBI::Gofer::Request>, L<DBI::Gofer::Response>, L<DBI::Gofer::Execute>.
-
-and some example transports:
-
-L<DBD::Gofer::Transport::stream>
-
-L<DBD::Gofer::Transport::http>
-
-L<DBI::Gofer::Transport::mod_perl>
-
-=cut
+++ /dev/null
-package DBD::Gofer::Transport::corostream;
-
-use strict;
-use warnings;
-
-use Carp;
-
-use Coro::Select; # a slow but coro-aware replacement for CORE::select (global effect!)
-
-use Coro;
-use Coro::Handle;
-
-use base qw(DBD::Gofer::Transport::stream);
-
-# XXX ensure DBI_PUREPERL for parent doesn't pass to child
-sub start_pipe_command {
- local $ENV{DBI_PUREPERL} = $ENV{DBI_PUREPERL_COROCHILD}; # typically undef
- my $connection = shift->SUPER::start_pipe_command(@_);
- return $connection;
-}
-
-
-
-1;
-
-__END__
-
-=head1 NAME
-
-DBD::Gofer::Transport::corostream - Async DBD::Gofer stream transport using Coro and AnyEvent
-
-=head1 SYNOPSIS
-
- DBI_AUTOPROXY="dbi:Gofer:transport=corostream" perl some-perl-script-using-dbi.pl
-
-or
-
- $dsn = ...; # the DSN for the driver and database you want to use
- $dbh = DBI->connect("dbi:Gofer:transport=corostream;dsn=$dsn", ...);
-
-=head1 DESCRIPTION
-
-The I<BIG WIN> from using L<Coro> is that it enables the use of existing
-DBI frameworks like L<DBIx::Class>.
-
-=head1 KNOWN ISSUES AND LIMITATIONS
-
- - Uses Coro::Select so alters CORE::select globally
- Parent class probably needs refactoring to enable a more encapsulated approach.
-
- - Doesn't prevent multiple concurrent requests
- Probably just needs a per-connection semaphore
-
- - Coro has many caveats. Caveat emptor.
-
-=head1 STATUS
-
-THIS IS CURRENTLY JUST A PROOF-OF-CONCEPT IMPLEMENTATION FOR EXPERIMENTATION.
-
-Please note that I have no plans to develop this code further myself.
-I'd very much welcome contributions. Interested? Let me know!
-
-=head1 AUTHOR
-
-Tim Bunce, L<http://www.tim.bunce.name>
-
-=head1 LICENCE AND COPYRIGHT
-
-Copyright (c) 2010, Tim Bunce, Ireland. All rights reserved.
-
-This module is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself. See L<perlartistic>.
-
-=head1 SEE ALSO
-
-L<DBD::Gofer::Transport::stream>
-
-L<DBD::Gofer>
-
-=head1 APPENDIX
-
-Example code:
-
- #!perl
-
- use strict;
- use warnings;
- use Time::HiRes qw(time);
-
- BEGIN { $ENV{PERL_ANYEVENT_STRICT} = 1; $ENV{PERL_ANYEVENT_VERBOSE} = 1; }
-
- use AnyEvent;
-
- BEGIN { $ENV{DBI_TRACE} = 0; $ENV{DBI_GOFER_TRACE} = 0; $ENV{DBD_GOFER_TRACE} = 0; };
-
- use DBI;
-
- $ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=corostream';
-
- my $ticker = AnyEvent->timer( after => 0, interval => 0.1, cb => sub {
- warn sprintf "-tick- %.2f\n", time
- } );
-
- warn "connecting...\n";
- my $dbh = DBI->connect("dbi:NullP:");
- warn "...connected\n";
-
- for (1..3) {
- warn "entering DBI...\n";
- $dbh->do("sleep 0.3"); # pseudo-sql understood by the DBD::NullP driver
- warn "...returned\n";
- }
-
- warn "done.";
-
-Example output:
-
- $ perl corogofer.pl
- connecting...
- -tick- 1293631437.14
- -tick- 1293631437.14
- ...connected
- entering DBI...
- -tick- 1293631437.25
- -tick- 1293631437.35
- -tick- 1293631437.45
- -tick- 1293631437.55
- ...returned
- entering DBI...
- -tick- 1293631437.66
- -tick- 1293631437.76
- -tick- 1293631437.86
- ...returned
- entering DBI...
- -tick- 1293631437.96
- -tick- 1293631438.06
- -tick- 1293631438.16
- ...returned
- done. at corogofer.pl line 39.
-
-You can see that the timer callback is firing while the code 'waits' inside the
-do() method for the response from the database. Normally that would block.
-
-=cut
+++ /dev/null
-package DBD::Gofer::Transport::null;
-
-# $Id: null.pm 10087 2007-10-16 12:42:37Z Tim $
-#
-# Copyright (c) 2007, Tim Bunce, Ireland
-#
-# You may distribute under the terms of either the GNU General Public
-# License or the Artistic License, as specified in the Perl README file.
-
-use strict;
-use warnings;
-
-use base qw(DBD::Gofer::Transport::Base);
-
-use DBI::Gofer::Execute;
-
-our $VERSION = "0.010088";
-
-__PACKAGE__->mk_accessors(qw(
- pending_response
- transmit_count
-));
-
-my $executor = DBI::Gofer::Execute->new();
-
-
-sub transmit_request_by_transport {
- my ($self, $request) = @_;
- $self->transmit_count( ($self->transmit_count()||0) + 1 ); # just for tests
-
- my $frozen_request = $self->freeze_request($request);
-
- # ...
- # the request is magically transported over to ... ourselves
- # ...
-
- my $response = $executor->execute_request( $self->thaw_request($frozen_request, undef, 1) );
-
- # put response 'on the shelf' ready for receive_response()
- $self->pending_response( $response );
-
- return undef;
-}
-
-
-sub receive_response_by_transport {
- my $self = shift;
-
- my $response = $self->pending_response;
-
- my $frozen_response = $self->freeze_response($response, undef, 1);
-
- # ...
- # the response is magically transported back to ... ourselves
- # ...
-
- return $self->thaw_response($frozen_response);
-}
-
-
-1;
-__END__
-
-=head1 NAME
-
-DBD::Gofer::Transport::null - DBD::Gofer client transport for testing
-
-=head1 SYNOPSIS
-
- my $original_dsn = "..."
- DBI->connect("dbi:Gofer:transport=null;dsn=$original_dsn",...)
-
-or, enable by setting the DBI_AUTOPROXY environment variable:
-
- export DBI_AUTOPROXY="dbi:Gofer:transport=null"
-
-=head1 DESCRIPTION
-
-Connect via DBD::Gofer but execute the requests within the same process.
-
-This is a quick and simple way to test applications for compatibility with the
-(few) restrictions that DBD::Gofer imposes.
-
-It also provides a simple, portable way for the DBI test suite to be used to
-test DBD::Gofer on all platforms with no setup.
-
-Also, by measuring the difference in performance between normal connections and
-connections via C<dbi:Gofer:transport=null> the basic cost of using DBD::Gofer
-can be measured. Furthermore, the additional cost of more advanced transports can be
-isolated by comparing their performance with the null transport.
-
-The C<t/85gofer.t> script in the DBI distribution includes a comparative benchmark.
-
-=head1 AUTHOR
-
-Tim Bunce, L<http://www.tim.bunce.name>
-
-=head1 LICENCE AND COPYRIGHT
-
-Copyright (c) 2007, Tim Bunce, Ireland. All rights reserved.
-
-This module is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself. See L<perlartistic>.
-
-=head1 SEE ALSO
-
-L<DBD::Gofer::Transport::Base>
-
-L<DBD::Gofer>
-
-=cut
+++ /dev/null
-package DBD::Gofer::Transport::pipeone;
-
-# $Id: pipeone.pm 10087 2007-10-16 12:42:37Z Tim $
-#
-# Copyright (c) 2007, Tim Bunce, Ireland
-#
-# You may distribute under the terms of either the GNU General Public
-# License or the Artistic License, as specified in the Perl README file.
-
-use strict;
-use warnings;
-
-use Carp;
-use Fcntl;
-use IO::Select;
-use IPC::Open3 qw(open3);
-use Symbol qw(gensym);
-
-use base qw(DBD::Gofer::Transport::Base);
-
-our $VERSION = "0.010088";
-
-__PACKAGE__->mk_accessors(qw(
- connection_info
- go_perl
-));
-
-
-sub new {
- my ($self, $args) = @_;
- $args->{go_perl} ||= do {
- ($INC{"blib.pm"}) ? [ $^X, '-Mblib' ] : [ $^X ];
- };
- if (not ref $args->{go_perl}) {
- # user can override the perl to be used, either with an array ref
- # containing the command name and args to use, or with a string
- # (ie via the DSN) in which case, to enable args to be passed,
- # we split on two or more consecutive spaces (otherwise the path
- # to perl couldn't contain a space itself).
- $args->{go_perl} = [ split /\s{2,}/, $args->{go_perl} ];
- }
- return $self->SUPER::new($args);
-}
-
-
-# nonblock($fh) puts filehandle into nonblocking mode
-sub nonblock {
- my $fh = shift;
- my $flags = fcntl($fh, F_GETFL, 0)
- or croak "Can't get flags for filehandle $fh: $!";
- fcntl($fh, F_SETFL, $flags | O_NONBLOCK)
- or croak "Can't make filehandle $fh nonblocking: $!";
-}
-
-
-sub start_pipe_command {
- my ($self, $cmd) = @_;
- $cmd = [ $cmd ] unless ref $cmd eq 'ARRAY';
-
- # if it's important that the subprocess uses the same
- # (versions of) modules as us then the caller should
- # set PERL5LIB itself.
-
- # limit various forms of insanity, for now
- local $ENV{DBI_TRACE}; # use DBI_GOFER_TRACE instead
- local $ENV{DBI_AUTOPROXY};
- local $ENV{DBI_PROFILE};
-
- my ($wfh, $rfh, $efh) = (gensym, gensym, gensym);
- my $pid = open3($wfh, $rfh, $efh, @$cmd)
- or die "error starting @$cmd: $!\n";
- if ($self->trace) {
- $self->trace_msg(sprintf("Started pid $pid: @$cmd {fd: w%d r%d e%d, ppid=$$}\n", fileno $wfh, fileno $rfh, fileno $efh),0);
- }
- nonblock($rfh);
- nonblock($efh);
- my $ios = IO::Select->new($rfh, $efh);
-
- return {
- cmd=>$cmd,
- pid=>$pid,
- wfh=>$wfh, rfh=>$rfh, efh=>$efh,
- ios=>$ios,
- };
-}
-
-
-sub cmd_as_string {
- my $self = shift;
- # XXX meant to return a properly shell-escaped string suitable for system
- # but its only for debugging so that can wait
- my $connection_info = $self->connection_info;
- return join " ", map { (m/^[-:\w]*$/) ? $_ : "'$_'" } @{$connection_info->{cmd}};
-}
-
-
-sub transmit_request_by_transport {
- my ($self, $request) = @_;
-
- my $frozen_request = $self->freeze_request($request);
-
- my $cmd = [ @{$self->go_perl}, qw(-MDBI::Gofer::Transport::pipeone -e run_one_stdio)];
- my $info = $self->start_pipe_command($cmd);
-
- my $wfh = delete $info->{wfh};
- # send frozen request
- local $\;
- print $wfh $frozen_request
- or warn "error writing to @$cmd: $!\n";
- # indicate that there's no more
- close $wfh
- or die "error closing pipe to @$cmd: $!\n";
-
- $self->connection_info( $info );
- return;
-}
-
-
-sub read_response_from_fh {
- my ($self, $fh_actions) = @_;
- my $trace = $self->trace;
-
- my $info = $self->connection_info || die;
- my ($ios) = @{$info}{qw(ios)};
- my $errors = 0;
- my $complete;
-
- die "No handles to read response from" unless $ios->count;
-
- while ($ios->count) {
- my @readable = $ios->can_read();
- for my $fh (@readable) {
- local $_;
- my $actions = $fh_actions->{$fh} || die "panic: no action for $fh";
- my $rv = sysread($fh, $_='', 1024*31); # to fit in 32KB slab
- unless ($rv) { # error (undef) or end of file (0)
- my $action;
- unless (defined $rv) { # was an error
- $self->trace_msg("error on handle $fh: $!\n") if $trace >= 4;
- $action = $actions->{error} || $actions->{eof};
- ++$errors;
- # XXX an error may be a permenent condition of the handle
- # if so we'll loop here - not good
- }
- else {
- $action = $actions->{eof};
- $self->trace_msg("eof on handle $fh\n") if $trace >= 4;
- }
- if ($action->($fh)) {
- $self->trace_msg("removing $fh from handle set\n") if $trace >= 4;
- $ios->remove($fh);
- }
- next;
- }
- # action returns true if the response is now complete
- # (we finish all handles
- $actions->{read}->($fh) && ++$complete;
- }
- last if $complete;
- }
- return $errors;
-}
-
-
-sub receive_response_by_transport {
- my $self = shift;
-
- my $info = $self->connection_info || die;
- my ($pid, $rfh, $efh, $ios, $cmd) = @{$info}{qw(pid rfh efh ios cmd)};
-
- my $frozen_response;
- my $stderr_msg;
-
- $self->read_response_from_fh( {
- $efh => {
- error => sub { warn "error reading response stderr: $!"; 1 },
- eof => sub { warn "eof on stderr" if 0; 1 },
- read => sub { $stderr_msg .= $_; 0 },
- },
- $rfh => {
- error => sub { warn "error reading response: $!"; 1 },
- eof => sub { warn "eof on stdout" if 0; 1 },
- read => sub { $frozen_response .= $_; 0 },
- },
- });
-
- waitpid $info->{pid}, 0
- or warn "waitpid: $!"; # XXX do something more useful?
-
- die ref($self)." command (@$cmd) failed: $stderr_msg"
- if not $frozen_response; # no output on stdout at all
-
- # XXX need to be able to detect and deal with corruption
- my $response = $self->thaw_response($frozen_response);
-
- if ($stderr_msg) {
- # add stderr messages as warnings (for PrintWarn)
- $response->add_err(0, $stderr_msg, undef, $self->trace)
- # but ignore warning from old version of blib
- unless $stderr_msg =~ /^Using .*blib/ && "@$cmd" =~ /-Mblib/;
- }
-
- return $response;
-}
-
-
-1;
-
-__END__
-
-=head1 NAME
-
-DBD::Gofer::Transport::pipeone - DBD::Gofer client transport for testing
-
-=head1 SYNOPSIS
-
- $original_dsn = "...";
- DBI->connect("dbi:Gofer:transport=pipeone;dsn=$original_dsn",...)
-
-or, enable by setting the DBI_AUTOPROXY environment variable:
-
- export DBI_AUTOPROXY="dbi:Gofer:transport=pipeone"
-
-=head1 DESCRIPTION
-
-Connect via DBD::Gofer and execute each request by starting executing a subprocess.
-
-This is, as you might imagine, spectacularly inefficient!
-
-It's only intended for testing. Specifically it demonstrates that the server
-side is completely stateless.
-
-It also provides a base class for the much more useful L<DBD::Gofer::Transport::stream>
-transport.
-
-=head1 AUTHOR
-
-Tim Bunce, L<http://www.tim.bunce.name>
-
-=head1 LICENCE AND COPYRIGHT
-
-Copyright (c) 2007, Tim Bunce, Ireland. All rights reserved.
-
-This module is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself. See L<perlartistic>.
-
-=head1 SEE ALSO
-
-L<DBD::Gofer::Transport::Base>
-
-L<DBD::Gofer>
-
-=cut
+++ /dev/null
-package DBD::Gofer::Transport::stream;
-
-# $Id: stream.pm 14598 2010-12-21 22:53:25Z Tim $
-#
-# Copyright (c) 2007, Tim Bunce, Ireland
-#
-# You may distribute under the terms of either the GNU General Public
-# License or the Artistic License, as specified in the Perl README file.
-
-use strict;
-use warnings;
-
-use Carp;
-
-use base qw(DBD::Gofer::Transport::pipeone);
-
-our $VERSION = "0.014599";
-
-__PACKAGE__->mk_accessors(qw(
- go_persist
-));
-
-my $persist_all = 5;
-my %persist;
-
-
-sub _connection_key {
- my ($self) = @_;
- return join "~", $self->go_url||"", @{ $self->go_perl || [] };
-}
-
-
-sub _connection_get {
- my ($self) = @_;
-
- my $persist = $self->go_persist; # = 0 can force non-caching
- $persist = $persist_all if not defined $persist;
- my $key = ($persist) ? $self->_connection_key : '';
- if ($persist{$key} && $self->_connection_check($persist{$key})) {
- $self->trace_msg("reusing persistent connection $key\n",0) if $self->trace >= 1;
- return $persist{$key};
- }
-
- my $connection = $self->_make_connection;
-
- if ($key) {
- %persist = () if keys %persist > $persist_all; # XXX quick hack to limit subprocesses
- $persist{$key} = $connection;
- }
-
- return $connection;
-}
-
-
-sub _connection_check {
- my ($self, $connection) = @_;
- $connection ||= $self->connection_info;
- my $pid = $connection->{pid};
- my $ok = (kill 0, $pid);
- $self->trace_msg("_connection_check: $ok (pid $$)\n",0) if $self->trace;
- return $ok;
-}
-
-
-sub _connection_kill {
- my ($self) = @_;
- my $connection = $self->connection_info;
- my ($pid, $wfh, $rfh, $efh) = @{$connection}{qw(pid wfh rfh efh)};
- $self->trace_msg("_connection_kill: closing write handle\n",0) if $self->trace;
- # closing the write file handle should be enough, generally
- close $wfh;
- # in future we may want to be more aggressive
- #close $rfh; close $efh; kill 15, $pid
- # but deleting from the persist cache...
- delete $persist{ $self->_connection_key };
- # ... and removing the connection_info should suffice
- $self->connection_info( undef );
- return;
-}
-
-
-sub _make_connection {
- my ($self) = @_;
-
- my $go_perl = $self->go_perl;
- my $cmd = [ @$go_perl, qw(-MDBI::Gofer::Transport::stream -e run_stdio_hex)];
-
- #push @$cmd, "DBI_TRACE=2=/tmp/goferstream.log", "sh", "-c";
- if (my $url = $self->go_url) {
- die "Only 'ssh:user\@host' style url supported by this transport"
- unless $url =~ s/^ssh://;
- my $ssh = $url;
- my $setup_env = join "||", map { "source $_ 2>/dev/null" } qw(.bash_profile .bash_login .profile);
- my $setup = $setup_env.q{; exec "$@"};
- # don't use $^X on remote system by default as it's possibly wrong
- $cmd->[0] = 'perl' if "@$go_perl" eq $^X;
- # -x not only 'Disables X11 forwarding' but also makes connections *much* faster
- unshift @$cmd, qw(ssh -xq), split(' ', $ssh), qw(bash -c), $setup;
- }
-
- $self->trace_msg("new connection: @$cmd\n",0) if $self->trace;
-
- # XXX add a handshake - some message from DBI::Gofer::Transport::stream that's
- # sent as soon as it starts that we can wait for to report success - and soak up
- # and report useful warnings etc from ssh before we get it? Increases latency though.
- my $connection = $self->start_pipe_command($cmd);
- return $connection;
-}
-
-
-sub transmit_request_by_transport {
- my ($self, $request) = @_;
- my $trace = $self->trace;
-
- my $connection = $self->connection_info || do {
- my $con = $self->_connection_get;
- $self->connection_info( $con );
- $con;
- };
-
- my $encoded_request = unpack("H*", $self->freeze_request($request));
- $encoded_request .= "\015\012";
-
- my $wfh = $connection->{wfh};
- $self->trace_msg(sprintf("transmit_request_by_transport: to fh %s fd%d\n", $wfh, fileno($wfh)),0)
- if $trace >= 4;
-
- # send frozen request
- local $\;
- $wfh->print($encoded_request) # autoflush enabled
- or do {
- my $err = $!;
- # XXX could/should make new connection and retry
- $self->_connection_kill;
- die "Error sending request: $err";
- };
- $self->trace_msg("Request sent: $encoded_request\n",0) if $trace >= 4;
-
- return undef; # indicate no response yet (so caller calls receive_response_by_transport)
-}
-
-
-sub receive_response_by_transport {
- my $self = shift;
- my $trace = $self->trace;
-
- $self->trace_msg("receive_response_by_transport: awaiting response\n",0) if $trace >= 4;
- my $connection = $self->connection_info || die;
- my ($pid, $rfh, $efh, $cmd) = @{$connection}{qw(pid rfh efh cmd)};
-
- my $errno = 0;
- my $encoded_response;
- my $stderr_msg;
-
- $self->read_response_from_fh( {
- $efh => {
- error => sub { warn "error reading response stderr: $!"; $errno||=$!; 1 },
- eof => sub { warn "eof reading efh" if $trace >= 4; 1 },
- read => sub { $stderr_msg .= $_; 0 },
- },
- $rfh => {
- error => sub { warn "error reading response: $!"; $errno||=$!; 1 },
- eof => sub { warn "eof reading rfh" if $trace >= 4; 1 },
- read => sub { $encoded_response .= $_; ($encoded_response=~s/\015\012$//) ? 1 : 0 },
- },
- });
-
- # if we got no output on stdout at all then the command has
- # probably exited, possibly with an error to stderr.
- # Turn this situation into a reasonably useful DBI error.
- if (not $encoded_response) {
- my @msg;
- push @msg, "error while reading response: $errno" if $errno;
- if ($stderr_msg) {
- chomp $stderr_msg;
- push @msg, sprintf "error reported by \"%s\" (pid %d%s): %s",
- $self->cmd_as_string,
- $pid, ((kill 0, $pid) ? "" : ", exited"),
- $stderr_msg;
- }
- die join(", ", "No response received", @msg)."\n";
- }
-
- $self->trace_msg("Response received: $encoded_response\n",0)
- if $trace >= 4;
-
- $self->trace_msg("Gofer stream stderr message: $stderr_msg\n",0)
- if $stderr_msg && $trace;
-
- my $frozen_response = pack("H*", $encoded_response);
-
- # XXX need to be able to detect and deal with corruption
- my $response = $self->thaw_response($frozen_response);
-
- if ($stderr_msg) {
- # add stderr messages as warnings (for PrintWarn)
- $response->add_err(0, $stderr_msg, undef, $trace)
- # but ignore warning from old version of blib
- unless $stderr_msg =~ /^Using .*blib/ && "@$cmd" =~ /-Mblib/;
- }
-
- return $response;
-}
-
-sub transport_timedout {
- my $self = shift;
- $self->_connection_kill;
- return $self->SUPER::transport_timedout(@_);
-}
-
-1;
-
-__END__
-
-=head1 NAME
-
-DBD::Gofer::Transport::stream - DBD::Gofer transport for stdio streaming
-
-=head1 SYNOPSIS
-
- DBI->connect('dbi:Gofer:transport=stream;url=ssh:username@host.example.com;dsn=dbi:...',...)
-
-or, enable by setting the DBI_AUTOPROXY environment variable:
-
- export DBI_AUTOPROXY='dbi:Gofer:transport=stream;url=ssh:username@host.example.com'
-
-=head1 DESCRIPTION
-
-Without the C<url=> parameter it launches a subprocess as
-
- perl -MDBI::Gofer::Transport::stream -e run_stdio_hex
-
-and feeds requests into it and reads responses from it. But that's not very useful.
-
-With a C<url=ssh:username@host.example.com> parameter it uses ssh to launch the subprocess
-on a remote system. That's much more useful!
-
-It gives you secure remote access to DBI databases on any system you can login to.
-Using ssh also gives you optional compression and many other features (see the
-ssh manual for how to configure that and many other options via ~/.ssh/config file).
-
-The actual command invoked is something like:
-
- ssh -xq ssh:username@host.example.com bash -c $setup $run
-
-where $run is the command shown above, and $command is
-
- . .bash_profile 2>/dev/null || . .bash_login 2>/dev/null || . .profile 2>/dev/null; exec "$@"
-
-which is trying (in a limited and fairly unportable way) to setup the environment
-(PATH, PERL5LIB etc) as it would be if you had logged in to that system.
-
-The "C<perl>" used in the command will default to the value of $^X when not using ssh.
-On most systems that's the full path to the perl that's currently executing.
-
-
-=head1 PERSISTENCE
-
-Currently gofer stream connections persist (remain connected) after all
-database handles have been disconnected. This makes later connections in the
-same process very fast.
-
-Currently up to 5 different gofer stream connections (based on url) can
-persist. If more than 5 are in the cache when a new connection is made then
-the cache is cleared before adding the new connection. Simple but effective.
-
-=head1 TO DO
-
-Document go_perl attribute
-
-Automatically reconnect (within reason) if there's a transport error.
-
-Decide on default for persistent connection - on or off? limits? ttl?
-
-=head1 AUTHOR
-
-Tim Bunce, L<http://www.tim.bunce.name>
-
-=head1 LICENCE AND COPYRIGHT
-
-Copyright (c) 2007, Tim Bunce, Ireland. All rights reserved.
-
-This module is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself. See L<perlartistic>.
-
-=head1 SEE ALSO
-
-L<DBD::Gofer::Transport::Base>
-
-L<DBD::Gofer>
-
-=cut
+++ /dev/null
-# -*- perl -*-
-#
-# DBD::Mem - A DBI driver for in-memory tables
-#
-# This module is currently maintained by
-#
-# Jens Rehsack
-#
-# Copyright (C) 2016,2017 by Jens Rehsack
-#
-# All rights reserved.
-#
-# You may distribute this module under the terms of either the GNU
-# General Public License or the Artistic License, as specified in
-# the Perl README file.
-
-require 5.008;
-use strict;
-
-#################
-package DBD::Mem;
-#################
-use base qw( DBI::DBD::SqlEngine );
-use vars qw($VERSION $ATTRIBUTION $drh);
-$VERSION = '0.001';
-$ATTRIBUTION = 'DBD::Mem by Jens Rehsack';
-
-# no need to have driver() unless you need private methods
-#
-sub driver ($;$)
-{
- my ( $class, $attr ) = @_;
- return $drh if ($drh);
-
- # do the real work in DBI::DBD::SqlEngine
- #
- $attr->{Attribution} = 'DBD::Mem by Jens Rehsack';
- $drh = $class->SUPER::driver($attr);
-
- return $drh;
-}
-
-sub CLONE
-{
- undef $drh;
-}
-
-#####################
-package DBD::Mem::dr;
-#####################
-$DBD::Mem::dr::imp_data_size = 0;
-@DBD::Mem::dr::ISA = qw(DBI::DBD::SqlEngine::dr);
-
-# you could put some :dr private methods here
-
-# you may need to over-ride some DBI::DBD::SqlEngine::dr methods here
-# but you can probably get away with just letting it do the work
-# in most cases
-
-#####################
-package DBD::Mem::db;
-#####################
-$DBD::Mem::db::imp_data_size = 0;
-@DBD::Mem::db::ISA = qw(DBI::DBD::SqlEngine::db);
-
-use Carp qw/carp/;
-
-sub set_versions
-{
- my $this = $_[0];
- $this->{mem_version} = $DBD::Mem::VERSION;
- return $this->SUPER::set_versions();
-}
-
-sub init_valid_attributes
-{
- my $dbh = shift;
-
- # define valid private attributes
- #
- # attempts to set non-valid attrs in connect() or
- # with $dbh->{attr} will throw errors
- #
- # the attrs here *must* start with mem_ or foo_
- #
- # see the STORE methods below for how to check these attrs
- #
- $dbh->{mem_valid_attrs} = {
- mem_version => 1, # verbose DBD::Mem version
- mem_valid_attrs => 1, # DBD::Mem::db valid attrs
- mem_readonly_attrs => 1, # DBD::Mem::db r/o attrs
- mem_meta => 1, # DBD::Mem public access for f_meta
- mem_tables => 1, # DBD::Mem public access for f_meta
- };
- $dbh->{mem_readonly_attrs} = {
- mem_version => 1, # verbose DBD::Mem version
- mem_valid_attrs => 1, # DBD::Mem::db valid attrs
- mem_readonly_attrs => 1, # DBD::Mem::db r/o attrs
- mem_meta => 1, # DBD::Mem public access for f_meta
- };
-
- $dbh->{mem_meta} = "mem_tables";
-
- return $dbh->SUPER::init_valid_attributes();
-}
-
-sub get_mem_versions
-{
- my ( $dbh, $table ) = @_;
- $table ||= '';
-
- my $meta;
- my $class = $dbh->{ImplementorClass};
- $class =~ s/::db$/::Table/;
- $table and ( undef, $meta ) = $class->get_table_meta( $dbh, $table, 1 );
- $meta or ( $meta = {} and $class->bootstrap_table_meta( $dbh, $meta, $table ) );
-
- return sprintf( "%s using %s", $dbh->{mem_version}, $AnyData2::VERSION );
-}
-
-package DBD::Mem::st;
-
-use strict;
-use warnings;
-
-our $imp_data_size = 0;
-our @ISA = qw(DBI::DBD::SqlEngine::st);
-
-############################
-package DBD::Mem::Statement;
-############################
-
-@DBD::Mem::Statement::ISA = qw(DBI::DBD::SqlEngine::Statement);
-
-
-sub open_table ($$$$$)
-{
- my ( $self, $data, $table, $createMode, $lockMode ) = @_;
-
- my $class = ref $self;
- $class =~ s/::Statement/::Table/;
-
- my $flags = {
- createMode => $createMode,
- lockMode => $lockMode,
- };
- if( defined( $data->{Database}->{mem_table_data}->{$table} ) && $data->{Database}->{mem_table_data}->{$table})
- {
- my $t = $data->{Database}->{mem_tables}->{$table};
- $t->seek( $data, 0, 0 );
- return $t;
- }
-
- return $self->SUPER::open_table($data, $table, $createMode, $lockMode);
-}
-
-# ====== DataSource ============================================================
-
-package DBD::Mem::DataSource;
-
-use strict;
-use warnings;
-
-use Carp;
-
-@DBD::Mem::DataSource::ISA = "DBI::DBD::SqlEngine::DataSource";
-
-sub complete_table_name ($$;$)
-{
- my ( $self, $meta, $table, $respect_case ) = @_;
- $table;
-}
-
-sub open_data ($)
-{
- my ( $self, $meta, $attrs, $flags ) = @_;
- defined $meta->{data_tbl} or $meta->{data_tbl} = [];
-}
-
-########################
-package DBD::Mem::Table;
-########################
-
-# shamelessly stolen from SQL::Statement::RAM
-
-use Carp qw/croak/;
-
-@DBD::Mem::Table::ISA = qw(DBI::DBD::SqlEngine::Table);
-
-use Carp qw(croak);
-
-sub new
-{
- #my ( $class, $tname, $col_names, $data_tbl ) = @_;
- my ( $class, $data, $attrs, $flags ) = @_;
- my $self = $class->SUPER::new($data, $attrs, $flags);
-
- my $meta = $self->{meta};
- $self->{records} = $meta->{data_tbl};
- $self->{index} = 0;
-
- $self;
-}
-
-sub bootstrap_table_meta
-{
- my ( $self, $dbh, $meta, $table ) = @_;
-
- defined $meta->{sql_data_source} or $meta->{sql_data_source} = "DBD::Mem::DataSource";
-
- $meta;
-}
-
-sub fetch_row
-{
- my ( $self, $data ) = @_;
-
- return $self->{row} =
- ( $self->{records} and ( $self->{index} < scalar( @{ $self->{records} } ) ) )
- ? [ @{ $self->{records}->[ $self->{index}++ ] } ]
- : undef;
-}
-
-sub push_row
-{
- my ( $self, $data, $fields ) = @_;
- my $currentRow = $self->{index};
- $self->{index} = $currentRow + 1;
- $self->{records}->[$currentRow] = $fields;
- return 1;
-}
-
-sub truncate
-{
- my $self = shift;
- return splice @{ $self->{records} }, $self->{index}, 1;
-}
-
-sub push_names
-{
- my ( $self, $data, $names ) = @_;
- my $meta = $self->{meta};
- $meta->{col_names} = $self->{col_names} = $names;
- $self->{org_col_names} = [ @{$names} ];
- $self->{col_nums} = {};
- $self->{col_nums}{ $names->[$_] } = $_ for ( 0 .. scalar @$names - 1 );
-}
-
-sub drop ($)
-{
- my ($self, $data) = @_;
- delete $data->{Database}{sql_meta}{$self->{table}};
- return 1;
-} # drop
-
-sub seek
-{
- my ( $self, $data, $pos, $whence ) = @_;
- return unless defined $self->{records};
-
- my ($currentRow) = $self->{index};
- if ( $whence == 0 )
- {
- $currentRow = $pos;
- }
- elsif ( $whence == 1 )
- {
- $currentRow += $pos;
- }
- elsif ( $whence == 2 )
- {
- $currentRow = @{ $self->{records} } + $pos;
- }
- else
- {
- croak $self . "->seek: Illegal whence argument ($whence)";
- }
-
- $currentRow < 0 and
- croak "Illegal row number: $currentRow";
- $self->{index} = $currentRow;
-}
-
-1;
-
-=head1 NAME
-
-DBD::Mem - a DBI driver for Mem & MLMem files
-
-=head1 SYNOPSIS
-
- use DBI;
- $dbh = DBI->connect('dbi:Mem:', undef, undef, {});
- $dbh = DBI->connect('dbi:Mem:', undef, undef, {RaiseError => 1});
-
- # or
- $dbh = DBI->connect('dbi:Mem:');
- $dbh = DBI->connect('DBI:Mem(RaiseError=1):');
-
-and other variations on connect() as shown in the L<DBI> docs and
-<DBI::DBD::SqlEngine metadata|DBI::DBD::SqlEngine/Metadata>.
-
-Use standard DBI prepare, execute, fetch, placeholders, etc.,
-see L<QUICK START> for an example.
-
-=head1 DESCRIPTION
-
-DBD::Mem is a database management system that works right out of the box.
-If you have a standard installation of Perl and DBI you can begin creating,
-accessing, and modifying simple database tables without any further modules.
-You can add other modules (e.g., SQL::Statement) for improved functionality.
-
-DBD::Mem doesn't store any data persistently - all data has the lifetime of
-the instantiated C<$dbh>. The main reason to use DBD::Mem is to use extended
-features of L<SQL::Statement> where temporary tables are required. One can
-use DBD::Mem to simulate C<VIEWS> or sub-queries.
-
-Bundling C<DBD::Mem> with L<DBI> will allow us further compatibility checks
-of L<DBI::DBD::SqlEngine> beyond the capabilities of L<DBD::File> and
-L<DBD::DBM>. This will ensure DBI provided basis for drivers like
-L<DBD::AnyData2> or L<DBD::Amazon> are better prepared and tested for
-not-file based backends.
-
-=head2 Metadata
-
-There're no new meta data introduced by C<DBD::Mem>. See
-L<DBI::DBD::SqlEngine/Metadata> for full description.
-
-=head1 GETTING HELP, MAKING SUGGESTIONS, AND REPORTING BUGS
-
-If you need help installing or using DBD::Mem, please write to the DBI
-users mailing list at L<mailto:dbi-users@perl.org> or to the
-comp.lang.perl.modules newsgroup on usenet. I cannot always answer
-every question quickly but there are many on the mailing list or in
-the newsgroup who can.
-
-DBD developers for DBD's which rely on DBI::DBD::SqlEngine or DBD::Mem or
-use one of them as an example are suggested to join the DBI developers
-mailing list at L<mailto:dbi-dev@perl.org> and strongly encouraged to join our
-IRC channel at L<irc://irc.perl.org/dbi>.
-
-If you have suggestions, ideas for improvements, or bugs to report, please
-report a bug as described in DBI. Do not mail any of the authors directly,
-you might not get an answer.
-
-When reporting bugs, please send the output of C<< $dbh->mem_versions($table) >>
-for a table that exhibits the bug and as small a sample as you can make of
-the code that produces the bug. And of course, patches are welcome, too
-:-).
-
-If you need enhancements quickly, you can get commercial support as
-described at L<http://dbi.perl.org/support/> or you can contact Jens Rehsack
-at rehsack@cpan.org for commercial support.
-
-=head1 AUTHOR AND COPYRIGHT
-
-This module is written by Jens Rehsack < rehsack AT cpan.org >.
-
- Copyright (c) 2016- by Jens Rehsack, all rights reserved.
-
-You may freely distribute and/or modify this module under the terms of
-either the GNU General Public License (GPL) or the Artistic License, as
-specified in the Perl README file.
-
-=head1 SEE ALSO
-
-L<DBI> for the Database interface of the Perl Programming Language.
-
-L<SQL::Statement> and L<DBI::SQL::Nano> for the available SQL engines.
-
-L<SQL::Statement::RAM> where the implementation is shamelessly stolen from
-to allow DBI bundled Pure-Perl drivers increase the test coverage.
-
-L<DBD::SQLite> using C<dbname=:memory:> for an incredible fast in-memory database engine.
-
-=cut
+++ /dev/null
-use strict;
-{
- package DBD::NullP;
-
- require DBI;
- require Carp;
-
- our @EXPORT = qw(); # Do NOT @EXPORT anything.
- our $VERSION = "12.014715";
-
-# $Id: NullP.pm 14714 2011-02-22 17:27:07Z Tim $
-#
-# Copyright (c) 1994-2007 Tim Bunce
-#
-# You may distribute under the terms of either the GNU General Public
-# License or the Artistic License, as specified in the Perl README file.
-
- our $drh = undef; # holds driver handle once initialised
-
- sub driver{
- return $drh if $drh;
- my($class, $attr) = @_;
- $class .= "::dr";
- ($drh) = DBI::_new_drh($class, {
- 'Name' => 'NullP',
- 'Version' => $VERSION,
- 'Attribution' => 'DBD Example Null Perl stub by Tim Bunce',
- }, [ qw'example implementors private data']);
- $drh;
- }
-
- sub CLONE {
- undef $drh;
- }
-}
-
-
-{ package DBD::NullP::dr; # ====== DRIVER ======
- our $imp_data_size = 0;
- use strict;
-
- sub connect { # normally overridden, but a handy default
- my $dbh = shift->SUPER::connect(@_)
- or return;
- $dbh->STORE(Active => 1);
- $dbh;
- }
-
-
- sub DESTROY { undef }
-}
-
-
-{ package DBD::NullP::db; # ====== DATABASE ======
- our $imp_data_size = 0;
- use strict;
- use Carp qw(croak);
-
- # Added get_info to support tests in 10examp.t
- sub get_info {
- my ($dbh, $type) = @_;
-
- if ($type == 29) { # identifier quote
- return '"';
- }
- return;
- }
-
- # Added table_info to support tests in 10examp.t
- sub table_info {
- my ($dbh, $catalog, $schema, $table, $type) = @_;
-
- my ($outer, $sth) = DBI::_new_sth($dbh, {
- 'Statement' => 'tables',
- });
- if (defined($type) && $type eq '%' && # special case for tables('','','','%')
- grep {defined($_) && $_ eq ''} ($catalog, $schema, $table)) {
- $outer->{dbd_nullp_data} = [[undef, undef, undef, 'TABLE', undef],
- [undef, undef, undef, 'VIEW', undef],
- [undef, undef, undef, 'ALIAS', undef]];
- } elsif (defined($catalog) && $catalog eq '%' && # special case for tables('%','','')
- grep {defined($_) && $_ eq ''} ($schema, $table)) {
- $outer->{dbd_nullp_data} = [['catalog1', undef, undef, undef, undef],
- ['catalog2', undef, undef, undef, undef]];
- } else {
- $outer->{dbd_nullp_data} = [['catalog', 'schema', 'table1', 'TABLE']];
- $outer->{dbd_nullp_data} = [['catalog', 'schema', 'table2', 'TABLE']];
- $outer->{dbd_nullp_data} = [['catalog', 'schema', 'table3', 'TABLE']];
- }
- $outer->STORE(NUM_OF_FIELDS => 5);
- $sth->STORE(Active => 1);
- return $outer;
- }
-
- sub prepare {
- my ($dbh, $statement)= @_;
-
- my ($outer, $sth) = DBI::_new_sth($dbh, {
- 'Statement' => $statement,
- });
-
- return $outer;
- }
-
- sub FETCH {
- my ($dbh, $attrib) = @_;
- # In reality this would interrogate the database engine to
- # either return dynamic values that cannot be precomputed
- # or fetch and cache attribute values too expensive to prefetch.
- return $dbh->SUPER::FETCH($attrib);
- }
-
- sub STORE {
- my ($dbh, $attrib, $value) = @_;
- # would normally validate and only store known attributes
- # else pass up to DBI to handle
- if ($attrib eq 'AutoCommit') {
- Carp::croak("Can't disable AutoCommit") unless $value;
- # convert AutoCommit values to magic ones to let DBI
- # know that the driver has 'handled' the AutoCommit attribute
- $value = ($value) ? -901 : -900;
- } elsif ($attrib eq 'nullp_set_err') {
- # a fake attribute to produce a test case where STORE issues a warning
- $dbh->set_err($value, $value);
- }
- return $dbh->SUPER::STORE($attrib, $value);
- }
-
- sub ping { 1 }
-
- sub disconnect {
- shift->STORE(Active => 0);
- }
-
-}
-
-
-{ package DBD::NullP::st; # ====== STATEMENT ======
- our $imp_data_size = 0;
- use strict;
-
- sub bind_param {
- my ($sth, $param, $value, $attr) = @_;
- $sth->{ParamValues}{$param} = $value;
- $sth->{ParamAttr}{$param} = $attr
- if defined $attr; # attr is sticky if not explicitly set
- return 1;
- }
-
- sub execute {
- my $sth = shift;
- $sth->bind_param($_, $_[$_-1]) for (1..@_);
- if ($sth->{Statement} =~ m/^ \s* SELECT \s+/xmsi) {
- $sth->STORE(NUM_OF_FIELDS => 1);
- $sth->{NAME} = [ "fieldname" ];
- # just for the sake of returning something, we return the params
- my $params = $sth->{ParamValues} || {};
- $sth->{dbd_nullp_data} = [ @{$params}{ sort keys %$params } ];
- $sth->STORE(Active => 1);
- }
- # force a sleep - handy for testing
- elsif ($sth->{Statement} =~ m/^ \s* SLEEP \s+ (\S+) /xmsi) {
- my $secs = $1;
- if (eval { require Time::HiRes; defined &Time::HiRes::sleep }) {
- Time::HiRes::sleep($secs);
- }
- else {
- sleep $secs;
- }
- }
- # force an error - handy for testing
- elsif ($sth->{Statement} =~ m/^ \s* ERROR \s+ (\d+) \s* (.*) /xmsi) {
- return $sth->set_err($1, $2);
- }
- # anything else is silently ignored, successfully
- 1;
- }
-
- sub fetchrow_arrayref {
- my $sth = shift;
- my $data = shift @{$sth->{dbd_nullp_data}};
- if (!$data || !@$data) {
- $sth->finish; # no more data so finish
- return undef;
- }
- return $sth->_set_fbav($data);
- }
- *fetch = \&fetchrow_arrayref; # alias
-
- sub FETCH {
- my ($sth, $attrib) = @_;
- # would normally validate and only fetch known attributes
- # else pass up to DBI to handle
- return $sth->SUPER::FETCH($attrib);
- }
-
- sub STORE {
- my ($sth, $attrib, $value) = @_;
- # would normally validate and only store known attributes
- # else pass up to DBI to handle
- return $sth->SUPER::STORE($attrib, $value);
- }
-
-}
-
-1;
+++ /dev/null
-# -*- perl -*-
-#
-#
-# DBD::Proxy - DBI Proxy driver
-#
-#
-# Copyright (c) 1997,1998 Jochen Wiedmann
-#
-# The DBD::Proxy module is free software; you can redistribute it and/or
-# modify it under the same terms as Perl itself. In particular permission
-# is granted to Tim Bunce for distributing this as a part of the DBI.
-#
-#
-# Author: Jochen Wiedmann
-# Am Eisteich 9
-# 72555 Metzingen
-# Germany
-#
-# Email: joe@ispsoft.de
-# Phone: +49 7123 14881
-#
-
-use strict;
-use Carp;
-
-require DBI;
-DBI->require_version(1.0201);
-
-use RPC::PlClient 0.2000; # XXX change to 0.2017 once it's released
-
-{ package DBD::Proxy::RPC::PlClient;
- @DBD::Proxy::RPC::PlClient::ISA = qw(RPC::PlClient);
- sub Call {
- my $self = shift;
- if ($self->{debug}) {
- my ($rpcmeth, $obj, $method, @args) = @_;
- local $^W; # silence undefs
- Carp::carp("Server $rpcmeth $method(@args)");
- }
- return $self->SUPER::Call(@_);
- }
-}
-
-
-package DBD::Proxy;
-
-use vars qw($VERSION $drh %ATTR);
-
-$VERSION = "0.2004";
-
-$drh = undef; # holds driver handle once initialised
-
-%ATTR = ( # common to db & st, see also %ATTR in DBD::Proxy::db & ::st
- 'Warn' => 'local',
- 'Active' => 'local',
- 'Kids' => 'local',
- 'CachedKids' => 'local',
- 'PrintError' => 'local',
- 'RaiseError' => 'local',
- 'HandleError' => 'local',
- 'TraceLevel' => 'cached',
- 'CompatMode' => 'local',
-);
-
-sub driver ($$) {
- if (!$drh) {
- my($class, $attr) = @_;
-
- $class .= "::dr";
-
- $drh = DBI::_new_drh($class, {
- 'Name' => 'Proxy',
- 'Version' => $VERSION,
- 'Attribution' => 'DBD::Proxy by Jochen Wiedmann',
- });
- $drh->STORE(CompatMode => 1); # disable DBI dispatcher attribute cache (for FETCH)
- }
- $drh;
-}
-
-sub CLONE {
- undef $drh;
-}
-
-sub proxy_set_err {
- my ($h,$errmsg) = @_;
- my ($err, $state) = ($errmsg =~ s/ \[err=(.*?),state=(.*?)\]//)
- ? ($1, $2) : (1, ' ' x 5);
- return $h->set_err($err, $errmsg, $state);
-}
-
-package DBD::Proxy::dr; # ====== DRIVER ======
-
-$DBD::Proxy::dr::imp_data_size = 0;
-
-sub connect ($$;$$) {
- my($drh, $dsn, $user, $auth, $attr)= @_;
- my($dsnOrig) = $dsn;
-
- my %attr = %$attr;
- my ($var, $val);
- while (length($dsn)) {
- if ($dsn =~ /^dsn=(.*)/) {
- $attr{'dsn'} = $1;
- last;
- }
- if ($dsn =~ /^(.*?);(.*)/) {
- $var = $1;
- $dsn = $2;
- } else {
- $var = $dsn;
- $dsn = '';
- }
- if ($var =~ /^(.*?)=(.*)/) {
- $var = $1;
- $val = $2;
- $attr{$var} = $val;
- }
- }
-
- my $err = '';
- if (!defined($attr{'hostname'})) { $err .= " Missing hostname."; }
- if (!defined($attr{'port'})) { $err .= " Missing port."; }
- if (!defined($attr{'dsn'})) { $err .= " Missing remote dsn."; }
-
- # Create a cipher object, if requested
- my $cipherRef = undef;
- if ($attr{'cipher'}) {
- $cipherRef = eval { $attr{'cipher'}->new(pack('H*',
- $attr{'key'})) };
- if ($@) { $err .= " Cannot create cipher object: $@."; }
- }
- my $userCipherRef = undef;
- if ($attr{'userkey'}) {
- my $cipher = $attr{'usercipher'} || $attr{'cipher'};
- $userCipherRef = eval { $cipher->new(pack('H*', $attr{'userkey'})) };
- if ($@) { $err .= " Cannot create usercipher object: $@."; }
- }
-
- return DBD::Proxy::proxy_set_err($drh, $err) if $err; # Returns undef
-
- my %client_opts = (
- 'peeraddr' => $attr{'hostname'},
- 'peerport' => $attr{'port'},
- 'socket_proto' => 'tcp',
- 'application' => $attr{dsn},
- 'user' => $user || '',
- 'password' => $auth || '',
- 'version' => $DBD::Proxy::VERSION,
- 'cipher' => $cipherRef,
- 'debug' => $attr{debug} || 0,
- 'timeout' => $attr{timeout} || undef,
- 'logfile' => $attr{logfile} || undef
- );
- # Options starting with 'proxy_rpc_' are forwarded to the RPC layer after
- # stripping the prefix.
- while (my($var,$val) = each %attr) {
- if ($var =~ s/^proxy_rpc_//) {
- $client_opts{$var} = $val;
- }
- }
- # Create an RPC::PlClient object.
- my($client, $msg) = eval { DBD::Proxy::RPC::PlClient->new(%client_opts) };
-
- return DBD::Proxy::proxy_set_err($drh, "Cannot log in to DBI::ProxyServer: $@")
- if $@; # Returns undef
- return DBD::Proxy::proxy_set_err($drh, "Constructor didn't return a handle: $msg")
- unless ($msg =~ /^((?:\w+|\:\:)+)=(\w+)/); # Returns undef
-
- $msg = RPC::PlClient::Object->new($1, $client, $msg);
-
- my $max_proto_ver;
- my ($server_ver_str) = eval { $client->Call('Version') };
- if ( $@ ) {
- # Server denies call, assume legacy protocol.
- $max_proto_ver = 1;
- } else {
- # Parse proxy server version.
- my ($server_ver_num) = $server_ver_str =~ /^DBI::ProxyServer\s+([\d\.]+)/;
- $max_proto_ver = $server_ver_num >= 0.3 ? 2 : 1;
- }
- my $req_proto_ver;
- if ( exists $attr{proxy_lazy_prepare} ) {
- $req_proto_ver = ($attr{proxy_lazy_prepare} == 0) ? 2 : 1;
- return DBD::Proxy::proxy_set_err($drh,
- "DBI::ProxyServer does not support synchronous statement preparation.")
- if $max_proto_ver < $req_proto_ver;
- }
-
- # Switch to user specific encryption mode, if desired
- if ($userCipherRef) {
- $client->{'cipher'} = $userCipherRef;
- }
-
- # create a 'blank' dbh
- my $this = DBI::_new_dbh($drh, {
- 'Name' => $dsnOrig,
- 'proxy_dbh' => $msg,
- 'proxy_client' => $client,
- 'RowCacheSize' => $attr{'RowCacheSize'} || 20,
- 'proxy_proto_ver' => $req_proto_ver || 1
- });
-
- foreach $var (keys %attr) {
- if ($var =~ /proxy_/) {
- $this->{$var} = $attr{$var};
- }
- }
- $this->SUPER::STORE('Active' => 1);
-
- $this;
-}
-
-
-sub DESTROY { undef }
-
-
-package DBD::Proxy::db; # ====== DATABASE ======
-
-$DBD::Proxy::db::imp_data_size = 0;
-
-# XXX probably many more methods need to be added here
-# in order to trigger our AUTOLOAD to redirect them to the server.
-# (Unless the sub is declared it's bypassed by perl method lookup.)
-# See notes in ToDo about method metadata
-# The question is whether to add all the methods in %DBI::DBI_methods
-# to the corresponding classes (::db, ::st etc)
-# Also need to consider methods that, if proxied, would change the server state
-# in a way that might not be visible on the client, ie begin_work -> AutoCommit.
-
-sub commit;
-sub rollback;
-sub ping;
-
-use vars qw(%ATTR $AUTOLOAD);
-
-# inherited: STORE / FETCH against this class.
-# local: STORE / FETCH against parent class.
-# cached: STORE to remote and local objects, FETCH from local.
-# remote: STORE / FETCH against remote object only (default).
-#
-# Note: Attribute names starting with 'proxy_' always treated as 'inherited'.
-#
-%ATTR = ( # see also %ATTR in DBD::Proxy::st
- %DBD::Proxy::ATTR,
- RowCacheSize => 'inherited',
- #AutoCommit => 'cached',
- 'FetchHashKeyName' => 'cached',
- Statement => 'local',
- Driver => 'local',
- dbi_connect_closure => 'local',
- Username => 'local',
-);
-
-sub AUTOLOAD {
- my $method = $AUTOLOAD;
- $method =~ s/(.*::(.*)):://;
- my $class = $1;
- my $type = $2;
- #warn "AUTOLOAD of $method (class=$class, type=$type)";
- my %expand = (
- 'method' => $method,
- 'class' => $class,
- 'type' => $type,
- 'call' => "$method(\@_)",
- # XXX was trying to be smart but was tripping up over the DBI's own
- # smartness. Disabled, but left here in case there are issues.
- # 'call' => (UNIVERSAL::can("DBI::_::$type", $method)) ? "$method(\@_)" : "func(\@_, '$method')",
- );
-
- my $method_code = q{
- package ~class~;
- sub ~method~ {
- my $h = shift;
- local $@;
- my @result = wantarray
- ? eval { $h->{'proxy_~type~h'}->~call~ }
- : eval { scalar $h->{'proxy_~type~h'}->~call~ };
- return DBD::Proxy::proxy_set_err($h, $@) if $@;
- return wantarray ? @result : $result[0];
- }
- };
- $method_code =~ s/\~(\w+)\~/$expand{$1}/eg;
- local $SIG{__DIE__} = 'DEFAULT';
- my $err = do { local $@; eval $method_code.2; $@ };
- die $err if $err;
- goto &$AUTOLOAD;
-}
-
-sub DESTROY {
- my $dbh = shift;
- local $@ if $@; # protect $@
- $dbh->disconnect if $dbh->SUPER::FETCH('Active');
-}
-
-
-sub connected { } # client-side not server-side, RT#75868
-
-sub disconnect ($) {
- my ($dbh) = @_;
-
- # Sadly the Proxy too-often disagrees with the backend database
- # on the subject of 'Active'. In the short term, I'd like the
- # Proxy to ease up and let me decide when it's proper to go over
- # the wire. This ultimately applies to finish() as well.
- #return unless $dbh->SUPER::FETCH('Active');
-
- # Drop database connection at remote end
- my $rdbh = $dbh->{'proxy_dbh'};
- if ( $rdbh ) {
- local $SIG{__DIE__} = 'DEFAULT';
- local $@;
- eval { $rdbh->disconnect() } ;
- DBD::Proxy::proxy_set_err($dbh, $@) if $@;
- }
-
- # Close TCP connect to remote
- # XXX possibly best left till DESTROY? Add a config attribute to choose?
- #$dbh->{proxy_client}->Disconnect(); # Disconnect method requires newer PlRPC module
- $dbh->{proxy_client}->{socket} = undef; # hack
-
- $dbh->SUPER::STORE('Active' => 0);
- 1;
-}
-
-
-sub STORE ($$$) {
- my($dbh, $attr, $val) = @_;
- my $type = $ATTR{$attr} || 'remote';
-
- if ($attr eq 'TraceLevel') {
- warn("TraceLevel $val");
- my $pc = $dbh->{proxy_client} || die;
- $pc->{logfile} ||= 1; # XXX hack
- $pc->{debug} = ($val && $val >= 4);
- $pc->Debug("$pc debug enabled") if $pc->{debug};
- }
-
- if ($attr =~ /^proxy_/ || $type eq 'inherited') {
- $dbh->{$attr} = $val;
- return 1;
- }
-
- if ($type eq 'remote' || $type eq 'cached') {
- local $SIG{__DIE__} = 'DEFAULT';
- local $@;
- my $result = eval { $dbh->{'proxy_dbh'}->STORE($attr => $val) };
- return DBD::Proxy::proxy_set_err($dbh, $@) if $@; # returns undef
- $dbh->SUPER::STORE($attr => $val) if $type eq 'cached';
- return $result;
- }
- return $dbh->SUPER::STORE($attr => $val);
-}
-
-sub FETCH ($$) {
- my($dbh, $attr) = @_;
- # we only get here for cached attribute values if the handle is in CompatMode
- # otherwise the DBI dispatcher handles the FETCH itself from the attribute cache.
- my $type = $ATTR{$attr} || 'remote';
-
- if ($attr =~ /^proxy_/ || $type eq 'inherited' || $type eq 'cached') {
- return $dbh->{$attr};
- }
-
- return $dbh->SUPER::FETCH($attr) unless $type eq 'remote';
-
- local $SIG{__DIE__} = 'DEFAULT';
- local $@;
- my $result = eval { $dbh->{'proxy_dbh'}->FETCH($attr) };
- return DBD::Proxy::proxy_set_err($dbh, $@) if $@;
- return $result;
-}
-
-sub prepare ($$;$) {
- my($dbh, $stmt, $attr) = @_;
- my $sth = DBI::_new_sth($dbh, {
- 'Statement' => $stmt,
- 'proxy_attr' => $attr,
- 'proxy_cache_only' => 0,
- 'proxy_params' => [],
- }
- );
- my $proto_ver = $dbh->{'proxy_proto_ver'};
- if ( $proto_ver > 1 ) {
- $sth->{'proxy_attr_cache'} = {cache_filled => 0};
- my $rdbh = $dbh->{'proxy_dbh'};
- local $SIG{__DIE__} = 'DEFAULT';
- local $@;
- my $rsth = eval { $rdbh->prepare($sth->{'Statement'}, $sth->{'proxy_attr'}, undef, $proto_ver) };
- return DBD::Proxy::proxy_set_err($sth, $@) if $@;
- return DBD::Proxy::proxy_set_err($sth, "Constructor didn't return a handle: $rsth")
- unless ($rsth =~ /^((?:\w+|\:\:)+)=(\w+)/);
-
- my $client = $dbh->{'proxy_client'};
- $rsth = RPC::PlClient::Object->new($1, $client, $rsth);
-
- $sth->{'proxy_sth'} = $rsth;
- # If statement is a positioned update we do not want any readahead.
- $sth->{'RowCacheSize'} = 1 if $stmt =~ /\bfor\s+update\b/i;
- # Since resources are used by prepared remote handle, mark us active.
- $sth->SUPER::STORE(Active => 1);
- }
- $sth;
-}
-
-sub quote {
- my $dbh = shift;
- my $proxy_quote = $dbh->{proxy_quote} || 'remote';
-
- return $dbh->SUPER::quote(@_)
- if $proxy_quote eq 'local' && @_ == 1;
-
- # For the common case of only a single argument
- # (no $data_type) we could learn and cache the behaviour.
- # Or we could probe the driver with a few test cases.
- # Or we could add a way to ask the DBI::ProxyServer
- # if $dbh->can('quote') == \&DBI::_::db::quote.
- # Tim
- #
- # Sounds all *very* smart to me. I'd rather suggest to
- # implement some of the typical quote possibilities
- # and let the user set
- # $dbh->{'proxy_quote'} = 'backslash_escaped';
- # for example.
- # Jochen
- local $SIG{__DIE__} = 'DEFAULT';
- local $@;
- my $result = eval { $dbh->{'proxy_dbh'}->quote(@_) };
- return DBD::Proxy::proxy_set_err($dbh, $@) if $@;
- return $result;
-}
-
-sub table_info {
- my $dbh = shift;
- my $rdbh = $dbh->{'proxy_dbh'};
- #warn "table_info(@_)";
- local $SIG{__DIE__} = 'DEFAULT';
- local $@;
- my($numFields, $names, $types, @rows) = eval { $rdbh->table_info(@_) };
- return DBD::Proxy::proxy_set_err($dbh, $@) if $@;
- my ($sth, $inner) = DBI::_new_sth($dbh, {
- 'Statement' => "SHOW TABLES",
- 'proxy_params' => [],
- 'proxy_data' => \@rows,
- 'proxy_attr_cache' => {
- 'NUM_OF_PARAMS' => 0,
- 'NUM_OF_FIELDS' => $numFields,
- 'NAME' => $names,
- 'TYPE' => $types,
- 'cache_filled' => 1
- },
- 'proxy_cache_only' => 1,
- });
- $sth->SUPER::STORE('NUM_OF_FIELDS' => $numFields);
- $inner->{NAME} = $names;
- $inner->{TYPE} = $types;
- $sth->SUPER::STORE('Active' => 1); # already execute()'d
- $sth->{'proxy_rows'} = @rows;
- return $sth;
-}
-
-sub tables {
- my $dbh = shift;
- #warn "tables(@_)";
- return $dbh->SUPER::tables(@_);
-}
-
-
-sub type_info_all {
- my $dbh = shift;
- local $SIG{__DIE__} = 'DEFAULT';
- local $@;
- my $result = eval { $dbh->{'proxy_dbh'}->type_info_all(@_) };
- return DBD::Proxy::proxy_set_err($dbh, $@) if $@;
- return $result;
-}
-
-
-package DBD::Proxy::st; # ====== STATEMENT ======
-
-$DBD::Proxy::st::imp_data_size = 0;
-
-use vars qw(%ATTR);
-
-# inherited: STORE to current object. FETCH from current if exists, else call up
-# to the (proxy) database object.
-# local: STORE / FETCH against parent class.
-# cache_only: STORE noop (read-only). FETCH from private_* if exists, else call
-# remote and cache the result.
-# remote: STORE / FETCH against remote object only (default).
-#
-# Note: Attribute names starting with 'proxy_' always treated as 'inherited'.
-#
-%ATTR = ( # see also %ATTR in DBD::Proxy::db
- %DBD::Proxy::ATTR,
- 'Database' => 'local',
- 'RowsInCache' => 'local',
- 'RowCacheSize' => 'inherited',
- 'NULLABLE' => 'cache_only',
- 'NAME' => 'cache_only',
- 'TYPE' => 'cache_only',
- 'PRECISION' => 'cache_only',
- 'SCALE' => 'cache_only',
- 'NUM_OF_FIELDS' => 'cache_only',
- 'NUM_OF_PARAMS' => 'cache_only'
-);
-
-*AUTOLOAD = \&DBD::Proxy::db::AUTOLOAD;
-
-sub execute ($@) {
- my $sth = shift;
- my $params = @_ ? \@_ : $sth->{'proxy_params'};
-
- # new execute, so delete any cached rows from previous execute
- undef $sth->{'proxy_data'};
- undef $sth->{'proxy_rows'};
-
- my $rsth = $sth->{proxy_sth};
- my $dbh = $sth->FETCH('Database');
- my $proto_ver = $dbh->{proxy_proto_ver};
-
- my ($numRows, @outData);
-
- local $SIG{__DIE__} = 'DEFAULT';
- local $@;
- if ( $proto_ver > 1 ) {
- ($numRows, @outData) = eval { $rsth->execute($params, $proto_ver) };
- return DBD::Proxy::proxy_set_err($sth, $@) if $@;
-
- # Attributes passed back only on the first execute() of a statement.
- unless ($sth->{proxy_attr_cache}->{cache_filled}) {
- my ($numFields, $numParams, $names, $types) = splice(@outData, 0, 4);
- $sth->{'proxy_attr_cache'} = {
- 'NUM_OF_FIELDS' => $numFields,
- 'NUM_OF_PARAMS' => $numParams,
- 'NAME' => $names,
- 'cache_filled' => 1
- };
- $sth->SUPER::STORE('NUM_OF_FIELDS' => $numFields);
- $sth->SUPER::STORE('NUM_OF_PARAMS' => $numParams);
- }
-
- }
- else {
- if ($rsth) {
- ($numRows, @outData) = eval { $rsth->execute($params, $proto_ver) };
- return DBD::Proxy::proxy_set_err($sth, $@) if $@;
-
- }
- else {
- my $rdbh = $dbh->{'proxy_dbh'};
-
- # Legacy prepare is actually prepare + first execute on the server.
- ($rsth, @outData) =
- eval { $rdbh->prepare($sth->{'Statement'},
- $sth->{'proxy_attr'}, $params, $proto_ver) };
- return DBD::Proxy::proxy_set_err($sth, $@) if $@;
- return DBD::Proxy::proxy_set_err($sth, "Constructor didn't return a handle: $rsth")
- unless ($rsth =~ /^((?:\w+|\:\:)+)=(\w+)/);
-
- my $client = $dbh->{'proxy_client'};
- $rsth = RPC::PlClient::Object->new($1, $client, $rsth);
-
- my ($numFields, $numParams, $names, $types) = splice(@outData, 0, 4);
- $sth->{'proxy_sth'} = $rsth;
- $sth->{'proxy_attr_cache'} = {
- 'NUM_OF_FIELDS' => $numFields,
- 'NUM_OF_PARAMS' => $numParams,
- 'NAME' => $names
- };
- $sth->SUPER::STORE('NUM_OF_FIELDS' => $numFields);
- $sth->SUPER::STORE('NUM_OF_PARAMS' => $numParams);
- $numRows = shift @outData;
- }
- }
- # Always condition active flag.
- $sth->SUPER::STORE('Active' => 1) if $sth->FETCH('NUM_OF_FIELDS'); # is SELECT
- $sth->{'proxy_rows'} = $numRows;
- # Any remaining items are output params.
- if (@outData) {
- foreach my $p (@$params) {
- if (ref($p->[0])) {
- my $ref = shift @outData;
- ${$p->[0]} = $$ref;
- }
- }
- }
-
- $sth->{'proxy_rows'} || '0E0';
-}
-
-sub fetch ($) {
- my $sth = shift;
-
- my $data = $sth->{'proxy_data'};
-
- $sth->{'proxy_rows'} = 0 unless defined $sth->{'proxy_rows'};
-
- if(!$data || !@$data) {
- return undef unless $sth->SUPER::FETCH('Active');
-
- my $rsth = $sth->{'proxy_sth'};
- if (!$rsth) {
- die "Attempt to fetch row without execute";
- }
- my $num_rows = $sth->FETCH('RowCacheSize') || 20;
- local $SIG{__DIE__} = 'DEFAULT';
- local $@;
- my @rows = eval { $rsth->fetch($num_rows) };
- return DBD::Proxy::proxy_set_err($sth, $@) if $@;
- unless (@rows == $num_rows) {
- undef $sth->{'proxy_data'};
- # server side has already called finish
- $sth->SUPER::STORE(Active => 0);
- }
- return undef unless @rows;
- $sth->{'proxy_data'} = $data = [@rows];
- }
- my $row = shift @$data;
-
- $sth->SUPER::STORE(Active => 0) if ( $sth->{proxy_cache_only} and !@$data );
- $sth->{'proxy_rows'}++;
- return $sth->_set_fbav($row);
-}
-*fetchrow_arrayref = \&fetch;
-
-sub rows ($) {
- my $rows = shift->{'proxy_rows'};
- return (defined $rows) ? $rows : -1;
-}
-
-sub finish ($) {
- my($sth) = @_;
- return 1 unless $sth->SUPER::FETCH('Active');
- my $rsth = $sth->{'proxy_sth'};
- $sth->SUPER::STORE('Active' => 0);
- return 0 unless $rsth; # Something's out of sync
- my $no_finish = exists($sth->{'proxy_no_finish'})
- ? $sth->{'proxy_no_finish'}
- : $sth->FETCH('Database')->{'proxy_no_finish'};
- unless ($no_finish) {
- local $SIG{__DIE__} = 'DEFAULT';
- local $@;
- my $result = eval { $rsth->finish() };
- return DBD::Proxy::proxy_set_err($sth, $@) if $@;
- return $result;
- }
- 1;
-}
-
-sub STORE ($$$) {
- my($sth, $attr, $val) = @_;
- my $type = $ATTR{$attr} || 'remote';
-
- if ($attr =~ /^proxy_/ || $type eq 'inherited') {
- $sth->{$attr} = $val;
- return 1;
- }
-
- if ($type eq 'cache_only') {
- return 0;
- }
-
- if ($type eq 'remote' || $type eq 'cached') {
- my $rsth = $sth->{'proxy_sth'} or return undef;
- local $SIG{__DIE__} = 'DEFAULT';
- local $@;
- my $result = eval { $rsth->STORE($attr => $val) };
- return DBD::Proxy::proxy_set_err($sth, $@) if ($@);
- return $result if $type eq 'remote'; # else fall through to cache locally
- }
- return $sth->SUPER::STORE($attr => $val);
-}
-
-sub FETCH ($$) {
- my($sth, $attr) = @_;
-
- if ($attr =~ /^proxy_/) {
- return $sth->{$attr};
- }
-
- my $type = $ATTR{$attr} || 'remote';
- if ($type eq 'inherited') {
- if (exists($sth->{$attr})) {
- return $sth->{$attr};
- }
- return $sth->FETCH('Database')->{$attr};
- }
-
- if ($type eq 'cache_only' &&
- exists($sth->{'proxy_attr_cache'}->{$attr})) {
- return $sth->{'proxy_attr_cache'}->{$attr};
- }
-
- if ($type ne 'local') {
- my $rsth = $sth->{'proxy_sth'} or return undef;
- local $SIG{__DIE__} = 'DEFAULT';
- local $@;
- my $result = eval { $rsth->FETCH($attr) };
- return DBD::Proxy::proxy_set_err($sth, $@) if $@;
- return $result;
- }
- elsif ($attr eq 'RowsInCache') {
- my $data = $sth->{'proxy_data'};
- $data ? @$data : 0;
- }
- else {
- $sth->SUPER::FETCH($attr);
- }
-}
-
-sub bind_param ($$$@) {
- my $sth = shift; my $param = shift;
- $sth->{'proxy_params'}->[$param-1] = [@_];
-}
-*bind_param_inout = \&bind_param;
-
-sub DESTROY {
- my $sth = shift;
- $sth->finish if $sth->SUPER::FETCH('Active');
-}
-
-
-1;
-
-
-__END__
-
-=head1 NAME
-
-DBD::Proxy - A proxy driver for the DBI
-
-=head1 SYNOPSIS
-
- use DBI;
-
- $dbh = DBI->connect("dbi:Proxy:hostname=$host;port=$port;dsn=$db",
- $user, $passwd);
-
- # See the DBI module documentation for full details
-
-=head1 DESCRIPTION
-
-DBD::Proxy is a Perl module for connecting to a database via a remote
-DBI driver. See L<DBD::Gofer> for an alternative with different trade-offs.
-
-This is of course not needed for DBI drivers which already
-support connecting to a remote database, but there are engines which
-don't offer network connectivity.
-
-Another application is offering database access through a firewall, as
-the driver offers query based restrictions. For example you can
-restrict queries to exactly those that are used in a given CGI
-application.
-
-Speaking of CGI, another application is (or rather, will be) to reduce
-the database connect/disconnect overhead from CGI scripts by using
-proxying the connect_cached method. The proxy server will hold the
-database connections open in a cache. The CGI script then trades the
-database connect/disconnect overhead for the DBD::Proxy
-connect/disconnect overhead which is typically much less.
-
-
-=head1 CONNECTING TO THE DATABASE
-
-Before connecting to a remote database, you must ensure, that a Proxy
-server is running on the remote machine. There's no default port, so
-you have to ask your system administrator for the port number. See
-L<DBI::ProxyServer> for details.
-
-Say, your Proxy server is running on machine "alpha", port 3334, and
-you'd like to connect to an ODBC database called "mydb" as user "joe"
-with password "hello". When using DBD::ODBC directly, you'd do a
-
- $dbh = DBI->connect("DBI:ODBC:mydb", "joe", "hello");
-
-With DBD::Proxy this becomes
-
- $dsn = "DBI:Proxy:hostname=alpha;port=3334;dsn=DBI:ODBC:mydb";
- $dbh = DBI->connect($dsn, "joe", "hello");
-
-You see, this is mainly the same. The DBD::Proxy module will create a
-connection to the Proxy server on "alpha" which in turn will connect
-to the ODBC database.
-
-Refer to the L<DBI> documentation on the C<connect> method for a way
-to automatically use DBD::Proxy without having to change your code.
-
-DBD::Proxy's DSN string has the format
-
- $dsn = "DBI:Proxy:key1=val1; ... ;keyN=valN;dsn=valDSN";
-
-In other words, it is a collection of key/value pairs. The following
-keys are recognized:
-
-=over 4
-
-=item hostname
-
-=item port
-
-Hostname and port of the Proxy server; these keys must be present,
-no defaults. Example:
-
- hostname=alpha;port=3334
-
-=item dsn
-
-The value of this attribute will be used as a dsn name by the Proxy
-server. Thus it must have the format C<DBI:driver:...>, in particular
-it will contain colons. The I<dsn> value may contain semicolons, hence
-this key *must* be the last and it's value will be the complete
-remaining part of the dsn. Example:
-
- dsn=DBI:ODBC:mydb
-
-=item cipher
-
-=item key
-
-=item usercipher
-
-=item userkey
-
-By using these fields you can enable encryption. If you set,
-for example,
-
- cipher=$class;key=$key
-
-(note the semicolon) then DBD::Proxy will create a new cipher object
-by executing
-
- $cipherRef = $class->new(pack("H*", $key));
-
-and pass this object to the RPC::PlClient module when creating a
-client. See L<RPC::PlClient>. Example:
-
- cipher=IDEA;key=97cd2375efa329aceef2098babdc9721
-
-The usercipher/userkey attributes allow you to use two phase encryption:
-The cipher/key encryption will be used in the login and authorisation
-phase. Once the client is authorised, he will change to usercipher/userkey
-encryption. Thus the cipher/key pair is a B<host> based secret, typically
-less secure than the usercipher/userkey secret and readable by anyone.
-The usercipher/userkey secret is B<your> private secret.
-
-Of course encryption requires an appropriately configured server. See
-L<DBD::ProxyServer/CONFIGURATION FILE>.
-
-=item debug
-
-Turn on debugging mode
-
-=item stderr
-
-This attribute will set the corresponding attribute of the RPC::PlClient
-object, thus logging will not use syslog(), but redirected to stderr.
-This is the default under Windows.
-
- stderr=1
-
-=item logfile
-
-Similar to the stderr attribute, but output will be redirected to the
-given file.
-
- logfile=/dev/null
-
-=item RowCacheSize
-
-The DBD::Proxy driver supports this attribute (which is DBI standard,
-as of DBI 1.02). It's used to reduce network round-trips by fetching
-multiple rows in one go. The current default value is 20, but this may
-change.
-
-
-=item proxy_no_finish
-
-This attribute can be used to reduce network traffic: If the
-application is calling $sth->finish() then the proxy tells the server
-to finish the remote statement handle. Of course this slows down things
-quite a lot, but is perfectly good for reducing memory usage with
-persistent connections.
-
-However, if you set the I<proxy_no_finish> attribute to a TRUE value,
-either in the database handle or in the statement handle, then finish()
-calls will be suppressed. This is what you want, for example, in small
-and fast CGI applications.
-
-=item proxy_quote
-
-This attribute can be used to reduce network traffic: By default calls
-to $dbh->quote() are passed to the remote driver. Of course this slows
-down things quite a lot, but is the safest default behaviour.
-
-However, if you set the I<proxy_quote> attribute to the value 'C<local>'
-either in the database handle or in the statement handle, and the call
-to quote has only one parameter, then the local default DBI quote
-method will be used (which will be faster but may be wrong).
-
-=back
-
-=head1 KNOWN ISSUES
-
-=head2 Unproxied method calls
-
-If a method isn't being proxied, try declaring a stub sub in the appropriate
-package (DBD::Proxy::db for a dbh method, and DBD::Proxy::st for an sth method).
-For example:
-
- sub DBD::Proxy::db::selectall_arrayref;
-
-That will enable selectall_arrayref to be proxied.
-
-Currently many methods aren't explicitly proxied and so you get the DBI's
-default methods executed on the client.
-
-Some of those methods, like selectall_arrayref, may then call other methods
-that are proxied (selectall_arrayref calls fetchall_arrayref which calls fetch
-which is proxied). So things may appear to work but operate more slowly than
-the could.
-
-This may all change in a later version.
-
-=head2 Complex handle attributes
-
-Sometimes handles are having complex attributes like hash refs or
-array refs and not simple strings or integers. For example, with
-DBD::CSV, you would like to write something like
-
- $dbh->{"csv_tables"}->{"passwd"} =
- { "sep_char" => ":", "eol" => "\n";
-
-The above example would advice the CSV driver to assume the file
-"passwd" to be in the format of the /etc/passwd file: Colons as
-separators and a line feed without carriage return as line
-terminator.
-
-Surprisingly this example doesn't work with the proxy driver. To understand
-the reasons, you should consider the following: The Perl compiler is
-executing the above example in two steps:
-
-=over
-
-=item 1
-
-The first step is fetching the value of the key "csv_tables" in the
-handle $dbh. The value returned is complex, a hash ref.
-
-=item 2
-
-The second step is storing some value (the right hand side of the
-assignment) as the key "passwd" in the hash ref from step 1.
-
-=back
-
-This becomes a little bit clearer, if we rewrite the above code:
-
- $tables = $dbh->{"csv_tables"};
- $tables->{"passwd"} = { "sep_char" => ":", "eol" => "\n";
-
-While the examples work fine without the proxy, the fail due to a
-subtle difference in step 1: By DBI magic, the hash ref
-$dbh->{'csv_tables'} is returned from the server to the client.
-The client creates a local copy. This local copy is the result of
-step 1. In other words, step 2 modifies a local copy of the hash ref,
-but not the server's hash ref.
-
-The workaround is storing the modified local copy back to the server:
-
- $tables = $dbh->{"csv_tables"};
- $tables->{"passwd"} = { "sep_char" => ":", "eol" => "\n";
- $dbh->{"csv_tables"} = $tables;
-
-
-=head1 SECURITY WARNING
-
-L<RPC::PlClient> used underneath is not secure due to serializing and
-deserializing data with L<Storable> module. Use the proxy driver only in
-trusted environment.
-
-
-=head1 AUTHOR AND COPYRIGHT
-
-This module is Copyright (c) 1997, 1998
-
- Jochen Wiedmann
- Am Eisteich 9
- 72555 Metzingen
- Germany
-
- Email: joe@ispsoft.de
- Phone: +49 7123 14887
-
-The DBD::Proxy module is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself. In particular permission
-is granted to Tim Bunce for distributing this as a part of the DBI.
-
-
-=head1 SEE ALSO
-
-L<DBI>, L<RPC::PlClient>, L<Storable>
-
-=cut
+++ /dev/null
-use strict;
-{
- package DBD::Sponge;
-
- require DBI;
- require Carp;
-
- our @EXPORT = qw(); # Do NOT @EXPORT anything.
- our $VERSION = "12.010003";
-
-# $Id: Sponge.pm 10002 2007-09-26 21:03:25Z Tim $
-#
-# Copyright (c) 1994-2003 Tim Bunce Ireland
-#
-# You may distribute under the terms of either the GNU General Public
-# License or the Artistic License, as specified in the Perl README file.
-
- our $drh = undef; # holds driver handle once initialised
- my $methods_already_installed;
-
- sub driver{
- return $drh if $drh;
-
- DBD::Sponge::db->install_method("sponge_test_installed_method")
- unless $methods_already_installed++;
-
- my($class, $attr) = @_;
- $class .= "::dr";
- ($drh) = DBI::_new_drh($class, {
- 'Name' => 'Sponge',
- 'Version' => $VERSION,
- 'Attribution' => "DBD::Sponge $VERSION (fake cursor driver) by Tim Bunce",
- });
- $drh;
- }
-
- sub CLONE {
- undef $drh;
- }
-}
-
-
-{ package DBD::Sponge::dr; # ====== DRIVER ======
- our $imp_data_size = 0;
- # we use default (dummy) connect method
-}
-
-
-{ package DBD::Sponge::db; # ====== DATABASE ======
- our $imp_data_size = 0;
- use strict;
-
- sub prepare {
- my($dbh, $statement, $attribs) = @_;
- my $rows = delete $attribs->{'rows'}
- or return $dbh->set_err($DBI::stderr,"No rows attribute supplied to prepare");
- my ($outer, $sth) = DBI::_new_sth($dbh, {
- 'Statement' => $statement,
- 'rows' => $rows,
- (map { exists $attribs->{$_} ? ($_=>$attribs->{$_}) : () }
- qw(execute_hook)
- ),
- });
- if (my $behave_like = $attribs->{behave_like}) {
- $outer->{$_} = $behave_like->{$_}
- foreach (qw(RaiseError PrintError HandleError ShowErrorStatement));
- }
-
- if ($statement =~ /^\s*insert\b/) { # very basic, just for testing execute_array()
- $sth->{is_insert} = 1;
- my $NUM_OF_PARAMS = $attribs->{NUM_OF_PARAMS}
- or return $dbh->set_err($DBI::stderr,"NUM_OF_PARAMS not specified for INSERT statement");
- $sth->STORE('NUM_OF_PARAMS' => $attribs->{NUM_OF_PARAMS} );
- }
- else { #assume select
-
- # we need to set NUM_OF_FIELDS
- my $numFields;
- if ($attribs->{'NUM_OF_FIELDS'}) {
- $numFields = $attribs->{'NUM_OF_FIELDS'};
- } elsif ($attribs->{'NAME'}) {
- $numFields = @{$attribs->{NAME}};
- } elsif ($attribs->{'TYPE'}) {
- $numFields = @{$attribs->{TYPE}};
- } elsif (my $firstrow = $rows->[0]) {
- $numFields = scalar @$firstrow;
- } else {
- return $dbh->set_err($DBI::stderr, 'Cannot determine NUM_OF_FIELDS');
- }
- $sth->STORE('NUM_OF_FIELDS' => $numFields);
- $sth->{NAME} = $attribs->{NAME}
- || [ map { "col$_" } 1..$numFields ];
- $sth->{TYPE} = $attribs->{TYPE}
- || [ (DBI::SQL_VARCHAR()) x $numFields ];
- $sth->{PRECISION} = $attribs->{PRECISION}
- || [ map { length($sth->{NAME}->[$_]) } 0..$numFields -1 ];
- $sth->{SCALE} = $attribs->{SCALE}
- || [ (0) x $numFields ];
- $sth->{NULLABLE} = $attribs->{NULLABLE}
- || [ (2) x $numFields ];
- }
-
- $outer;
- }
-
- sub type_info_all {
- my ($dbh) = @_;
- my $ti = [
- { TYPE_NAME => 0,
- DATA_TYPE => 1,
- PRECISION => 2,
- LITERAL_PREFIX => 3,
- LITERAL_SUFFIX => 4,
- CREATE_PARAMS => 5,
- NULLABLE => 6,
- CASE_SENSITIVE => 7,
- SEARCHABLE => 8,
- UNSIGNED_ATTRIBUTE=> 9,
- MONEY => 10,
- AUTO_INCREMENT => 11,
- LOCAL_TYPE_NAME => 12,
- MINIMUM_SCALE => 13,
- MAXIMUM_SCALE => 14,
- },
- [ 'VARCHAR', DBI::SQL_VARCHAR(), undef, "'","'", undef, 0, 1, 1, 0, 0,0,undef,0,0 ],
- ];
- return $ti;
- }
-
- sub FETCH {
- my ($dbh, $attrib) = @_;
- # In reality this would interrogate the database engine to
- # either return dynamic values that cannot be precomputed
- # or fetch and cache attribute values too expensive to prefetch.
- return 1 if $attrib eq 'AutoCommit';
- # else pass up to DBI to handle
- return $dbh->SUPER::FETCH($attrib);
- }
-
- sub STORE {
- my ($dbh, $attrib, $value) = @_;
- # would normally validate and only store known attributes
- # else pass up to DBI to handle
- if ($attrib eq 'AutoCommit') {
- return 1 if $value; # is already set
- Carp::croak("Can't disable AutoCommit");
- }
- return $dbh->SUPER::STORE($attrib, $value);
- }
-
- sub sponge_test_installed_method {
- my ($dbh, @args) = @_;
- return $dbh->set_err(42, "not enough parameters") unless @args >= 2;
- return \@args;
- }
-}
-
-
-{ package DBD::Sponge::st; # ====== STATEMENT ======
- our $imp_data_size = 0;
- use strict;
-
- sub execute {
- my $sth = shift;
-
- # hack to support ParamValues (when not using bind_param)
- $sth->{ParamValues} = (@_) ? { map { $_ => $_[$_-1] } 1..@_ } : undef;
-
- if (my $hook = $sth->{execute_hook}) {
- &$hook($sth, @_) or return;
- }
-
- if ($sth->{is_insert}) {
- my $row;
- $row = (@_) ? [ @_ ] : die "bind_param not supported yet" ;
- my $NUM_OF_PARAMS = $sth->{NUM_OF_PARAMS};
- return $sth->set_err($DBI::stderr, @$row." values bound (@$row) but $NUM_OF_PARAMS expected")
- if @$row != $NUM_OF_PARAMS;
- { local $^W; $sth->trace_msg("inserting (@$row)\n"); }
- push @{ $sth->{rows} }, $row;
- }
- else { # mark select sth as Active
- $sth->STORE(Active => 1);
- }
- # else do nothing for select as data is already in $sth->{rows}
- return 1;
- }
-
- sub fetch {
- my ($sth) = @_;
- my $row = shift @{$sth->{'rows'}};
- unless ($row) {
- $sth->STORE(Active => 0);
- return undef;
- }
- return $sth->_set_fbav($row);
- }
- *fetchrow_arrayref = \&fetch;
-
- sub FETCH {
- my ($sth, $attrib) = @_;
- # would normally validate and only fetch known attributes
- # else pass up to DBI to handle
- return $sth->SUPER::FETCH($attrib);
- }
-
- sub STORE {
- my ($sth, $attrib, $value) = @_;
- # would normally validate and only store known attributes
- # else pass up to DBI to handle
- return $sth->SUPER::STORE($attrib, $value);
- }
-}
-
-1;
-
-__END__
-
-=pod
-
-=head1 NAME
-
-DBD::Sponge - Create a DBI statement handle from Perl data
-
-=head1 SYNOPSIS
-
- my $sponge = DBI->connect("dbi:Sponge:","","",{ RaiseError => 1 });
- my $sth = $sponge->prepare($statement, {
- rows => $data,
- NAME => $names,
- %attr
- }
- );
-
-=head1 DESCRIPTION
-
-DBD::Sponge is useful for making a Perl data structure accessible through a
-standard DBI statement handle. This may be useful to DBD module authors who
-need to transform data in this way.
-
-=head1 METHODS
-
-=head2 connect()
-
- my $sponge = DBI->connect("dbi:Sponge:","","",{ RaiseError => 1 });
-
-Here's a sample syntax for creating a database handle for the Sponge driver.
-No username and password are needed.
-
-=head2 prepare()
-
- my $sth = $sponge->prepare($statement, {
- rows => $data,
- NAME => $names,
- %attr
- }
- );
-
-=over 4
-
-=item *
-
-The C<$statement> here is an arbitrary statement or name you want
-to provide as identity of your data. If you're using DBI::Profile
-it will appear in the profile data.
-
-Generally it's expected that you are preparing a statement handle
-as if a C<select> statement happened.
-
-=item *
-
-C<$data> is a reference to the data you are providing, given as an array of arrays.
-
-=item *
-
-C<$names> is a reference an array of column names for the C<$data> you are providing.
-The number and order should match the number and ordering of the C<$data> columns.
-
-=item *
-
-C<%attr> is a hash of other standard DBI attributes that you might pass to a prepare statement.
-
-Currently only NAME, TYPE, and PRECISION are supported.
-
-=back
-
-=head1 BUGS
-
-Using this module to prepare INSERT-like statements is not currently documented.
-
-=head1 AUTHOR AND COPYRIGHT
-
-This module is Copyright (c) 2003 Tim Bunce
-
-Documentation initially written by Mark Stosberg
-
-The DBD::Sponge module is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself. In particular permission
-is granted to Tim Bunce for distributing this as a part of the DBI.
-
-=head1 SEE ALSO
-
-L<DBI>
-
-=cut
+++ /dev/null
-# $Id: ANSI.pm 8696 2007-01-24 23:12:38Z Tim $
-#
-# Copyright (c) 2002 Tim Bunce Ireland
-#
-# Constant data describing ANSI CLI info types and return values for the
-# SQLGetInfo() method of ODBC.
-#
-# You may distribute under the terms of either the GNU General Public
-# License or the Artistic License, as specified in the Perl README file.
-use strict;
-
-package DBI::Const::GetInfo::ANSI;
-
-our (%InfoTypes,%ReturnTypes,%ReturnValues,);
-
-=head1 NAME
-
-DBI::Const::GetInfo::ANSI - ISO/IEC SQL/CLI Constants for GetInfo
-
-=head1 SYNOPSIS
-
- The API for this module is private and subject to change.
-
-=head1 DESCRIPTION
-
-Information requested by GetInfo().
-
-See: A.1 C header file SQLCLI.H, Page 316, 317.
-
-The API for this module is private and subject to change.
-
-=head1 REFERENCES
-
- ISO/IEC FCD 9075-3:200x Information technology - Database Languages -
- SQL - Part 3: Call-Level Interface (SQL/CLI)
-
- SC32 N00744 = WG3:VIE-005 = H2-2002-007
-
- Date: 2002-01-15
-
-=cut
-
-my
-$VERSION = "2.008697";
-
-%InfoTypes =
-(
- SQL_ALTER_TABLE => 86
-, SQL_CATALOG_NAME => 10003
-, SQL_COLLATING_SEQUENCE => 10004
-, SQL_CURSOR_COMMIT_BEHAVIOR => 23
-, SQL_CURSOR_SENSITIVITY => 10001
-, SQL_DATA_SOURCE_NAME => 2
-, SQL_DATA_SOURCE_READ_ONLY => 25
-, SQL_DBMS_NAME => 17
-, SQL_DBMS_VERSION => 18
-, SQL_DEFAULT_TRANSACTION_ISOLATION => 26
-, SQL_DESCRIBE_PARAMETER => 10002
-, SQL_FETCH_DIRECTION => 8
-, SQL_GETDATA_EXTENSIONS => 81
-, SQL_IDENTIFIER_CASE => 28
-, SQL_INTEGRITY => 73
-, SQL_MAXIMUM_CATALOG_NAME_LENGTH => 34
-, SQL_MAXIMUM_COLUMNS_IN_GROUP_BY => 97
-, SQL_MAXIMUM_COLUMNS_IN_ORDER_BY => 99
-, SQL_MAXIMUM_COLUMNS_IN_SELECT => 100
-, SQL_MAXIMUM_COLUMNS_IN_TABLE => 101
-, SQL_MAXIMUM_COLUMN_NAME_LENGTH => 30
-, SQL_MAXIMUM_CONCURRENT_ACTIVITIES => 1
-, SQL_MAXIMUM_CURSOR_NAME_LENGTH => 31
-, SQL_MAXIMUM_DRIVER_CONNECTIONS => 0
-, SQL_MAXIMUM_IDENTIFIER_LENGTH => 10005
-, SQL_MAXIMUM_SCHEMA_NAME_LENGTH => 32
-, SQL_MAXIMUM_STMT_OCTETS => 20000
-, SQL_MAXIMUM_STMT_OCTETS_DATA => 20001
-, SQL_MAXIMUM_STMT_OCTETS_SCHEMA => 20002
-, SQL_MAXIMUM_TABLES_IN_SELECT => 106
-, SQL_MAXIMUM_TABLE_NAME_LENGTH => 35
-, SQL_MAXIMUM_USER_NAME_LENGTH => 107
-, SQL_NULL_COLLATION => 85
-, SQL_ORDER_BY_COLUMNS_IN_SELECT => 90
-, SQL_OUTER_JOIN_CAPABILITIES => 115
-, SQL_SCROLL_CONCURRENCY => 43
-, SQL_SEARCH_PATTERN_ESCAPE => 14
-, SQL_SERVER_NAME => 13
-, SQL_SPECIAL_CHARACTERS => 94
-, SQL_TRANSACTION_CAPABLE => 46
-, SQL_TRANSACTION_ISOLATION_OPTION => 72
-, SQL_USER_NAME => 47
-);
-
-=head2 %ReturnTypes
-
-See: Codes and data types for implementation information (Table 28), Page 85, 86.
-
-Mapped to ODBC datatype names.
-
-=cut
-
-%ReturnTypes = # maxlen
-(
- SQL_ALTER_TABLE => 'SQLUINTEGER bitmask' # INTEGER
-, SQL_CATALOG_NAME => 'SQLCHAR' # CHARACTER (1)
-, SQL_COLLATING_SEQUENCE => 'SQLCHAR' # CHARACTER (254)
-, SQL_CURSOR_COMMIT_BEHAVIOR => 'SQLUSMALLINT' # SMALLINT
-, SQL_CURSOR_SENSITIVITY => 'SQLUINTEGER' # INTEGER
-, SQL_DATA_SOURCE_NAME => 'SQLCHAR' # CHARACTER (128)
-, SQL_DATA_SOURCE_READ_ONLY => 'SQLCHAR' # CHARACTER (1)
-, SQL_DBMS_NAME => 'SQLCHAR' # CHARACTER (254)
-, SQL_DBMS_VERSION => 'SQLCHAR' # CHARACTER (254)
-, SQL_DEFAULT_TRANSACTION_ISOLATION => 'SQLUINTEGER' # INTEGER
-, SQL_DESCRIBE_PARAMETER => 'SQLCHAR' # CHARACTER (1)
-, SQL_FETCH_DIRECTION => 'SQLUINTEGER bitmask' # INTEGER
-, SQL_GETDATA_EXTENSIONS => 'SQLUINTEGER bitmask' # INTEGER
-, SQL_IDENTIFIER_CASE => 'SQLUSMALLINT' # SMALLINT
-, SQL_INTEGRITY => 'SQLCHAR' # CHARACTER (1)
-, SQL_MAXIMUM_CATALOG_NAME_LENGTH => 'SQLUSMALLINT' # SMALLINT
-, SQL_MAXIMUM_COLUMNS_IN_GROUP_BY => 'SQLUSMALLINT' # SMALLINT
-, SQL_MAXIMUM_COLUMNS_IN_ORDER_BY => 'SQLUSMALLINT' # SMALLINT
-, SQL_MAXIMUM_COLUMNS_IN_SELECT => 'SQLUSMALLINT' # SMALLINT
-, SQL_MAXIMUM_COLUMNS_IN_TABLE => 'SQLUSMALLINT' # SMALLINT
-, SQL_MAXIMUM_COLUMN_NAME_LENGTH => 'SQLUSMALLINT' # SMALLINT
-, SQL_MAXIMUM_CONCURRENT_ACTIVITIES => 'SQLUSMALLINT' # SMALLINT
-, SQL_MAXIMUM_CURSOR_NAME_LENGTH => 'SQLUSMALLINT' # SMALLINT
-, SQL_MAXIMUM_DRIVER_CONNECTIONS => 'SQLUSMALLINT' # SMALLINT
-, SQL_MAXIMUM_IDENTIFIER_LENGTH => 'SQLUSMALLINT' # SMALLINT
-, SQL_MAXIMUM_SCHEMA_NAME_LENGTH => 'SQLUSMALLINT' # SMALLINT
-, SQL_MAXIMUM_STMT_OCTETS => 'SQLUSMALLINT' # SMALLINT
-, SQL_MAXIMUM_STMT_OCTETS_DATA => 'SQLUSMALLINT' # SMALLINT
-, SQL_MAXIMUM_STMT_OCTETS_SCHEMA => 'SQLUSMALLINT' # SMALLINT
-, SQL_MAXIMUM_TABLES_IN_SELECT => 'SQLUSMALLINT' # SMALLINT
-, SQL_MAXIMUM_TABLE_NAME_LENGTH => 'SQLUSMALLINT' # SMALLINT
-, SQL_MAXIMUM_USER_NAME_LENGTH => 'SQLUSMALLINT' # SMALLINT
-, SQL_NULL_COLLATION => 'SQLUSMALLINT' # SMALLINT
-, SQL_ORDER_BY_COLUMNS_IN_SELECT => 'SQLCHAR' # CHARACTER (1)
-, SQL_OUTER_JOIN_CAPABILITIES => 'SQLUINTEGER bitmask' # INTEGER
-, SQL_SCROLL_CONCURRENCY => 'SQLUINTEGER bitmask' # INTEGER
-, SQL_SEARCH_PATTERN_ESCAPE => 'SQLCHAR' # CHARACTER (1)
-, SQL_SERVER_NAME => 'SQLCHAR' # CHARACTER (128)
-, SQL_SPECIAL_CHARACTERS => 'SQLCHAR' # CHARACTER (254)
-, SQL_TRANSACTION_CAPABLE => 'SQLUSMALLINT' # SMALLINT
-, SQL_TRANSACTION_ISOLATION_OPTION => 'SQLUINTEGER bitmask' # INTEGER
-, SQL_USER_NAME => 'SQLCHAR' # CHARACTER (128)
-);
-
-=head2 %ReturnValues
-
-See: A.1 C header file SQLCLI.H, Page 317, 318.
-
-=cut
-
-$ReturnValues{SQL_ALTER_TABLE} =
-{
- SQL_AT_ADD_COLUMN => 0x00000001
-, SQL_AT_DROP_COLUMN => 0x00000002
-, SQL_AT_ALTER_COLUMN => 0x00000004
-, SQL_AT_ADD_CONSTRAINT => 0x00000008
-, SQL_AT_DROP_CONSTRAINT => 0x00000010
-};
-$ReturnValues{SQL_CURSOR_COMMIT_BEHAVIOR} =
-{
- SQL_CB_DELETE => 0
-, SQL_CB_CLOSE => 1
-, SQL_CB_PRESERVE => 2
-};
-$ReturnValues{SQL_FETCH_DIRECTION} =
-{
- SQL_FD_FETCH_NEXT => 0x00000001
-, SQL_FD_FETCH_FIRST => 0x00000002
-, SQL_FD_FETCH_LAST => 0x00000004
-, SQL_FD_FETCH_PRIOR => 0x00000008
-, SQL_FD_FETCH_ABSOLUTE => 0x00000010
-, SQL_FD_FETCH_RELATIVE => 0x00000020
-};
-$ReturnValues{SQL_GETDATA_EXTENSIONS} =
-{
- SQL_GD_ANY_COLUMN => 0x00000001
-, SQL_GD_ANY_ORDER => 0x00000002
-};
-$ReturnValues{SQL_IDENTIFIER_CASE} =
-{
- SQL_IC_UPPER => 1
-, SQL_IC_LOWER => 2
-, SQL_IC_SENSITIVE => 3
-, SQL_IC_MIXED => 4
-};
-$ReturnValues{SQL_NULL_COLLATION} =
-{
- SQL_NC_HIGH => 1
-, SQL_NC_LOW => 2
-};
-$ReturnValues{SQL_OUTER_JOIN_CAPABILITIES} =
-{
- SQL_OUTER_JOIN_LEFT => 0x00000001
-, SQL_OUTER_JOIN_RIGHT => 0x00000002
-, SQL_OUTER_JOIN_FULL => 0x00000004
-, SQL_OUTER_JOIN_NESTED => 0x00000008
-, SQL_OUTER_JOIN_NOT_ORDERED => 0x00000010
-, SQL_OUTER_JOIN_INNER => 0x00000020
-, SQL_OUTER_JOIN_ALL_COMPARISON_OPS => 0x00000040
-};
-$ReturnValues{SQL_SCROLL_CONCURRENCY} =
-{
- SQL_SCCO_READ_ONLY => 0x00000001
-, SQL_SCCO_LOCK => 0x00000002
-, SQL_SCCO_OPT_ROWVER => 0x00000004
-, SQL_SCCO_OPT_VALUES => 0x00000008
-};
-$ReturnValues{SQL_TRANSACTION_ACCESS_MODE} =
-{
- SQL_TRANSACTION_READ_ONLY => 0x00000001
-, SQL_TRANSACTION_READ_WRITE => 0x00000002
-};
-$ReturnValues{SQL_TRANSACTION_CAPABLE} =
-{
- SQL_TC_NONE => 0
-, SQL_TC_DML => 1
-, SQL_TC_ALL => 2
-, SQL_TC_DDL_COMMIT => 3
-, SQL_TC_DDL_IGNORE => 4
-};
-$ReturnValues{SQL_TRANSACTION_ISOLATION} =
-{
- SQL_TRANSACTION_READ_UNCOMMITTED => 0x00000001
-, SQL_TRANSACTION_READ_COMMITTED => 0x00000002
-, SQL_TRANSACTION_REPEATABLE_READ => 0x00000004
-, SQL_TRANSACTION_SERIALIZABLE => 0x00000008
-};
-
-1;
-
-=head1 TODO
-
-Corrections, e.g.:
-
- SQL_TRANSACTION_ISOLATION_OPTION vs. SQL_TRANSACTION_ISOLATION
-
-=cut
+++ /dev/null
-# $Id: ODBC.pm 11373 2008-06-02 19:01:33Z Tim $
-#
-# Copyright (c) 2002 Tim Bunce Ireland
-#
-# Constant data describing Microsoft ODBC info types and return values
-# for the SQLGetInfo() method of ODBC.
-#
-# You may distribute under the terms of either the GNU General Public
-# License or the Artistic License, as specified in the Perl README file.
-use strict;
-package DBI::Const::GetInfo::ODBC;
-
-our (%InfoTypes,%ReturnTypes,%ReturnValues,);
-=head1 NAME
-
-DBI::Const::GetInfo::ODBC - ODBC Constants for GetInfo
-
-=head1 SYNOPSIS
-
- The API for this module is private and subject to change.
-
-=head1 DESCRIPTION
-
-Information requested by GetInfo().
-
-The API for this module is private and subject to change.
-
-=head1 REFERENCES
-
- MDAC SDK 2.6
- ODBC version number (0x0351)
-
- sql.h
- sqlext.h
-
-=cut
-
-my
-$VERSION = "2.011374";
-
-%InfoTypes =
-(
- SQL_ACCESSIBLE_PROCEDURES => 20
-, SQL_ACCESSIBLE_TABLES => 19
-, SQL_ACTIVE_CONNECTIONS => 0
-, SQL_ACTIVE_ENVIRONMENTS => 116
-, SQL_ACTIVE_STATEMENTS => 1
-, SQL_AGGREGATE_FUNCTIONS => 169
-, SQL_ALTER_DOMAIN => 117
-, SQL_ALTER_TABLE => 86
-, SQL_ASYNC_MODE => 10021
-, SQL_BATCH_ROW_COUNT => 120
-, SQL_BATCH_SUPPORT => 121
-, SQL_BOOKMARK_PERSISTENCE => 82
-, SQL_CATALOG_LOCATION => 114 # SQL_QUALIFIER_LOCATION
-, SQL_CATALOG_NAME => 10003
-, SQL_CATALOG_NAME_SEPARATOR => 41 # SQL_QUALIFIER_NAME_SEPARATOR
-, SQL_CATALOG_TERM => 42 # SQL_QUALIFIER_TERM
-, SQL_CATALOG_USAGE => 92 # SQL_QUALIFIER_USAGE
-, SQL_COLLATION_SEQ => 10004
-, SQL_COLUMN_ALIAS => 87
-, SQL_CONCAT_NULL_BEHAVIOR => 22
-, SQL_CONVERT_BIGINT => 53
-, SQL_CONVERT_BINARY => 54
-, SQL_CONVERT_BIT => 55
-, SQL_CONVERT_CHAR => 56
-, SQL_CONVERT_DATE => 57
-, SQL_CONVERT_DECIMAL => 58
-, SQL_CONVERT_DOUBLE => 59
-, SQL_CONVERT_FLOAT => 60
-, SQL_CONVERT_FUNCTIONS => 48
-, SQL_CONVERT_GUID => 173
-, SQL_CONVERT_INTEGER => 61
-, SQL_CONVERT_INTERVAL_DAY_TIME => 123
-, SQL_CONVERT_INTERVAL_YEAR_MONTH => 124
-, SQL_CONVERT_LONGVARBINARY => 71
-, SQL_CONVERT_LONGVARCHAR => 62
-, SQL_CONVERT_NUMERIC => 63
-, SQL_CONVERT_REAL => 64
-, SQL_CONVERT_SMALLINT => 65
-, SQL_CONVERT_TIME => 66
-, SQL_CONVERT_TIMESTAMP => 67
-, SQL_CONVERT_TINYINT => 68
-, SQL_CONVERT_VARBINARY => 69
-, SQL_CONVERT_VARCHAR => 70
-, SQL_CONVERT_WCHAR => 122
-, SQL_CONVERT_WLONGVARCHAR => 125
-, SQL_CONVERT_WVARCHAR => 126
-, SQL_CORRELATION_NAME => 74
-, SQL_CREATE_ASSERTION => 127
-, SQL_CREATE_CHARACTER_SET => 128
-, SQL_CREATE_COLLATION => 129
-, SQL_CREATE_DOMAIN => 130
-, SQL_CREATE_SCHEMA => 131
-, SQL_CREATE_TABLE => 132
-, SQL_CREATE_TRANSLATION => 133
-, SQL_CREATE_VIEW => 134
-, SQL_CURSOR_COMMIT_BEHAVIOR => 23
-, SQL_CURSOR_ROLLBACK_BEHAVIOR => 24
-, SQL_CURSOR_SENSITIVITY => 10001
-, SQL_DATA_SOURCE_NAME => 2
-, SQL_DATA_SOURCE_READ_ONLY => 25
-, SQL_DATABASE_NAME => 16
-, SQL_DATETIME_LITERALS => 119
-, SQL_DBMS_NAME => 17
-, SQL_DBMS_VER => 18
-, SQL_DDL_INDEX => 170
-, SQL_DEFAULT_TXN_ISOLATION => 26
-, SQL_DESCRIBE_PARAMETER => 10002
-, SQL_DM_VER => 171
-, SQL_DRIVER_HDBC => 3
-, SQL_DRIVER_HDESC => 135
-, SQL_DRIVER_HENV => 4
-, SQL_DRIVER_HLIB => 76
-, SQL_DRIVER_HSTMT => 5
-, SQL_DRIVER_NAME => 6
-, SQL_DRIVER_ODBC_VER => 77
-, SQL_DRIVER_VER => 7
-, SQL_DROP_ASSERTION => 136
-, SQL_DROP_CHARACTER_SET => 137
-, SQL_DROP_COLLATION => 138
-, SQL_DROP_DOMAIN => 139
-, SQL_DROP_SCHEMA => 140
-, SQL_DROP_TABLE => 141
-, SQL_DROP_TRANSLATION => 142
-, SQL_DROP_VIEW => 143
-, SQL_DYNAMIC_CURSOR_ATTRIBUTES1 => 144
-, SQL_DYNAMIC_CURSOR_ATTRIBUTES2 => 145
-, SQL_EXPRESSIONS_IN_ORDERBY => 27
-, SQL_FETCH_DIRECTION => 8
-, SQL_FILE_USAGE => 84
-, SQL_FORWARD_ONLY_CURSOR_ATTRIBUTES1 => 146
-, SQL_FORWARD_ONLY_CURSOR_ATTRIBUTES2 => 147
-, SQL_GETDATA_EXTENSIONS => 81
-, SQL_GROUP_BY => 88
-, SQL_IDENTIFIER_CASE => 28
-, SQL_IDENTIFIER_QUOTE_CHAR => 29
-, SQL_INDEX_KEYWORDS => 148
-# SQL_INFO_DRIVER_START => 1000
-# SQL_INFO_FIRST => 0
-# SQL_INFO_LAST => 114 # SQL_QUALIFIER_LOCATION
-, SQL_INFO_SCHEMA_VIEWS => 149
-, SQL_INSERT_STATEMENT => 172
-, SQL_INTEGRITY => 73
-, SQL_KEYSET_CURSOR_ATTRIBUTES1 => 150
-, SQL_KEYSET_CURSOR_ATTRIBUTES2 => 151
-, SQL_KEYWORDS => 89
-, SQL_LIKE_ESCAPE_CLAUSE => 113
-, SQL_LOCK_TYPES => 78
-, SQL_MAXIMUM_CATALOG_NAME_LENGTH => 34 # SQL_MAX_CATALOG_NAME_LEN
-, SQL_MAXIMUM_COLUMNS_IN_GROUP_BY => 97 # SQL_MAX_COLUMNS_IN_GROUP_BY
-, SQL_MAXIMUM_COLUMNS_IN_INDEX => 98 # SQL_MAX_COLUMNS_IN_INDEX
-, SQL_MAXIMUM_COLUMNS_IN_ORDER_BY => 99 # SQL_MAX_COLUMNS_IN_ORDER_BY
-, SQL_MAXIMUM_COLUMNS_IN_SELECT => 100 # SQL_MAX_COLUMNS_IN_SELECT
-, SQL_MAXIMUM_COLUMN_NAME_LENGTH => 30 # SQL_MAX_COLUMN_NAME_LEN
-, SQL_MAXIMUM_CONCURRENT_ACTIVITIES => 1 # SQL_MAX_CONCURRENT_ACTIVITIES
-, SQL_MAXIMUM_CURSOR_NAME_LENGTH => 31 # SQL_MAX_CURSOR_NAME_LEN
-, SQL_MAXIMUM_DRIVER_CONNECTIONS => 0 # SQL_MAX_DRIVER_CONNECTIONS
-, SQL_MAXIMUM_IDENTIFIER_LENGTH => 10005 # SQL_MAX_IDENTIFIER_LEN
-, SQL_MAXIMUM_INDEX_SIZE => 102 # SQL_MAX_INDEX_SIZE
-, SQL_MAXIMUM_ROW_SIZE => 104 # SQL_MAX_ROW_SIZE
-, SQL_MAXIMUM_SCHEMA_NAME_LENGTH => 32 # SQL_MAX_SCHEMA_NAME_LEN
-, SQL_MAXIMUM_STATEMENT_LENGTH => 105 # SQL_MAX_STATEMENT_LEN
-, SQL_MAXIMUM_TABLES_IN_SELECT => 106 # SQL_MAX_TABLES_IN_SELECT
-, SQL_MAXIMUM_USER_NAME_LENGTH => 107 # SQL_MAX_USER_NAME_LEN
-, SQL_MAX_ASYNC_CONCURRENT_STATEMENTS => 10022
-, SQL_MAX_BINARY_LITERAL_LEN => 112
-, SQL_MAX_CATALOG_NAME_LEN => 34
-, SQL_MAX_CHAR_LITERAL_LEN => 108
-, SQL_MAX_COLUMNS_IN_GROUP_BY => 97
-, SQL_MAX_COLUMNS_IN_INDEX => 98
-, SQL_MAX_COLUMNS_IN_ORDER_BY => 99
-, SQL_MAX_COLUMNS_IN_SELECT => 100
-, SQL_MAX_COLUMNS_IN_TABLE => 101
-, SQL_MAX_COLUMN_NAME_LEN => 30
-, SQL_MAX_CONCURRENT_ACTIVITIES => 1
-, SQL_MAX_CURSOR_NAME_LEN => 31
-, SQL_MAX_DRIVER_CONNECTIONS => 0
-, SQL_MAX_IDENTIFIER_LEN => 10005
-, SQL_MAX_INDEX_SIZE => 102
-, SQL_MAX_OWNER_NAME_LEN => 32
-, SQL_MAX_PROCEDURE_NAME_LEN => 33
-, SQL_MAX_QUALIFIER_NAME_LEN => 34
-, SQL_MAX_ROW_SIZE => 104
-, SQL_MAX_ROW_SIZE_INCLUDES_LONG => 103
-, SQL_MAX_SCHEMA_NAME_LEN => 32
-, SQL_MAX_STATEMENT_LEN => 105
-, SQL_MAX_TABLES_IN_SELECT => 106
-, SQL_MAX_TABLE_NAME_LEN => 35
-, SQL_MAX_USER_NAME_LEN => 107
-, SQL_MULTIPLE_ACTIVE_TXN => 37
-, SQL_MULT_RESULT_SETS => 36
-, SQL_NEED_LONG_DATA_LEN => 111
-, SQL_NON_NULLABLE_COLUMNS => 75
-, SQL_NULL_COLLATION => 85
-, SQL_NUMERIC_FUNCTIONS => 49
-, SQL_ODBC_API_CONFORMANCE => 9
-, SQL_ODBC_INTERFACE_CONFORMANCE => 152
-, SQL_ODBC_SAG_CLI_CONFORMANCE => 12
-, SQL_ODBC_SQL_CONFORMANCE => 15
-, SQL_ODBC_SQL_OPT_IEF => 73
-, SQL_ODBC_VER => 10
-, SQL_OJ_CAPABILITIES => 115
-, SQL_ORDER_BY_COLUMNS_IN_SELECT => 90
-, SQL_OUTER_JOINS => 38
-, SQL_OUTER_JOIN_CAPABILITIES => 115 # SQL_OJ_CAPABILITIES
-, SQL_OWNER_TERM => 39
-, SQL_OWNER_USAGE => 91
-, SQL_PARAM_ARRAY_ROW_COUNTS => 153
-, SQL_PARAM_ARRAY_SELECTS => 154
-, SQL_POSITIONED_STATEMENTS => 80
-, SQL_POS_OPERATIONS => 79
-, SQL_PROCEDURES => 21
-, SQL_PROCEDURE_TERM => 40
-, SQL_QUALIFIER_LOCATION => 114
-, SQL_QUALIFIER_NAME_SEPARATOR => 41
-, SQL_QUALIFIER_TERM => 42
-, SQL_QUALIFIER_USAGE => 92
-, SQL_QUOTED_IDENTIFIER_CASE => 93
-, SQL_ROW_UPDATES => 11
-, SQL_SCHEMA_TERM => 39 # SQL_OWNER_TERM
-, SQL_SCHEMA_USAGE => 91 # SQL_OWNER_USAGE
-, SQL_SCROLL_CONCURRENCY => 43
-, SQL_SCROLL_OPTIONS => 44
-, SQL_SEARCH_PATTERN_ESCAPE => 14
-, SQL_SERVER_NAME => 13
-, SQL_SPECIAL_CHARACTERS => 94
-, SQL_SQL92_DATETIME_FUNCTIONS => 155
-, SQL_SQL92_FOREIGN_KEY_DELETE_RULE => 156
-, SQL_SQL92_FOREIGN_KEY_UPDATE_RULE => 157
-, SQL_SQL92_GRANT => 158
-, SQL_SQL92_NUMERIC_VALUE_FUNCTIONS => 159
-, SQL_SQL92_PREDICATES => 160
-, SQL_SQL92_RELATIONAL_JOIN_OPERATORS => 161
-, SQL_SQL92_REVOKE => 162
-, SQL_SQL92_ROW_VALUE_CONSTRUCTOR => 163
-, SQL_SQL92_STRING_FUNCTIONS => 164
-, SQL_SQL92_VALUE_EXPRESSIONS => 165
-, SQL_SQL_CONFORMANCE => 118
-, SQL_STANDARD_CLI_CONFORMANCE => 166
-, SQL_STATIC_CURSOR_ATTRIBUTES1 => 167
-, SQL_STATIC_CURSOR_ATTRIBUTES2 => 168
-, SQL_STATIC_SENSITIVITY => 83
-, SQL_STRING_FUNCTIONS => 50
-, SQL_SUBQUERIES => 95
-, SQL_SYSTEM_FUNCTIONS => 51
-, SQL_TABLE_TERM => 45
-, SQL_TIMEDATE_ADD_INTERVALS => 109
-, SQL_TIMEDATE_DIFF_INTERVALS => 110
-, SQL_TIMEDATE_FUNCTIONS => 52
-, SQL_TRANSACTION_CAPABLE => 46 # SQL_TXN_CAPABLE
-, SQL_TRANSACTION_ISOLATION_OPTION => 72 # SQL_TXN_ISOLATION_OPTION
-, SQL_TXN_CAPABLE => 46
-, SQL_TXN_ISOLATION_OPTION => 72
-, SQL_UNION => 96
-, SQL_UNION_STATEMENT => 96 # SQL_UNION
-, SQL_USER_NAME => 47
-, SQL_XOPEN_CLI_YEAR => 10000
-);
-
-=head2 %ReturnTypes
-
-See: mk:@MSITStore:X:\dm\cli\mdac\sdk26\Docs\odbc.chm::/htm/odbcsqlgetinfo.htm
-
- => : alias
- => !!! : edited
-
-=cut
-
-%ReturnTypes =
-(
- SQL_ACCESSIBLE_PROCEDURES => 'SQLCHAR' # 20
-, SQL_ACCESSIBLE_TABLES => 'SQLCHAR' # 19
-, SQL_ACTIVE_CONNECTIONS => 'SQLUSMALLINT' # 0 =>
-, SQL_ACTIVE_ENVIRONMENTS => 'SQLUSMALLINT' # 116
-, SQL_ACTIVE_STATEMENTS => 'SQLUSMALLINT' # 1 =>
-, SQL_AGGREGATE_FUNCTIONS => 'SQLUINTEGER bitmask' # 169
-, SQL_ALTER_DOMAIN => 'SQLUINTEGER bitmask' # 117
-, SQL_ALTER_TABLE => 'SQLUINTEGER bitmask' # 86
-, SQL_ASYNC_MODE => 'SQLUINTEGER' # 10021
-, SQL_BATCH_ROW_COUNT => 'SQLUINTEGER bitmask' # 120
-, SQL_BATCH_SUPPORT => 'SQLUINTEGER bitmask' # 121
-, SQL_BOOKMARK_PERSISTENCE => 'SQLUINTEGER bitmask' # 82
-, SQL_CATALOG_LOCATION => 'SQLUSMALLINT' # 114
-, SQL_CATALOG_NAME => 'SQLCHAR' # 10003
-, SQL_CATALOG_NAME_SEPARATOR => 'SQLCHAR' # 41
-, SQL_CATALOG_TERM => 'SQLCHAR' # 42
-, SQL_CATALOG_USAGE => 'SQLUINTEGER bitmask' # 92
-, SQL_COLLATION_SEQ => 'SQLCHAR' # 10004
-, SQL_COLUMN_ALIAS => 'SQLCHAR' # 87
-, SQL_CONCAT_NULL_BEHAVIOR => 'SQLUSMALLINT' # 22
-, SQL_CONVERT_BIGINT => 'SQLUINTEGER bitmask' # 53
-, SQL_CONVERT_BINARY => 'SQLUINTEGER bitmask' # 54
-, SQL_CONVERT_BIT => 'SQLUINTEGER bitmask' # 55
-, SQL_CONVERT_CHAR => 'SQLUINTEGER bitmask' # 56
-, SQL_CONVERT_DATE => 'SQLUINTEGER bitmask' # 57
-, SQL_CONVERT_DECIMAL => 'SQLUINTEGER bitmask' # 58
-, SQL_CONVERT_DOUBLE => 'SQLUINTEGER bitmask' # 59
-, SQL_CONVERT_FLOAT => 'SQLUINTEGER bitmask' # 60
-, SQL_CONVERT_FUNCTIONS => 'SQLUINTEGER bitmask' # 48
-, SQL_CONVERT_GUID => 'SQLUINTEGER bitmask' # 173
-, SQL_CONVERT_INTEGER => 'SQLUINTEGER bitmask' # 61
-, SQL_CONVERT_INTERVAL_DAY_TIME => 'SQLUINTEGER bitmask' # 123
-, SQL_CONVERT_INTERVAL_YEAR_MONTH => 'SQLUINTEGER bitmask' # 124
-, SQL_CONVERT_LONGVARBINARY => 'SQLUINTEGER bitmask' # 71
-, SQL_CONVERT_LONGVARCHAR => 'SQLUINTEGER bitmask' # 62
-, SQL_CONVERT_NUMERIC => 'SQLUINTEGER bitmask' # 63
-, SQL_CONVERT_REAL => 'SQLUINTEGER bitmask' # 64
-, SQL_CONVERT_SMALLINT => 'SQLUINTEGER bitmask' # 65
-, SQL_CONVERT_TIME => 'SQLUINTEGER bitmask' # 66
-, SQL_CONVERT_TIMESTAMP => 'SQLUINTEGER bitmask' # 67
-, SQL_CONVERT_TINYINT => 'SQLUINTEGER bitmask' # 68
-, SQL_CONVERT_VARBINARY => 'SQLUINTEGER bitmask' # 69
-, SQL_CONVERT_VARCHAR => 'SQLUINTEGER bitmask' # 70
-, SQL_CONVERT_WCHAR => 'SQLUINTEGER bitmask' # 122 => !!!
-, SQL_CONVERT_WLONGVARCHAR => 'SQLUINTEGER bitmask' # 125 => !!!
-, SQL_CONVERT_WVARCHAR => 'SQLUINTEGER bitmask' # 126 => !!!
-, SQL_CORRELATION_NAME => 'SQLUSMALLINT' # 74
-, SQL_CREATE_ASSERTION => 'SQLUINTEGER bitmask' # 127
-, SQL_CREATE_CHARACTER_SET => 'SQLUINTEGER bitmask' # 128
-, SQL_CREATE_COLLATION => 'SQLUINTEGER bitmask' # 129
-, SQL_CREATE_DOMAIN => 'SQLUINTEGER bitmask' # 130
-, SQL_CREATE_SCHEMA => 'SQLUINTEGER bitmask' # 131
-, SQL_CREATE_TABLE => 'SQLUINTEGER bitmask' # 132
-, SQL_CREATE_TRANSLATION => 'SQLUINTEGER bitmask' # 133
-, SQL_CREATE_VIEW => 'SQLUINTEGER bitmask' # 134
-, SQL_CURSOR_COMMIT_BEHAVIOR => 'SQLUSMALLINT' # 23
-, SQL_CURSOR_ROLLBACK_BEHAVIOR => 'SQLUSMALLINT' # 24
-, SQL_CURSOR_SENSITIVITY => 'SQLUINTEGER' # 10001
-, SQL_DATA_SOURCE_NAME => 'SQLCHAR' # 2
-, SQL_DATA_SOURCE_READ_ONLY => 'SQLCHAR' # 25
-, SQL_DATABASE_NAME => 'SQLCHAR' # 16
-, SQL_DATETIME_LITERALS => 'SQLUINTEGER bitmask' # 119
-, SQL_DBMS_NAME => 'SQLCHAR' # 17
-, SQL_DBMS_VER => 'SQLCHAR' # 18
-, SQL_DDL_INDEX => 'SQLUINTEGER bitmask' # 170
-, SQL_DEFAULT_TXN_ISOLATION => 'SQLUINTEGER' # 26
-, SQL_DESCRIBE_PARAMETER => 'SQLCHAR' # 10002
-, SQL_DM_VER => 'SQLCHAR' # 171
-, SQL_DRIVER_HDBC => 'SQLUINTEGER' # 3
-, SQL_DRIVER_HDESC => 'SQLUINTEGER' # 135
-, SQL_DRIVER_HENV => 'SQLUINTEGER' # 4
-, SQL_DRIVER_HLIB => 'SQLUINTEGER' # 76
-, SQL_DRIVER_HSTMT => 'SQLUINTEGER' # 5
-, SQL_DRIVER_NAME => 'SQLCHAR' # 6
-, SQL_DRIVER_ODBC_VER => 'SQLCHAR' # 77
-, SQL_DRIVER_VER => 'SQLCHAR' # 7
-, SQL_DROP_ASSERTION => 'SQLUINTEGER bitmask' # 136
-, SQL_DROP_CHARACTER_SET => 'SQLUINTEGER bitmask' # 137
-, SQL_DROP_COLLATION => 'SQLUINTEGER bitmask' # 138
-, SQL_DROP_DOMAIN => 'SQLUINTEGER bitmask' # 139
-, SQL_DROP_SCHEMA => 'SQLUINTEGER bitmask' # 140
-, SQL_DROP_TABLE => 'SQLUINTEGER bitmask' # 141
-, SQL_DROP_TRANSLATION => 'SQLUINTEGER bitmask' # 142
-, SQL_DROP_VIEW => 'SQLUINTEGER bitmask' # 143
-, SQL_DYNAMIC_CURSOR_ATTRIBUTES1 => 'SQLUINTEGER bitmask' # 144
-, SQL_DYNAMIC_CURSOR_ATTRIBUTES2 => 'SQLUINTEGER bitmask' # 145
-, SQL_EXPRESSIONS_IN_ORDERBY => 'SQLCHAR' # 27
-, SQL_FETCH_DIRECTION => 'SQLUINTEGER bitmask' # 8 => !!!
-, SQL_FILE_USAGE => 'SQLUSMALLINT' # 84
-, SQL_FORWARD_ONLY_CURSOR_ATTRIBUTES1 => 'SQLUINTEGER bitmask' # 146
-, SQL_FORWARD_ONLY_CURSOR_ATTRIBUTES2 => 'SQLUINTEGER bitmask' # 147
-, SQL_GETDATA_EXTENSIONS => 'SQLUINTEGER bitmask' # 81
-, SQL_GROUP_BY => 'SQLUSMALLINT' # 88
-, SQL_IDENTIFIER_CASE => 'SQLUSMALLINT' # 28
-, SQL_IDENTIFIER_QUOTE_CHAR => 'SQLCHAR' # 29
-, SQL_INDEX_KEYWORDS => 'SQLUINTEGER bitmask' # 148
-# SQL_INFO_DRIVER_START => '' # 1000 =>
-# SQL_INFO_FIRST => 'SQLUSMALLINT' # 0 =>
-# SQL_INFO_LAST => 'SQLUSMALLINT' # 114 =>
-, SQL_INFO_SCHEMA_VIEWS => 'SQLUINTEGER bitmask' # 149
-, SQL_INSERT_STATEMENT => 'SQLUINTEGER bitmask' # 172
-, SQL_INTEGRITY => 'SQLCHAR' # 73
-, SQL_KEYSET_CURSOR_ATTRIBUTES1 => 'SQLUINTEGER bitmask' # 150
-, SQL_KEYSET_CURSOR_ATTRIBUTES2 => 'SQLUINTEGER bitmask' # 151
-, SQL_KEYWORDS => 'SQLCHAR' # 89
-, SQL_LIKE_ESCAPE_CLAUSE => 'SQLCHAR' # 113
-, SQL_LOCK_TYPES => 'SQLUINTEGER bitmask' # 78 => !!!
-, SQL_MAXIMUM_CATALOG_NAME_LENGTH => 'SQLUSMALLINT' # 34 =>
-, SQL_MAXIMUM_COLUMNS_IN_GROUP_BY => 'SQLUSMALLINT' # 97 =>
-, SQL_MAXIMUM_COLUMNS_IN_INDEX => 'SQLUSMALLINT' # 98 =>
-, SQL_MAXIMUM_COLUMNS_IN_ORDER_BY => 'SQLUSMALLINT' # 99 =>
-, SQL_MAXIMUM_COLUMNS_IN_SELECT => 'SQLUSMALLINT' # 100 =>
-, SQL_MAXIMUM_COLUMN_NAME_LENGTH => 'SQLUSMALLINT' # 30 =>
-, SQL_MAXIMUM_CONCURRENT_ACTIVITIES => 'SQLUSMALLINT' # 1 =>
-, SQL_MAXIMUM_CURSOR_NAME_LENGTH => 'SQLUSMALLINT' # 31 =>
-, SQL_MAXIMUM_DRIVER_CONNECTIONS => 'SQLUSMALLINT' # 0 =>
-, SQL_MAXIMUM_IDENTIFIER_LENGTH => 'SQLUSMALLINT' # 10005 =>
-, SQL_MAXIMUM_INDEX_SIZE => 'SQLUINTEGER' # 102 =>
-, SQL_MAXIMUM_ROW_SIZE => 'SQLUINTEGER' # 104 =>
-, SQL_MAXIMUM_SCHEMA_NAME_LENGTH => 'SQLUSMALLINT' # 32 =>
-, SQL_MAXIMUM_STATEMENT_LENGTH => 'SQLUINTEGER' # 105 =>
-, SQL_MAXIMUM_TABLES_IN_SELECT => 'SQLUSMALLINT' # 106 =>
-, SQL_MAXIMUM_USER_NAME_LENGTH => 'SQLUSMALLINT' # 107 =>
-, SQL_MAX_ASYNC_CONCURRENT_STATEMENTS => 'SQLUINTEGER' # 10022
-, SQL_MAX_BINARY_LITERAL_LEN => 'SQLUINTEGER' # 112
-, SQL_MAX_CATALOG_NAME_LEN => 'SQLUSMALLINT' # 34
-, SQL_MAX_CHAR_LITERAL_LEN => 'SQLUINTEGER' # 108
-, SQL_MAX_COLUMNS_IN_GROUP_BY => 'SQLUSMALLINT' # 97
-, SQL_MAX_COLUMNS_IN_INDEX => 'SQLUSMALLINT' # 98
-, SQL_MAX_COLUMNS_IN_ORDER_BY => 'SQLUSMALLINT' # 99
-, SQL_MAX_COLUMNS_IN_SELECT => 'SQLUSMALLINT' # 100
-, SQL_MAX_COLUMNS_IN_TABLE => 'SQLUSMALLINT' # 101
-, SQL_MAX_COLUMN_NAME_LEN => 'SQLUSMALLINT' # 30
-, SQL_MAX_CONCURRENT_ACTIVITIES => 'SQLUSMALLINT' # 1
-, SQL_MAX_CURSOR_NAME_LEN => 'SQLUSMALLINT' # 31
-, SQL_MAX_DRIVER_CONNECTIONS => 'SQLUSMALLINT' # 0
-, SQL_MAX_IDENTIFIER_LEN => 'SQLUSMALLINT' # 10005
-, SQL_MAX_INDEX_SIZE => 'SQLUINTEGER' # 102
-, SQL_MAX_OWNER_NAME_LEN => 'SQLUSMALLINT' # 32 =>
-, SQL_MAX_PROCEDURE_NAME_LEN => 'SQLUSMALLINT' # 33
-, SQL_MAX_QUALIFIER_NAME_LEN => 'SQLUSMALLINT' # 34 =>
-, SQL_MAX_ROW_SIZE => 'SQLUINTEGER' # 104
-, SQL_MAX_ROW_SIZE_INCLUDES_LONG => 'SQLCHAR' # 103
-, SQL_MAX_SCHEMA_NAME_LEN => 'SQLUSMALLINT' # 32
-, SQL_MAX_STATEMENT_LEN => 'SQLUINTEGER' # 105
-, SQL_MAX_TABLES_IN_SELECT => 'SQLUSMALLINT' # 106
-, SQL_MAX_TABLE_NAME_LEN => 'SQLUSMALLINT' # 35
-, SQL_MAX_USER_NAME_LEN => 'SQLUSMALLINT' # 107
-, SQL_MULTIPLE_ACTIVE_TXN => 'SQLCHAR' # 37
-, SQL_MULT_RESULT_SETS => 'SQLCHAR' # 36
-, SQL_NEED_LONG_DATA_LEN => 'SQLCHAR' # 111
-, SQL_NON_NULLABLE_COLUMNS => 'SQLUSMALLINT' # 75
-, SQL_NULL_COLLATION => 'SQLUSMALLINT' # 85
-, SQL_NUMERIC_FUNCTIONS => 'SQLUINTEGER bitmask' # 49
-, SQL_ODBC_API_CONFORMANCE => 'SQLUSMALLINT' # 9 => !!!
-, SQL_ODBC_INTERFACE_CONFORMANCE => 'SQLUINTEGER' # 152
-, SQL_ODBC_SAG_CLI_CONFORMANCE => 'SQLUSMALLINT' # 12 => !!!
-, SQL_ODBC_SQL_CONFORMANCE => 'SQLUSMALLINT' # 15 => !!!
-, SQL_ODBC_SQL_OPT_IEF => 'SQLCHAR' # 73 =>
-, SQL_ODBC_VER => 'SQLCHAR' # 10
-, SQL_OJ_CAPABILITIES => 'SQLUINTEGER bitmask' # 115
-, SQL_ORDER_BY_COLUMNS_IN_SELECT => 'SQLCHAR' # 90
-, SQL_OUTER_JOINS => 'SQLCHAR' # 38 => !!!
-, SQL_OUTER_JOIN_CAPABILITIES => 'SQLUINTEGER bitmask' # 115 =>
-, SQL_OWNER_TERM => 'SQLCHAR' # 39 =>
-, SQL_OWNER_USAGE => 'SQLUINTEGER bitmask' # 91 =>
-, SQL_PARAM_ARRAY_ROW_COUNTS => 'SQLUINTEGER' # 153
-, SQL_PARAM_ARRAY_SELECTS => 'SQLUINTEGER' # 154
-, SQL_POSITIONED_STATEMENTS => 'SQLUINTEGER bitmask' # 80 => !!!
-, SQL_POS_OPERATIONS => 'SQLINTEGER bitmask' # 79
-, SQL_PROCEDURES => 'SQLCHAR' # 21
-, SQL_PROCEDURE_TERM => 'SQLCHAR' # 40
-, SQL_QUALIFIER_LOCATION => 'SQLUSMALLINT' # 114 =>
-, SQL_QUALIFIER_NAME_SEPARATOR => 'SQLCHAR' # 41 =>
-, SQL_QUALIFIER_TERM => 'SQLCHAR' # 42 =>
-, SQL_QUALIFIER_USAGE => 'SQLUINTEGER bitmask' # 92 =>
-, SQL_QUOTED_IDENTIFIER_CASE => 'SQLUSMALLINT' # 93
-, SQL_ROW_UPDATES => 'SQLCHAR' # 11
-, SQL_SCHEMA_TERM => 'SQLCHAR' # 39
-, SQL_SCHEMA_USAGE => 'SQLUINTEGER bitmask' # 91
-, SQL_SCROLL_CONCURRENCY => 'SQLUINTEGER bitmask' # 43 => !!!
-, SQL_SCROLL_OPTIONS => 'SQLUINTEGER bitmask' # 44
-, SQL_SEARCH_PATTERN_ESCAPE => 'SQLCHAR' # 14
-, SQL_SERVER_NAME => 'SQLCHAR' # 13
-, SQL_SPECIAL_CHARACTERS => 'SQLCHAR' # 94
-, SQL_SQL92_DATETIME_FUNCTIONS => 'SQLUINTEGER bitmask' # 155
-, SQL_SQL92_FOREIGN_KEY_DELETE_RULE => 'SQLUINTEGER bitmask' # 156
-, SQL_SQL92_FOREIGN_KEY_UPDATE_RULE => 'SQLUINTEGER bitmask' # 157
-, SQL_SQL92_GRANT => 'SQLUINTEGER bitmask' # 158
-, SQL_SQL92_NUMERIC_VALUE_FUNCTIONS => 'SQLUINTEGER bitmask' # 159
-, SQL_SQL92_PREDICATES => 'SQLUINTEGER bitmask' # 160
-, SQL_SQL92_RELATIONAL_JOIN_OPERATORS => 'SQLUINTEGER bitmask' # 161
-, SQL_SQL92_REVOKE => 'SQLUINTEGER bitmask' # 162
-, SQL_SQL92_ROW_VALUE_CONSTRUCTOR => 'SQLUINTEGER bitmask' # 163
-, SQL_SQL92_STRING_FUNCTIONS => 'SQLUINTEGER bitmask' # 164
-, SQL_SQL92_VALUE_EXPRESSIONS => 'SQLUINTEGER bitmask' # 165
-, SQL_SQL_CONFORMANCE => 'SQLUINTEGER' # 118
-, SQL_STANDARD_CLI_CONFORMANCE => 'SQLUINTEGER bitmask' # 166
-, SQL_STATIC_CURSOR_ATTRIBUTES1 => 'SQLUINTEGER bitmask' # 167
-, SQL_STATIC_CURSOR_ATTRIBUTES2 => 'SQLUINTEGER bitmask' # 168
-, SQL_STATIC_SENSITIVITY => 'SQLUINTEGER bitmask' # 83 => !!!
-, SQL_STRING_FUNCTIONS => 'SQLUINTEGER bitmask' # 50
-, SQL_SUBQUERIES => 'SQLUINTEGER bitmask' # 95
-, SQL_SYSTEM_FUNCTIONS => 'SQLUINTEGER bitmask' # 51
-, SQL_TABLE_TERM => 'SQLCHAR' # 45
-, SQL_TIMEDATE_ADD_INTERVALS => 'SQLUINTEGER bitmask' # 109
-, SQL_TIMEDATE_DIFF_INTERVALS => 'SQLUINTEGER bitmask' # 110
-, SQL_TIMEDATE_FUNCTIONS => 'SQLUINTEGER bitmask' # 52
-, SQL_TRANSACTION_CAPABLE => 'SQLUSMALLINT' # 46 =>
-, SQL_TRANSACTION_ISOLATION_OPTION => 'SQLUINTEGER bitmask' # 72 =>
-, SQL_TXN_CAPABLE => 'SQLUSMALLINT' # 46
-, SQL_TXN_ISOLATION_OPTION => 'SQLUINTEGER bitmask' # 72
-, SQL_UNION => 'SQLUINTEGER bitmask' # 96
-, SQL_UNION_STATEMENT => 'SQLUINTEGER bitmask' # 96 =>
-, SQL_USER_NAME => 'SQLCHAR' # 47
-, SQL_XOPEN_CLI_YEAR => 'SQLCHAR' # 10000
-);
-
-=head2 %ReturnValues
-
-See: sql.h, sqlext.h
-Edited:
- SQL_TXN_ISOLATION_OPTION
-
-=cut
-
-$ReturnValues{SQL_AGGREGATE_FUNCTIONS} =
-{
- SQL_AF_AVG => 0x00000001
-, SQL_AF_COUNT => 0x00000002
-, SQL_AF_MAX => 0x00000004
-, SQL_AF_MIN => 0x00000008
-, SQL_AF_SUM => 0x00000010
-, SQL_AF_DISTINCT => 0x00000020
-, SQL_AF_ALL => 0x00000040
-};
-$ReturnValues{SQL_ALTER_DOMAIN} =
-{
- SQL_AD_CONSTRAINT_NAME_DEFINITION => 0x00000001
-, SQL_AD_ADD_DOMAIN_CONSTRAINT => 0x00000002
-, SQL_AD_DROP_DOMAIN_CONSTRAINT => 0x00000004
-, SQL_AD_ADD_DOMAIN_DEFAULT => 0x00000008
-, SQL_AD_DROP_DOMAIN_DEFAULT => 0x00000010
-, SQL_AD_ADD_CONSTRAINT_INITIALLY_DEFERRED => 0x00000020
-, SQL_AD_ADD_CONSTRAINT_INITIALLY_IMMEDIATE => 0x00000040
-, SQL_AD_ADD_CONSTRAINT_DEFERRABLE => 0x00000080
-, SQL_AD_ADD_CONSTRAINT_NON_DEFERRABLE => 0x00000100
-};
-$ReturnValues{SQL_ALTER_TABLE} =
-{
- SQL_AT_ADD_COLUMN => 0x00000001
-, SQL_AT_DROP_COLUMN => 0x00000002
-, SQL_AT_ADD_CONSTRAINT => 0x00000008
-, SQL_AT_ADD_COLUMN_SINGLE => 0x00000020
-, SQL_AT_ADD_COLUMN_DEFAULT => 0x00000040
-, SQL_AT_ADD_COLUMN_COLLATION => 0x00000080
-, SQL_AT_SET_COLUMN_DEFAULT => 0x00000100
-, SQL_AT_DROP_COLUMN_DEFAULT => 0x00000200
-, SQL_AT_DROP_COLUMN_CASCADE => 0x00000400
-, SQL_AT_DROP_COLUMN_RESTRICT => 0x00000800
-, SQL_AT_ADD_TABLE_CONSTRAINT => 0x00001000
-, SQL_AT_DROP_TABLE_CONSTRAINT_CASCADE => 0x00002000
-, SQL_AT_DROP_TABLE_CONSTRAINT_RESTRICT => 0x00004000
-, SQL_AT_CONSTRAINT_NAME_DEFINITION => 0x00008000
-, SQL_AT_CONSTRAINT_INITIALLY_DEFERRED => 0x00010000
-, SQL_AT_CONSTRAINT_INITIALLY_IMMEDIATE => 0x00020000
-, SQL_AT_CONSTRAINT_DEFERRABLE => 0x00040000
-, SQL_AT_CONSTRAINT_NON_DEFERRABLE => 0x00080000
-};
-$ReturnValues{SQL_ASYNC_MODE} =
-{
- SQL_AM_NONE => 0
-, SQL_AM_CONNECTION => 1
-, SQL_AM_STATEMENT => 2
-};
-$ReturnValues{SQL_ATTR_MAX_ROWS} =
-{
- SQL_CA2_MAX_ROWS_SELECT => 0x00000080
-, SQL_CA2_MAX_ROWS_INSERT => 0x00000100
-, SQL_CA2_MAX_ROWS_DELETE => 0x00000200
-, SQL_CA2_MAX_ROWS_UPDATE => 0x00000400
-, SQL_CA2_MAX_ROWS_CATALOG => 0x00000800
-# SQL_CA2_MAX_ROWS_AFFECTS_ALL =>
-};
-$ReturnValues{SQL_ATTR_SCROLL_CONCURRENCY} =
-{
- SQL_CA2_READ_ONLY_CONCURRENCY => 0x00000001
-, SQL_CA2_LOCK_CONCURRENCY => 0x00000002
-, SQL_CA2_OPT_ROWVER_CONCURRENCY => 0x00000004
-, SQL_CA2_OPT_VALUES_CONCURRENCY => 0x00000008
-, SQL_CA2_SENSITIVITY_ADDITIONS => 0x00000010
-, SQL_CA2_SENSITIVITY_DELETIONS => 0x00000020
-, SQL_CA2_SENSITIVITY_UPDATES => 0x00000040
-};
-$ReturnValues{SQL_BATCH_ROW_COUNT} =
-{
- SQL_BRC_PROCEDURES => 0x0000001
-, SQL_BRC_EXPLICIT => 0x0000002
-, SQL_BRC_ROLLED_UP => 0x0000004
-};
-$ReturnValues{SQL_BATCH_SUPPORT} =
-{
- SQL_BS_SELECT_EXPLICIT => 0x00000001
-, SQL_BS_ROW_COUNT_EXPLICIT => 0x00000002
-, SQL_BS_SELECT_PROC => 0x00000004
-, SQL_BS_ROW_COUNT_PROC => 0x00000008
-};
-$ReturnValues{SQL_BOOKMARK_PERSISTENCE} =
-{
- SQL_BP_CLOSE => 0x00000001
-, SQL_BP_DELETE => 0x00000002
-, SQL_BP_DROP => 0x00000004
-, SQL_BP_TRANSACTION => 0x00000008
-, SQL_BP_UPDATE => 0x00000010
-, SQL_BP_OTHER_HSTMT => 0x00000020
-, SQL_BP_SCROLL => 0x00000040
-};
-$ReturnValues{SQL_CATALOG_LOCATION} =
-{
- SQL_CL_START => 0x0001 # SQL_QL_START
-, SQL_CL_END => 0x0002 # SQL_QL_END
-};
-$ReturnValues{SQL_CATALOG_USAGE} =
-{
- SQL_CU_DML_STATEMENTS => 0x00000001 # SQL_QU_DML_STATEMENTS
-, SQL_CU_PROCEDURE_INVOCATION => 0x00000002 # SQL_QU_PROCEDURE_INVOCATION
-, SQL_CU_TABLE_DEFINITION => 0x00000004 # SQL_QU_TABLE_DEFINITION
-, SQL_CU_INDEX_DEFINITION => 0x00000008 # SQL_QU_INDEX_DEFINITION
-, SQL_CU_PRIVILEGE_DEFINITION => 0x00000010 # SQL_QU_PRIVILEGE_DEFINITION
-};
-$ReturnValues{SQL_CONCAT_NULL_BEHAVIOR} =
-{
- SQL_CB_NULL => 0x0000
-, SQL_CB_NON_NULL => 0x0001
-};
-$ReturnValues{SQL_CONVERT_} =
-{
- SQL_CVT_CHAR => 0x00000001
-, SQL_CVT_NUMERIC => 0x00000002
-, SQL_CVT_DECIMAL => 0x00000004
-, SQL_CVT_INTEGER => 0x00000008
-, SQL_CVT_SMALLINT => 0x00000010
-, SQL_CVT_FLOAT => 0x00000020
-, SQL_CVT_REAL => 0x00000040
-, SQL_CVT_DOUBLE => 0x00000080
-, SQL_CVT_VARCHAR => 0x00000100
-, SQL_CVT_LONGVARCHAR => 0x00000200
-, SQL_CVT_BINARY => 0x00000400
-, SQL_CVT_VARBINARY => 0x00000800
-, SQL_CVT_BIT => 0x00001000
-, SQL_CVT_TINYINT => 0x00002000
-, SQL_CVT_BIGINT => 0x00004000
-, SQL_CVT_DATE => 0x00008000
-, SQL_CVT_TIME => 0x00010000
-, SQL_CVT_TIMESTAMP => 0x00020000
-, SQL_CVT_LONGVARBINARY => 0x00040000
-, SQL_CVT_INTERVAL_YEAR_MONTH => 0x00080000
-, SQL_CVT_INTERVAL_DAY_TIME => 0x00100000
-, SQL_CVT_WCHAR => 0x00200000
-, SQL_CVT_WLONGVARCHAR => 0x00400000
-, SQL_CVT_WVARCHAR => 0x00800000
-, SQL_CVT_GUID => 0x01000000
-};
-$ReturnValues{SQL_CONVERT_BIGINT } = $ReturnValues{SQL_CONVERT_};
-$ReturnValues{SQL_CONVERT_BINARY } = $ReturnValues{SQL_CONVERT_};
-$ReturnValues{SQL_CONVERT_BIT } = $ReturnValues{SQL_CONVERT_};
-$ReturnValues{SQL_CONVERT_CHAR } = $ReturnValues{SQL_CONVERT_};
-$ReturnValues{SQL_CONVERT_DATE } = $ReturnValues{SQL_CONVERT_};
-$ReturnValues{SQL_CONVERT_DECIMAL } = $ReturnValues{SQL_CONVERT_};
-$ReturnValues{SQL_CONVERT_DOUBLE } = $ReturnValues{SQL_CONVERT_};
-$ReturnValues{SQL_CONVERT_FLOAT } = $ReturnValues{SQL_CONVERT_};
-$ReturnValues{SQL_CONVERT_GUID } = $ReturnValues{SQL_CONVERT_};
-$ReturnValues{SQL_CONVERT_INTEGER } = $ReturnValues{SQL_CONVERT_};
-$ReturnValues{SQL_CONVERT_INTERVAL_DAY_TIME } = $ReturnValues{SQL_CONVERT_};
-$ReturnValues{SQL_CONVERT_INTERVAL_YEAR_MONTH} = $ReturnValues{SQL_CONVERT_};
-$ReturnValues{SQL_CONVERT_LONGVARBINARY } = $ReturnValues{SQL_CONVERT_};
-$ReturnValues{SQL_CONVERT_LONGVARCHAR } = $ReturnValues{SQL_CONVERT_};
-$ReturnValues{SQL_CONVERT_NUMERIC } = $ReturnValues{SQL_CONVERT_};
-$ReturnValues{SQL_CONVERT_REAL } = $ReturnValues{SQL_CONVERT_};
-$ReturnValues{SQL_CONVERT_SMALLINT } = $ReturnValues{SQL_CONVERT_};
-$ReturnValues{SQL_CONVERT_TIME } = $ReturnValues{SQL_CONVERT_};
-$ReturnValues{SQL_CONVERT_TIMESTAMP } = $ReturnValues{SQL_CONVERT_};
-$ReturnValues{SQL_CONVERT_TINYINT } = $ReturnValues{SQL_CONVERT_};
-$ReturnValues{SQL_CONVERT_VARBINARY } = $ReturnValues{SQL_CONVERT_};
-$ReturnValues{SQL_CONVERT_VARCHAR } = $ReturnValues{SQL_CONVERT_};
-$ReturnValues{SQL_CONVERT_WCHAR } = $ReturnValues{SQL_CONVERT_};
-$ReturnValues{SQL_CONVERT_WLONGVARCHAR } = $ReturnValues{SQL_CONVERT_};
-$ReturnValues{SQL_CONVERT_WVARCHAR } = $ReturnValues{SQL_CONVERT_};
-
-$ReturnValues{SQL_CONVERT_FUNCTIONS} =
-{
- SQL_FN_CVT_CONVERT => 0x00000001
-, SQL_FN_CVT_CAST => 0x00000002
-};
-$ReturnValues{SQL_CORRELATION_NAME} =
-{
- SQL_CN_NONE => 0x0000
-, SQL_CN_DIFFERENT => 0x0001
-, SQL_CN_ANY => 0x0002
-};
-$ReturnValues{SQL_CREATE_ASSERTION} =
-{
- SQL_CA_CREATE_ASSERTION => 0x00000001
-, SQL_CA_CONSTRAINT_INITIALLY_DEFERRED => 0x00000010
-, SQL_CA_CONSTRAINT_INITIALLY_IMMEDIATE => 0x00000020
-, SQL_CA_CONSTRAINT_DEFERRABLE => 0x00000040
-, SQL_CA_CONSTRAINT_NON_DEFERRABLE => 0x00000080
-};
-$ReturnValues{SQL_CREATE_CHARACTER_SET} =
-{
- SQL_CCS_CREATE_CHARACTER_SET => 0x00000001
-, SQL_CCS_COLLATE_CLAUSE => 0x00000002
-, SQL_CCS_LIMITED_COLLATION => 0x00000004
-};
-$ReturnValues{SQL_CREATE_COLLATION} =
-{
- SQL_CCOL_CREATE_COLLATION => 0x00000001
-};
-$ReturnValues{SQL_CREATE_DOMAIN} =
-{
- SQL_CDO_CREATE_DOMAIN => 0x00000001
-, SQL_CDO_DEFAULT => 0x00000002
-, SQL_CDO_CONSTRAINT => 0x00000004
-, SQL_CDO_COLLATION => 0x00000008
-, SQL_CDO_CONSTRAINT_NAME_DEFINITION => 0x00000010
-, SQL_CDO_CONSTRAINT_INITIALLY_DEFERRED => 0x00000020
-, SQL_CDO_CONSTRAINT_INITIALLY_IMMEDIATE => 0x00000040
-, SQL_CDO_CONSTRAINT_DEFERRABLE => 0x00000080
-, SQL_CDO_CONSTRAINT_NON_DEFERRABLE => 0x00000100
-};
-$ReturnValues{SQL_CREATE_SCHEMA} =
-{
- SQL_CS_CREATE_SCHEMA => 0x00000001
-, SQL_CS_AUTHORIZATION => 0x00000002
-, SQL_CS_DEFAULT_CHARACTER_SET => 0x00000004
-};
-$ReturnValues{SQL_CREATE_TABLE} =
-{
- SQL_CT_CREATE_TABLE => 0x00000001
-, SQL_CT_COMMIT_PRESERVE => 0x00000002
-, SQL_CT_COMMIT_DELETE => 0x00000004
-, SQL_CT_GLOBAL_TEMPORARY => 0x00000008
-, SQL_CT_LOCAL_TEMPORARY => 0x00000010
-, SQL_CT_CONSTRAINT_INITIALLY_DEFERRED => 0x00000020
-, SQL_CT_CONSTRAINT_INITIALLY_IMMEDIATE => 0x00000040
-, SQL_CT_CONSTRAINT_DEFERRABLE => 0x00000080
-, SQL_CT_CONSTRAINT_NON_DEFERRABLE => 0x00000100
-, SQL_CT_COLUMN_CONSTRAINT => 0x00000200
-, SQL_CT_COLUMN_DEFAULT => 0x00000400
-, SQL_CT_COLUMN_COLLATION => 0x00000800
-, SQL_CT_TABLE_CONSTRAINT => 0x00001000
-, SQL_CT_CONSTRAINT_NAME_DEFINITION => 0x00002000
-};
-$ReturnValues{SQL_CREATE_TRANSLATION} =
-{
- SQL_CTR_CREATE_TRANSLATION => 0x00000001
-};
-$ReturnValues{SQL_CREATE_VIEW} =
-{
- SQL_CV_CREATE_VIEW => 0x00000001
-, SQL_CV_CHECK_OPTION => 0x00000002
-, SQL_CV_CASCADED => 0x00000004
-, SQL_CV_LOCAL => 0x00000008
-};
-$ReturnValues{SQL_CURSOR_COMMIT_BEHAVIOR} =
-{
- SQL_CB_DELETE => 0
-, SQL_CB_CLOSE => 1
-, SQL_CB_PRESERVE => 2
-};
-$ReturnValues{SQL_CURSOR_ROLLBACK_BEHAVIOR} = $ReturnValues{SQL_CURSOR_COMMIT_BEHAVIOR};
-
-$ReturnValues{SQL_CURSOR_SENSITIVITY} =
-{
- SQL_UNSPECIFIED => 0
-, SQL_INSENSITIVE => 1
-, SQL_SENSITIVE => 2
-};
-$ReturnValues{SQL_DATETIME_LITERALS} =
-{
- SQL_DL_SQL92_DATE => 0x00000001
-, SQL_DL_SQL92_TIME => 0x00000002
-, SQL_DL_SQL92_TIMESTAMP => 0x00000004
-, SQL_DL_SQL92_INTERVAL_YEAR => 0x00000008
-, SQL_DL_SQL92_INTERVAL_MONTH => 0x00000010
-, SQL_DL_SQL92_INTERVAL_DAY => 0x00000020
-, SQL_DL_SQL92_INTERVAL_HOUR => 0x00000040
-, SQL_DL_SQL92_INTERVAL_MINUTE => 0x00000080
-, SQL_DL_SQL92_INTERVAL_SECOND => 0x00000100
-, SQL_DL_SQL92_INTERVAL_YEAR_TO_MONTH => 0x00000200
-, SQL_DL_SQL92_INTERVAL_DAY_TO_HOUR => 0x00000400
-, SQL_DL_SQL92_INTERVAL_DAY_TO_MINUTE => 0x00000800
-, SQL_DL_SQL92_INTERVAL_DAY_TO_SECOND => 0x00001000
-, SQL_DL_SQL92_INTERVAL_HOUR_TO_MINUTE => 0x00002000
-, SQL_DL_SQL92_INTERVAL_HOUR_TO_SECOND => 0x00004000
-, SQL_DL_SQL92_INTERVAL_MINUTE_TO_SECOND => 0x00008000
-};
-$ReturnValues{SQL_DDL_INDEX} =
-{
- SQL_DI_CREATE_INDEX => 0x00000001
-, SQL_DI_DROP_INDEX => 0x00000002
-};
-$ReturnValues{SQL_DIAG_CURSOR_ROW_COUNT} =
-{
- SQL_CA2_CRC_EXACT => 0x00001000
-, SQL_CA2_CRC_APPROXIMATE => 0x00002000
-, SQL_CA2_SIMULATE_NON_UNIQUE => 0x00004000
-, SQL_CA2_SIMULATE_TRY_UNIQUE => 0x00008000
-, SQL_CA2_SIMULATE_UNIQUE => 0x00010000
-};
-$ReturnValues{SQL_DROP_ASSERTION} =
-{
- SQL_DA_DROP_ASSERTION => 0x00000001
-};
-$ReturnValues{SQL_DROP_CHARACTER_SET} =
-{
- SQL_DCS_DROP_CHARACTER_SET => 0x00000001
-};
-$ReturnValues{SQL_DROP_COLLATION} =
-{
- SQL_DC_DROP_COLLATION => 0x00000001
-};
-$ReturnValues{SQL_DROP_DOMAIN} =
-{
- SQL_DD_DROP_DOMAIN => 0x00000001
-, SQL_DD_RESTRICT => 0x00000002
-, SQL_DD_CASCADE => 0x00000004
-};
-$ReturnValues{SQL_DROP_SCHEMA} =
-{
- SQL_DS_DROP_SCHEMA => 0x00000001
-, SQL_DS_RESTRICT => 0x00000002
-, SQL_DS_CASCADE => 0x00000004
-};
-$ReturnValues{SQL_DROP_TABLE} =
-{
- SQL_DT_DROP_TABLE => 0x00000001
-, SQL_DT_RESTRICT => 0x00000002
-, SQL_DT_CASCADE => 0x00000004
-};
-$ReturnValues{SQL_DROP_TRANSLATION} =
-{
- SQL_DTR_DROP_TRANSLATION => 0x00000001
-};
-$ReturnValues{SQL_DROP_VIEW} =
-{
- SQL_DV_DROP_VIEW => 0x00000001
-, SQL_DV_RESTRICT => 0x00000002
-, SQL_DV_CASCADE => 0x00000004
-};
-$ReturnValues{SQL_CURSOR_ATTRIBUTES1} =
-{
- SQL_CA1_NEXT => 0x00000001
-, SQL_CA1_ABSOLUTE => 0x00000002
-, SQL_CA1_RELATIVE => 0x00000004
-, SQL_CA1_BOOKMARK => 0x00000008
-, SQL_CA1_LOCK_NO_CHANGE => 0x00000040
-, SQL_CA1_LOCK_EXCLUSIVE => 0x00000080
-, SQL_CA1_LOCK_UNLOCK => 0x00000100
-, SQL_CA1_POS_POSITION => 0x00000200
-, SQL_CA1_POS_UPDATE => 0x00000400
-, SQL_CA1_POS_DELETE => 0x00000800
-, SQL_CA1_POS_REFRESH => 0x00001000
-, SQL_CA1_POSITIONED_UPDATE => 0x00002000
-, SQL_CA1_POSITIONED_DELETE => 0x00004000
-, SQL_CA1_SELECT_FOR_UPDATE => 0x00008000
-, SQL_CA1_BULK_ADD => 0x00010000
-, SQL_CA1_BULK_UPDATE_BY_BOOKMARK => 0x00020000
-, SQL_CA1_BULK_DELETE_BY_BOOKMARK => 0x00040000
-, SQL_CA1_BULK_FETCH_BY_BOOKMARK => 0x00080000
-};
-$ReturnValues{ SQL_DYNAMIC_CURSOR_ATTRIBUTES1} = $ReturnValues{SQL_CURSOR_ATTRIBUTES1};
-$ReturnValues{SQL_FORWARD_ONLY_CURSOR_ATTRIBUTES1} = $ReturnValues{SQL_CURSOR_ATTRIBUTES1};
-$ReturnValues{ SQL_KEYSET_CURSOR_ATTRIBUTES1} = $ReturnValues{SQL_CURSOR_ATTRIBUTES1};
-$ReturnValues{ SQL_STATIC_CURSOR_ATTRIBUTES1} = $ReturnValues{SQL_CURSOR_ATTRIBUTES1};
-
-$ReturnValues{SQL_CURSOR_ATTRIBUTES2} =
-{
- SQL_CA2_READ_ONLY_CONCURRENCY => 0x00000001
-, SQL_CA2_LOCK_CONCURRENCY => 0x00000002
-, SQL_CA2_OPT_ROWVER_CONCURRENCY => 0x00000004
-, SQL_CA2_OPT_VALUES_CONCURRENCY => 0x00000008
-, SQL_CA2_SENSITIVITY_ADDITIONS => 0x00000010
-, SQL_CA2_SENSITIVITY_DELETIONS => 0x00000020
-, SQL_CA2_SENSITIVITY_UPDATES => 0x00000040
-, SQL_CA2_MAX_ROWS_SELECT => 0x00000080
-, SQL_CA2_MAX_ROWS_INSERT => 0x00000100
-, SQL_CA2_MAX_ROWS_DELETE => 0x00000200
-, SQL_CA2_MAX_ROWS_UPDATE => 0x00000400
-, SQL_CA2_MAX_ROWS_CATALOG => 0x00000800
-, SQL_CA2_CRC_EXACT => 0x00001000
-, SQL_CA2_CRC_APPROXIMATE => 0x00002000
-, SQL_CA2_SIMULATE_NON_UNIQUE => 0x00004000
-, SQL_CA2_SIMULATE_TRY_UNIQUE => 0x00008000
-, SQL_CA2_SIMULATE_UNIQUE => 0x00010000
-};
-$ReturnValues{ SQL_DYNAMIC_CURSOR_ATTRIBUTES2} = $ReturnValues{SQL_CURSOR_ATTRIBUTES2};
-$ReturnValues{SQL_FORWARD_ONLY_CURSOR_ATTRIBUTES2} = $ReturnValues{SQL_CURSOR_ATTRIBUTES2};
-$ReturnValues{ SQL_KEYSET_CURSOR_ATTRIBUTES2} = $ReturnValues{SQL_CURSOR_ATTRIBUTES2};
-$ReturnValues{ SQL_STATIC_CURSOR_ATTRIBUTES2} = $ReturnValues{SQL_CURSOR_ATTRIBUTES2};
-
-$ReturnValues{SQL_FETCH_DIRECTION} =
-{
- SQL_FD_FETCH_NEXT => 0x00000001
-, SQL_FD_FETCH_FIRST => 0x00000002
-, SQL_FD_FETCH_LAST => 0x00000004
-, SQL_FD_FETCH_PRIOR => 0x00000008
-, SQL_FD_FETCH_ABSOLUTE => 0x00000010
-, SQL_FD_FETCH_RELATIVE => 0x00000020
-, SQL_FD_FETCH_RESUME => 0x00000040
-, SQL_FD_FETCH_BOOKMARK => 0x00000080
-};
-$ReturnValues{SQL_FILE_USAGE} =
-{
- SQL_FILE_NOT_SUPPORTED => 0x0000
-, SQL_FILE_TABLE => 0x0001
-, SQL_FILE_QUALIFIER => 0x0002
-, SQL_FILE_CATALOG => 0x0002 # SQL_FILE_QUALIFIER
-};
-$ReturnValues{SQL_GETDATA_EXTENSIONS} =
-{
- SQL_GD_ANY_COLUMN => 0x00000001
-, SQL_GD_ANY_ORDER => 0x00000002
-, SQL_GD_BLOCK => 0x00000004
-, SQL_GD_BOUND => 0x00000008
-};
-$ReturnValues{SQL_GROUP_BY} =
-{
- SQL_GB_NOT_SUPPORTED => 0x0000
-, SQL_GB_GROUP_BY_EQUALS_SELECT => 0x0001
-, SQL_GB_GROUP_BY_CONTAINS_SELECT => 0x0002
-, SQL_GB_NO_RELATION => 0x0003
-, SQL_GB_COLLATE => 0x0004
-};
-$ReturnValues{SQL_IDENTIFIER_CASE} =
-{
- SQL_IC_UPPER => 1
-, SQL_IC_LOWER => 2
-, SQL_IC_SENSITIVE => 3
-, SQL_IC_MIXED => 4
-};
-$ReturnValues{SQL_INDEX_KEYWORDS} =
-{
- SQL_IK_NONE => 0x00000000
-, SQL_IK_ASC => 0x00000001
-, SQL_IK_DESC => 0x00000002
-# SQL_IK_ALL =>
-};
-$ReturnValues{SQL_INFO_SCHEMA_VIEWS} =
-{
- SQL_ISV_ASSERTIONS => 0x00000001
-, SQL_ISV_CHARACTER_SETS => 0x00000002
-, SQL_ISV_CHECK_CONSTRAINTS => 0x00000004
-, SQL_ISV_COLLATIONS => 0x00000008
-, SQL_ISV_COLUMN_DOMAIN_USAGE => 0x00000010
-, SQL_ISV_COLUMN_PRIVILEGES => 0x00000020
-, SQL_ISV_COLUMNS => 0x00000040
-, SQL_ISV_CONSTRAINT_COLUMN_USAGE => 0x00000080
-, SQL_ISV_CONSTRAINT_TABLE_USAGE => 0x00000100
-, SQL_ISV_DOMAIN_CONSTRAINTS => 0x00000200
-, SQL_ISV_DOMAINS => 0x00000400
-, SQL_ISV_KEY_COLUMN_USAGE => 0x00000800
-, SQL_ISV_REFERENTIAL_CONSTRAINTS => 0x00001000
-, SQL_ISV_SCHEMATA => 0x00002000
-, SQL_ISV_SQL_LANGUAGES => 0x00004000
-, SQL_ISV_TABLE_CONSTRAINTS => 0x00008000
-, SQL_ISV_TABLE_PRIVILEGES => 0x00010000
-, SQL_ISV_TABLES => 0x00020000
-, SQL_ISV_TRANSLATIONS => 0x00040000
-, SQL_ISV_USAGE_PRIVILEGES => 0x00080000
-, SQL_ISV_VIEW_COLUMN_USAGE => 0x00100000
-, SQL_ISV_VIEW_TABLE_USAGE => 0x00200000
-, SQL_ISV_VIEWS => 0x00400000
-};
-$ReturnValues{SQL_INSERT_STATEMENT} =
-{
- SQL_IS_INSERT_LITERALS => 0x00000001
-, SQL_IS_INSERT_SEARCHED => 0x00000002
-, SQL_IS_SELECT_INTO => 0x00000004
-};
-$ReturnValues{SQL_LOCK_TYPES} =
-{
- SQL_LCK_NO_CHANGE => 0x00000001
-, SQL_LCK_EXCLUSIVE => 0x00000002
-, SQL_LCK_UNLOCK => 0x00000004
-};
-$ReturnValues{SQL_NON_NULLABLE_COLUMNS} =
-{
- SQL_NNC_NULL => 0x0000
-, SQL_NNC_NON_NULL => 0x0001
-};
-$ReturnValues{SQL_NULL_COLLATION} =
-{
- SQL_NC_HIGH => 0
-, SQL_NC_LOW => 1
-, SQL_NC_START => 0x0002
-, SQL_NC_END => 0x0004
-};
-$ReturnValues{SQL_NUMERIC_FUNCTIONS} =
-{
- SQL_FN_NUM_ABS => 0x00000001
-, SQL_FN_NUM_ACOS => 0x00000002
-, SQL_FN_NUM_ASIN => 0x00000004
-, SQL_FN_NUM_ATAN => 0x00000008
-, SQL_FN_NUM_ATAN2 => 0x00000010
-, SQL_FN_NUM_CEILING => 0x00000020
-, SQL_FN_NUM_COS => 0x00000040
-, SQL_FN_NUM_COT => 0x00000080
-, SQL_FN_NUM_EXP => 0x00000100
-, SQL_FN_NUM_FLOOR => 0x00000200
-, SQL_FN_NUM_LOG => 0x00000400
-, SQL_FN_NUM_MOD => 0x00000800
-, SQL_FN_NUM_SIGN => 0x00001000
-, SQL_FN_NUM_SIN => 0x00002000
-, SQL_FN_NUM_SQRT => 0x00004000
-, SQL_FN_NUM_TAN => 0x00008000
-, SQL_FN_NUM_PI => 0x00010000
-, SQL_FN_NUM_RAND => 0x00020000
-, SQL_FN_NUM_DEGREES => 0x00040000
-, SQL_FN_NUM_LOG10 => 0x00080000
-, SQL_FN_NUM_POWER => 0x00100000
-, SQL_FN_NUM_RADIANS => 0x00200000
-, SQL_FN_NUM_ROUND => 0x00400000
-, SQL_FN_NUM_TRUNCATE => 0x00800000
-};
-$ReturnValues{SQL_ODBC_API_CONFORMANCE} =
-{
- SQL_OAC_NONE => 0x0000
-, SQL_OAC_LEVEL1 => 0x0001
-, SQL_OAC_LEVEL2 => 0x0002
-};
-$ReturnValues{SQL_ODBC_INTERFACE_CONFORMANCE} =
-{
- SQL_OIC_CORE => 1
-, SQL_OIC_LEVEL1 => 2
-, SQL_OIC_LEVEL2 => 3
-};
-$ReturnValues{SQL_ODBC_SAG_CLI_CONFORMANCE} =
-{
- SQL_OSCC_NOT_COMPLIANT => 0x0000
-, SQL_OSCC_COMPLIANT => 0x0001
-};
-$ReturnValues{SQL_ODBC_SQL_CONFORMANCE} =
-{
- SQL_OSC_MINIMUM => 0x0000
-, SQL_OSC_CORE => 0x0001
-, SQL_OSC_EXTENDED => 0x0002
-};
-$ReturnValues{SQL_OJ_CAPABILITIES} =
-{
- SQL_OJ_LEFT => 0x00000001
-, SQL_OJ_RIGHT => 0x00000002
-, SQL_OJ_FULL => 0x00000004
-, SQL_OJ_NESTED => 0x00000008
-, SQL_OJ_NOT_ORDERED => 0x00000010
-, SQL_OJ_INNER => 0x00000020
-, SQL_OJ_ALL_COMPARISON_OPS => 0x00000040
-};
-$ReturnValues{SQL_OWNER_USAGE} =
-{
- SQL_OU_DML_STATEMENTS => 0x00000001
-, SQL_OU_PROCEDURE_INVOCATION => 0x00000002
-, SQL_OU_TABLE_DEFINITION => 0x00000004
-, SQL_OU_INDEX_DEFINITION => 0x00000008
-, SQL_OU_PRIVILEGE_DEFINITION => 0x00000010
-};
-$ReturnValues{SQL_PARAM_ARRAY_ROW_COUNTS} =
-{
- SQL_PARC_BATCH => 1
-, SQL_PARC_NO_BATCH => 2
-};
-$ReturnValues{SQL_PARAM_ARRAY_SELECTS} =
-{
- SQL_PAS_BATCH => 1
-, SQL_PAS_NO_BATCH => 2
-, SQL_PAS_NO_SELECT => 3
-};
-$ReturnValues{SQL_POSITIONED_STATEMENTS} =
-{
- SQL_PS_POSITIONED_DELETE => 0x00000001
-, SQL_PS_POSITIONED_UPDATE => 0x00000002
-, SQL_PS_SELECT_FOR_UPDATE => 0x00000004
-};
-$ReturnValues{SQL_POS_OPERATIONS} =
-{
- SQL_POS_POSITION => 0x00000001
-, SQL_POS_REFRESH => 0x00000002
-, SQL_POS_UPDATE => 0x00000004
-, SQL_POS_DELETE => 0x00000008
-, SQL_POS_ADD => 0x00000010
-};
-$ReturnValues{SQL_QUALIFIER_LOCATION} =
-{
- SQL_QL_START => 0x0001
-, SQL_QL_END => 0x0002
-};
-$ReturnValues{SQL_QUALIFIER_USAGE} =
-{
- SQL_QU_DML_STATEMENTS => 0x00000001
-, SQL_QU_PROCEDURE_INVOCATION => 0x00000002
-, SQL_QU_TABLE_DEFINITION => 0x00000004
-, SQL_QU_INDEX_DEFINITION => 0x00000008
-, SQL_QU_PRIVILEGE_DEFINITION => 0x00000010
-};
-$ReturnValues{SQL_QUOTED_IDENTIFIER_CASE} = $ReturnValues{SQL_IDENTIFIER_CASE};
-
-$ReturnValues{SQL_SCHEMA_USAGE} =
-{
- SQL_SU_DML_STATEMENTS => 0x00000001 # SQL_OU_DML_STATEMENTS
-, SQL_SU_PROCEDURE_INVOCATION => 0x00000002 # SQL_OU_PROCEDURE_INVOCATION
-, SQL_SU_TABLE_DEFINITION => 0x00000004 # SQL_OU_TABLE_DEFINITION
-, SQL_SU_INDEX_DEFINITION => 0x00000008 # SQL_OU_INDEX_DEFINITION
-, SQL_SU_PRIVILEGE_DEFINITION => 0x00000010 # SQL_OU_PRIVILEGE_DEFINITION
-};
-$ReturnValues{SQL_SCROLL_CONCURRENCY} =
-{
- SQL_SCCO_READ_ONLY => 0x00000001
-, SQL_SCCO_LOCK => 0x00000002
-, SQL_SCCO_OPT_ROWVER => 0x00000004
-, SQL_SCCO_OPT_VALUES => 0x00000008
-};
-$ReturnValues{SQL_SCROLL_OPTIONS} =
-{
- SQL_SO_FORWARD_ONLY => 0x00000001
-, SQL_SO_KEYSET_DRIVEN => 0x00000002
-, SQL_SO_DYNAMIC => 0x00000004
-, SQL_SO_MIXED => 0x00000008
-, SQL_SO_STATIC => 0x00000010
-};
-$ReturnValues{SQL_SQL92_DATETIME_FUNCTIONS} =
-{
- SQL_SDF_CURRENT_DATE => 0x00000001
-, SQL_SDF_CURRENT_TIME => 0x00000002
-, SQL_SDF_CURRENT_TIMESTAMP => 0x00000004
-};
-$ReturnValues{SQL_SQL92_FOREIGN_KEY_DELETE_RULE} =
-{
- SQL_SFKD_CASCADE => 0x00000001
-, SQL_SFKD_NO_ACTION => 0x00000002
-, SQL_SFKD_SET_DEFAULT => 0x00000004
-, SQL_SFKD_SET_NULL => 0x00000008
-};
-$ReturnValues{SQL_SQL92_FOREIGN_KEY_UPDATE_RULE} =
-{
- SQL_SFKU_CASCADE => 0x00000001
-, SQL_SFKU_NO_ACTION => 0x00000002
-, SQL_SFKU_SET_DEFAULT => 0x00000004
-, SQL_SFKU_SET_NULL => 0x00000008
-};
-$ReturnValues{SQL_SQL92_GRANT} =
-{
- SQL_SG_USAGE_ON_DOMAIN => 0x00000001
-, SQL_SG_USAGE_ON_CHARACTER_SET => 0x00000002
-, SQL_SG_USAGE_ON_COLLATION => 0x00000004
-, SQL_SG_USAGE_ON_TRANSLATION => 0x00000008
-, SQL_SG_WITH_GRANT_OPTION => 0x00000010
-, SQL_SG_DELETE_TABLE => 0x00000020
-, SQL_SG_INSERT_TABLE => 0x00000040
-, SQL_SG_INSERT_COLUMN => 0x00000080
-, SQL_SG_REFERENCES_TABLE => 0x00000100
-, SQL_SG_REFERENCES_COLUMN => 0x00000200
-, SQL_SG_SELECT_TABLE => 0x00000400
-, SQL_SG_UPDATE_TABLE => 0x00000800
-, SQL_SG_UPDATE_COLUMN => 0x00001000
-};
-$ReturnValues{SQL_SQL92_NUMERIC_VALUE_FUNCTIONS} =
-{
- SQL_SNVF_BIT_LENGTH => 0x00000001
-, SQL_SNVF_CHAR_LENGTH => 0x00000002
-, SQL_SNVF_CHARACTER_LENGTH => 0x00000004
-, SQL_SNVF_EXTRACT => 0x00000008
-, SQL_SNVF_OCTET_LENGTH => 0x00000010
-, SQL_SNVF_POSITION => 0x00000020
-};
-$ReturnValues{SQL_SQL92_PREDICATES} =
-{
- SQL_SP_EXISTS => 0x00000001
-, SQL_SP_ISNOTNULL => 0x00000002
-, SQL_SP_ISNULL => 0x00000004
-, SQL_SP_MATCH_FULL => 0x00000008
-, SQL_SP_MATCH_PARTIAL => 0x00000010
-, SQL_SP_MATCH_UNIQUE_FULL => 0x00000020
-, SQL_SP_MATCH_UNIQUE_PARTIAL => 0x00000040
-, SQL_SP_OVERLAPS => 0x00000080
-, SQL_SP_UNIQUE => 0x00000100
-, SQL_SP_LIKE => 0x00000200
-, SQL_SP_IN => 0x00000400
-, SQL_SP_BETWEEN => 0x00000800
-, SQL_SP_COMPARISON => 0x00001000
-, SQL_SP_QUANTIFIED_COMPARISON => 0x00002000
-};
-$ReturnValues{SQL_SQL92_RELATIONAL_JOIN_OPERATORS} =
-{
- SQL_SRJO_CORRESPONDING_CLAUSE => 0x00000001
-, SQL_SRJO_CROSS_JOIN => 0x00000002
-, SQL_SRJO_EXCEPT_JOIN => 0x00000004
-, SQL_SRJO_FULL_OUTER_JOIN => 0x00000008
-, SQL_SRJO_INNER_JOIN => 0x00000010
-, SQL_SRJO_INTERSECT_JOIN => 0x00000020
-, SQL_SRJO_LEFT_OUTER_JOIN => 0x00000040
-, SQL_SRJO_NATURAL_JOIN => 0x00000080
-, SQL_SRJO_RIGHT_OUTER_JOIN => 0x00000100
-, SQL_SRJO_UNION_JOIN => 0x00000200
-};
-$ReturnValues{SQL_SQL92_REVOKE} =
-{
- SQL_SR_USAGE_ON_DOMAIN => 0x00000001
-, SQL_SR_USAGE_ON_CHARACTER_SET => 0x00000002
-, SQL_SR_USAGE_ON_COLLATION => 0x00000004
-, SQL_SR_USAGE_ON_TRANSLATION => 0x00000008
-, SQL_SR_GRANT_OPTION_FOR => 0x00000010
-, SQL_SR_CASCADE => 0x00000020
-, SQL_SR_RESTRICT => 0x00000040
-, SQL_SR_DELETE_TABLE => 0x00000080
-, SQL_SR_INSERT_TABLE => 0x00000100
-, SQL_SR_INSERT_COLUMN => 0x00000200
-, SQL_SR_REFERENCES_TABLE => 0x00000400
-, SQL_SR_REFERENCES_COLUMN => 0x00000800
-, SQL_SR_SELECT_TABLE => 0x00001000
-, SQL_SR_UPDATE_TABLE => 0x00002000
-, SQL_SR_UPDATE_COLUMN => 0x00004000
-};
-$ReturnValues{SQL_SQL92_ROW_VALUE_CONSTRUCTOR} =
-{
- SQL_SRVC_VALUE_EXPRESSION => 0x00000001
-, SQL_SRVC_NULL => 0x00000002
-, SQL_SRVC_DEFAULT => 0x00000004
-, SQL_SRVC_ROW_SUBQUERY => 0x00000008
-};
-$ReturnValues{SQL_SQL92_STRING_FUNCTIONS} =
-{
- SQL_SSF_CONVERT => 0x00000001
-, SQL_SSF_LOWER => 0x00000002
-, SQL_SSF_UPPER => 0x00000004
-, SQL_SSF_SUBSTRING => 0x00000008
-, SQL_SSF_TRANSLATE => 0x00000010
-, SQL_SSF_TRIM_BOTH => 0x00000020
-, SQL_SSF_TRIM_LEADING => 0x00000040
-, SQL_SSF_TRIM_TRAILING => 0x00000080
-};
-$ReturnValues{SQL_SQL92_VALUE_EXPRESSIONS} =
-{
- SQL_SVE_CASE => 0x00000001
-, SQL_SVE_CAST => 0x00000002
-, SQL_SVE_COALESCE => 0x00000004
-, SQL_SVE_NULLIF => 0x00000008
-};
-$ReturnValues{SQL_SQL_CONFORMANCE} =
-{
- SQL_SC_SQL92_ENTRY => 0x00000001
-, SQL_SC_FIPS127_2_TRANSITIONAL => 0x00000002
-, SQL_SC_SQL92_INTERMEDIATE => 0x00000004
-, SQL_SC_SQL92_FULL => 0x00000008
-};
-$ReturnValues{SQL_STANDARD_CLI_CONFORMANCE} =
-{
- SQL_SCC_XOPEN_CLI_VERSION1 => 0x00000001
-, SQL_SCC_ISO92_CLI => 0x00000002
-};
-$ReturnValues{SQL_STATIC_SENSITIVITY} =
-{
- SQL_SS_ADDITIONS => 0x00000001
-, SQL_SS_DELETIONS => 0x00000002
-, SQL_SS_UPDATES => 0x00000004
-};
-$ReturnValues{SQL_STRING_FUNCTIONS} =
-{
- SQL_FN_STR_CONCAT => 0x00000001
-, SQL_FN_STR_INSERT => 0x00000002
-, SQL_FN_STR_LEFT => 0x00000004
-, SQL_FN_STR_LTRIM => 0x00000008
-, SQL_FN_STR_LENGTH => 0x00000010
-, SQL_FN_STR_LOCATE => 0x00000020
-, SQL_FN_STR_LCASE => 0x00000040
-, SQL_FN_STR_REPEAT => 0x00000080
-, SQL_FN_STR_REPLACE => 0x00000100
-, SQL_FN_STR_RIGHT => 0x00000200
-, SQL_FN_STR_RTRIM => 0x00000400
-, SQL_FN_STR_SUBSTRING => 0x00000800
-, SQL_FN_STR_UCASE => 0x00001000
-, SQL_FN_STR_ASCII => 0x00002000
-, SQL_FN_STR_CHAR => 0x00004000
-, SQL_FN_STR_DIFFERENCE => 0x00008000
-, SQL_FN_STR_LOCATE_2 => 0x00010000
-, SQL_FN_STR_SOUNDEX => 0x00020000
-, SQL_FN_STR_SPACE => 0x00040000
-, SQL_FN_STR_BIT_LENGTH => 0x00080000
-, SQL_FN_STR_CHAR_LENGTH => 0x00100000
-, SQL_FN_STR_CHARACTER_LENGTH => 0x00200000
-, SQL_FN_STR_OCTET_LENGTH => 0x00400000
-, SQL_FN_STR_POSITION => 0x00800000
-};
-$ReturnValues{SQL_SUBQUERIES} =
-{
- SQL_SQ_COMPARISON => 0x00000001
-, SQL_SQ_EXISTS => 0x00000002
-, SQL_SQ_IN => 0x00000004
-, SQL_SQ_QUANTIFIED => 0x00000008
-, SQL_SQ_CORRELATED_SUBQUERIES => 0x00000010
-};
-$ReturnValues{SQL_SYSTEM_FUNCTIONS} =
-{
- SQL_FN_SYS_USERNAME => 0x00000001
-, SQL_FN_SYS_DBNAME => 0x00000002
-, SQL_FN_SYS_IFNULL => 0x00000004
-};
-$ReturnValues{SQL_TIMEDATE_ADD_INTERVALS} =
-{
- SQL_FN_TSI_FRAC_SECOND => 0x00000001
-, SQL_FN_TSI_SECOND => 0x00000002
-, SQL_FN_TSI_MINUTE => 0x00000004
-, SQL_FN_TSI_HOUR => 0x00000008
-, SQL_FN_TSI_DAY => 0x00000010
-, SQL_FN_TSI_WEEK => 0x00000020
-, SQL_FN_TSI_MONTH => 0x00000040
-, SQL_FN_TSI_QUARTER => 0x00000080
-, SQL_FN_TSI_YEAR => 0x00000100
-};
-$ReturnValues{SQL_TIMEDATE_FUNCTIONS} =
-{
- SQL_FN_TD_NOW => 0x00000001
-, SQL_FN_TD_CURDATE => 0x00000002
-, SQL_FN_TD_DAYOFMONTH => 0x00000004
-, SQL_FN_TD_DAYOFWEEK => 0x00000008
-, SQL_FN_TD_DAYOFYEAR => 0x00000010
-, SQL_FN_TD_MONTH => 0x00000020
-, SQL_FN_TD_QUARTER => 0x00000040
-, SQL_FN_TD_WEEK => 0x00000080
-, SQL_FN_TD_YEAR => 0x00000100
-, SQL_FN_TD_CURTIME => 0x00000200
-, SQL_FN_TD_HOUR => 0x00000400
-, SQL_FN_TD_MINUTE => 0x00000800
-, SQL_FN_TD_SECOND => 0x00001000
-, SQL_FN_TD_TIMESTAMPADD => 0x00002000
-, SQL_FN_TD_TIMESTAMPDIFF => 0x00004000
-, SQL_FN_TD_DAYNAME => 0x00008000
-, SQL_FN_TD_MONTHNAME => 0x00010000
-, SQL_FN_TD_CURRENT_DATE => 0x00020000
-, SQL_FN_TD_CURRENT_TIME => 0x00040000
-, SQL_FN_TD_CURRENT_TIMESTAMP => 0x00080000
-, SQL_FN_TD_EXTRACT => 0x00100000
-};
-$ReturnValues{SQL_TXN_CAPABLE} =
-{
- SQL_TC_NONE => 0
-, SQL_TC_DML => 1
-, SQL_TC_ALL => 2
-, SQL_TC_DDL_COMMIT => 3
-, SQL_TC_DDL_IGNORE => 4
-};
-$ReturnValues{SQL_TRANSACTION_ISOLATION_OPTION} =
-{
- SQL_TRANSACTION_READ_UNCOMMITTED => 0x00000001 # SQL_TXN_READ_UNCOMMITTED
-, SQL_TRANSACTION_READ_COMMITTED => 0x00000002 # SQL_TXN_READ_COMMITTED
-, SQL_TRANSACTION_REPEATABLE_READ => 0x00000004 # SQL_TXN_REPEATABLE_READ
-, SQL_TRANSACTION_SERIALIZABLE => 0x00000008 # SQL_TXN_SERIALIZABLE
-};
-$ReturnValues{SQL_DEFAULT_TRANSACTION_ISOLATION} = $ReturnValues{SQL_TRANSACTION_ISOLATION_OPTION};
-
-$ReturnValues{SQL_TXN_ISOLATION_OPTION} =
-{
- SQL_TXN_READ_UNCOMMITTED => 0x00000001
-, SQL_TXN_READ_COMMITTED => 0x00000002
-, SQL_TXN_REPEATABLE_READ => 0x00000004
-, SQL_TXN_SERIALIZABLE => 0x00000008
-};
-$ReturnValues{SQL_DEFAULT_TXN_ISOLATION} = $ReturnValues{SQL_TXN_ISOLATION_OPTION};
-
-$ReturnValues{SQL_TXN_VERSIONING} =
-{
- SQL_TXN_VERSIONING => 0x00000010
-};
-$ReturnValues{SQL_UNION} =
-{
- SQL_U_UNION => 0x00000001
-, SQL_U_UNION_ALL => 0x00000002
-};
-$ReturnValues{SQL_UNION_STATEMENT} =
-{
- SQL_US_UNION => 0x00000001 # SQL_U_UNION
-, SQL_US_UNION_ALL => 0x00000002 # SQL_U_UNION_ALL
-};
-
-1;
-
-=head1 TODO
-
- Corrections?
- SQL_NULL_COLLATION: ODBC vs ANSI
- Unique values for $ReturnValues{...}?, e.g. SQL_FILE_USAGE
-
-=cut
+++ /dev/null
-# $Id: GetInfoReturn.pm 8696 2007-01-24 23:12:38Z Tim $
-#
-# Copyright (c) 2002 Tim Bunce Ireland
-#
-# Constant data describing return values from the DBI getinfo function.
-#
-# You may distribute under the terms of either the GNU General Public
-# License or the Artistic License, as specified in the Perl README file.
-
-package DBI::Const::GetInfoReturn;
-
-use strict;
-
-use Exporter ();
-
-use vars qw(@ISA @EXPORT @EXPORT_OK %GetInfoReturnTypes %GetInfoReturnValues);
-
-@ISA = qw(Exporter);
-@EXPORT = qw(%GetInfoReturnTypes %GetInfoReturnValues);
-
-my
-$VERSION = "2.008697";
-
-=head1 NAME
-
-DBI::Const::GetInfoReturn - Data and functions for describing GetInfo results
-
-=head1 SYNOPSIS
-
-The interface to this module is undocumented and liable to change.
-
-=head1 DESCRIPTION
-
-Data and functions for describing GetInfo results
-
-=cut
-
-use DBI::Const::GetInfoType;
-
-use DBI::Const::GetInfo::ANSI ();
-use DBI::Const::GetInfo::ODBC ();
-
-%GetInfoReturnTypes =
-(
- %DBI::Const::GetInfo::ANSI::ReturnTypes
-, %DBI::Const::GetInfo::ODBC::ReturnTypes
-);
-
-%GetInfoReturnValues = ();
-{
- my $A = \%DBI::Const::GetInfo::ANSI::ReturnValues;
- my $O = \%DBI::Const::GetInfo::ODBC::ReturnValues;
- while ( my ($k, $v) = each %$A ) {
- my %h = ( exists $O->{$k} ) ? ( %$v, %{$O->{$k}} ) : %$v;
- $GetInfoReturnValues{$k} = \%h;
- }
- while ( my ($k, $v) = each %$O ) {
- next if exists $A->{$k};
- my %h = %$v;
- $GetInfoReturnValues{$k} = \%h;
- }
-}
-
-# -----------------------------------------------------------------------------
-
-sub Format {
- my $InfoType = shift;
- my $Value = shift;
-
- return '' unless defined $Value;
-
- my $ReturnType = $GetInfoReturnTypes{$InfoType};
-
- return sprintf '0x%08X', $Value if $ReturnType eq 'SQLUINTEGER bitmask';
- return sprintf '0x%08X', $Value if $ReturnType eq 'SQLINTEGER bitmask';
-# return '"' . $Value . '"' if $ReturnType eq 'SQLCHAR';
- return $Value;
-}
-
-
-sub Explain {
- my $InfoType = shift;
- my $Value = shift;
-
- return '' unless defined $Value;
- return '' unless exists $GetInfoReturnValues{$InfoType};
-
- $Value = int $Value;
- my $ReturnType = $GetInfoReturnTypes{$InfoType};
- my %h = reverse %{$GetInfoReturnValues{$InfoType}};
-
- if ( $ReturnType eq 'SQLUINTEGER bitmask'|| $ReturnType eq 'SQLINTEGER bitmask') {
- my @a = ();
- for my $k ( sort { $a <=> $b } keys %h ) {
- push @a, $h{$k} if $Value & $k;
- }
- return wantarray ? @a : join(' ', @a );
- }
- else {
- return $h{$Value} ||'?';
- }
-}
-
-1;
+++ /dev/null
-# $Id: GetInfoType.pm 8696 2007-01-24 23:12:38Z Tim $
-#
-# Copyright (c) 2002 Tim Bunce Ireland
-#
-# Constant data describing info type codes for the DBI getinfo function.
-#
-# You may distribute under the terms of either the GNU General Public
-# License or the Artistic License, as specified in the Perl README file.
-
-package DBI::Const::GetInfoType;
-
-use strict;
-
-use Exporter ();
-
-use vars qw(@ISA @EXPORT @EXPORT_OK %GetInfoType);
-
-@ISA = qw(Exporter);
-@EXPORT = qw(%GetInfoType);
-
-my
-$VERSION = "2.008697";
-
-=head1 NAME
-
-DBI::Const::GetInfoType - Data describing GetInfo type codes
-
-=head1 SYNOPSIS
-
- use DBI::Const::GetInfoType;
-
-=head1 DESCRIPTION
-
-Imports a %GetInfoType hash which maps names for GetInfo Type Codes
-into their corresponding numeric values. For example:
-
- $database_version = $dbh->get_info( $GetInfoType{SQL_DBMS_VER} );
-
-The interface to this module is new and nothing beyond what is
-written here is guaranteed.
-
-=cut
-
-use DBI::Const::GetInfo::ANSI (); # liable to change
-use DBI::Const::GetInfo::ODBC (); # liable to change
-
-%GetInfoType =
-(
- %DBI::Const::GetInfo::ANSI::InfoTypes # liable to change
-, %DBI::Const::GetInfo::ODBC::InfoTypes # liable to change
-);
-
-1;
+++ /dev/null
-package DBI::DBD;
-# vim:ts=8:sw=4
-use strict;
-use vars qw($VERSION); # set $VERSION early so we don't confuse PAUSE/CPAN etc
-
-# don't use Revision here because that's not in svn:keywords so that the
-# examples that use it below won't be messed up
-$VERSION = "12.015129";
-
-# $Id: DBD.pm 15128 2012-02-04 20:51:39Z Tim $
-#
-# Copyright (c) 1997-2006 Jonathan Leffler, Jochen Wiedmann, Steffen
-# Goeldner and Tim Bunce
-#
-# You may distribute under the terms of either the GNU General Public
-# License or the Artistic License, as specified in the Perl README file.
-
-=head1 NAME
-
-DBI::DBD - Perl DBI Database Driver Writer's Guide
-
-=head1 SYNOPSIS
-
- perldoc DBI::DBD
-
-=head2 Version and volatility
-
-This document is I<still> a minimal draft which is in need of further work.
-
-Please read the B<DBI> documentation first and fully. Then look at the
-implementation of some high-profile and regularly maintained drivers like
-DBD::Oracle, DBD::ODBC, DBD::Pg etc. (Those are no no particular order.)
-
-Then reread the B<DBI> specification and the code of those drivers again as
-you're reading this. It'll help. Where this document and the driver code
-differ it's likely that the driver code is more correct, especially if multiple
-drivers do the same thing.
-
-This document is a patchwork of contributions from various authors.
-More contributions (preferably as patches) are very welcome.
-
-=head1 DESCRIPTION
-
-This document is primarily intended to help people writing new
-database drivers for the Perl Database Interface (Perl DBI).
-It may also help others interested in discovering why the internals of
-a B<DBD> driver are written the way they are.
-
-This is a guide. Few (if any) of the statements in it are completely
-authoritative under all possible circumstances. This means you will
-need to use judgement in applying the guidelines in this document.
-If in I<any> doubt at all, please do contact the I<dbi-dev> mailing list
-(details given below) where Tim Bunce and other driver authors can help.
-
-=head1 CREATING A NEW DRIVER
-
-The first rule for creating a new database driver for the Perl DBI is
-very simple: B<DON'T!>
-
-There is usually a driver already available for the database you want
-to use, almost regardless of which database you choose. Very often, the
-database will provide an ODBC driver interface, so you can often use
-B<DBD::ODBC> to access the database. This is typically less convenient
-on a Unix box than on a Microsoft Windows box, but there are numerous
-options for ODBC driver managers on Unix too, and very often the ODBC
-driver is provided by the database supplier.
-
-Before deciding that you need to write a driver, do your homework to
-ensure that you are not wasting your energies.
-
-[As of December 2002, the consensus is that if you need an ODBC driver
-manager on Unix, then the unixODBC driver (available from
-L<http://www.unixodbc.org/>) is the way to go.]
-
-The second rule for creating a new database driver for the Perl DBI is
-also very simple: B<Don't -- get someone else to do it for you!>
-
-Nevertheless, there are occasions when it is necessary to write a new
-driver, often to use a proprietary language or API to access the
-database more swiftly, or more comprehensively, than an ODBC driver can.
-Then you should read this document very carefully, but with a suitably
-sceptical eye.
-
-If there is something in here that does not make any sense, question it.
-You might be right that the information is bogus, but don't come to that
-conclusion too quickly.
-
-=head2 URLs and mailing lists
-
-The primary web-site for locating B<DBI> software and information is
-
- http://dbi.perl.org/
-
-There are two main and one auxiliary mailing lists for people working
-with B<DBI>. The primary lists are I<dbi-users@perl.org> for general users
-of B<DBI> and B<DBD> drivers, and I<dbi-dev@perl.org> mainly for B<DBD> driver
-writers (don't join the I<dbi-dev> list unless you have a good reason).
-The auxiliary list is I<dbi-announce@perl.org> for announcing new
-releases of B<DBI> or B<DBD> drivers.
-
-You can join these lists by accessing the web-site L<http://dbi.perl.org/>.
-The lists are closed so you cannot send email to any of the lists
-unless you join the list first.
-
-You should also consider monitoring the I<comp.lang.perl.*> newsgroups,
-especially I<comp.lang.perl.modules>.
-
-=head2 The Cheetah book
-
-The definitive book on Perl DBI is the Cheetah book, so called because
-of the picture on the cover. Its proper title is 'I<Programming the
-Perl DBI: Database programming with Perl>' by Alligator Descartes
-and Tim Bunce, published by O'Reilly Associates, February 2000, ISBN
-1-56592-699-4. Buy it now if you have not already done so, and read it.
-
-=head2 Locating drivers
-
-Before writing a new driver, it is in your interests to find out
-whether there already is a driver for your database. If there is such
-a driver, it would be much easier to make use of it than to write your
-own!
-
-The primary web-site for locating Perl software is
-L<http://search.cpan.org/>. You should look under the various
-modules listings for the software you are after. For example:
-
- http://search.cpan.org/modlist/Database_Interfaces
-
-Follow the B<DBD::> and B<DBIx::> links at the top to see those subsets.
-
-See the B<DBI> docs for information on B<DBI> web sites and mailing lists.
-
-=head2 Registering a new driver
-
-Before going through any official registration process, you will need
-to establish that there is no driver already in the works. You'll do
-that by asking the B<DBI> mailing lists whether there is such a driver
-available, or whether anybody is working on one.
-
-When you get the go ahead, you will need to establish the name of the
-driver and a prefix for the driver. Typically, the name is based on the
-name of the database software it uses, and the prefix is a contraction
-of that. Hence, B<DBD::Oracle> has the name I<Oracle> and the prefix
-'I<ora_>'. The prefix must be lowercase and contain no underscores other
-than the one at the end.
-
-This information will be recorded in the B<DBI> module. Apart from
-documentation purposes, registration is a prerequisite for
-L<installing private methods|DBI/install_method>.
-
-If you are writing a driver which will not be distributed on CPAN, then
-you should choose a prefix beginning with 'I<x_>', to avoid potential
-prefix collisions with drivers registered in the future. Thus, if you
-wrote a non-CPAN distributed driver called B<DBD::CustomDB>, the prefix
-might be 'I<x_cdb_>'.
-
-This document assumes you are writing a driver called B<DBD::Driver>, and
-that the prefix 'I<drv_>' is assigned to the driver.
-
-=head2 Two styles of database driver
-
-There are two distinct styles of database driver that can be written to
-work with the Perl DBI.
-
-Your driver can be written in pure Perl, requiring no C compiler.
-When feasible, this is the best solution, but most databases are not
-written in such a way that this can be done. Some examples of pure
-Perl drivers are B<DBD::File> and B<DBD::CSV>.
-
-Alternatively, and most commonly, your driver will need to use some C
-code to gain access to the database. This will be classified as a C/XS
-driver.
-
-=head2 What code will you write?
-
-There are a number of files that need to be written for either a pure
-Perl driver or a C/XS driver. There are no extra files needed only by
-a pure Perl driver, but there are several extra files needed only by a
-C/XS driver.
-
-=head3 Files common to pure Perl and C/XS drivers
-
-Assuming that your driver is called B<DBD::Driver>, these files are:
-
-=over 4
-
-=item * F<Makefile.PL>
-
-=item * F<META.yml>
-
-=item * F<README>
-
-=item * F<MANIFEST>
-
-=item * F<Driver.pm>
-
-=item * F<lib/Bundle/DBD/Driver.pm>
-
-=item * F<lib/DBD/Driver/Summary.pm>
-
-=item * F<t/*.t>
-
-=back
-
-The first four files are mandatory. F<Makefile.PL> is used to control
-how the driver is built and installed. The F<README> file tells people
-who download the file about how to build the module and any prerequisite
-software that must be installed. The F<MANIFEST> file is used by the
-standard Perl module distribution mechanism. It lists all the source
-files that need to be distributed with your module. F<Driver.pm> is what
-is loaded by the B<DBI> code; it contains the methods peculiar to your
-driver.
-
-Although the F<META.yml> file is not B<required> you are advised to
-create one. Of particular importance are the I<build_requires> and
-I<configure_requires> attributes which newer CPAN modules understand.
-You use these to tell the CPAN module (and CPANPLUS) that your build
-and configure mechanisms require DBI. The best reference for META.yml
-(at the time of writing) is
-L<http://module-build.sourceforge.net/META-spec-v1.4.html>. You can find
-a reasonable example of a F<META.yml> in DBD::ODBC.
-
-The F<lib/Bundle/DBD/Driver.pm> file allows you to specify other Perl
-modules on which yours depends in a format that allows someone to type a
-simple command and ensure that all the pre-requisites are in place as
-well as building your driver.
-
-The F<lib/DBD/Driver/Summary.pm> file contains (an updated version of) the
-information that was included - or that would have been included - in
-the appendices of the Cheetah book as a summary of the abilities of your
-driver and the associated database.
-
-The files in the F<t> subdirectory are unit tests for your driver.
-You should write your tests as stringently as possible, while taking
-into account the diversity of installations that you can encounter:
-
-=over 4
-
-=item *
-
-Your tests should not casually modify operational databases.
-
-=item *
-
-You should never damage existing tables in a database.
-
-=item *
-
-You should code your tests to use a constrained name space within the
-database. For example, the tables (and all other named objects) that are
-created could all begin with 'I<dbd_drv_>'.
-
-=item *
-
-At the end of a test run, there should be no testing objects left behind
-in the database.
-
-=item *
-
-If you create any databases, you should remove them.
-
-=item *
-
-If your database supports temporary tables that are automatically
-removed at the end of a session, then exploit them as often as possible.
-
-=item *
-
-Try to make your tests independent of each other. If you have a
-test F<t/t11dowhat.t> that depends upon the successful running
-of F<t/t10thingamy.t>, people cannot run the single test case
-F<t/t11dowhat.t>. Further, running F<t/t11dowhat.t> twice in a row is
-likely to fail (at least, if F<t/t11dowhat.t> modifies the database at
-all) because the database at the start of the second run is not what you
-saw at the start of the first run.
-
-=item *
-
-Document in your F<README> file what you do, and what privileges people
-need to do it.
-
-=item *
-
-You can, and probably should, sequence your tests by including a test
-number before an abbreviated version of the test name; the tests are run
-in the order in which the names are expanded by shell-style globbing.
-
-=item *
-
-It is in your interests to ensure that your tests work as widely
-as possible.
-
-=back
-
-Many drivers also install sub-modules B<DBD::Driver::SubModule>
-for any of a variety of different reasons, such as to support
-the metadata methods (see the discussion of L</METADATA METHODS>
-below). Such sub-modules are conventionally stored in the directory
-F<lib/DBD/Driver>. The module itself would usually be in a file
-F<SubModule.pm>. All such sub-modules should themselves be version
-stamped (see the discussions far below).
-
-=head3 Extra files needed by C/XS drivers
-
-The software for a C/XS driver will typically contain at least four
-extra files that are not relevant to a pure Perl driver.
-
-=over 4
-
-=item * F<Driver.xs>
-
-=item * F<Driver.h>
-
-=item * F<dbdimp.h>
-
-=item * F<dbdimp.c>
-
-=back
-
-The F<Driver.xs> file is used to generate C code that Perl can call to gain
-access to the C functions you write that will, in turn, call down onto
-your database software.
-
-The F<Driver.h> header is a stylized header that ensures you can access the
-necessary Perl and B<DBI> macros, types, and function declarations.
-
-The F<dbdimp.h> is used to specify which functions have been implemented by
-your driver.
-
-The F<dbdimp.c> file is where you write the C code that does the real work
-of translating between Perl-ish data types and what the database expects
-to use and return.
-
-There are some (mainly small, but very important) differences between
-the contents of F<Makefile.PL> and F<Driver.pm> for pure Perl and C/XS
-drivers, so those files are described both in the section on creating a
-pure Perl driver and in the section on creating a C/XS driver.
-
-Obviously, you can add extra source code files to the list.
-
-=head2 Requirements on a driver and driver writer
-
-To be remotely useful, your driver must be implemented in a format that
-allows it to be distributed via CPAN, the Comprehensive Perl Archive
-Network (L<http://www.cpan.org/> and L<http://search.cpan.org>).
-Of course, it is easier if you do not have to meet this criterion, but
-you will not be able to ask for much help if you do not do so, and
-no-one is likely to want to install your module if they have to learn a
-new installation mechanism.
-
-=head1 CREATING A PURE PERL DRIVER
-
-Writing a pure Perl driver is surprisingly simple. However, there are
-some problems you should be aware of. The best option is of course
-picking up an existing driver and carefully modifying one method
-after the other.
-
-Also look carefully at B<DBD::AnyData> and B<DBD::Template>.
-
-As an example we take a look at the B<DBD::File> driver, a driver for
-accessing plain files as tables, which is part of the B<DBD::CSV> package.
-
-The minimal set of files we have to implement are F<Makefile.PL>,
-F<README>, F<MANIFEST> and F<Driver.pm>.
-
-=head2 Pure Perl version of Makefile.PL
-
-You typically start with writing F<Makefile.PL>, a Makefile
-generator. The contents of this file are described in detail in
-the L<ExtUtils::MakeMaker> man pages. It is definitely a good idea
-if you start reading them. At least you should know about the
-variables I<CONFIGURE>, I<DEFINED>, I<PM>, I<DIR>, I<EXE_FILES>,
-I<INC>, I<LIBS>, I<LINKTYPE>, I<NAME>, I<OPTIMIZE>, I<PL_FILES>,
-I<VERSION>, I<VERSION_FROM>, I<clean>, I<depend>, I<realclean> from
-the L<ExtUtils::MakeMaker> man page: these are used in almost any
-F<Makefile.PL>.
-
-Additionally read the section on I<Overriding MakeMaker Methods> and the
-descriptions of the I<distcheck>, I<disttest> and I<dist> targets: They
-will definitely be useful for you.
-
-Of special importance for B<DBI> drivers is the I<postamble> method from
-the L<ExtUtils::MM_Unix> man page.
-
-For Emacs users, I recommend the I<libscan> method, which removes
-Emacs backup files (file names which end with a tilde '~') from lists of
-files.
-
-Now an example, I use the word C<Driver> wherever you should insert
-your driver's name:
-
- # -*- perl -*-
-
- use ExtUtils::MakeMaker;
-
- WriteMakefile(
- dbd_edit_mm_attribs( {
- 'NAME' => 'DBD::Driver',
- 'VERSION_FROM' => 'Driver.pm',
- 'INC' => '',
- 'dist' => { 'SUFFIX' => '.gz',
- 'COMPRESS' => 'gzip -9f' },
- 'realclean' => { FILES => '*.xsi' },
- 'PREREQ_PM' => '1.03',
- 'CONFIGURE' => sub {
- eval {require DBI::DBD;};
- if ($@) {
- warn $@;
- exit 0;
- }
- my $dbi_arch_dir = dbd_dbi_arch_dir();
- if (exists($opts{INC})) {
- return {INC => "$opts{INC} -I$dbi_arch_dir"};
- } else {
- return {INC => "-I$dbi_arch_dir"};
- }
- }
- },
- { create_pp_tests => 1})
- );
-
- package MY;
- sub postamble { return main::dbd_postamble(@_); }
- sub libscan {
- my ($self, $path) = @_;
- ($path =~ m/\~$/) ? undef : $path;
- }
-
-Note the calls to C<dbd_edit_mm_attribs()> and C<dbd_postamble()>.
-
-The second hash reference in the call to C<dbd_edit_mm_attribs()>
-(containing C<create_pp_tests()>) is optional; you should not use it
-unless your driver is a pure Perl driver (that is, it does not use C and
-XS code). Therefore, the call to C<dbd_edit_mm_attribs()> is not
-relevant for C/XS drivers and may be omitted; simply use the (single)
-hash reference containing NAME etc as the only argument to C<WriteMakefile()>.
-
-Note that the C<dbd_edit_mm_attribs()> code will fail if you do not have a
-F<t> sub-directory containing at least one test case.
-
-I<PREREQ_PM> tells MakeMaker that DBI (version 1.03 in this case) is
-required for this module. This will issue a warning that DBI 1.03 is
-missing if someone attempts to install your DBD without DBI 1.03. See
-I<CONFIGURE> below for why this does not work reliably in stopping cpan
-testers failing your module if DBI is not installed.
-
-I<CONFIGURE> is a subroutine called by MakeMaker during
-C<WriteMakefile>. By putting the C<require DBI::DBD> in this section
-we can attempt to load DBI::DBD but if it is missing we exit with
-success. As we exit successfully without creating a Makefile when
-DBI::DBD is missing cpan testers will not report a failure. This may
-seem at odds with I<PREREQ_PM> but I<PREREQ_PM> does not cause
-C<WriteMakefile> to fail (unless you also specify PREREQ_FATAL which
-is strongly discouraged by MakeMaker) so C<WriteMakefile> would
-continue to call C<dbd_dbi_arch_dir> and fail.
-
-All drivers must use C<dbd_postamble()> or risk running into problems.
-
-Note the specification of I<VERSION_FROM>; the named file
-(F<Driver.pm>) will be scanned for the first line that looks like an
-assignment to I<$VERSION>, and the subsequent text will be used to
-determine the version number. Note the commentary in
-L<ExtUtils::MakeMaker> on the subject of correctly formatted version
-numbers.
-
-If your driver depends upon external software (it usually will), you
-will need to add code to ensure that your environment is workable
-before the call to C<WriteMakefile()>. If you need to check for the
-existence of an external library and perhaps modify I<INC> to include
-the paths to where the external library header files are located and
-you cannot find the library or header files make sure you output a
-message saying they cannot be found but C<exit 0> (success) B<before>
-calling C<WriteMakefile> or CPAN testers will fail your module if the
-external library is not found.
-
-A full-fledged I<Makefile.PL> can be quite large (for example, the
-files for B<DBD::Oracle> and B<DBD::Informix> are both over 1000 lines
-long, and the Informix one uses - and creates - auxiliary modules
-too).
-
-See also L<ExtUtils::MakeMaker> and L<ExtUtils::MM_Unix>. Consider using
-L<CPAN::MakeMaker> in place of I<ExtUtils::MakeMaker>.
-
-=head2 README
-
-The L<README> file should describe what the driver is for, the
-pre-requisites for the build process, the actual build process, how to
-report errors, and who to report them to.
-
-Users will find ways of breaking the driver build and test process
-which you would never even have dreamed to be possible in your worst
-nightmares. Therefore, you need to write this document defensively,
-precisely and concisely.
-
-As always, use the F<README> from one of the established drivers as a basis
-for your own; the version in B<DBD::Informix> is worth a look as it has
-been quite successful in heading off problems.
-
-=over 4
-
-=item *
-
-Note that users will have versions of Perl and B<DBI> that are both older
-and newer than you expected, but this will seldom cause much trouble.
-When it does, it will be because you are using features of B<DBI> that are
-not supported in the version they are using.
-
-=item *
-
-Note that users will have versions of the database software that are
-both older and newer than you expected. You will save yourself time in
-the long run if you can identify the range of versions which have been
-tested and warn about versions which are not known to be OK.
-
-=item *
-
-Note that many people trying to install your driver will not be experts
-in the database software.
-
-=item *
-
-Note that many people trying to install your driver will not be experts
-in C or Perl.
-
-=back
-
-=head2 MANIFEST
-
-The F<MANIFEST> will be used by the Makefile's dist target to build the
-distribution tar file that is uploaded to CPAN. It should list every
-file that you want to include in your distribution, one per line.
-
-=head2 lib/Bundle/DBD/Driver.pm
-
-The CPAN module provides an extremely powerful bundle mechanism that
-allows you to specify pre-requisites for your driver.
-
-The primary pre-requisite is B<Bundle::DBI>; you may want or need to add
-some more. With the bundle set up correctly, the user can type:
-
- perl -MCPAN -e 'install Bundle::DBD::Driver'
-
-and Perl will download, compile, test and install all the Perl modules
-needed to build your driver.
-
-The prerequisite modules are listed in the C<CONTENTS> section, with the
-official name of the module followed by a dash and an informal name or
-description.
-
-=over 4
-
-=item *
-
-Listing B<Bundle::DBI> as the main pre-requisite simplifies life.
-
-=item *
-
-Don't forget to list your driver.
-
-=item *
-
-Note that unless the DBMS is itself a Perl module, you cannot list it as
-a pre-requisite in this file.
-
-=item *
-
-You should keep the version of the bundle the same as the version of
-your driver.
-
-=item *
-
-You should add configuration management, copyright, and licencing
-information at the top.
-
-=back
-
-A suitable skeleton for this file is shown below.
-
- package Bundle::DBD::Driver;
-
- $VERSION = '0.01';
-
- 1;
-
- __END__
-
- =head1 NAME
-
- Bundle::DBD::Driver - A bundle to install all DBD::Driver related modules
-
- =head1 SYNOPSIS
-
- C<perl -MCPAN -e 'install Bundle::DBD::Driver'>
-
- =head1 CONTENTS
-
- Bundle::DBI - Bundle for DBI by TIMB (Tim Bunce)
-
- DBD::Driver - DBD::Driver by YOU (Your Name)
-
- =head1 DESCRIPTION
-
- This bundle includes all the modules used by the Perl Database
- Interface (DBI) driver for Driver (DBD::Driver), assuming the
- use of DBI version 1.13 or later, created by Tim Bunce.
-
- If you've not previously used the CPAN module to install any
- bundles, you will be interrogated during its setup phase.
- But when you've done it once, it remembers what you told it.
- You could start by running:
-
- C<perl -MCPAN -e 'install Bundle::CPAN'>
-
- =head1 SEE ALSO
-
- Bundle::DBI
-
- =head1 AUTHOR
-
- Your Name E<lt>F<you@yourdomain.com>E<gt>
-
- =head1 THANKS
-
- This bundle was created by ripping off Bundle::libnet created by
- Graham Barr E<lt>F<gbarr@ti.com>E<gt>, and radically simplified
- with some information from Jochen Wiedmann E<lt>F<joe@ispsoft.de>E<gt>.
- The template was then included in the DBI::DBD documentation by
- Jonathan Leffler E<lt>F<jleffler@informix.com>E<gt>.
-
- =cut
-
-=head2 lib/DBD/Driver/Summary.pm
-
-There is no substitute for taking the summary file from a driver that
-was documented in the Perl book (such as B<DBD::Oracle> or B<DBD::Informix> or
-B<DBD::ODBC>, to name but three), and adapting it to describe the
-facilities available via B<DBD::Driver> when accessing the Driver database.
-
-=head2 Pure Perl version of Driver.pm
-
-The F<Driver.pm> file defines the Perl module B<DBD::Driver> for your driver.
-It will define a package B<DBD::Driver> along with some version information,
-some variable definitions, and a function C<driver()> which will have a more
-or less standard structure.
-
-It will also define three sub-packages of B<DBD::Driver>:
-
-=over 4
-
-=item DBD::Driver::dr
-
-with methods C<connect()>, C<data_sources()> and C<disconnect_all()>;
-
-=item DBD::Driver::db
-
-with methods such as C<prepare()>;
-
-=item DBD::Driver::st
-
-with methods such as C<execute()> and C<fetch()>.
-
-=back
-
-The F<Driver.pm> file will also contain the documentation specific to
-B<DBD::Driver> in the format used by perldoc.
-
-In a pure Perl driver, the F<Driver.pm> file is the core of the
-implementation. You will need to provide all the key methods needed by B<DBI>.
-
-Now let's take a closer look at an excerpt of F<File.pm> as an example.
-We ignore things that are common to any module (even non-DBI modules)
-or really specific to the B<DBD::File> package.
-
-=head3 The DBD::Driver package
-
-=head4 The header
-
- package DBD::File;
-
- use strict;
- use vars qw($VERSION $drh);
-
- $VERSION = "1.23.00" # Version number of DBD::File
-
-This is where the version number of your driver is specified, and is
-where F<Makefile.PL> looks for this information. Please ensure that any
-other modules added with your driver are also version stamped so that
-CPAN does not get confused.
-
-It is recommended that you use a two-part (1.23) or three-part (1.23.45)
-version number. Also consider the CPAN system, which gets confused and
-considers version 1.10 to precede version 1.9, so that using a raw CVS,
-RCS or SCCS version number is probably not appropriate (despite being
-very common).
-
-For Subversion you could use:
-
- $VERSION = "12.012346";
-
-(use lots of leading zeros on the second portion so if you move the code to a
-shared repository like svn.perl.org the much larger revision numbers won't
-cause a problem, at least not for a few years). For RCS or CVS you can use:
-
- $VERSION = "11.22";
-
-which pads out the fractional part with leading zeros so all is well
-(so long as you don't go past x.99)
-
- $drh = undef; # holds driver handle once initialized
-
-This is where the driver handle will be stored, once created.
-Note that you may assume there is only one handle for your driver.
-
-=head4 The driver constructor
-
-The C<driver()> method is the driver handle constructor. Note that
-the C<driver()> method is in the B<DBD::Driver> package, not in
-one of the sub-packages B<DBD::Driver::dr>, B<DBD::Driver::db>, or
-B<DBD::Driver::db>.
-
- sub driver
- {
- return $drh if $drh; # already created - return same one
- my ($class, $attr) = @_;
-
- $class .= "::dr";
-
- DBD::Driver::db->install_method('drv_example_dbh_method');
- DBD::Driver::st->install_method('drv_example_sth_method');
-
- # not a 'my' since we use it above to prevent multiple drivers
- $drh = DBI::_new_drh($class, {
- 'Name' => 'File',
- 'Version' => $VERSION,
- 'Attribution' => 'DBD::File by Jochen Wiedmann',
- })
- or return undef;
-
- return $drh;
- }
-
-This is a reasonable example of how B<DBI> implements its handles. There
-are three kinds: B<driver handles> (typically stored in I<$drh>; from
-now on called I<drh> or I<$drh>), B<database handles> (from now on
-called I<dbh> or I<$dbh>) and B<statement handles> (from now on called
-I<sth> or I<$sth>).
-
-The prototype of C<DBI::_new_drh()> is
-
- $drh = DBI::_new_drh($class, $public_attrs, $private_attrs);
-
-with the following arguments:
-
-=over 4
-
-=item I<$class>
-
-is typically the class for your driver, (for example, "DBD::File::dr"),
-passed as the first argument to the C<driver()> method.
-
-=item I<$public_attrs>
-
-is a hash ref to attributes like I<Name>, I<Version>, and I<Attribution>.
-These are processed and used by B<DBI>. You had better not make any
-assumptions about them nor should you add private attributes here.
-
-=item I<$private_attrs>
-
-This is another (optional) hash ref with your private attributes.
-B<DBI> will store them and otherwise leave them alone.
-
-=back
-
-The C<DBI::_new_drh()> method and the C<driver()> method both return C<undef>
-for failure (in which case you must look at I<$DBI::err> and I<$DBI::errstr>
-for the failure information, because you have no driver handle to use).
-
-
-=head4 Using install_method() to expose driver-private methods
-
- DBD::Foo::db->install_method($method_name, \%attr);
-
-Installs the driver-private method named by $method_name into the
-DBI method dispatcher so it can be called directly, avoiding the
-need to use the func() method.
-
-It is called as a static method on the driver class to which the
-method belongs. The method name must begin with the corresponding
-registered driver-private prefix. For example, for DBD::Oracle
-$method_name must being with 'C<ora_>', and for DBD::AnyData it
-must begin with 'C<ad_>'.
-
-The C<\%attr> attributes can be used to provide fine control over how the DBI
-dispatcher handles the dispatching of the method. However it's undocumented
-at the moment. See the IMA_* #define's in DBI.xs and the O=>0x000x values in
-the initialization of %DBI::DBI_methods in DBI.pm. (Volunteers to polish up
-and document the interface are very welcome to get in touch via dbi-dev@perl.org).
-
-Methods installed using install_method default to the standard error
-handling behaviour for DBI methods: clearing err and errstr before
-calling the method, and checking for errors to trigger RaiseError
-etc. on return. This differs from the default behaviour of func().
-
-Note for driver authors: The DBD::Foo::xx->install_method call won't
-work until the class-hierarchy has been setup. Normally the DBI
-looks after that just after the driver is loaded. This means
-install_method() can't be called at the time the driver is loaded
-unless the class-hierarchy is set up first. The way to do that is
-to call the setup_driver() method:
-
- DBI->setup_driver('DBD::Foo');
-
-before using install_method().
-
-
-=head4 The CLONE special subroutine
-
-Also needed here, in the B<DBD::Driver> package, is a C<CLONE()> method
-that will be called by perl when an interpreter is cloned. All your
-C<CLONE()> method needs to do, currently, is clear the cached I<$drh> so
-the new interpreter won't start using the cached I<$drh> from the old
-interpreter:
-
- sub CLONE {
- undef $drh;
- }
-
-See L<http://search.cpan.org/dist/perl/pod/perlmod.pod#Making_your_module_threadsafe>
-for details.
-
-=head3 The DBD::Driver::dr package
-
-The next lines of code look as follows:
-
- package DBD::Driver::dr; # ====== DRIVER ======
-
- $DBD::Driver::dr::imp_data_size = 0;
-
-Note that no I<@ISA> is needed here, or for the other B<DBD::Driver::*>
-classes, because the B<DBI> takes care of that for you when the driver is
-loaded.
-
- *FIX ME* Explain what the imp_data_size is, so that implementors aren't
- practicing cargo-cult programming.
-
-=head4 The database handle constructor
-
-The database handle constructor is the driver's (hence the changed
-namespace) C<connect()> method:
-
- sub connect
- {
- my ($drh, $dr_dsn, $user, $auth, $attr) = @_;
-
- # Some database specific verifications, default settings
- # and the like can go here. This should only include
- # syntax checks or similar stuff where it's legal to
- # 'die' in case of errors.
- # For example, many database packages requires specific
- # environment variables to be set; this could be where you
- # validate that they are set, or default them if they are not set.
-
- my $driver_prefix = "drv_"; # the assigned prefix for this driver
-
- # Process attributes from the DSN; we assume ODBC syntax
- # here, that is, the DSN looks like var1=val1;...;varN=valN
- foreach my $var ( split /;/, $dr_dsn ) {
- my ($attr_name, $attr_value) = split '=', $var, 2;
- return $drh->set_err($DBI::stderr, "Can't parse DSN part '$var'")
- unless defined $attr_value;
-
- # add driver prefix to attribute name if it doesn't have it already
- $attr_name = $driver_prefix.$attr_name
- unless $attr_name =~ /^$driver_prefix/o;
-
- # Store attribute into %$attr, replacing any existing value.
- # The DBI will STORE() these into $dbh after we've connected
- $attr->{$attr_name} = $attr_value;
- }
-
- # Get the attributes we'll use to connect.
- # We use delete here because these no need to STORE them
- my $db = delete $attr->{drv_database} || delete $attr->{drv_db}
- or return $drh->set_err($DBI::stderr, "No database name given in DSN '$dr_dsn'");
- my $host = delete $attr->{drv_host} || 'localhost';
- my $port = delete $attr->{drv_port} || 123456;
-
- # Assume you can attach to your database via drv_connect:
- my $connection = drv_connect($db, $host, $port, $user, $auth)
- or return $drh->set_err($DBI::stderr, "Can't connect to $dr_dsn: ...");
-
- # create a 'blank' dbh (call superclass constructor)
- my ($outer, $dbh) = DBI::_new_dbh($drh, { Name => $dr_dsn });
-
- $dbh->STORE('Active', 1 );
- $dbh->{drv_connection} = $connection;
-
- return $outer;
- }
-
-This is mostly the same as in the I<driver handle constructor> above.
-The arguments are described in L<DBI>.
-
-The constructor C<DBI::_new_dbh()> is called, returning a database handle.
-The constructor's prototype is:
-
- ($outer, $inner) = DBI::_new_dbh($drh, $public_attr, $private_attr);
-
-with similar arguments to those in the I<driver handle constructor>,
-except that the I<$class> is replaced by I<$drh>. The I<Name> attribute
-is a standard B<DBI> attribute (see L<DBI/Database Handle Attributes>).
-
-In scalar context, only the outer handle is returned.
-
-Note the use of the C<STORE()> method for setting the I<dbh> attributes.
-That's because within the driver code, the handle object you have is
-the 'inner' handle of a tied hash, not the outer handle that the
-users of your driver have.
-
-Because you have the inner handle, tie magic doesn't get invoked
-when you get or set values in the hash. This is often very handy for
-speed when you want to get or set simple non-special driver-specific
-attributes.
-
-However, some attribute values, such as those handled by the B<DBI> like
-I<PrintError>, don't actually exist in the hash and must be read via
-C<$h-E<gt>FETCH($attrib)> and set via C<$h-E<gt>STORE($attrib, $value)>.
-If in any doubt, use these methods.
-
-=head4 The data_sources() method
-
-The C<data_sources()> method must populate and return a list of valid data
-sources, prefixed with the "I<dbi:Driver>" incantation that allows them to
-be used in the first argument of the C<DBI-E<gt>connect()> method.
-An example of this might be scanning the F<$HOME/.odbcini> file on Unix
-for ODBC data sources (DSNs).
-
-As a trivial example, consider a fixed list of data sources:
-
- sub data_sources
- {
- my($drh, $attr) = @_;
- my(@list) = ();
- # You need more sophisticated code than this to set @list...
- push @list, "dbi:Driver:abc";
- push @list, "dbi:Driver:def";
- push @list, "dbi:Driver:ghi";
- # End of code to set @list
- return @list;
- }
-
-=head4 The disconnect_all() method
-
-If you need to release any resources when the driver is unloaded, you
-can provide a disconnect_all method.
-
-=head4 Other driver handle methods
-
-If you need any other driver handle methods, they can follow here.
-
-=head4 Error handling
-
-It is quite likely that something fails in the connect method.
-With B<DBD::File> for example, you might catch an error when setting the
-current directory to something not existent by using the
-(driver-specific) I<f_dir> attribute.
-
-To report an error, you use the C<set_err()> method:
-
- $h->set_err($err, $errmsg, $state);
-
-This will ensure that the error is recorded correctly and that
-I<RaiseError> and I<PrintError> etc are handled correctly.
-
-Typically you'll always use the method instance, aka your method's first
-argument.
-
-As C<set_err()> always returns C<undef> your error handling code can
-usually be simplified to something like this:
-
- return $h->set_err($err, $errmsg, $state) if ...;
-
-=head3 The DBD::Driver::db package
-
- package DBD::Driver::db; # ====== DATABASE ======
-
- $DBD::Driver::db::imp_data_size = 0;
-
-=head4 The statement handle constructor
-
-There's nothing much new in the statement handle constructor, which
-is the C<prepare()> method:
-
- sub prepare
- {
- my ($dbh, $statement, @attribs) = @_;
-
- # create a 'blank' sth
- my ($outer, $sth) = DBI::_new_sth($dbh, { Statement => $statement });
-
- $sth->STORE('NUM_OF_PARAMS', ($statement =~ tr/?//));
-
- $sth->{drv_params} = [];
-
- return $outer;
- }
-
-This is still the same -- check the arguments and call the super class
-constructor C<DBI::_new_sth()>. Again, in scalar context, only the outer
-handle is returned. The I<Statement> attribute should be cached as
-shown.
-
-Note the prefix I<drv_> in the attribute names: it is required that
-all your private attributes use a lowercase prefix unique to your driver.
-As mentioned earlier in this document, the B<DBI> contains a registry of
-known driver prefixes and may one day warn about unknown attributes
-that don't have a registered prefix.
-
-Note that we parse the statement here in order to set the attribute
-I<NUM_OF_PARAMS>. The technique illustrated is not very reliable; it can
-be confused by question marks appearing in quoted strings, delimited
-identifiers or in SQL comments that are part of the SQL statement. We
-could set I<NUM_OF_PARAMS> in the C<execute()> method instead because
-the B<DBI> specification explicitly allows a driver to defer this, but then
-the user could not call C<bind_param()>.
-
-=head4 Transaction handling
-
-Pure Perl drivers will rarely support transactions. Thus your C<commit()>
-and C<rollback()> methods will typically be quite simple:
-
- sub commit
- {
- my ($dbh) = @_;
- if ($dbh->FETCH('Warn')) {
- warn("Commit ineffective while AutoCommit is on");
- }
- 0;
- }
-
- sub rollback {
- my ($dbh) = @_;
- if ($dbh->FETCH('Warn')) {
- warn("Rollback ineffective while AutoCommit is on");
- }
- 0;
- }
-
-Or even simpler, just use the default methods provided by the B<DBI> that
-do nothing except return C<undef>.
-
-The B<DBI>'s default C<begin_work()> method can be used by inheritance.
-
-=head4 The STORE() and FETCH() methods
-
-These methods (that we have already used, see above) are called for
-you, whenever the user does a:
-
- $dbh->{$attr} = $val;
-
-or, respectively,
-
- $val = $dbh->{$attr};
-
-See L<perltie> for details on tied hash refs to understand why these
-methods are required.
-
-The B<DBI> will handle most attributes for you, in particular attributes
-like I<RaiseError> or I<PrintError>. All you have to do is handle your
-driver's private attributes and any attributes, like I<AutoCommit> and
-I<ChopBlanks>, that the B<DBI> can't handle for you.
-
-A good example might look like this:
-
- sub STORE
- {
- my ($dbh, $attr, $val) = @_;
- if ($attr eq 'AutoCommit') {
- # AutoCommit is currently the only standard attribute we have
- # to consider.
- if (!$val) { die "Can't disable AutoCommit"; }
- return 1;
- }
- if ($attr =~ m/^drv_/) {
- # Handle only our private attributes here
- # Note that we could trigger arbitrary actions.
- # Ideally we should warn about unknown attributes.
- $dbh->{$attr} = $val; # Yes, we are allowed to do this,
- return 1; # but only for our private attributes
- }
- # Else pass up to DBI to handle for us
- $dbh->SUPER::STORE($attr, $val);
- }
-
- sub FETCH
- {
- my ($dbh, $attr) = @_;
- if ($attr eq 'AutoCommit') { return 1; }
- if ($attr =~ m/^drv_/) {
- # Handle only our private attributes here
- # Note that we could trigger arbitrary actions.
- return $dbh->{$attr}; # Yes, we are allowed to do this,
- # but only for our private attributes
- }
- # Else pass up to DBI to handle
- $dbh->SUPER::FETCH($attr);
- }
-
-The B<DBI> will actually store and fetch driver-specific attributes (with all
-lowercase names) without warning or error, so there's actually no need to
-implement driver-specific any code in your C<FETCH()> and C<STORE()>
-methods unless you need extra logic/checks, beyond getting or setting
-the value.
-
-Unless your driver documentation indicates otherwise, the return value of
-the C<STORE()> method is unspecified and the caller shouldn't use that value.
-
-=head4 Other database handle methods
-
-As with the driver package, other database handle methods may follow here.
-In particular you should consider a (possibly empty) C<disconnect()>
-method and possibly a C<quote()> method if B<DBI>'s default isn't correct for
-you. You may also need the C<type_info_all()> and C<get_info()> methods,
-as described elsewhere in this document.
-
-Where reasonable use C<$h-E<gt>SUPER::foo()> to call the B<DBI>'s method in
-some or all cases and just wrap your custom behavior around that.
-
-If you want to use private trace flags you'll probably want to be
-able to set them by name. To do that you'll need to define a
-C<parse_trace_flag()> method (note that's "parse_trace_flag", singular,
-not "parse_trace_flags", plural).
-
- sub parse_trace_flag {
- my ($h, $name) = @_;
- return 0x01000000 if $name eq 'foo';
- return 0x02000000 if $name eq 'bar';
- return 0x04000000 if $name eq 'baz';
- return 0x08000000 if $name eq 'boo';
- return 0x10000000 if $name eq 'bop';
- return $h->SUPER::parse_trace_flag($name);
- }
-
-All private flag names must be lowercase, and all private flags
-must be in the top 8 of the 32 bits.
-
-=head3 The DBD::Driver::st package
-
-This package follows the same pattern the others do:
-
- package DBD::Driver::st;
-
- $DBD::Driver::st::imp_data_size = 0;
-
-=head4 The execute() and bind_param() methods
-
-This is perhaps the most difficult method because we have to consider
-parameter bindings here. In addition to that, there are a number of
-statement attributes which must be set for inherited B<DBI> methods to
-function correctly (see L</Statement attributes> below).
-
-We present a simplified implementation by using the I<drv_params>
-attribute from above:
-
- sub bind_param
- {
- my ($sth, $pNum, $val, $attr) = @_;
- my $type = (ref $attr) ? $attr->{TYPE} : $attr;
- if ($type) {
- my $dbh = $sth->{Database};
- $val = $dbh->quote($sth, $type);
- }
- my $params = $sth->{drv_params};
- $params->[$pNum-1] = $val;
- 1;
- }
-
- sub execute
- {
- my ($sth, @bind_values) = @_;
-
- # start of by finishing any previous execution if still active
- $sth->finish if $sth->FETCH('Active');
-
- my $params = (@bind_values) ?
- \@bind_values : $sth->{drv_params};
- my $numParam = $sth->FETCH('NUM_OF_PARAMS');
- return $sth->set_err($DBI::stderr, "Wrong number of parameters")
- if @$params != $numParam;
- my $statement = $sth->{'Statement'};
- for (my $i = 0; $i < $numParam; $i++) {
- $statement =~ s/?/$params->[$i]/; # XXX doesn't deal with quoting etc!
- }
- # Do anything ... we assume that an array ref of rows is
- # created and store it:
- $sth->{'drv_data'} = $data;
- $sth->{'drv_rows'} = @$data; # number of rows
- $sth->STORE('NUM_OF_FIELDS') = $numFields;
- $sth->{Active} = 1;
- @$data || '0E0';
- }
-
-There are a number of things you should note here.
-
-We initialize the I<NUM_OF_FIELDS> and I<Active> attributes here,
-because they are essential for C<bind_columns()> to work.
-
-We use attribute C<$sth-E<gt>{Statement}> which we created
-within C<prepare()>. The attribute C<$sth-E<gt>{Database}>, which is
-nothing else than the I<dbh>, was automatically created by B<DBI>.
-
-Finally, note that (as specified in the B<DBI> specification) we return the
-string C<'0E0'> instead of the number 0, so that the result tests true but
-equal to zero.
-
- $sth->execute() or die $sth->errstr;
-
-=head4 The execute_array(), execute_for_fetch() and bind_param_array() methods
-
-In general, DBD's only need to implement C<execute_for_fetch()> and
-C<bind_param_array>. DBI's default C<execute_array()> will invoke the
-DBD's C<execute_for_fetch()> as needed.
-
-The following sequence describes the interaction between
-DBI C<execute_array> and a DBD's C<execute_for_fetch>:
-
-=over
-
-=item 1
-
-App calls C<$sth-E<gt>execute_array(\%attrs, @array_of_arrays)>
-
-=item 2
-
-If C<@array_of_arrays> was specified, DBI processes C<@array_of_arrays> by calling
-DBD's C<bind_param_array()>. Alternately, App may have directly called
-C<bind_param_array()>
-
-=item 3
-
-DBD validates and binds each array
-
-=item 4
-
-DBI retrieves the validated param arrays from DBD's ParamArray attribute
-
-=item 5
-
-DBI calls DBD's C<execute_for_fetch($fetch_tuple_sub, \@tuple_status)>,
-where C<&$fetch_tuple_sub> is a closure to iterate over the
-returned ParamArray values, and C<\@tuple_status> is an array to receive
-the disposition status of each tuple.
-
-=item 6
-
-DBD iteratively calls C<&$fetch_tuple_sub> to retrieve parameter tuples
-to be added to its bulk database operation/request.
-
-=item 7
-
-when DBD reaches the limit of tuples it can handle in a single database
-operation/request, or the C<&$fetch_tuple_sub> indicates no more
-tuples by returning undef, the DBD executes the bulk operation, and
-reports the disposition of each tuple in \@tuple_status.
-
-=item 8
-
-DBD repeats steps 6 and 7 until all tuples are processed.
-
-=back
-
-E.g., here's the essence of L<DBD::Oracle>'s execute_for_fetch:
-
- while (1) {
- my @tuple_batch;
- for (my $i = 0; $i < $batch_size; $i++) {
- push @tuple_batch, [ @{$fetch_tuple_sub->() || last} ];
- }
- last unless @tuple_batch;
- my $res = ora_execute_array($sth, \@tuple_batch,
- scalar(@tuple_batch), $tuple_batch_status);
- push @$tuple_status, @$tuple_batch_status;
- }
-
-Note that DBI's default execute_array()/execute_for_fetch() implementation
-requires the use of positional (i.e., '?') placeholders. Drivers
-which B<require> named placeholders must either emulate positional
-placeholders (e.g., see L<DBD::Oracle>), or must implement their own
-execute_array()/execute_for_fetch() methods to properly sequence bound
-parameter arrays.
-
-=head4 Fetching data
-
-Only one method needs to be written for fetching data, C<fetchrow_arrayref()>.
-The other methods, C<fetchrow_array()>, C<fetchall_arrayref()>, etc, as well
-as the database handle's C<select*> methods are part of B<DBI>, and call
-C<fetchrow_arrayref()> as necessary.
-
- sub fetchrow_arrayref
- {
- my ($sth) = @_;
- my $data = $sth->{drv_data};
- my $row = shift @$data;
- if (!$row) {
- $sth->STORE(Active => 0); # mark as no longer active
- return undef;
- }
- if ($sth->FETCH('ChopBlanks')) {
- map { $_ =~ s/\s+$//; } @$row;
- }
- return $sth->_set_fbav($row);
- }
- *fetch = \&fetchrow_arrayref; # required alias for fetchrow_arrayref
-
-Note the use of the method C<_set_fbav()> -- this is required so that
-C<bind_col()> and C<bind_columns()> work.
-
-If an error occurs which leaves the I<$sth> in a state where remaining rows
-can't be fetched then I<Active> should be turned off before the method returns.
-
-The C<rows()> method for this driver can be implemented like this:
-
- sub rows { shift->{drv_rows} }
-
-because it knows in advance how many rows it has fetched.
-Alternatively you could delete that method and so fallback
-to the B<DBI>'s own method which does the right thing based
-on the number of calls to C<_set_fbav()>.
-
-=head4 The more_results method
-
-If your driver doesn't support multiple result sets, then don't even implement this method.
-
-Otherwise, this method needs to get the statement handle ready to fetch results
-from the next result set, if there is one. Typically you'd start with:
-
- $sth->finish;
-
-then you should delete all the attributes from the attribute cache that may no
-longer be relevant for the new result set:
-
- delete $sth->{$_}
- for qw(NAME TYPE PRECISION SCALE ...);
-
-for drivers written in C use:
-
- hv_delete((HV*)SvRV(sth), "NAME", 4, G_DISCARD);
- hv_delete((HV*)SvRV(sth), "NULLABLE", 8, G_DISCARD);
- hv_delete((HV*)SvRV(sth), "NUM_OF_FIELDS", 13, G_DISCARD);
- hv_delete((HV*)SvRV(sth), "PRECISION", 9, G_DISCARD);
- hv_delete((HV*)SvRV(sth), "SCALE", 5, G_DISCARD);
- hv_delete((HV*)SvRV(sth), "TYPE", 4, G_DISCARD);
-
-Don't forget to also delete, or update, any driver-private attributes that may
-not be correct for the next resultset.
-
-The NUM_OF_FIELDS attribute is a special case. It should be set using STORE:
-
- $sth->STORE(NUM_OF_FIELDS => 0); /* for DBI <= 1.53 */
- $sth->STORE(NUM_OF_FIELDS => $new_value);
-
-for drivers written in C use this incantation:
-
- /* Adjust NUM_OF_FIELDS - which also adjusts the row buffer size */
- DBIc_NUM_FIELDS(imp_sth) = 0; /* for DBI <= 1.53 */
- DBIc_STATE(imp_xxh)->set_attr_k(sth, sv_2mortal(newSVpvn("NUM_OF_FIELDS",13)), 0,
- sv_2mortal(newSViv(mysql_num_fields(imp_sth->result)))
- );
-
-For DBI versions prior to 1.54 you'll also need to explicitly adjust the
-number of elements in the row buffer array (C<DBIc_FIELDS_AV(imp_sth)>)
-to match the new result set. Fill any new values with newSV(0) not &sv_undef.
-Alternatively you could free DBIc_FIELDS_AV(imp_sth) and set it to null,
-but that would mean bind_columns() wouldn't work across result sets.
-
-
-=head4 Statement attributes
-
-The main difference between I<dbh> and I<sth> attributes is, that you
-should implement a lot of attributes here that are required by
-the B<DBI>, such as I<NAME>, I<NULLABLE>, I<TYPE>, etc. See
-L<DBI/Statement Handle Attributes> for a complete list.
-
-Pay attention to attributes which are marked as read only, such as
-I<NUM_OF_PARAMS>. These attributes can only be set the first time
-a statement is executed. If a statement is prepared, then executed
-multiple times, warnings may be generated.
-
-You can protect against these warnings, and prevent the recalculation
-of attributes which might be expensive to calculate (such as the
-I<NAME> and I<NAME_*> attributes):
-
- my $storedNumParams = $sth->FETCH('NUM_OF_PARAMS');
- if (!defined $storedNumParams or $storedNumFields < 0) {
- $sth->STORE('NUM_OF_PARAMS') = $numParams;
-
- # Set other useful attributes that only need to be set once
- # for a statement, like $sth->{NAME} and $sth->{TYPE}
- }
-
-One particularly important attribute to set correctly (mentioned in
-L<DBI/ATTRIBUTES COMMON TO ALL HANDLES> is I<Active>. Many B<DBI> methods,
-including C<bind_columns()>, depend on this attribute.
-
-Besides that the C<STORE()> and C<FETCH()> methods are mainly the same
-as above for I<dbh>'s.
-
-=head4 Other statement methods
-
-A trivial C<finish()> method to discard stored data, reset any attributes
-(such as I<Active>) and do C<$sth-E<gt>SUPER::finish()>.
-
-If you've defined a C<parse_trace_flag()> method in B<::db> you'll also want
-it in B<::st>, so just alias it in:
-
- *parse_trace_flag = \&DBD::foo:db::parse_trace_flag;
-
-And perhaps some other methods that are not part of the B<DBI>
-specification, in particular to make metadata available.
-Remember that they must have names that begin with your drivers
-registered prefix so they can be installed using C<install_method()>.
-
-If C<DESTROY()> is called on a statement handle that's still active
-(C<$sth-E<gt>{Active}> is true) then it should effectively call C<finish()>.
-
- sub DESTROY {
- my $sth = shift;
- $sth->finish if $sth->FETCH('Active');
- }
-
-=head2 Tests
-
-The test process should conform as closely as possibly to the Perl
-standard test harness.
-
-In particular, most (all) of the tests should be run in the F<t> sub-directory,
-and should simply produce an C<ok> when run under C<make test>.
-For details on how this is done, see the Camel book and the section in
-Chapter 7, "The Standard Perl Library" on L<Test::Harness>.
-
-The tests may need to adapt to the type of database which is being used
-for testing, and to the privileges of the user testing the driver. For
-example, the B<DBD::Informix> test code has to adapt in a number of
-places to the type of database to which it is connected as different
-Informix databases have different capabilities: some of the tests are
-for databases without transaction logs; others are for databases with a
-transaction log; some versions of the server have support for blobs, or
-stored procedures, or user-defined data types, and others do not.
-
-When a complete file of tests must be skipped, you can provide a reason
-in a pseudo-comment:
-
- if ($no_transactions_available)
- {
- print "1..0 # Skip: No transactions available\n";
- exit 0;
- }
-
-Consider downloading the B<DBD::Informix> code and look at the code in
-F<DBD/Informix/TestHarness.pm> which is used throughout the
-B<DBD::Informix> tests in the F<t> sub-directory.
-
-=head1 CREATING A C/XS DRIVER
-
-Please also see the section under L<CREATING A PURE PERL DRIVER>
-regarding the creation of the F<Makefile.PL>.
-
-Creating a new C/XS driver from scratch will always be a daunting task.
-You can and should greatly simplify your task by taking a good
-reference driver implementation and modifying that to match the
-database product for which you are writing a driver.
-
-The de facto reference driver has been the one for B<DBD::Oracle> written
-by Tim Bunce, who is also the author of the B<DBI> package. The B<DBD::Oracle>
-module is a good example of a driver implemented around a C-level API.
-
-Nowadays it it seems better to base on B<DBD::ODBC>, another driver
-maintained by Tim and Jeff Urlwin, because it offers a lot of metadata
-and seems to become the guideline for the future development. (Also as
-B<DBD::Oracle> digs deeper into the Oracle 8 OCI interface it'll get even
-more hairy than it is now.)
-
-The B<DBD::Informix> driver is one driver implemented using embedded SQL
-instead of a function-based API.
-B<DBD::Ingres> may also be worth a look.
-
-=head2 C/XS version of Driver.pm
-
-A lot of the code in the F<Driver.pm> file is very similar to the code for pure Perl modules
-- see above. However,
-there are also some subtle (and not so subtle) differences, including:
-
-=over 8
-
-=item *
-
-The variables I<$DBD::Driver::{dr|db|st}::imp_data_size> are not defined
-here, but in the XS code, because they declare the size of certain
-C structures.
-
-=item *
-
-Some methods are typically moved to the XS code, in particular
-C<prepare()>, C<execute()>, C<disconnect()>, C<disconnect_all()> and the
-C<STORE()> and C<FETCH()> methods.
-
-=item *
-
-Other methods are still part of F<Driver.pm>, but have callbacks to
-the XS code.
-
-=item *
-
-If the driver-specific parts of the I<imp_drh_t> structure need to be
-formally initialized (which does not seem to be a common requirement),
-then you need to add a call to an appropriate XS function in the driver
-method of C<DBD::Driver::driver()>, and you define the corresponding function
-in F<Driver.xs>, and you define the C code in F<dbdimp.c> and the prototype in
-F<dbdimp.h>.
-
-For example, B<DBD::Informix> has such a requirement, and adds the
-following call after the call to C<_new_drh()> in F<Informix.pm>:
-
- DBD::Informix::dr::driver_init($drh);
-
-and the following code in F<Informix.xs>:
-
- # Initialize the DBD::Informix driver data structure
- void
- driver_init(drh)
- SV *drh
- CODE:
- ST(0) = dbd_ix_dr_driver_init(drh) ? &sv_yes : &sv_no;
-
-and the code in F<dbdimp.h> declares:
-
- extern int dbd_ix_dr_driver_init(SV *drh);
-
-and the code in F<dbdimp.ec> (equivalent to F<dbdimp.c>) defines:
-
- /* Formally initialize the DBD::Informix driver structure */
- int
- dbd_ix_dr_driver(SV *drh)
- {
- D_imp_drh(drh);
- imp_drh->n_connections = 0; /* No active connections */
- imp_drh->current_connection = 0; /* No current connection */
- imp_drh->multipleconnections = (ESQLC_VERSION >= 600) ? True : False;
- dbd_ix_link_newhead(&imp_drh->head); /* Empty linked list of connections */
- return 1;
- }
-
-B<DBD::Oracle> has a similar requirement but gets around it by checking
-whether the private data part of the driver handle is all zeroed out,
-rather than add extra functions.
-
-=back
-
-Now let's take a closer look at an excerpt from F<Oracle.pm> (revised
-heavily to remove idiosyncrasies) as an example, ignoring things that
-were already discussed for pure Perl drivers.
-
-=head3 The connect method
-
-The connect method is the database handle constructor.
-You could write either of two versions of this method: either one which
-takes connection attributes (new code) and one which ignores them (old
-code only).
-
-If you ignore the connection attributes, then you omit all mention of
-the I<$auth> variable (which is a reference to a hash of attributes), and
-the XS system manages the differences for you.
-
- sub connect
- {
- my ($drh, $dbname, $user, $auth, $attr) = @_;
-
- # Some database specific verifications, default settings
- # and the like following here. This should only include
- # syntax checks or similar stuff where it's legal to
- # 'die' in case of errors.
-
- my $dbh = DBI::_new_dbh($drh, {
- 'Name' => $dbname,
- })
- or return undef;
-
- # Call the driver-specific function _login in Driver.xs file which
- # calls the DBMS-specific function(s) to connect to the database,
- # and populate internal handle data.
- DBD::Driver::db::_login($dbh, $dbname, $user, $auth, $attr)
- or return undef;
-
- $dbh;
- }
-
-This is mostly the same as in the pure Perl case, the exception being
-the use of the private C<_login()> callback, which is the function
-that will really connect to the database. It is implemented in
-F<Driver.xst> (you should not implement it) and calls
-C<dbd_db_login6()> or C<dbd_db_login6_sv> from F<dbdimp.c>. See below
-for details.
-
-If your driver has driver-specific attributes which may be passed in the
-connect method and hence end up in C<$attr> in C<dbd_db_login6> then it
-is best to delete any you process so DBI does not send them again
-via STORE after connect. You can do this in C like this:
-
- DBD_ATTRIB_DELETE(attr, "my_attribute_name",
- strlen("my_attribute_name"));
-
-However, prior to DBI subversion version 11605 (and fixed post 1.607)
-DBD_ATTRIB_DELETE segfaulted so if you cannot guarantee the DBI version
-will be post 1.607 you need to use:
-
- hv_delete((HV*)SvRV(attr), "my_attribute_name",
- strlen("my_attribute_name"), G_DISCARD);
-
- *FIX ME* Discuss removing attributes in Perl code.
-
-=head3 The disconnect_all method
-
- *FIX ME* T.B.S
-
-=head3 The data_sources method
-
-If your C<data_sources()> method can be implemented in pure Perl, then do
-so because it is easier than doing it in XS code (see the section above
-for pure Perl drivers).
-
-If your C<data_sources()> method must call onto compiled functions, then
-you will need to define I<dbd_dr_data_sources> in your F<dbdimp.h> file, which
-will trigger F<Driver.xst> (in B<DBI> v1.33 or greater) to generate the XS
-code that calls your actual C function (see the discussion below for
-details) and you do not code anything in F<Driver.pm> to handle it.
-
-=head3 The prepare method
-
-The prepare method is the statement handle constructor, and most of it
-is not new. Like the C<connect()> method, it now has a C callback:
-
- package DBD::Driver::db; # ====== DATABASE ======
- use strict;
-
- sub prepare
- {
- my ($dbh, $statement, $attribs) = @_;
-
- # create a 'blank' sth
- my $sth = DBI::_new_sth($dbh, {
- 'Statement' => $statement,
- })
- or return undef;
-
- # Call the driver-specific function _prepare in Driver.xs file
- # which calls the DBMS-specific function(s) to prepare a statement
- # and populate internal handle data.
- DBD::Driver::st::_prepare($sth, $statement, $attribs)
- or return undef;
- $sth;
- }
-
-=head3 The execute method
-
- *FIX ME* T.B.S
-
-=head3 The fetchrow_arrayref method
-
- *FIX ME* T.B.S
-
-=head3 Other methods?
-
- *FIX ME* T.B.S
-
-=head2 Driver.xs
-
-F<Driver.xs> should look something like this:
-
- #include "Driver.h"
-
- DBISTATE_DECLARE;
-
- INCLUDE: Driver.xsi
-
- MODULE = DBD::Driver PACKAGE = DBD::Driver::dr
-
- /* Non-standard drh XS methods following here, if any. */
- /* If none (the usual case), omit the MODULE line above too. */
-
- MODULE = DBD::Driver PACKAGE = DBD::Driver::db
-
- /* Non-standard dbh XS methods following here, if any. */
- /* Currently this includes things like _list_tables from */
- /* DBD::mSQL and DBD::mysql. */
-
- MODULE = DBD::Driver PACKAGE = DBD::Driver::st
-
- /* Non-standard sth XS methods following here, if any. */
- /* In particular this includes things like _list_fields from */
- /* DBD::mSQL and DBD::mysql for accessing metadata. */
-
-Note especially the include of F<Driver.xsi> here: B<DBI> inserts stub
-functions for almost all private methods here which will typically do
-much work for you.
-
-Wherever you really have to implement something, it will call a private
-function in F<dbdimp.c>, and this is what you have to implement.
-
-You need to set up an extra routine if your driver needs to export
-constants of its own, analogous to the SQL types available when you say:
-
- use DBI qw(:sql_types);
-
- *FIX ME* T.B.S
-
-=head2 Driver.h
-
-F<Driver.h> is very simple and the operational contents should look like this:
-
- #ifndef DRIVER_H_INCLUDED
- #define DRIVER_H_INCLUDED
-
- #define NEED_DBIXS_VERSION 93 /* 93 for DBI versions 1.00 to 1.51+ */
- #define PERL_NO_GET_CONTEXT /* if used require DBI 1.51+ */
-
- #include <DBIXS.h> /* installed by the DBI module */
-
- #include "dbdimp.h"
-
- #include "dbivport.h" /* see below */
-
- #include <dbd_xsh.h> /* installed by the DBI module */
-
- #endif /* DRIVER_H_INCLUDED */
-
-The F<DBIXS.h> header defines most of the interesting information that
-the writer of a driver needs.
-
-The file F<dbd_xsh.h> header provides prototype declarations for the C
-functions that you might decide to implement. Note that you should
-normally only define one of C<dbd_db_login()>, C<dbd_db_login6()> or
-C<dbd_db_login6_sv> unless you are intent on supporting really old
-versions of B<DBI> (prior to B<DBI> 1.06) as well as modern
-versions. The only standard, B<DBI>-mandated functions that you need
-write are those specified in the F<dbd_xsh.h> header. You might also
-add extra driver-specific functions in F<Driver.xs>.
-
-The F<dbivport.h> file should be I<copied> from the latest B<DBI> release
-into your distribution each time you modify your driver. Its job is to
-allow you to enhance your code to work with the latest B<DBI> API while
-still allowing your driver to be compiled and used with older versions
-of the B<DBI> (for example, when the C<DBIh_SET_ERR_CHAR()> macro was added
-to B<DBI> 1.41, an emulation of it was added to F<dbivport.h>). This makes
-users happy and your life easier. Always read the notes in F<dbivport.h>
-to check for any limitations in the emulation that you should be aware
-of.
-
-With B<DBI> v1.51 or better I recommend that the driver defines
-I<PERL_NO_GET_CONTEXT> before F<DBIXS.h> is included. This can significantly
-improve efficiency when running under a thread enabled perl. (Remember that
-the standard perl in most Linux distributions is built with threads enabled.
-So is ActiveState perl for Windows, and perl built for Apache mod_perl2.)
-If you do this there are some things to keep in mind:
-
-=over 4
-
-=item *
-
-If I<PERL_NO_GET_CONTEXT> is defined, then every function that calls the Perl
-API will need to start out with a C<dTHX;> declaration.
-
-=item *
-
-You'll know which functions need this, because the C compiler will
-complain that the undeclared identifier C<my_perl> is used if I<and only if>
-the perl you are using to develop and test your driver has threads enabled.
-
-=item *
-
-If you don't remember to test with a thread-enabled perl before making
-a release it's likely that you'll get failure reports from users who are.
-
-=item *
-
-For driver private functions it is possible to gain even more
-efficiency by replacing C<dTHX;> with C<pTHX_> prepended to the
-parameter list and then C<aTHX_> prepended to the argument list where
-the function is called.
-
-=back
-
-See L<perlguts/How multiple interpreters and concurrency are supported> for
-additional information about I<PERL_NO_GET_CONTEXT>.
-
-=head2 Implementation header dbdimp.h
-
-This header file has two jobs:
-
-First it defines data structures for your private part of the handles.
-Note that the DBI provides many common fields for you. For example
-the statement handle (imp_sth) already has a row_count field with an IV type
-that accessed via the DBIc_ROW_COUNT(imp_sth) macro. Using this is strongly
-recommended as it's built in to some DBI internals so the DBI can 'just work'
-in more cases and you'll have less driver-specific code to write.
-Study DBIXS.h to see what's included with each type of handle.
-
-Second it defines macros that rename the generic names like
-C<dbd_db_login()> to database specific names like C<ora_db_login()>. This
-avoids name clashes and enables use of different drivers when you work
-with a statically linked perl.
-
-It also will have the important task of disabling XS methods that you
-don't want to implement.
-
-Finally, the macros will also be used to select alternate
-implementations of some functions. For example, the C<dbd_db_login()>
-function is not passed the attribute hash.
-
-Since B<DBI> v1.06, if a C<dbd_db_login6()> macro is defined (for a function
-with 6 arguments), it will be used instead with the attribute hash
-passed as the sixth argument.
-
-Since B<DBI> post v1.607, if a C<dbd_db_login6_sv()> macro is defined (for
-a function like dbd_db_login6 but with scalar pointers for the dbname,
-username and password), it will be used instead. This will allow your
-login6 function to see if there are any Unicode characters in the
-dbname.
-
-Similarly defining dbd_db_do4_iv is preferred over dbd_db_do4, dbd_st_rows_iv
-over dbd_st_rows, and dbd_st_execute_iv over dbd_st_execute. The *_iv forms are
-declared to return the IV type instead of an int.
-
-People used to just pick Oracle's F<dbdimp.c> and use the same names,
-structures and types. I strongly recommend against that. At first glance
-this saves time, but your implementation will be less readable. It was
-just hell when I had to separate B<DBI> specific parts, Oracle specific
-parts, mSQL specific parts and mysql specific parts in B<DBD::mysql>'s
-I<dbdimp.h> and I<dbdimp.c>. (B<DBD::mysql> was a port of B<DBD::mSQL>
-which was based on B<DBD::Oracle>.) [Seconded, based on the experience
-taking B<DBD::Informix> apart, even though the version inherited in 1996
-was only based on B<DBD::Oracle>.]
-
-This part of the driver is I<your exclusive part>. Rewrite it from
-scratch, so it will be clean and short: in other words, a better piece
-of code. (Of course keep an eye on other people's work.)
-
- struct imp_drh_st {
- dbih_drc_t com; /* MUST be first element in structure */
- /* Insert your driver handle attributes here */
- };
-
- struct imp_dbh_st {
- dbih_dbc_t com; /* MUST be first element in structure */
- /* Insert your database handle attributes here */
- };
-
- struct imp_sth_st {
- dbih_stc_t com; /* MUST be first element in structure */
- /* Insert your statement handle attributes here */
- };
-
- /* Rename functions for avoiding name clashes; prototypes are */
- /* in dbd_xsh.h */
- #define dbd_init drv_dr_init
- #define dbd_db_login6_sv drv_db_login_sv
- #define dbd_db_do drv_db_do
- ... many more here ...
-
-These structures implement your private part of the handles.
-
-You I<have> to use the name C<imp_dbh_{dr|db|st}> and the first field
-I<must> be of type I<dbih_drc_t|_dbc_t|_stc_t> and I<must> be called
-C<com>.
-
-You should never access these fields directly, except by using the
-I<DBIc_xxx()> macros below.
-
-=head2 Implementation source dbdimp.c
-
-Conventionally, F<dbdimp.c> is the main implementation file (but
-B<DBD::Informix> calls the file F<dbdimp.ec>). This section includes a
-short note on each function that is used in the F<Driver.xsi> template
-and thus I<has> to be implemented.
-
-Of course, you will probably also need to implement other support
-functions, which should usually be file static if they are placed in
-F<dbdimp.c>. If they are placed in other files, you need to list those
-files in F<Makefile.PL> (and F<MANIFEST>) to handle them correctly.
-
-It is wise to adhere to a namespace convention for your functions to
-avoid conflicts. For example, for a driver with prefix I<drv_>, you
-might call externally visible functions I<dbd_drv_xxxx>. You should also
-avoid non-constant global variables as much as possible to improve the
-support for threading.
-
-Since Perl requires support for function prototypes (ANSI or ISO or
-Standard C), you should write your code using function prototypes too.
-
-It is possible to use either the unmapped names such as C<dbd_init()> or
-the mapped names such as C<dbd_ix_dr_init()> in the F<dbdimp.c> file.
-B<DBD::Informix> uses the mapped names which makes it easier to identify
-where to look for linkage problems at runtime (which will report errors
-using the mapped names).
-
-Most other drivers, and in particular B<DBD::Oracle>, use the unmapped
-names in the source code which makes it a little easier to compare code
-between drivers and eases discussions on the I<dbi-dev> mailing list.
-The majority of the code fragments here will use the unmapped names.
-
-Ultimately, you should provide implementations for most of the
-functions listed in the F<dbd_xsh.h> header. The exceptions are
-optional functions (such as C<dbd_st_rows()>) and those functions with
-alternative signatures, such as C<dbd_db_login6_sv>,
-C<dbd_db_login6()> and I<dbd_db_login()>. Then you should only
-implement one of the alternatives, and generally the newer one of the
-alternatives.
-
-=head3 The dbd_init method
-
- #include "Driver.h"
-
- DBISTATE_DECLARE;
-
- void dbd_init(dbistate_t* dbistate)
- {
- DBISTATE_INIT; /* Initialize the DBI macros */
- }
-
-The C<dbd_init()> function will be called when your driver is first
-loaded; the bootstrap command in C<DBD::Driver::dr::driver()> triggers this,
-and the call is generated in the I<BOOT> section of F<Driver.xst>.
-These statements are needed to allow your driver to use the B<DBI> macros.
-They will include your private header file F<dbdimp.h> in turn.
-Note that I<DBISTATE_INIT> requires the name of the argument to C<dbd_init()>
-to be called C<dbistate()>.
-
-=head3 The dbd_drv_error method
-
-You need a function to record errors so B<DBI> can access them properly.
-You can call it whatever you like, but we'll call it C<dbd_drv_error()>
-here.
-
-The argument list depends on your database software; different systems
-provide different ways to get at error information.
-
- static void dbd_drv_error(SV *h, int rc, const char *what)
- {
-
-Note that I<h> is a generic handle, may it be a driver handle, a
-database or a statement handle.
-
- D_imp_xxh(h);
-
-This macro will declare and initialize a variable I<imp_xxh> with
-a pointer to your private handle pointer. You may cast this to
-to I<imp_drh_t>, I<imp_dbh_t> or I<imp_sth_t>.
-
-To record the error correctly, equivalent to the C<set_err()> method,
-use one of the C<DBIh_SET_ERR_CHAR(...)> or C<DBIh_SET_ERR_SV(...)> macros,
-which were added in B<DBI> 1.41:
-
- DBIh_SET_ERR_SV(h, imp_xxh, err, errstr, state, method);
- DBIh_SET_ERR_CHAR(h, imp_xxh, err_c, err_i, errstr, state, method);
-
-For C<DBIh_SET_ERR_SV> the I<err>, I<errstr>, I<state>, and I<method>
-parameters are C<SV*> (use &sv_undef instead of NULL).
-
-For C<DBIh_SET_ERR_CHAR> the I<err_c>, I<errstr>, I<state>, I<method>
-parameters are C<char*>.
-
-The I<err_i> parameter is an C<IV> that's used instead of I<err_c> if
-I<err_c> is C<Null>.
-
-The I<method> parameter can be ignored.
-
-The C<DBIh_SET_ERR_CHAR> macro is usually the simplest to use when you
-just have an integer error code and an error message string:
-
- DBIh_SET_ERR_CHAR(h, imp_xxh, Nullch, rc, what, Nullch, Nullch);
-
-As you can see, any parameters that aren't relevant to you can be C<Null>.
-
-To make drivers compatible with B<DBI> < 1.41 you should be using F<dbivport.h>
-as described in L</Driver.h> above.
-
-The (obsolete) macros such as C<DBIh_EVENT2> should be removed from drivers.
-
-The names C<dbis> and C<DBIS>, which were used in previous versions of
-this document, should be replaced with the C<DBIc_DBISTATE(imp_xxh)> macro.
-
-The name C<DBILOGFP>, which was also used in previous versions of this
-document, should be replaced by C<DBIc_LOGPIO(imp_xxh)>.
-
-Your code should not call the C C<E<lt>stdio.hE<gt>> I/O functions; you
-should use C<PerlIO_printf()> as shown:
-
- if (DBIc_TRACE_LEVEL(imp_xxh) >= 2)
- PerlIO_printf(DBIc_LOGPIO(imp_xxh), "foobar %s: %s\n",
- foo, neatsvpv(errstr,0));
-
-That's the first time we see how tracing works within a B<DBI> driver. Make
-use of this as often as you can, but don't output anything at a trace
-level less than 3. Levels 1 and 2 are reserved for the B<DBI>.
-
-You can define up to 8 private trace flags using the top 8 bits
-of C<DBIc_TRACE_FLAGS(imp)>, that is: C<0xFF000000>. See the
-C<parse_trace_flag()> method elsewhere in this document.
-
-=head3 The dbd_dr_data_sources method
-
-This method is optional; the support for it was added in B<DBI> v1.33.
-
-As noted in the discussion of F<Driver.pm>, if the data sources
-can be determined by pure Perl code, do it that way. If, as in
-B<DBD::Informix>, the information is obtained by a C function call, then
-you need to define a function that matches the prototype:
-
- extern AV *dbd_dr_data_sources(SV *drh, imp_drh_t *imp_drh, SV *attrs);
-
-An outline implementation for B<DBD::Informix> follows, assuming that the
-C<sqgetdbs()> function call shown will return up to 100 databases names,
-with the pointers to each name in the array dbsname and the name strings
-themselves being stores in dbsarea.
-
- AV *dbd_dr_data_sources(SV *drh, imp_drh_t *imp_drh, SV *attr)
- {
- int ndbs;
- int i;
- char *dbsname[100];
- char dbsarea[10000];
- AV *av = Nullav;
-
- if (sqgetdbs(&ndbs, dbsname, 100, dbsarea, sizeof(dbsarea)) == 0)
- {
- av = NewAV();
- av_extend(av, (I32)ndbs);
- sv_2mortal((SV *)av);
- for (i = 0; i < ndbs; i++)
- av_store(av, i, newSVpvf("dbi:Informix:%s", dbsname[i]));
- }
- return(av);
- }
-
-The actual B<DBD::Informix> implementation has a number of extra lines of
-code, logs function entry and exit, reports the error from C<sqgetdbs()>,
-and uses C<#define>'d constants for the array sizes.
-
-=head3 The dbd_db_login6 method
-
- int dbd_db_login6_sv(SV* dbh, imp_dbh_t* imp_dbh, SV* dbname,
- SV* user, SV* auth, SV *attr);
-
- or
-
- int dbd_db_login6(SV* dbh, imp_dbh_t* imp_dbh, char* dbname,
- char* user, char* auth, SV *attr);
-
-This function will really connect to the database. The argument I<dbh>
-is the database handle. I<imp_dbh> is the pointer to the handles private
-data, as is I<imp_xxx> in C<dbd_drv_error()> above. The arguments
-I<dbname>, I<user>, I<auth> and I<attr> correspond to the arguments of
-the driver handle's C<connect()> method.
-
-You will quite often use database specific attributes here, that are
-specified in the DSN. I recommend you parse the DSN (using Perl) within
-the C<connect()> method and pass the segments of the DSN via the
-attributes parameter through C<_login()> to C<dbd_db_login6()>.
-
-Here's how you fetch them; as an example we use I<hostname> attribute,
-which can be up to 12 characters long excluding null terminator:
-
- SV** svp;
- STRLEN len;
- char* hostname;
-
- if ( (svp = DBD_ATTRIB_GET_SVP(attr, "drv_hostname", 12)) && SvTRUE(*svp)) {
- hostname = SvPV(*svp, len);
- DBD_ATTRIB_DELETE(attr, "drv_hostname", 12); /* avoid later STORE */
- } else {
- hostname = "localhost";
- }
-
-If you handle any driver specific attributes in the dbd_db_login6
-method you probably want to delete them from C<attr> (as above with
-DBD_ATTRIB_DELETE). If you don't delete your handled attributes DBI
-will call C<STORE> for each attribute after the connect/login and this
-is at best redundant for attributes you have already processed.
-
-B<Note: Until revision 11605 (post DBI 1.607), there was a problem with
-DBD_ATTRIBUTE_DELETE so unless you require a DBI version after 1.607
-you need to replace each DBD_ATTRIBUTE_DELETE call with:>
-
- hv_delete((HV*)SvRV(attr), key, key_len, G_DISCARD)
-
-Note that you can also obtain standard attributes such as I<AutoCommit> and
-I<ChopBlanks> from the attributes parameter, using C<DBD_ATTRIB_GET_IV> for
-integer attributes.
-
-If, for example, your database does not support transactions but
-I<AutoCommit> is set off (requesting transaction support), then you can
-emulate a 'failure to connect'.
-
-Now you should really connect to the database. In general, if the
-connection fails, it is best to ensure that all allocated resources are
-released so that the handle does not need to be destroyed separately. If
-you are successful (and possibly even if you fail but you have allocated
-some resources), you should use the following macros:
-
- DBIc_IMPSET_on(imp_dbh);
-
-This indicates that the driver (implementor) has allocated resources in
-the I<imp_dbh> structure and that the implementors private C<dbd_db_destroy()>
-function should be called when the handle is destroyed.
-
- DBIc_ACTIVE_on(imp_dbh);
-
-This indicates that the handle has an active connection to the server
-and that the C<dbd_db_disconnect()> function should be called before the
-handle is destroyed.
-
-Note that if you do need to fail, you should report errors via the I<drh>
-or I<imp_drh> rather than via I<dbh> or I<imp_dbh> because I<imp_dbh> will be
-destroyed by the failure, so errors recorded in that handle will not be
-visible to B<DBI>, and hence not the user either.
-
-Note too, that the function is passed I<dbh> and I<imp_dbh>, and there
-is a macro C<D_imp_drh_from_dbh> which can recover the I<imp_drh> from
-the I<imp_dbh>. However, there is no B<DBI> macro to provide you with the
-I<drh> given either the I<imp_dbh> or the I<dbh> or the I<imp_drh> (and
-there's no way to recover the I<dbh> given just the I<imp_dbh>).
-
-This suggests that, despite the above notes about C<dbd_drv_error()>
-taking an C<SV *>, it may be better to have two error routines, one
-taking I<imp_dbh> and one taking I<imp_drh> instead. With care, you can
-factor most of the formatting code out so that these are small routines
-calling a common error formatter. See the code in B<DBD::Informix>
-1.05.00 for more information.
-
-The C<dbd_db_login6()> function should return I<TRUE> for success,
-I<FALSE> otherwise.
-
-Drivers implemented long ago may define the five-argument function
-C<dbd_db_login()> instead of C<dbd_db_login6()>. The missing argument is
-the attributes. There are ways to work around the missing attributes,
-but they are ungainly; it is much better to use the 6-argument form.
-Even later drivers will use C<dbd_db_login6_sv()> which provides the
-dbname, username and password as SVs.
-
-=head3 The dbd_db_commit and dbd_db_rollback methods
-
- int dbd_db_commit(SV *dbh, imp_dbh_t *imp_dbh);
- int dbd_db_rollback(SV* dbh, imp_dbh_t* imp_dbh);
-
-These are used for commit and rollback. They should return I<TRUE> for
-success, I<FALSE> for error.
-
-The arguments I<dbh> and I<imp_dbh> are the same as for C<dbd_db_login6()>
-above; I will omit describing them in what follows, as they appear
-always.
-
-These functions should return I<TRUE> for success, I<FALSE> otherwise.
-
-=head3 The dbd_db_disconnect method
-
-This is your private part of the C<disconnect()> method. Any I<dbh> with
-the I<ACTIVE> flag on must be disconnected. (Note that you have to set
-it in C<dbd_db_connect()> above.)
-
- int dbd_db_disconnect(SV* dbh, imp_dbh_t* imp_dbh);
-
-The database handle will return I<TRUE> for success, I<FALSE> otherwise.
-In any case it should do a:
-
- DBIc_ACTIVE_off(imp_dbh);
-
-before returning so B<DBI> knows that C<dbd_db_disconnect()> was executed.
-
-Note that there's nothing to stop a I<dbh> being I<disconnected> while
-it still have active children. If your database API reacts badly to
-trying to use an I<sth> in this situation then you'll need to add code
-like this to all I<sth> methods:
-
- if (!DBIc_ACTIVE(DBIc_PARENT_COM(imp_sth)))
- return 0;
-
-Alternatively, you can add code to your driver to keep explicit track of
-the statement handles that exist for each database handle and arrange
-to destroy those handles before disconnecting from the database. There
-is code to do this in B<DBD::Informix>. Similar comments apply to the
-driver handle keeping track of all the database handles.
-
-Note that the code which destroys the subordinate handles should only
-release the associated database resources and mark the handles inactive;
-it does not attempt to free the actual handle structures.
-
-This function should return I<TRUE> for success, I<FALSE> otherwise, but
-it is not clear what anything can do about a failure.
-
-=head3 The dbd_db_discon_all method
-
- int dbd_discon_all (SV *drh, imp_drh_t *imp_drh);
-
-This function may be called at shutdown time. It should make
-best-efforts to disconnect all database handles - if possible. Some
-databases don't support that, in which case you can do nothing
-but return 'success'.
-
-This function should return I<TRUE> for success, I<FALSE> otherwise, but
-it is not clear what anything can do about a failure.
-
-=head3 The dbd_db_destroy method
-
-This is your private part of the database handle destructor. Any I<dbh> with
-the I<IMPSET> flag on must be destroyed, so that you can safely free
-resources. (Note that you have to set it in C<dbd_db_connect()> above.)
-
- void dbd_db_destroy(SV* dbh, imp_dbh_t* imp_dbh)
- {
- DBIc_IMPSET_off(imp_dbh);
- }
-
-The B<DBI> F<Driver.xst> code will have called C<dbd_db_disconnect()> for you,
-if the handle is still 'active', before calling C<dbd_db_destroy()>.
-
-Before returning the function must switch I<IMPSET> to off, so B<DBI> knows
-that the destructor was called.
-
-A B<DBI> handle doesn't keep references to its children. But children
-do keep references to their parents. So a database handle won't be
-C<DESTROY>'d until all its children have been C<DESTROY>'d.
-
-=head3 The dbd_db_STORE_attrib method
-
-This function handles
-
- $dbh->{$key} = $value;
-
-Its prototype is:
-
- int dbd_db_STORE_attrib(SV* dbh, imp_dbh_t* imp_dbh, SV* keysv,
- SV* valuesv);
-
-You do not handle all attributes; on the contrary, you should not handle
-B<DBI> attributes here: leave this to B<DBI>. (There are two exceptions,
-I<AutoCommit> and I<ChopBlanks>, which you should care about.)
-
-The return value is I<TRUE> if you have handled the attribute or I<FALSE>
-otherwise. If you are handling an attribute and something fails, you
-should call C<dbd_drv_error()>, so B<DBI> can raise exceptions, if desired.
-If C<dbd_drv_error()> returns, however, you have a problem: the user will
-never know about the error, because he typically will not check
-C<$dbh-E<gt>errstr()>.
-
-I cannot recommend a general way of going on, if C<dbd_drv_error()> returns,
-but there are examples where even the B<DBI> specification expects that
-you C<croak()>. (See the I<AutoCommit> method in L<DBI>.)
-
-If you have to store attributes, you should either use your private
-data structure I<imp_xxx>, the handle hash (via C<(HV*)SvRV(dbh)>), or use
-the private I<imp_data>.
-
-The first is best for internal C values like integers or pointers and
-where speed is important within the driver. The handle hash is best for
-values the user may want to get/set via driver-specific attributes.
-The private I<imp_data> is an additional C<SV> attached to the handle. You
-could think of it as an unnamed handle attribute. It's not normally used.
-
-=head3 The dbd_db_FETCH_attrib method
-
-This is the counterpart of C<dbd_db_STORE_attrib()>, needed for:
-
- $value = $dbh->{$key};
-
-Its prototype is:
-
- SV* dbd_db_FETCH_attrib(SV* dbh, imp_dbh_t* imp_dbh, SV* keysv);
-
-Unlike all previous methods this returns an C<SV> with the value. Note
-that you should normally execute C<sv_2mortal()>, if you return a nonconstant
-value. (Constant values are C<&sv_undef>, C<&sv_no> and C<&sv_yes>.)
-
-Note, that B<DBI> implements a caching algorithm for attribute values.
-If you think, that an attribute may be fetched, you store it in the
-I<dbh> itself:
-
- if (cacheit) /* cache value for later DBI 'quick' fetch? */
- hv_store((HV*)SvRV(dbh), key, kl, cachesv, 0);
-
-=head3 The dbd_st_prepare method
-
-This is the private part of the C<prepare()> method. Note that you
-B<must not> really execute the statement here. You may, however,
-preparse and validate the statement, or do similar things.
-
- int dbd_st_prepare(SV* sth, imp_sth_t* imp_sth, char* statement,
- SV* attribs);
-
-A typical, simple, possibility is to do nothing and rely on the perl
-C<prepare()> code that set the I<Statement> attribute on the handle. This
-attribute can then be used by C<dbd_st_execute()>.
-
-If the driver supports placeholders then the I<NUM_OF_PARAMS> attribute
-must be set correctly by C<dbd_st_prepare()>:
-
- DBIc_NUM_PARAMS(imp_sth) = ...
-
-If you can, you should also setup attributes like I<NUM_OF_FIELDS>, I<NAME>,
-etc. here, but B<DBI> doesn't require that - they can be deferred until
-execute() is called. However, if you do, document it.
-
-In any case you should set the I<IMPSET> flag, as you did in
-C<dbd_db_connect()> above:
-
- DBIc_IMPSET_on(imp_sth);
-
-=head3 The dbd_st_execute method
-
-This is where a statement will really be executed.
-
- int dbd_st_execute(SV* sth, imp_sth_t* imp_sth);
-
-C<dbd_st_execute> should return -2 for any error, -1 if the number of
-rows affected is unknown else it should be the number of affected
-(updated, inserted) rows.
-
-Note that you must be aware a statement may be executed repeatedly.
-Also, you should not expect that C<finish()> will be called between two
-executions, so you might need code, like the following, near the start
-of the function:
-
- if (DBIc_ACTIVE(imp_sth))
- dbd_st_finish(h, imp_sth);
-
-If your driver supports the binding of parameters (it should!), but the
-database doesn't, you must do it here. This can be done as follows:
-
- SV *svp;
- char* statement = DBD_ATTRIB_GET_PV(h, "Statement", 9, svp, "");
- int numParam = DBIc_NUM_PARAMS(imp_sth);
- int i;
-
- for (i = 0; i < numParam; i++)
- {
- char* value = dbd_db_get_param(sth, imp_sth, i);
- /* It is your drivers task to implement dbd_db_get_param, */
- /* it must be setup as a counterpart of dbd_bind_ph. */
- /* Look for '?' and replace it with 'value'. Difficult */
- /* task, note that you may have question marks inside */
- /* quotes and comments the like ... :-( */
- /* See DBD::mysql for an example. (Don't look too deep into */
- /* the example, you will notice where I was lazy ...) */
- }
-
-The next thing is to really execute the statement.
-
-Note that you must set the attributes I<NUM_OF_FIELDS>, I<NAME>, etc
-when the statement is successfully executed if the driver has not
-already done so: they may be used even before a potential C<fetchrow()>.
-In particular you have to tell B<DBI> the number of fields that the
-statement has, because it will be used by B<DBI> internally. Thus the
-function will typically ends with:
-
- if (isSelectStatement) {
- DBIc_NUM_FIELDS(imp_sth) = numFields;
- DBIc_ACTIVE_on(imp_sth);
- }
-
-It is important that the I<ACTIVE> flag only be set for C<SELECT>
-statements (or any other statements that can return many
-values from the database using a cursor-like mechanism). See
-C<dbd_db_connect()> above for more explanations.
-
-There plans for a preparse function to be provided by B<DBI>, but this has
-not reached fruition yet.
-Meantime, if you want to know how ugly it can get, try looking at the
-C<dbd_ix_preparse()> in B<DBD::Informix> F<dbdimp.ec> and the related
-functions in F<iustoken.c> and F<sqltoken.c>.
-
-=head3 The dbd_st_fetch method
-
-This function fetches a row of data. The row is stored in in an array,
-of C<SV>'s that B<DBI> prepares for you. This has two advantages: it is fast
-(you even reuse the C<SV>'s, so they don't have to be created after the
-first C<fetchrow()>), and it guarantees that B<DBI> handles C<bind_cols()> for
-you.
-
-What you do is the following:
-
- AV* av;
- int numFields = DBIc_NUM_FIELDS(imp_sth); /* Correct, if NUM_FIELDS
- is constant for this statement. There are drivers where this is
- not the case! */
- int chopBlanks = DBIc_is(imp_sth, DBIcf_ChopBlanks);
- int i;
-
- if (!fetch_new_row_of_data(...)) {
- ... /* check for error or end-of-data */
- DBIc_ACTIVE_off(imp_sth); /* turn off Active flag automatically */
- return Nullav;
- }
- /* get the fbav (field buffer array value) for this row */
- /* it is very important to only call this after you know */
- /* that you have a row of data to return. */
- av = DBIc_DBISTATE(imp_sth)->get_fbav(imp_sth);
- for (i = 0; i < numFields; i++) {
- SV* sv = fetch_a_field(..., i);
- if (chopBlanks && SvOK(sv) && type_is_blank_padded(field_type[i])) {
- /* Remove white space from end (only) of sv */
- }
- sv_setsv(AvARRAY(av)[i], sv); /* Note: (re)use! */
- }
- return av;
-
-There's no need to use a C<fetch_a_field()> function returning an C<SV*>.
-It's more common to use your database API functions to fetch the
-data as character strings and use code like this:
-
- sv_setpvn(AvARRAY(av)[i], char_ptr, char_count);
-
-C<NULL> values must be returned as C<undef>. You can use code like this:
-
- SvOK_off(AvARRAY(av)[i]);
-
-The function returns the C<AV> prepared by B<DBI> for success or C<Nullav>
-otherwise.
-
- *FIX ME* Discuss what happens when there's no more data to fetch.
- Are errors permitted if another fetch occurs after the first fetch
- that reports no more data. (Permitted, not required.)
-
-If an error occurs which leaves the I<$sth> in a state where remaining
-rows can't be fetched then I<Active> should be turned off before the
-method returns.
-
-=head3 The dbd_st_finish3 method
-
-The C<$sth-E<gt>finish()> method can be called if the user wishes to
-indicate that no more rows will be fetched even if the database has more
-rows to offer, and the B<DBI> code can call the function when handles are
-being destroyed. See the B<DBI> specification for more background details.
-
-In both circumstances, the B<DBI> code ends up calling the
-C<dbd_st_finish3()> method (if you provide a mapping for
-C<dbd_st_finish3()> in F<dbdimp.h>), or C<dbd_st_finish()> otherwise.
-The difference is that C<dbd_st_finish3()> takes a third argument which
-is an C<int> with the value 1 if it is being called from a C<destroy()>
-method and 0 otherwise.
-
-Note that B<DBI> v1.32 and earlier test on C<dbd_db_finish3()> to call
-C<dbd_st_finish3()>; if you provide C<dbd_st_finish3()>, either define
-C<dbd_db_finish3()> too, or insist on B<DBI> v1.33 or later.
-
-All it I<needs> to do is turn off the I<Active> flag for the I<sth>.
-It will only be called by F<Driver.xst> code, if the driver has set I<ACTIVE>
-to on for the I<sth>.
-
-Outline example:
-
- int dbd_st_finish3(SV* sth, imp_sth_t* imp_sth, int from_destroy) {
- if (DBIc_ACTIVE(imp_sth))
- {
- /* close cursor or equivalent action */
- DBIc_ACTIVE_off(imp_sth);
- }
- return 1;
- }
-
-The from_destroy parameter is true if C<dbd_st_finish3()> is being called
-from C<DESTROY()> - and so the statement is about to be destroyed.
-For many drivers there is no point in doing anything more than turning off
-the I<Active> flag in this case.
-
-The function returns I<TRUE> for success, I<FALSE> otherwise, but there isn't
-a lot anyone can do to recover if there is an error.
-
-=head3 The dbd_st_destroy method
-
-This function is the private part of the statement handle destructor.
-
- void dbd_st_destroy(SV* sth, imp_sth_t* imp_sth) {
- ... /* any clean-up that's needed */
- DBIc_IMPSET_off(imp_sth); /* let DBI know we've done it */
- }
-
-The B<DBI> F<Driver.xst> code will call C<dbd_st_finish()> for you, if the
-I<sth> has the I<ACTIVE> flag set, before calling C<dbd_st_destroy()>.
-
-=head3 The dbd_st_STORE_attrib and dbd_st_FETCH_attrib methods
-
-These functions correspond to C<dbd_db_STORE()> and C<dbd_db_FETCH()> attrib
-above, except that they are for statement handles.
-See above.
-
- int dbd_st_STORE_attrib(SV* sth, imp_sth_t* imp_sth, SV* keysv,
- SV* valuesv);
- SV* dbd_st_FETCH_attrib(SV* sth, imp_sth_t* imp_sth, SV* keysv);
-
-=head3 The dbd_bind_ph method
-
-This function is internally used by the C<bind_param()> method, the
-C<bind_param_inout()> method and by the B<DBI> F<Driver.xst> code if
-C<execute()> is called with any bind parameters.
-
- int dbd_bind_ph (SV *sth, imp_sth_t *imp_sth, SV *param,
- SV *value, IV sql_type, SV *attribs,
- int is_inout, IV maxlen);
-
-The I<param> argument holds an C<IV> with the parameter number (1, 2, ...).
-The I<value> argument is the parameter value and I<sql_type> is its type.
-
-If your driver does not support C<bind_param_inout()> then you should
-ignore I<maxlen> and croak if I<is_inout> is I<TRUE>.
-
-If your driver I<does> support C<bind_param_inout()> then you should
-note that I<value> is the C<SV> I<after> dereferencing the reference
-passed to C<bind_param_inout()>.
-
-In drivers of simple databases the function will, for example, store
-the value in a parameter array and use it later in C<dbd_st_execute()>.
-See the B<DBD::mysql> driver for an example.
-
-=head3 Implementing bind_param_inout support
-
-To provide support for parameters bound by reference rather than by
-value, the driver must do a number of things. First, and most
-importantly, it must note the references and stash them in its own
-driver structure. Secondly, when a value is bound to a column, the
-driver must discard any previous reference bound to the column. On
-each execute, the driver must evaluate the references and internally
-bind the values resulting from the references. This is only applicable
-if the user writes:
-
- $sth->execute;
-
-If the user writes:
-
- $sth->execute(@values);
-
-then B<DBI> automatically calls the binding code for each element of
-I<@values>. These calls are indistinguishable from explicit user calls to
-C<bind_param()>.
-
-=head2 C/XS version of Makefile.PL
-
-The F<Makefile.PL> file for a C/XS driver is similar to the code needed
-for a pure Perl driver, but there are a number of extra bits of
-information needed by the build system.
-
-For example, the attributes list passed to C<WriteMakefile()> needs
-to specify the object files that need to be compiled and built into
-the shared object (DLL). This is often, but not necessarily, just
-F<dbdimp.o> (unless that should be F<dbdimp.obj> because you're building
-on MS Windows).
-
-Note that you can reliably determine the extension of the object files
-from the I<$Config{obj_ext}> values, and there are many other useful pieces
-of configuration information lurking in that hash.
-You get access to it with:
-
- use Config;
-
-=head2 Methods which do not need to be written
-
-The B<DBI> code implements the majority of the methods which are accessed
-using the notation C<DBI-E<gt>function()>, the only exceptions being
-C<DBI-E<gt>connect()> and C<DBI-E<gt>data_sources()> which require
-support from the driver.
-
-The B<DBI> code implements the following documented driver, database and
-statement functions which do not need to be written by the B<DBD> driver
-writer.
-
-=over 4
-
-=item $dbh->do()
-
-The default implementation of this function prepares, executes and
-destroys the statement. This can be replaced if there is a better
-way to implement this, such as C<EXECUTE IMMEDIATE> which can
-sometimes be used if there are no parameters.
-
-=item $h->errstr()
-
-=item $h->err()
-
-=item $h->state()
-
-=item $h->trace()
-
-The B<DBD> driver does not need to worry about these routines at all.
-
-=item $h->{ChopBlanks}
-
-This attribute needs to be honored during C<fetch()> operations, but does
-not need to be handled by the attribute handling code.
-
-=item $h->{RaiseError}
-
-The B<DBD> driver does not need to worry about this attribute at all.
-
-=item $h->{PrintError}
-
-The B<DBD> driver does not need to worry about this attribute at all.
-
-=item $sth->bind_col()
-
-Assuming the driver uses the C<DBIc_DBISTATE(imp_xxh)-E<gt>get_fbav()>
-function (C drivers, see below), or the C<$sth-E<gt>_set_fbav($data)>
-method (Perl drivers) the driver does not need to do anything about this
-routine.
-
-=item $sth->bind_columns()
-
-Regardless of whether the driver uses
-C<DBIc_DBISTATE(imp_xxh)-E<gt>get_fbav()>, the driver does not need
-to do anything about this routine as it simply iteratively calls
-C<$sth-E<gt>bind_col()>.
-
-=back
-
-The B<DBI> code implements a default implementation of the following
-functions which do not need to be written by the B<DBD> driver writer
-unless the default implementation is incorrect for the Driver.
-
-=over 4
-
-=item $dbh->quote()
-
-This should only be written if the database does not accept the ANSI
-SQL standard for quoting strings, with the string enclosed in single
-quotes and any embedded single quotes replaced by two consecutive
-single quotes.
-
-For the two argument form of quote, you need to implement the
-C<type_info()> method to provide the information that quote needs.
-
-=item $dbh->ping()
-
-This should be implemented as a simple efficient way to determine
-whether the connection to the database is still alive. Typically
-code like this:
-
- sub ping {
- my $dbh = shift;
- $sth = $dbh->prepare_cached(q{
- select * from A_TABLE_NAME where 1=0
- }) or return 0;
- $sth->execute or return 0;
- $sth->finish;
- return 1;
- }
-
-where I<A_TABLE_NAME> is the name of a table that always exists (such as a
-database system catalogue).
-
-=item $drh->default_user
-
-The default implementation of default_user will get the database
-username and password fields from C<$ENV{DBI_USER}> and
-C<$ENV{DBI_PASS}>. You can override this method. It is called as
-follows:
-
- ($user, $pass) = $drh->default_user($user, $pass, $attr)
-
-=back
-
-=head1 METADATA METHODS
-
-The exposition above ignores the B<DBI> MetaData methods.
-The metadata methods are all associated with a database handle.
-
-=head2 Using DBI::DBD::Metadata
-
-The B<DBI::DBD::Metadata> module is a good semi-automatic way for the
-developer of a B<DBD> module to write the C<get_info()> and C<type_info()>
-functions quickly and accurately.
-
-=head3 Generating the get_info method
-
-Prior to B<DBI> v1.33, this existed as the method C<write_getinfo_pm()>
-in the B<DBI::DBD> module. From B<DBI> v1.33, it exists as the method
-C<write_getinfo_pm()> in the B<DBI::DBD::Metadata> module. This
-discussion assumes you have B<DBI> v1.33 or later.
-
-You examine the documentation for C<write_getinfo_pm()> using:
-
- perldoc DBI::DBD::Metadata
-
-To use it, you need a Perl B<DBI> driver for your database which implements
-the C<get_info()> method. In practice, this means you need to install
-B<DBD::ODBC>, an ODBC driver manager, and an ODBC driver for your
-database.
-
-With the pre-requisites in place, you might type:
-
- perl -MDBI::DBD::Metadata -we \
- "write_getinfo_pm (qw{ dbi:ODBC:foo_db username password Driver })"
-
-The procedure writes to standard output the code that should be added to
-your F<Driver.pm> file and the code that should be written to
-F<lib/DBD/Driver/GetInfo.pm>.
-
-You should review the output to ensure that it is sensible.
-
-=head3 Generating the type_info method
-
-Given the idea of the C<write_getinfo_pm()> method, it was not hard
-to devise a parallel method, C<write_typeinfo_pm()>, which does the
-analogous job for the B<DBI> C<type_info_all()> metadata method. The
-C<write_typeinfo_pm()> method was added to B<DBI> v1.33.
-
-You examine the documentation for C<write_typeinfo_pm()> using:
-
- perldoc DBI::DBD::Metadata
-
-The setup is exactly analogous to the mechanism described in
-L</Generating the get_info method>.
-
-With the pre-requisites in place, you might type:
-
- perl -MDBI::DBD::Metadata -we \
- "write_typeinfo_pm (qw{ dbi:ODBC:foo_db username password Driver })"
-
-The procedure writes to standard output the code that should be added to
-your F<Driver.pm> file and the code that should be written to
-F<lib/DBD/Driver/TypeInfo.pm>.
-
-You should review the output to ensure that it is sensible.
-
-=head2 Writing DBD::Driver::db::get_info
-
-If you use the B<DBI::DBD::Metadata> module, then the code you need is
-generated for you.
-
-If you decide not to use the B<DBI::DBD::Metadata> module, you
-should probably borrow the code from a driver that has done so (eg
-B<DBD::Informix> from version 1.05 onwards) and crib the code from
-there, or look at the code that generates that module and follow
-that. The method in F<Driver.pm> will be very simple; the method in
-F<lib/DBD/Driver/GetInfo.pm> is not very much more complex unless your
-DBMS itself is much more complex.
-
-Note that some of the B<DBI> utility methods rely on information from the
-C<get_info()> method to perform their operations correctly. See, for
-example, the C<quote_identifier()> and quote methods, discussed below.
-
-=head2 Writing DBD::Driver::db::type_info_all
-
-If you use the C<DBI::DBD::Metadata> module, then the code you need is
-generated for you.
-
-If you decide not to use the C<DBI::DBD::Metadata> module, you
-should probably borrow the code from a driver that has done so (eg
-C<DBD::Informix> from version 1.05 onwards) and crib the code from
-there, or look at the code that generates that module and follow
-that. The method in F<Driver.pm> will be very simple; the method in
-F<lib/DBD/Driver/TypeInfo.pm> is not very much more complex unless your
-DBMS itself is much more complex.
-
-=head2 Writing DBD::Driver::db::type_info
-
-The guidelines on writing this method are still not really clear.
-No sample implementation is available.
-
-=head2 Writing DBD::Driver::db::table_info
-
- *FIX ME* The guidelines on writing this method have not been written yet.
- No sample implementation is available.
-
-=head2 Writing DBD::Driver::db::column_info
-
- *FIX ME* The guidelines on writing this method have not been written yet.
- No sample implementation is available.
-
-=head2 Writing DBD::Driver::db::primary_key_info
-
- *FIX ME* The guidelines on writing this method have not been written yet.
- No sample implementation is available.
-
-=head2 Writing DBD::Driver::db::primary_key
-
- *FIX ME* The guidelines on writing this method have not been written yet.
- No sample implementation is available.
-
-=head2 Writing DBD::Driver::db::foreign_key_info
-
- *FIX ME* The guidelines on writing this method have not been written yet.
- No sample implementation is available.
-
-=head2 Writing DBD::Driver::db::tables
-
-This method generates an array of names in a format suitable for being
-embedded in SQL statements in places where a table name is expected.
-
-If your database hews close enough to the SQL standard or if you have
-implemented an appropriate C<table_info()> function and and the appropriate
-C<quote_identifier()> function, then the B<DBI> default version of this method
-will work for your driver too.
-
-Otherwise, you have to write a function yourself, such as:
-
- sub tables
- {
- my($dbh, $cat, $sch, $tab, $typ) = @_;
- my(@res);
- my($sth) = $dbh->table_info($cat, $sch, $tab, $typ);
- my(@arr);
- while (@arr = $sth->fetchrow_array)
- {
- push @res, $dbh->quote_identifier($arr[0], $arr[1], $arr[2]);
- }
- return @res;
- }
-
-See also the default implementation in F<DBI.pm>.
-
-=head2 Writing DBD::Driver::db::quote
-
-This method takes a value and converts it into a string suitable for
-embedding in an SQL statement as a string literal.
-
-If your DBMS accepts the SQL standard notation for strings (single
-quotes around the string as a whole with any embedded single quotes
-doubled up), then you do not need to write this method as B<DBI> provides a
-default method that does it for you.
-
-If your DBMS uses an alternative notation or escape mechanism, then you
-need to provide an equivalent function. For example, suppose your DBMS
-used C notation with double quotes around the string and backslashes
-escaping both double quotes and backslashes themselves. Then you might
-write the function as:
-
- sub quote
- {
- my($dbh, $str) = @_;
- $str =~ s/["\\]/\\$&/gmo;
- return qq{"$str"};
- }
-
-Handling newlines and other control characters is left as an exercise
-for the reader.
-
-This sample method ignores the I<$data_type> indicator which is the
-optional second argument to the method.
-
-=head2 Writing DBD::Driver::db::quote_identifier
-
-This method is called to ensure that the name of the given table (or
-other database object) can be embedded into an SQL statement without
-danger of misinterpretation. The result string should be usable in the
-text of an SQL statement as the identifier for a table.
-
-If your DBMS accepts the SQL standard notation for quoted identifiers
-(which uses double quotes around the identifier as a whole, with any
-embedded double quotes doubled up) and accepts I<"schema"."identifier">
-(and I<"catalog"."schema"."identifier"> when a catalog is specified), then
-you do not need to write this method as B<DBI> provides a default method
-that does it for you.
-
-In fact, even if your DBMS does not handle exactly that notation but
-you have implemented the C<get_info()> method and it gives the correct
-responses, then it will work for you. If your database is fussier, then
-you need to implement your own version of the function.
-
-For example, B<DBD::Informix> has to deal with an environment variable
-I<DELIMIDENT>. If it is not set, then the DBMS treats names enclosed in
-double quotes as strings rather than names, which is usually a syntax
-error. Additionally, the catalog portion of the name is separated from
-the schema and table by a different delimiter (colon instead of dot),
-and the catalog portion is never enclosed in quotes. (Fortunately,
-valid strings for the catalog will never contain weird characters that
-might need to be escaped, unless you count dots, dashes, slashes and
-at-signs as weird.) Finally, an Informix database can contain objects
-that cannot be accessed because they were created by a user with the
-I<DELIMIDENT> environment variable set, but the current user does not
-have it set. By design choice, the C<quote_identifier()> method encloses
-those identifiers in double quotes anyway, which generally triggers a
-syntax error, and the metadata methods which generate lists of tables
-etc omit those identifiers from the result sets.
-
- sub quote_identifier
- {
- my($dbh, $cat, $sch, $obj) = @_;
- my($rv) = "";
- my($qq) = (defined $ENV{DELIMIDENT}) ? '"' : '';
- $rv .= qq{$cat:} if (defined $cat);
- if (defined $sch)
- {
- if ($sch !~ m/^\w+$/o)
- {
- $qq = '"';
- $sch =~ s/$qq/$qq$qq/gm;
- }
- $rv .= qq{$qq$sch$qq.};
- }
- if (defined $obj)
- {
- if ($obj !~ m/^\w+$/o)
- {
- $qq = '"';
- $obj =~ s/$qq/$qq$qq/gm;
- }
- $rv .= qq{$qq$obj$qq};
- }
- return $rv;
- }
-
-Handling newlines and other control characters is left as an exercise
-for the reader.
-
-Note that there is an optional fourth parameter to this function which
-is a reference to a hash of attributes; this sample implementation
-ignores that.
-
-This sample implementation also ignores the single-argument variant of
-the method.
-
-=head1 TRACING
-
-Tracing in DBI is controlled with a combination of a trace level and a
-set of flags which together are known as the trace settings. The trace
-settings are stored in a single integer and divided into levels and
-flags by a set of masks (C<DBIc_TRACE_LEVEL_MASK> and
-C<DBIc_TRACE_FLAGS_MASK>).
-
-Each handle has it's own trace settings and so does the DBI. When you
-call a method the DBI merges the handles settings into its own for the
-duration of the call: the trace flags of the handle are OR'd into the
-trace flags of the DBI, and if the handle has a higher trace level
-then the DBI trace level is raised to match it. The previous DBI trace
-settings are restored when the called method returns.
-
-=head2 Trace Level
-
-The trace level is the first 4 bits of the trace settings (masked by
-C<DBIc_TRACE_FLAGS_MASK>) and represents trace levels of 1 to 15. Do
-not output anything at trace levels less than 3 as they are reserved
-for DBI.
-
-For advice on what to output at each level see "Trace Levels" in
-L<DBI>.
-
-To test for a trace level you can use the C<DBIc_TRACE_LEVEL> macro
-like this:
-
- if (DBIc_TRACE_LEVEL(imp_xxh) >= 2) {
- PerlIO_printf(DBIc_LOGPIO(imp_xxh), "foobar");
- }
-
-Also B<note> the use of PerlIO_printf which you should always use for
-tracing and never the C C<stdio.h> I/O functions.
-
-=head2 Trace Flags
-
-Trace flags are used to enable tracing of specific activities within
-the DBI and drivers. The DBI defines some trace flags and drivers can
-define others. DBI trace flag names begin with a capital letter and
-driver specific names begin with a lowercase letter. For a list of DBI
-defined trace flags see "Trace Flags" in L<DBI>.
-
-If you want to use private trace flags you'll probably want to be able
-to set them by name. Drivers are expected to override the
-parse_trace_flag (note the singular) and check if $trace_flag_name is
-a driver specific trace flags and, if not, then call the DBIs default
-parse_trace_flag(). To do that you'll need to define a
-parse_trace_flag() method like this:
-
- sub parse_trace_flag {
- my ($h, $name) = @_;
- return 0x01000000 if $name eq 'foo';
- return 0x02000000 if $name eq 'bar';
- return 0x04000000 if $name eq 'baz';
- return 0x08000000 if $name eq 'boo';
- return 0x10000000 if $name eq 'bop';
- return $h->SUPER::parse_trace_flag($name);
- }
-
-All private flag names must be lowercase, and all private flags must
-be in the top 8 of the 32 bits of C<DBIc_TRACE_FLAGS(imp)> i.e.,
-0xFF000000.
-
-If you've defined a parse_trace_flag() method in ::db you'll also want
-it in ::st, so just alias it in:
-
- *parse_trace_flag = \&DBD::foo:db::parse_trace_flag;
-
-You may want to act on the current 'SQL' trace flag that DBI defines
-to output SQL prepared/executed as DBI currently does not do SQL
-tracing.
-
-=head2 Trace Macros
-
-Access to the trace level and trace flags is via a set of macros.
-
- DBIc_TRACE_SETTINGS(imp) returns the trace settings
- DBIc_TRACE_LEVEL(imp) returns the trace level
- DBIc_TRACE_FLAGS(imp) returns the trace flags
- DBIc_TRACE(imp, flags, flaglevel, level)
-
- e.g.,
-
- DBIc_TRACE(imp, 0, 0, 4)
- if level >= 4
-
- DBIc_TRACE(imp, DBDtf_FOO, 2, 4)
- if tracing DBDtf_FOO & level>=2 or level>=4
-
- DBIc_TRACE(imp, DBDtf_FOO, 2, 0)
- as above but never trace just due to level
-
-=head1 WRITING AN EMULATION LAYER FOR AN OLD PERL INTERFACE
-
-Study F<Oraperl.pm> (supplied with B<DBD::Oracle>) and F<Ingperl.pm> (supplied
-with B<DBD::Ingres>) and the corresponding I<dbdimp.c> files for ideas.
-
-Note that the emulation code sets C<$dbh-E<gt>{CompatMode} = 1;> for each
-connection so that the internals of the driver can implement behaviour
-compatible with the old interface when dealing with those handles.
-
-=head2 Setting emulation perl variables
-
-For example, ingperl has a I<$sql_rowcount> variable. Rather than try
-to manually update this in F<Ingperl.pm> it can be done faster in C code.
-In C<dbd_init()>:
-
- sql_rowcount = perl_get_sv("Ingperl::sql_rowcount", GV_ADDMULTI);
-
-In the relevant places do:
-
- if (DBIc_COMPAT(imp_sth)) /* only do this for compatibility mode handles */
- sv_setiv(sql_rowcount, the_row_count);
-
-=head1 OTHER MISCELLANEOUS INFORMATION
-
-=head2 The imp_xyz_t types
-
-Any handle has a corresponding C structure filled with private data.
-Some of this data is reserved for use by B<DBI> (except for using the
-DBIc macros below), some is for you. See the description of the
-F<dbdimp.h> file above for examples. Most functions in F<dbdimp.c>
-are passed both the handle C<xyz> and a pointer to C<imp_xyz>. In
-rare cases, however, you may use the following macros:
-
-=over 4
-
-=item D_imp_dbh(dbh)
-
-Given a function argument I<dbh>, declare a variable I<imp_dbh> and
-initialize it with a pointer to the handles private data. Note: This
-must be a part of the function header, because it declares a variable.
-
-=item D_imp_sth(sth)
-
-Likewise for statement handles.
-
-=item D_imp_xxx(h)
-
-Given any handle, declare a variable I<imp_xxx> and initialize it
-with a pointer to the handles private data. It is safe, for example,
-to cast I<imp_xxx> to C<imp_dbh_t*>, if C<DBIc_TYPE(imp_xxx) == DBIt_DB>.
-(You can also call C<sv_derived_from(h, "DBI::db")>, but that's much
-slower.)
-
-=item D_imp_dbh_from_sth
-
-Given a I<imp_sth>, declare a variable I<imp_dbh> and initialize it with a
-pointer to the parent database handle's implementors structure.
-
-=back
-
-=head2 Using DBIc_IMPSET_on
-
-The driver code which initializes a handle should use C<DBIc_IMPSET_on()>
-as soon as its state is such that the cleanup code must be called.
-When this happens is determined by your driver code.
-
-B<Failure to call this can lead to corruption of data structures.>
-
-For example, B<DBD::Informix> maintains a linked list of database
-handles in the driver, and within each handle, a linked list of
-statements. Once a statement is added to the linked list, it is crucial
-that it is cleaned up (removed from the list). When I<DBIc_IMPSET_on()>
-was being called too late, it was able to cause all sorts of problems.
-
-=head2 Using DBIc_is(), DBIc_has(), DBIc_on() and DBIc_off()
-
-Once upon a long time ago, the only way of handling the internal B<DBI>
-boolean flags/attributes was through macros such as:
-
- DBIc_WARN DBIc_WARN_on DBIc_WARN_off
- DBIc_COMPAT DBIc_COMPAT_on DBIc_COMPAT_off
-
-Each of these took an I<imp_xxh> pointer as an argument.
-
-Since then, new attributes have been added such as I<ChopBlanks>,
-I<RaiseError> and I<PrintError>, and these do not have the full set of
-macros. The approved method for handling these is now the four macros:
-
- DBIc_is(imp, flag)
- DBIc_has(imp, flag) an alias for DBIc_is
- DBIc_on(imp, flag)
- DBIc_off(imp, flag)
- DBIc_set(imp, flag, on) set if on is true, else clear
-
-Consequently, the C<DBIc_XXXXX> family of macros is now mostly deprecated
-and new drivers should avoid using them, even though the older drivers
-will probably continue to do so for quite a while yet. However...
-
-There is an I<important exception> to that. The I<ACTIVE> and I<IMPSET>
-flags should be set via the C<DBIc_ACTIVE_on()> and C<DBIc_IMPSET_on()> macros,
-and unset via the C<DBIc_ACTIVE_off()> and C<DBIc_IMPSET_off()> macros.
-
-=head2 Using the get_fbav() method
-
-B<THIS IS CRITICAL for C/XS drivers>.
-
-The C<$sth-E<gt>bind_col()> and C<$sth-E<gt>bind_columns()> documented
-in the B<DBI> specification do not have to be implemented by the driver
-writer because B<DBI> takes care of the details for you.
-
-However, the key to ensuring that bound columns work is to call the
-function C<DBIc_DBISTATE(imp_xxh)-E<gt>get_fbav()> in the code which
-fetches a row of data.
-
-This returns an C<AV>, and each element of the C<AV> contains the C<SV> which
-should be set to contain the returned data.
-
-The pure Perl equivalent is the C<$sth-E<gt>_set_fbav($data)> method, as
-described in the part on pure Perl drivers.
-
-=head2 Casting strings to Perl types based on a SQL type
-
-DBI from 1.611 (and DBIXS_REVISION 13606) defines the
-sql_type_cast_svpv method which may be used to cast a string
-representation of a value to a more specific Perl type based on a SQL
-type. You should consider using this method when processing bound
-column data as it provides some support for the TYPE bind_col
-attribute which is rarely used in drivers.
-
- int sql_type_cast_svpv(pTHX_ SV *sv, int sql_type, U32 flags, void *v)
-
-C<sv> is what you would like cast, C<sql_type> is one of the DBI defined
-SQL types (e.g., C<SQL_INTEGER>) and C<flags> is a bitmask as follows:
-
-=over
-
-=item DBIstcf_STRICT
-
-If set this indicates you want an error state returned if the cast
-cannot be performed.
-
-=item DBIstcf_DISCARD_STRING
-
-If set and the pv portion of the C<sv> is cast then this will cause
-sv's pv to be freed up.
-
-=back
-
-sql_type_cast_svpv returns the following states:
-
- -2 sql_type is not handled - sv not changed
- -1 sv is undef, sv not changed
- 0 sv could not be cast cleanly and DBIstcf_STRICT was specified
- 1 sv could not be case cleanly and DBIstcf_STRICT was not specified
- 2 sv was cast ok
-
-The current implementation of sql_type_cast_svpv supports
-C<SQL_INTEGER>, C<SQL_DOUBLE> and C<SQL_NUMERIC>. C<SQL_INTEGER> uses
-sv_2iv and hence may set IV, UV or NV depending on the
-number. C<SQL_DOUBLE> uses sv_2nv so may set NV and C<SQL_NUMERIC>
-will set IV or UV or NV.
-
-DBIstcf_STRICT should be implemented as the StrictlyTyped attribute
-and DBIstcf_DISCARD_STRING implemented as the DiscardString attribute
-to the bind_col method and both default to off.
-
-See DBD::Oracle for an example of how this is used.
-
-=head1 SUBCLASSING DBI DRIVERS
-
-This is definitely an open subject. It can be done, as demonstrated by
-the B<DBD::File> driver, but it is not as simple as one might think.
-
-(Note that this topic is different from subclassing the B<DBI>. For an
-example of that, see the F<t/subclass.t> file supplied with the B<DBI>.)
-
-The main problem is that the I<dbh>'s and I<sth>'s that your C<connect()> and
-C<prepare()> methods return are not instances of your B<DBD::Driver::db>
-or B<DBD::Driver::st> packages, they are not even derived from it.
-Instead they are instances of the B<DBI::db> or B<DBI::st> classes or
-a derived subclass. Thus, if you write a method C<mymethod()> and do a
-
- $dbh->mymethod()
-
-then the autoloader will search for that method in the package B<DBI::db>.
-Of course you can instead to a
-
- $dbh->func('mymethod')
-
-and that will indeed work, even if C<mymethod()> is inherited, but not
-without additional work. Setting I<@ISA> is not sufficient.
-
-=head2 Overwriting methods
-
-The first problem is, that the C<connect()> method has no idea of
-subclasses. For example, you cannot implement base class and subclass
-in the same file: The C<install_driver()> method wants to do a
-
- require DBD::Driver;
-
-In particular, your subclass B<has> to be a separate driver, from
-the view of B<DBI>, and you cannot share driver handles.
-
-Of course that's not much of a problem. You should even be able
-to inherit the base classes C<connect()> method. But you cannot
-simply overwrite the method, unless you do something like this,
-quoted from B<DBD::CSV>:
-
- sub connect ($$;$$$) {
- my ($drh, $dbname, $user, $auth, $attr) = @_;
-
- my $this = $drh->DBD::File::dr::connect($dbname, $user, $auth, $attr);
- if (!exists($this->{csv_tables})) {
- $this->{csv_tables} = {};
- }
-
- $this;
- }
-
-Note that we cannot do a
-
- $drh->SUPER::connect($dbname, $user, $auth, $attr);
-
-as we would usually do in a an OO environment, because I<$drh> is an instance
-of B<DBI::dr>. And note, that the C<connect()> method of B<DBD::File> is
-able to handle subclass attributes. See the description of Pure Perl
-drivers above.
-
-It is essential that you always call superclass method in the above
-manner. However, that should do.
-
-=head2 Attribute handling
-
-Fortunately the B<DBI> specifications allow a simple, but still
-performant way of handling attributes. The idea is based on the
-convention that any driver uses a prefix I<driver_> for its private
-methods. Thus it's always clear whether to pass attributes to the super
-class or not. For example, consider this C<STORE()> method from the
-B<DBD::CSV> class:
-
- sub STORE {
- my ($dbh, $attr, $val) = @_;
- if ($attr !~ /^driver_/) {
- return $dbh->DBD::File::db::STORE($attr, $val);
- }
- if ($attr eq 'driver_foo') {
- ...
- }
-
-=cut
-
-use Exporter ();
-use Config qw(%Config);
-use Carp;
-use Cwd;
-use File::Spec;
-use strict;
-use vars qw(
- @ISA @EXPORT
- $is_dbi
-);
-
-BEGIN {
- if ($^O eq 'VMS') {
- require vmsish;
- import vmsish;
- require VMS::Filespec;
- import VMS::Filespec;
- }
- else {
- *vmsify = sub { return $_[0] };
- *unixify = sub { return $_[0] };
- }
-}
-
-@ISA = qw(Exporter);
-
-@EXPORT = qw(
- dbd_dbi_dir
- dbd_dbi_arch_dir
- dbd_edit_mm_attribs
- dbd_postamble
-);
-
-BEGIN {
- $is_dbi = (-r 'DBI.pm' && -r 'DBI.xs' && -r 'DBIXS.h');
- require DBI unless $is_dbi;
-}
-
-my $done_inst_checks;
-
-sub _inst_checks {
- return if $done_inst_checks++;
- my $cwd = cwd();
- if ($cwd =~ /\Q$Config{path_sep}/) {
- warn "*** Warning: Path separator characters (`$Config{path_sep}') ",
- "in the current directory path ($cwd) may cause problems\a\n\n";
- sleep 2;
- }
- if ($cwd =~ /\s/) {
- warn "*** Warning: whitespace characters ",
- "in the current directory path ($cwd) may cause problems\a\n\n";
- sleep 2;
- }
- if ( $^O eq 'MSWin32'
- && $Config{cc} eq 'cl'
- && !(exists $ENV{'LIB'} && exists $ENV{'INCLUDE'}))
- {
- die <<EOT;
-*** You're using Microsoft Visual C++ compiler or similar but
- the LIB and INCLUDE environment variables are not both set.
-
- You need to run the VCVARS32.BAT batch file that was supplied
- with the compiler before you can use it.
-
- A copy of vcvars32.bat can typically be found in the following
- directories under your Visual Studio install directory:
- Visual C++ 6.0: vc98\\bin
- Visual Studio .NET: vc7\\bin
-
- Find it, run it, then retry this.
-
- If you think this error is not correct then just set the LIB and
- INCLUDE environment variables to some value to disable the check.
-EOT
- }
-}
-
-sub dbd_edit_mm_attribs {
- # this both edits the attribs in-place and returns the flattened attribs
- my $mm_attr = shift;
- my $dbd_attr = shift || {};
- croak "dbd_edit_mm_attribs( \%makemaker [, \%other ]): too many parameters"
- if @_;
- _inst_checks();
-
- # what can be done
- my %test_variants = (
- p => { name => "DBI::PurePerl",
- match => qr/^\d/,
- add => [ '$ENV{DBI_PUREPERL} = 2',
- 'END { delete $ENV{DBI_PUREPERL}; }' ],
- },
- g => { name => "DBD::Gofer",
- match => qr/^\d/,
- add => [ q{$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic'},
- q|END { delete $ENV{DBI_AUTOPROXY}; }| ],
- },
- n => { name => "DBI::SQL::Nano",
- match => qr/^(?:48dbi_dbd_sqlengine|49dbd_file|5\ddbm_\w+|85gofer)\.t$/,
- add => [ q{$ENV{DBI_SQL_NANO} = 1},
- q|END { delete $ENV{DBI_SQL_NANO}; }| ],
- },
- # mx => { name => "DBD::Multiplex",
- # add => [ q{local $ENV{DBI_AUTOPROXY} = 'dbi:Multiplex:';} ],
- # }
- # px => { name => "DBD::Proxy",
- # need mechanism for starting/stopping the proxy server
- # add => [ q{local $ENV{DBI_AUTOPROXY} = 'dbi:Proxy:XXX';} ],
- # }
- );
-
- # decide what needs doing
- $dbd_attr->{create_pp_tests} or delete $test_variants{p};
- $dbd_attr->{create_nano_tests} or delete $test_variants{n};
- $dbd_attr->{create_gap_tests} or delete $test_variants{g};
-
- # expand for all combinations
- my @all_keys = my @tv_keys = sort keys %test_variants;
- while( @tv_keys ) {
- my $cur_key = shift @tv_keys;
- last if( 1 < length $cur_key );
- my @new_keys;
- foreach my $remain (@tv_keys) {
- push @new_keys, $cur_key . $remain unless $remain =~ /$cur_key/;
- }
- push @tv_keys, @new_keys;
- push @all_keys, @new_keys;
- }
-
- my %uniq_keys;
- foreach my $key (@all_keys) {
- @tv_keys = sort split //, $key;
- my $ordered = join( '', @tv_keys );
- $uniq_keys{$ordered} = 1;
- }
- @all_keys = sort { length $a <=> length $b or $a cmp $b } keys %uniq_keys;
-
- # do whatever needs doing
- if( keys %test_variants ) {
- # XXX need to convert this to work within the generated Makefile
- # so 'make' creates them and 'make clean' deletes them
- opendir DIR, 't' or die "Can't read 't' directory: $!";
- my @tests = grep { /\.t$/ } readdir DIR;
- closedir DIR;
-
- foreach my $test_combo (@all_keys) {
- @tv_keys = split //, $test_combo;
- my @test_names = map { $test_variants{$_}->{name} } @tv_keys;
- printf "Creating test wrappers for " . join( " + ", @test_names ) . ":\n";
- my @test_matches = map { $test_variants{$_}->{match} } @tv_keys;
- my @test_adds;
- foreach my $test_add ( map { $test_variants{$_}->{add} } @tv_keys) {
- push @test_adds, @$test_add;
- }
- my $v_type = $test_combo;
- $v_type = 'x' . $v_type if length( $v_type ) > 1;
-
- TEST:
- foreach my $test (sort @tests) {
- foreach my $match (@test_matches) {
- next TEST if $test !~ $match;
- }
- my $usethr = ($test =~ /(\d+|\b)thr/ && $] >= 5.008 && $Config{useithreads});
- my $v_test = "t/zv${v_type}_$test";
- my $v_perl = ($test =~ /taint/) ? "perl -wT" : "perl -w";
- printf "%s %s\n", $v_test, ($usethr) ? "(use threads)" : "";
- open PPT, ">$v_test" or warn "Can't create $v_test: $!";
- print PPT "#!$v_perl\n";
- print PPT "use threads;\n" if $usethr;
- print PPT "$_;\n" foreach @test_adds;
- print PPT "require './t/$test'; # or warn \$!;\n";
- close PPT or warn "Error writing $v_test: $!";
- }
- }
- }
- return %$mm_attr;
-}
-
-sub dbd_dbi_dir {
- _inst_checks();
- return '.' if $is_dbi;
- my $dbidir = $INC{'DBI.pm'} || die "DBI.pm not in %INC!";
- $dbidir =~ s:/DBI\.pm$::;
- return $dbidir;
-}
-
-sub dbd_dbi_arch_dir {
- _inst_checks();
- return '$(INST_ARCHAUTODIR)' if $is_dbi;
- my $dbidir = dbd_dbi_dir();
- my %seen;
- my @try = grep { not $seen{$_}++ } map { vmsify( unixify($_) . "/auto/DBI/" ) } @INC;
- my @xst = grep { -f vmsify( unixify($_) . "/Driver.xst" ) } @try;
- Carp::croak("Unable to locate Driver.xst in @try") unless @xst;
- Carp::carp( "Multiple copies of Driver.xst found in: @xst") if @xst > 1;
- print "Using DBI $DBI::VERSION (for perl $] on $Config{archname}) installed in $xst[0]\n";
- return File::Spec->canonpath($xst[0]);
-}
-
-sub dbd_postamble {
- my $self = shift;
- _inst_checks();
- my $dbi_instarch_dir = ($is_dbi) ? "." : dbd_dbi_arch_dir();
- my $dbi_driver_xst= File::Spec->catfile($dbi_instarch_dir, 'Driver.xst');
- my $xstf_h = File::Spec->catfile($dbi_instarch_dir, 'Driver_xst.h');
-
- # we must be careful of quotes, especially for Win32 here.
- return '
-# --- This section was generated by DBI::DBD::dbd_postamble()
-DBI_INSTARCH_DIR='.$dbi_instarch_dir.'
-DBI_DRIVER_XST='.$dbi_driver_xst.'
-
-# The main dependency (technically correct but probably not used)
-$(BASEEXT).c: $(BASEEXT).xsi
-
-# This dependency is needed since MakeMaker uses the .xs.o rule
-$(BASEEXT)$(OBJ_EXT): $(BASEEXT).xsi
-
-$(BASEEXT).xsi: $(DBI_DRIVER_XST) '.$xstf_h.'
- $(PERL) -p -e "s/~DRIVER~/$(BASEEXT)/g" $(DBI_DRIVER_XST) > $(BASEEXT).xsi
-
-# ---
-';
-}
-
-package DBDI; # just to reserve it via PAUSE for the future
-
-1;
-
-__END__
-
-=head1 AUTHORS
-
-Jonathan Leffler <jleffler@us.ibm.com> (previously <jleffler@informix.com>),
-Jochen Wiedmann <joe@ispsoft.de>,
-Steffen Goeldner <sgoeldner@cpan.org>,
-and Tim Bunce <dbi-users@perl.org>.
-
-=cut
+++ /dev/null
-package DBI::DBD::Metadata;
-
-# $Id: Metadata.pm 14213 2010-06-30 19:29:18Z Martin $
-#
-# Copyright (c) 1997-2003 Jonathan Leffler, Jochen Wiedmann,
-# Steffen Goeldner and Tim Bunce
-#
-# You may distribute under the terms of either the GNU General Public
-# License or the Artistic License, as specified in the Perl README file.
-
-use strict;
-
-use Exporter ();
-use Carp;
-
-use DBI;
-use DBI::Const::GetInfoType qw(%GetInfoType);
-
-our @ISA = qw(Exporter);
-our @EXPORT = qw(write_getinfo_pm write_typeinfo_pm);
-
-our $VERSION = "2.014214";
-
-
-=head1 NAME
-
-DBI::DBD::Metadata - Generate the code and data for some DBI metadata methods
-
-=head1 SYNOPSIS
-
-The idea is to extract metadata information from a good quality
-ODBC driver and use it to generate code and data to use in your own
-DBI driver for the same database.
-
-To generate code to support the get_info method:
-
- perl -MDBI::DBD::Metadata -e "write_getinfo_pm('dbi:ODBC:dsn-name','user','pass','Driver')"
-
- perl -MDBI::DBD::Metadata -e write_getinfo_pm dbi:ODBC:foo_db username password Driver
-
-To generate code to support the type_info method:
-
- perl -MDBI::DBD::Metadata -e "write_typeinfo_pm('dbi:ODBC:dsn-name','user','pass','Driver')"
-
- perl -MDBI::DBD::Metadata -e write_typeinfo_pm dbi:ODBC:dsn-name user pass Driver
-
-Where C<dbi:ODBC:dsn-name> is the connection to use to extract the
-data, and C<Driver> is the name of the driver you want the code
-generated for (the driver name gets embedded into the output in
-numerous places).
-
-=head1 Generating a GetInfo package for a driver
-
-The C<write_getinfo_pm> in the DBI::DBD::Metadata module generates a
-DBD::Driver::GetInfo package on standard output.
-
-This method generates a DBD::Driver::GetInfo package from the data
-source you specified in the parameter list or in the environment
-variable DBI_DSN.
-DBD::Driver::GetInfo should help a DBD author implement the DBI
-get_info() method.
-Because you are just creating this package, it is very unlikely that
-DBD::Driver already provides a good implementation for get_info().
-Thus you will probably connect via DBD::ODBC.
-
-Once you are sure that it is producing reasonably sane data, you should
-typically redirect the standard output to lib/DBD/Driver/GetInfo.pm, and
-then hand edit the result.
-Do not forget to update your Makefile.PL and MANIFEST to include this as
-an extra PM file that should be installed.
-
-If you connect via DBD::ODBC, you should use version 0.38 or greater;
-
-Please take a critical look at the data returned!
-ODBC drivers vary dramatically in their quality.
-
-The generator assumes that most values are static and places these
-values directly in the %info hash.
-A few examples show the use of CODE references and the implementation
-via subroutines.
-It is very likely that you will have to write additional subroutines for
-values depending on the session state or server version, e.g.
-SQL_DBMS_VER.
-
-A possible implementation of DBD::Driver::db::get_info() may look like:
-
- sub get_info {
- my($dbh, $info_type) = @_;
- require DBD::Driver::GetInfo;
- my $v = $DBD::Driver::GetInfo::info{int($info_type)};
- $v = $v->($dbh) if ref $v eq 'CODE';
- return $v;
- }
-
-Please replace Driver (or "<foo>") with the name of your driver.
-Note that this stub function is generated for you by write_getinfo_pm
-function, but you must manually transfer the code to Driver.pm.
-
-=cut
-
-sub write_getinfo_pm
-{
- my ($dsn, $user, $pass, $driver) = @_ ? @_ : @ARGV;
- my $dbh = DBI->connect($dsn, $user, $pass, {RaiseError=>1});
- $driver = "<foo>" unless defined $driver;
-
- print <<PERL;
-
-# Transfer this to ${driver}.pm
-
-# The get_info function was automatically generated by
-# DBI::DBD::Metadata::write_getinfo_pm v$DBI::DBD::Metadata::VERSION.
-
-package DBD::${driver}::db; # This line can be removed once transferred.
-
- sub get_info {
- my(\$dbh, \$info_type) = \@_;
- require DBD::${driver}::GetInfo;
- my \$v = \$DBD::${driver}::GetInfo::info{int(\$info_type)};
- \$v = \$v->(\$dbh) if ref \$v eq 'CODE';
- return \$v;
- }
-
-# Transfer this to lib/DBD/${driver}/GetInfo.pm
-
-# The \%info hash was automatically generated by
-# DBI::DBD::Metadata::write_getinfo_pm v$DBI::DBD::Metadata::VERSION.
-
-package DBD::${driver}::GetInfo;
-
-use strict;
-use DBD::${driver};
-
-# Beware: not officially documented interfaces...
-# use DBI::Const::GetInfoType qw(\%GetInfoType);
-# use DBI::Const::GetInfoReturn qw(\%GetInfoReturnTypes \%GetInfoReturnValues);
-
-my \$sql_driver = '${driver}';
-my \$sql_ver_fmt = '%02d.%02d.%04d'; # ODBC version string: ##.##.#####
-my \$sql_driver_ver = sprintf \$sql_ver_fmt, split (/\\./, \$DBD::${driver}::VERSION);
-PERL
-
-my $kw_map = 0;
-{
-# Informix CLI (ODBC) v3.81.0000 does not return a list of keywords.
- local $\ = "\n";
- local $, = "\n";
- my ($kw) = $dbh->get_info($GetInfoType{SQL_KEYWORDS});
- if ($kw)
- {
- print "\nmy \@Keywords = qw(\n";
- print sort split /,/, $kw;
- print ");\n\n";
- print "sub sql_keywords {\n";
- print q% return join ',', @Keywords;%;
- print "\n}\n\n";
- $kw_map = 1;
- }
-}
-
- print <<'PERL';
-
-sub sql_data_source_name {
- my $dbh = shift;
- return "dbi:$sql_driver:" . $dbh->{Name};
-}
-
-sub sql_user_name {
- my $dbh = shift;
- # CURRENT_USER is a non-standard attribute, probably undef
- # Username is a standard DBI attribute
- return $dbh->{CURRENT_USER} || $dbh->{Username};
-}
-
-PERL
-
- print "\nour \%info = (\n";
- foreach my $key (sort keys %GetInfoType)
- {
- my $num = $GetInfoType{$key};
- my $val = eval { $dbh->get_info($num); };
- if ($key eq 'SQL_DATA_SOURCE_NAME') {
- $val = '\&sql_data_source_name';
- }
- elsif ($key eq 'SQL_KEYWORDS') {
- $val = ($kw_map) ? '\&sql_keywords' : 'undef';
- }
- elsif ($key eq 'SQL_DRIVER_NAME') {
- $val = "\$INC{'DBD/$driver.pm'}";
- }
- elsif ($key eq 'SQL_DRIVER_VER') {
- $val = '$sql_driver_ver';
- }
- elsif ($key eq 'SQL_USER_NAME') {
- $val = '\&sql_user_name';
- }
- elsif (not defined $val) {
- $val = 'undef';
- }
- elsif ($val eq '') {
- $val = "''";
- }
- elsif ($val =~ /\D/) {
- $val =~ s/\\/\\\\/g;
- $val =~ s/'/\\'/g;
- $val = "'$val'";
- }
- printf "%s %5d => %-30s # %s\n", (($val eq 'undef') ? '#' : ' '), $num, "$val,", $key;
- }
- print ");\n\n1;\n\n__END__\n";
-}
-
-
-
-=head1 Generating a TypeInfo package for a driver
-
-The C<write_typeinfo_pm> function in the DBI::DBD::Metadata module generates
-on standard output the data needed for a driver's type_info_all method.
-It also provides default implementations of the type_info_all
-method for inclusion in the driver's main implementation file.
-
-The driver parameter is the name of the driver for which the methods
-will be generated; for the sake of examples, this will be "Driver".
-Typically, the dsn parameter will be of the form "dbi:ODBC:odbc_dsn",
-where the odbc_dsn is a DSN for one of the driver's databases.
-The user and pass parameters are the other optional connection
-parameters that will be provided to the DBI connect method.
-
-Once you are sure that it is producing reasonably sane data, you should
-typically redirect the standard output to lib/DBD/Driver/TypeInfo.pm,
-and then hand edit the result if necessary.
-Do not forget to update your Makefile.PL and MANIFEST to include this as
-an extra PM file that should be installed.
-
-Please take a critical look at the data returned!
-ODBC drivers vary dramatically in their quality.
-
-The generator assumes that all the values are static and places these
-values directly in the %info hash.
-
-A possible implementation of DBD::Driver::type_info_all() may look like:
-
- sub type_info_all {
- my ($dbh) = @_;
- require DBD::Driver::TypeInfo;
- return [ @$DBD::Driver::TypeInfo::type_info_all ];
- }
-
-Please replace Driver (or "<foo>") with the name of your driver.
-Note that this stub function is generated for you by the write_typeinfo_pm
-function, but you must manually transfer the code to Driver.pm.
-
-=cut
-
-
-# These two are used by fmt_value...
-my %dbi_inv;
-my %sql_type_inv;
-
-#-DEBUGGING-#
-#sub print_hash
-#{
-# my ($name, %hash) = @_;
-# print "Hash: $name\n";
-# foreach my $key (keys %hash)
-# {
-# print "$key => $hash{$key}\n";
-# }
-#}
-#-DEBUGGING-#
-
-sub inverse_hash
-{
- my (%hash) = @_;
- my (%inv);
- foreach my $key (keys %hash)
- {
- my $val = $hash{$key};
- die "Double mapping for key value $val ($inv{$val}, $key)!"
- if (defined $inv{$val});
- $inv{$val} = $key;
- }
- return %inv;
-}
-
-sub fmt_value
-{
- my ($num, $val) = @_;
- if (!defined $val)
- {
- $val = "undef";
- }
- elsif ($val !~ m/^[-+]?\d+$/)
- {
- # All the numbers in type_info_all are integers!
- # Anything that isn't an integer is a string.
- # Ensure that no double quotes screw things up.
- $val =~ s/"/\\"/g if ($val =~ m/"/o);
- $val = qq{"$val"};
- }
- elsif ($dbi_inv{$num} =~ m/^(SQL_)?DATA_TYPE$/)
- {
- # All numeric...
- $val = $sql_type_inv{$val}
- if (defined $sql_type_inv{$val});
- }
- return $val;
-}
-
-sub write_typeinfo_pm
-{
- my ($dsn, $user, $pass, $driver) = @_ ? @_ : @ARGV;
- my $dbh = DBI->connect($dsn, $user, $pass, {AutoCommit=>1, RaiseError=>1});
- $driver = "<foo>" unless defined $driver;
-
- print <<PERL;
-
-# Transfer this to ${driver}.pm
-
-# The type_info_all function was automatically generated by
-# DBI::DBD::Metadata::write_typeinfo_pm v$DBI::DBD::Metadata::VERSION.
-
-package DBD::${driver}::db; # This line can be removed once transferred.
-
- sub type_info_all
- {
- my (\$dbh) = \@_;
- require DBD::${driver}::TypeInfo;
- return [ \@\$DBD::${driver}::TypeInfo::type_info_all ];
- }
-
-# Transfer this to lib/DBD/${driver}/TypeInfo.pm.
-# Don't forget to add version and intellectual property control information.
-
-# The \%type_info_all hash was automatically generated by
-# DBI::DBD::Metadata::write_typeinfo_pm v$DBI::DBD::Metadata::VERSION.
-
-package DBD::${driver}::TypeInfo;
-
-{
- require Exporter;
- require DynaLoader;
- \@ISA = qw(Exporter DynaLoader);
- \@EXPORT = qw(type_info_all);
- use DBI qw(:sql_types);
-
-PERL
-
- # Generate SQL type name mapping hashes.
- # See code fragment in DBI specification.
- my %sql_type_map;
- foreach (@{$DBI::EXPORT_TAGS{sql_types}})
- {
- no strict 'refs';
- $sql_type_map{$_} = &{"DBI::$_"}();
- $sql_type_inv{$sql_type_map{$_}} = $_;
- }
- #-DEBUG-# print_hash("sql_type_map", %sql_type_map);
- #-DEBUG-# print_hash("sql_type_inv", %sql_type_inv);
-
- my %dbi_map =
- (
- TYPE_NAME => 0,
- DATA_TYPE => 1,
- COLUMN_SIZE => 2,
- LITERAL_PREFIX => 3,
- LITERAL_SUFFIX => 4,
- CREATE_PARAMS => 5,
- NULLABLE => 6,
- CASE_SENSITIVE => 7,
- SEARCHABLE => 8,
- UNSIGNED_ATTRIBUTE => 9,
- FIXED_PREC_SCALE => 10,
- AUTO_UNIQUE_VALUE => 11,
- LOCAL_TYPE_NAME => 12,
- MINIMUM_SCALE => 13,
- MAXIMUM_SCALE => 14,
- SQL_DATA_TYPE => 15,
- SQL_DATETIME_SUB => 16,
- NUM_PREC_RADIX => 17,
- INTERVAL_PRECISION => 18,
- );
-
- #-DEBUG-# print_hash("dbi_map", %dbi_map);
-
- %dbi_inv = inverse_hash(%dbi_map);
-
- #-DEBUG-# print_hash("dbi_inv", %dbi_inv);
-
- my $maxlen = 0;
- foreach my $key (keys %dbi_map)
- {
- $maxlen = length($key) if length($key) > $maxlen;
- }
-
- # Print the name/value mapping entry in the type_info_all array;
- my $fmt = " \%-${maxlen}s => \%2d,\n";
- my $numkey = 0;
- my $maxkey = 0;
- print " \$type_info_all = [\n {\n";
- foreach my $i (sort { $a <=> $b } keys %dbi_inv)
- {
- printf($fmt, $dbi_inv{$i}, $i);
- $numkey++;
- $maxkey = $i;
- }
- print " },\n";
-
- print STDERR "### WARNING - Non-dense set of keys ($numkey keys, $maxkey max key)\n"
- unless $numkey = $maxkey + 1;
-
- my $h = $dbh->type_info_all;
- my @tia = @$h;
- my %odbc_map = map { uc $_ => $tia[0]->{$_} } keys %{$tia[0]};
- shift @tia; # Remove the mapping reference.
- my $numtyp = $#tia;
-
- #-DEBUG-# print_hash("odbc_map", %odbc_map);
-
- # In theory, the key/number mapping sequence for %dbi_map
- # should be the same as the one from the ODBC driver. However, to
- # prevent the possibility of mismatches, and to deal with older
- # missing attributes or unexpected new ones, we chase back through
- # the %dbi_inv and %odbc_map hashes, generating @dbi_to_odbc
- # to map our new key number to the old one.
- # Report if @dbi_to_odbc is not an identity mapping.
- my @dbi_to_odbc;
- foreach my $num (sort { $a <=> $b } keys %dbi_inv)
- {
- # Find the name in %dbi_inv that matches this index number.
- my $dbi_key = $dbi_inv{$num};
- #-DEBUG-# print "dbi_key = $dbi_key\n";
- #-DEBUG-# print "odbc_key = $odbc_map{$dbi_key}\n";
- # Find the index in %odbc_map that has this key.
- $dbi_to_odbc[$num] = (defined $odbc_map{$dbi_key}) ? $odbc_map{$dbi_key} : undef;
- }
-
- # Determine the length of the longest formatted value in each field
- my @len;
- for (my $i = 0; $i <= $numtyp; $i++)
- {
- my @odbc_val = @{$tia[$i]};
- for (my $num = 0; $num <= $maxkey; $num++)
- {
- # Find the value of the entry in the @odbc_val array.
- my $val = (defined $dbi_to_odbc[$num]) ? $odbc_val[$dbi_to_odbc[$num]] : undef;
- $val = fmt_value($num, $val);
- #-DEBUG-# print "val = $val\n";
- $val = "$val,";
- $len[$num] = length($val) if !defined $len[$num] || length($val) > $len[$num];
- }
- }
-
- # Generate format strings to left justify each string in maximum field width.
- my @fmt;
- for (my $i = 0; $i <= $maxkey; $i++)
- {
- $fmt[$i] = "%-$len[$i]s";
- #-DEBUG-# print "fmt[$i] = $fmt[$i]\n";
- }
-
- # Format the data from type_info_all
- for (my $i = 0; $i <= $numtyp; $i++)
- {
- my @odbc_val = @{$tia[$i]};
- print " [ ";
- for (my $num = 0; $num <= $maxkey; $num++)
- {
- # Find the value of the entry in the @odbc_val array.
- my $val = (defined $dbi_to_odbc[$num]) ? $odbc_val[$dbi_to_odbc[$num]] : undef;
- $val = fmt_value($num, $val);
- printf $fmt[$num], "$val,";
- }
- print " ],\n";
- }
-
- print " ];\n\n 1;\n}\n\n__END__\n";
-
-}
-
-1;
-
-__END__
-
-=head1 AUTHORS
-
-Jonathan Leffler <jleffler@us.ibm.com> (previously <jleffler@informix.com>),
-Jochen Wiedmann <joe@ispsoft.de>,
-Steffen Goeldner <sgoeldner@cpan.org>,
-and Tim Bunce <dbi-users@perl.org>.
-
-=cut
+++ /dev/null
-# -*- perl -*-
-#
-# DBI::DBD::SqlEngine - A base class for implementing DBI drivers that
-# have not an own SQL engine
-#
-# This module is currently maintained by
-#
-# H.Merijn Brand & Jens Rehsack
-#
-# The original author is Jochen Wiedmann.
-#
-# Copyright (C) 2009-2013 by H.Merijn Brand & Jens Rehsack
-# Copyright (C) 2004 by Jeff Zucker
-# Copyright (C) 1998 by Jochen Wiedmann
-#
-# All rights reserved.
-#
-# You may distribute this module under the terms of either the GNU
-# General Public License or the Artistic License, as specified in
-# the Perl README file.
-
-require 5.008;
-
-use strict;
-
-use DBI ();
-require DBI::SQL::Nano;
-
-package DBI::DBD::SqlEngine;
-
-use strict;
-
-use Carp;
-use vars qw( @ISA $VERSION $drh %methods_installed);
-
-$VERSION = "0.06";
-
-$drh = undef; # holds driver handle(s) once initialized
-
-DBI->setup_driver("DBI::DBD::SqlEngine"); # only needed once but harmless to repeat
-
-my %accessors = (
- versions => "get_driver_versions",
- new_meta => "new_sql_engine_meta",
- get_meta => "get_sql_engine_meta",
- set_meta => "set_sql_engine_meta",
- clear_meta => "clear_sql_engine_meta",
- );
-
-sub driver ($;$)
-{
- my ( $class, $attr ) = @_;
-
- # Drivers typically use a singleton object for the $drh
- # We use a hash here to have one singleton per subclass.
- # (Otherwise DBD::CSV and DBD::DBM, for example, would
- # share the same driver object which would cause problems.)
- # An alternative would be to not cache the $drh here at all
- # and require that subclasses do that. Subclasses should do
- # their own caching, so caching here just provides extra safety.
- $drh->{$class} and return $drh->{$class};
-
- $attr ||= {};
- {
- no strict "refs";
- unless ( $attr->{Attribution} )
- {
- $class eq "DBI::DBD::SqlEngine"
- and $attr->{Attribution} = "$class by Jens Rehsack";
- $attr->{Attribution} ||= ${ $class . "::ATTRIBUTION" }
- || "oops the author of $class forgot to define this";
- }
- $attr->{Version} ||= ${ $class . "::VERSION" };
- $attr->{Name} or ( $attr->{Name} = $class ) =~ s/^DBD\:\://;
- }
-
- $drh->{$class} = DBI::_new_drh( $class . "::dr", $attr );
- $drh->{$class}->STORE( ShowErrorStatement => 1 );
-
- my $prefix = DBI->driver_prefix($class);
- if ($prefix)
- {
- my $dbclass = $class . "::db";
- while ( my ( $accessor, $funcname ) = each %accessors )
- {
- my $method = $prefix . $accessor;
- $dbclass->can($method) and next;
- my $inject = sprintf <<'EOI', $dbclass, $method, $dbclass, $funcname;
-sub %s::%s
-{
- my $func = %s->can (q{%s});
- goto &$func;
- }
-EOI
- eval $inject;
- $dbclass->install_method($method);
- }
- }
- else
- {
- warn "Using DBI::DBD::SqlEngine with unregistered driver $class.\n"
- . "Reading documentation how to prevent is strongly recommended.\n";
-
- }
-
- # XXX inject DBD::XXX::Statement unless exists
-
- my $stclass = $class . "::st";
- $stclass->install_method("sql_get_colnames") unless ( $methods_installed{__PACKAGE__}++ );
-
- return $drh->{$class};
-} # driver
-
-sub CLONE
-{
- undef $drh;
-} # CLONE
-
-# ====== DRIVER ================================================================
-
-package DBI::DBD::SqlEngine::dr;
-
-use strict;
-use warnings;
-
-use vars qw(@ISA $imp_data_size);
-
-use Carp qw/carp/;
-
-$imp_data_size = 0;
-
-sub connect ($$;$$$)
-{
- my ( $drh, $dbname, $user, $auth, $attr ) = @_;
-
- # create a 'blank' dbh
- my $dbh = DBI::_new_dbh(
- $drh,
- {
- Name => $dbname,
- USER => $user,
- CURRENT_USER => $user,
- }
- );
-
- if ($dbh)
- {
- # must be done first, because setting flags implicitly calls $dbdname::db->STORE
- $dbh->func( 0, "init_default_attributes" );
- my $two_phased_init;
- defined $dbh->{sql_init_phase} and $two_phased_init = ++$dbh->{sql_init_phase};
- my %second_phase_attrs;
- my @func_inits;
-
- # this must be done to allow DBI.pm reblessing got handle after successful connecting
- exists $attr->{RootClass} and $second_phase_attrs{RootClass} = delete $attr->{RootClass};
-
- my ( $var, $val );
- while ( length $dbname )
- {
- if ( $dbname =~ s/^((?:[^\\;]|\\.)*?);//s )
- {
- $var = $1;
- }
- else
- {
- $var = $dbname;
- $dbname = "";
- }
-
- if ( $var =~ m/^(.+?)=(.*)/s )
- {
- $var = $1;
- ( $val = $2 ) =~ s/\\(.)/$1/g;
- exists $attr->{$var}
- and carp("$var is given in DSN *and* \$attr during DBI->connect()")
- if ($^W);
- exists $attr->{$var} or $attr->{$var} = $val;
- }
- elsif ( $var =~ m/^(.+?)=>(.*)/s )
- {
- $var = $1;
- ( $val = $2 ) =~ s/\\(.)/$1/g;
- my $ref = eval $val;
- # $dbh->$var($ref);
- push( @func_inits, $var, $ref );
- }
- }
-
- # The attributes need to be sorted in a specific way as the
- # assignment is through tied hashes and calls STORE on each
- # attribute. Some attributes require to be called prior to
- # others
- # e.g. f_dir *must* be done before xx_tables in DBD::File
- # The dbh attribute sql_init_order is a hash with the order
- # as key (low is first, 0 .. 100) and the attributes that
- # are set to that oreder as anon-list as value:
- # { 0 => [qw( AutoCommit PrintError RaiseError Profile ... )],
- # 10 => [ list of attr to be dealt with immediately after first ],
- # 50 => [ all fields that are unspecified or default sort order ],
- # 90 => [ all fields that are needed after other initialisation ],
- # }
-
- my %order = map {
- my $order = $_;
- map { ( $_ => $order ) } @{ $dbh->{sql_init_order}{$order} };
- } sort { $a <=> $b } keys %{ $dbh->{sql_init_order} || {} };
- my @ordered_attr =
- map { $_->[0] }
- sort { $a->[1] <=> $b->[1] }
- map { [ $_, defined $order{$_} ? $order{$_} : 50 ] }
- keys %$attr;
-
- # initialize given attributes ... lower weighted before higher weighted
- foreach my $a (@ordered_attr)
- {
- exists $attr->{$a} or next;
- $two_phased_init and eval {
- $dbh->{$a} = $attr->{$a};
- delete $attr->{$a};
- };
- $@ and $second_phase_attrs{$a} = delete $attr->{$a};
- $two_phased_init or $dbh->STORE( $a, delete $attr->{$a} );
- }
-
- $two_phased_init and $dbh->func( 1, "init_default_attributes" );
- %$attr = %second_phase_attrs;
-
- for ( my $i = 0; $i < scalar(@func_inits); $i += 2 )
- {
- my $func = $func_inits[$i];
- my $arg = $func_inits[ $i + 1 ];
- $dbh->$func($arg);
- }
-
- $dbh->func("init_done");
-
- $dbh->STORE( Active => 1 );
- }
-
- return $dbh;
-} # connect
-
-sub data_sources ($;$)
-{
- my ( $drh, $attr ) = @_;
-
- my $tbl_src;
- $attr
- and defined $attr->{sql_table_source}
- and $attr->{sql_table_source}->isa('DBI::DBD::SqlEngine::TableSource')
- and $tbl_src = $attr->{sql_table_source};
-
- !defined($tbl_src)
- and $drh->{ImplementorClass}->can('default_table_source')
- and $tbl_src = $drh->{ImplementorClass}->default_table_source();
- defined($tbl_src) or return;
-
- $tbl_src->data_sources( $drh, $attr );
-} # data_sources
-
-sub disconnect_all
-{
-} # disconnect_all
-
-sub DESTROY
-{
- undef;
-} # DESTROY
-
-# ====== DATABASE ==============================================================
-
-package DBI::DBD::SqlEngine::db;
-
-use strict;
-use warnings;
-
-use vars qw(@ISA $imp_data_size);
-
-use Carp;
-
-if ( eval { require Clone; } )
-{
- Clone->import("clone");
-}
-else
-{
- require Storable; # in CORE since 5.7.3
- *clone = \&Storable::dclone;
-}
-
-$imp_data_size = 0;
-
-sub ping
-{
- ( $_[0]->FETCH("Active") ) ? 1 : 0;
-} # ping
-
-sub data_sources
-{
- my ( $dbh, $attr, @other ) = @_;
- my $drh = $dbh->{Driver}; # XXX proxy issues?
- ref($attr) eq 'HASH' or $attr = {};
- defined( $attr->{sql_table_source} ) or $attr->{sql_table_source} = $dbh->{sql_table_source};
- return $drh->data_sources( $attr, @other );
-}
-
-sub prepare ($$;@)
-{
- my ( $dbh, $statement, @attribs ) = @_;
-
- # create a 'blank' sth
- my $sth = DBI::_new_sth( $dbh, { Statement => $statement } );
-
- if ($sth)
- {
- my $class = $sth->FETCH("ImplementorClass");
- $class =~ s/::st$/::Statement/;
- my $stmt;
-
- # if using SQL::Statement version > 1
- # cache the parser object if the DBD supports parser caching
- # SQL::Nano and older SQL::Statements don't support this
-
- if ( $class->isa("SQL::Statement") )
- {
- my $parser = $dbh->{sql_parser_object};
- $parser ||= eval { $dbh->func("sql_parser_object") };
- if ($@)
- {
- $stmt = eval { $class->new($statement) };
- }
- else
- {
- $stmt = eval { $class->new( $statement, $parser ) };
- }
- }
- else
- {
- $stmt = eval { $class->new($statement) };
- }
- if ( $@ || $stmt->{errstr} )
- {
- $dbh->set_err( $DBI::stderr, $@ || $stmt->{errstr} );
- undef $sth;
- }
- else
- {
- $sth->STORE( "sql_stmt", $stmt );
- $sth->STORE( "sql_params", [] );
- $sth->STORE( "NUM_OF_PARAMS", scalar( $stmt->params() ) );
- my @colnames = $sth->sql_get_colnames();
- $sth->STORE( "NUM_OF_FIELDS", scalar @colnames );
- }
- }
- return $sth;
-} # prepare
-
-sub set_versions
-{
- my $dbh = $_[0];
- $dbh->{sql_engine_version} = $DBI::DBD::SqlEngine::VERSION;
- for (qw( nano_version statement_version ))
- {
- defined $DBI::SQL::Nano::versions->{$_} or next;
- $dbh->{"sql_$_"} = $DBI::SQL::Nano::versions->{$_};
- }
- $dbh->{sql_handler} =
- $dbh->{sql_statement_version}
- ? "SQL::Statement"
- : "DBI::SQL::Nano";
-
- return $dbh;
-} # set_versions
-
-sub init_valid_attributes
-{
- my $dbh = $_[0];
-
- $dbh->{sql_valid_attrs} = {
- sql_engine_version => 1, # DBI::DBD::SqlEngine version
- sql_handler => 1, # Nano or S:S
- sql_nano_version => 1, # Nano version
- sql_statement_version => 1, # S:S version
- sql_flags => 1, # flags for SQL::Parser
- sql_dialect => 1, # dialect for SQL::Parser
- sql_quoted_identifier_case => 1, # case for quoted identifiers
- sql_identifier_case => 1, # case for non-quoted identifiers
- sql_parser_object => 1, # SQL::Parser instance
- sql_sponge_driver => 1, # Sponge driver for table_info ()
- sql_valid_attrs => 1, # SQL valid attributes
- sql_readonly_attrs => 1, # SQL readonly attributes
- sql_init_phase => 1, # Only during initialization
- sql_meta => 1, # meta data for tables
- sql_meta_map => 1, # mapping table for identifier case
- sql_data_source => 1, # reasonable datasource class
- };
- $dbh->{sql_readonly_attrs} = {
- sql_engine_version => 1, # DBI::DBD::SqlEngine version
- sql_handler => 1, # Nano or S:S
- sql_nano_version => 1, # Nano version
- sql_statement_version => 1, # S:S version
- sql_quoted_identifier_case => 1, # case for quoted identifiers
- sql_parser_object => 1, # SQL::Parser instance
- sql_sponge_driver => 1, # Sponge driver for table_info ()
- sql_valid_attrs => 1, # SQL valid attributes
- sql_readonly_attrs => 1, # SQL readonly attributes
- };
-
- return $dbh;
-} # init_valid_attributes
-
-sub init_default_attributes
-{
- my ( $dbh, $phase ) = @_;
- my $given_phase = $phase;
-
- unless ( defined($phase) )
- {
- # we have an "old" driver here
- $phase = defined $dbh->{sql_init_phase};
- $phase and $phase = $dbh->{sql_init_phase};
- }
-
- if ( 0 == $phase )
- {
- # must be done first, because setting flags implicitly calls $dbdname::db->STORE
- $dbh->func("init_valid_attributes");
-
- $dbh->func("set_versions");
-
- $dbh->{sql_identifier_case} = 2; # SQL_IC_LOWER
- $dbh->{sql_quoted_identifier_case} = 3; # SQL_IC_SENSITIVE
-
- $dbh->{sql_dialect} = "CSV";
-
- $dbh->{sql_init_phase} = $given_phase;
-
- # complete derived attributes, if required
- ( my $drv_class = $dbh->{ImplementorClass} ) =~ s/::db$//;
- my $drv_prefix = DBI->driver_prefix($drv_class);
- my $valid_attrs = $drv_prefix . "valid_attrs";
- my $ro_attrs = $drv_prefix . "readonly_attrs";
-
- # check whether we're running in a Gofer server or not (see
- # validate_FETCH_attr for details)
- $dbh->{sql_engine_in_gofer} =
- ( defined $INC{"DBD/Gofer.pm"} && ( caller(5) )[0] eq "DBI::Gofer::Execute" );
- $dbh->{sql_meta} = {};
- $dbh->{sql_meta_map} = {}; # choose new name because it contains other keys
-
- # init_default_attributes calls inherited routine before derived DBD's
- # init their default attributes, so we don't override something here
- #
- # defining an order of attribute initialization from connect time
- # specified ones with a magic baarier (see next statement)
- my $drv_pfx_meta = $drv_prefix . "meta";
- $dbh->{sql_init_order} = {
- 0 => [qw( Profile RaiseError PrintError AutoCommit )],
- 90 => [ "sql_meta", $dbh->{$drv_pfx_meta} ? $dbh->{$drv_pfx_meta} : () ],
- };
- # ensuring Profile, RaiseError, PrintError, AutoCommit are initialized
- # first when initializing attributes from connect time specified
- # attributes
- # further, initializations to predefined tables are happens after any
- # unspecified attribute initialization (that default to order 50)
-
- my @comp_attrs = qw(valid_attrs version readonly_attrs);
-
- if ( exists $dbh->{$drv_pfx_meta} and !$dbh->{sql_engine_in_gofer} )
- {
- my $attr = $dbh->{$drv_pfx_meta};
- defined $attr
- and defined $dbh->{$valid_attrs}
- and !defined $dbh->{$valid_attrs}{$attr}
- and $dbh->{$valid_attrs}{$attr} = 1;
-
- my %h;
- tie %h, "DBI::DBD::SqlEngine::TieTables", $dbh;
- $dbh->{$attr} = \%h;
-
- push @comp_attrs, "meta";
- }
-
- foreach my $comp_attr (@comp_attrs)
- {
- my $attr = $drv_prefix . $comp_attr;
- defined $dbh->{$valid_attrs}
- and !defined $dbh->{$valid_attrs}{$attr}
- and $dbh->{$valid_attrs}{$attr} = 1;
- defined $dbh->{$ro_attrs}
- and !defined $dbh->{$ro_attrs}{$attr}
- and $dbh->{$ro_attrs}{$attr} = 1;
- }
- }
-
- return $dbh;
-} # init_default_attributes
-
-sub init_done
-{
- defined $_[0]->{sql_init_phase} and delete $_[0]->{sql_init_phase};
- delete $_[0]->{sql_valid_attrs}->{sql_init_phase};
- return;
-}
-
-sub sql_parser_object
-{
- my $dbh = $_[0];
- my $dialect = $dbh->{sql_dialect} || "CSV";
- my $parser = {
- RaiseError => $dbh->FETCH("RaiseError"),
- PrintError => $dbh->FETCH("PrintError"),
- };
- my $sql_flags = $dbh->FETCH("sql_flags") || {};
- %$parser = ( %$parser, %$sql_flags );
- $parser = SQL::Parser->new( $dialect, $parser );
- $dbh->{sql_parser_object} = $parser;
- return $parser;
-} # sql_parser_object
-
-sub sql_sponge_driver
-{
- my $dbh = $_[0];
- my $dbh2 = $dbh->{sql_sponge_driver};
- unless ($dbh2)
- {
- $dbh2 = $dbh->{sql_sponge_driver} = DBI->connect("DBI:Sponge:");
- unless ($dbh2)
- {
- $dbh->set_err( $DBI::stderr, $DBI::errstr );
- return;
- }
- }
-}
-
-sub disconnect ($)
-{
- %{ $_[0]->{sql_meta} } = ();
- %{ $_[0]->{sql_meta_map} } = ();
- $_[0]->STORE( Active => 0 );
- return 1;
-} # disconnect
-
-sub validate_FETCH_attr
-{
- my ( $dbh, $attrib ) = @_;
-
- # If running in a Gofer server, access to our tied compatibility hash
- # would force Gofer to serialize the tieing object including it's
- # private $dbh reference used to do the driver function calls.
- # This will result in nasty exceptions. So return a copy of the
- # sql_meta structure instead, which is the source of for the compatibility
- # tie-hash. It's not as good as liked, but the best we can do in this
- # situation.
- if ( $dbh->{sql_engine_in_gofer} )
- {
- ( my $drv_class = $dbh->{ImplementorClass} ) =~ s/::db$//;
- my $drv_prefix = DBI->driver_prefix($drv_class);
- exists $dbh->{ $drv_prefix . "meta" } && $attrib eq $dbh->{ $drv_prefix . "meta" }
- and $attrib = "sql_meta";
- }
-
- return $attrib;
-}
-
-sub FETCH ($$)
-{
- my ( $dbh, $attrib ) = @_;
- $attrib eq "AutoCommit"
- and return 1;
-
- # Driver private attributes are lower cased
- if ( $attrib eq ( lc $attrib ) )
- {
- # first let the implementation deliver an alias for the attribute to fetch
- # after it validates the legitimation of the fetch request
- $attrib = $dbh->func( $attrib, "validate_FETCH_attr" ) or return;
-
- my $attr_prefix;
- $attrib =~ m/^([a-z]+_)/ and $attr_prefix = $1;
- unless ($attr_prefix)
- {
- ( my $drv_class = $dbh->{ImplementorClass} ) =~ s/::db$//;
- $attr_prefix = DBI->driver_prefix($drv_class);
- $attrib = $attr_prefix . $attrib;
- }
- my $valid_attrs = $attr_prefix . "valid_attrs";
- my $ro_attrs = $attr_prefix . "readonly_attrs";
-
- exists $dbh->{$valid_attrs}
- and ( $dbh->{$valid_attrs}{$attrib}
- or return $dbh->set_err( $DBI::stderr, "Invalid attribute '$attrib'" ) );
- exists $dbh->{$ro_attrs}
- and $dbh->{$ro_attrs}{$attrib}
- and defined $dbh->{$attrib}
- and refaddr( $dbh->{$attrib} )
- and return clone( $dbh->{$attrib} );
-
- return $dbh->{$attrib};
- }
- # else pass up to DBI to handle
- return $dbh->SUPER::FETCH($attrib);
-} # FETCH
-
-sub validate_STORE_attr
-{
- my ( $dbh, $attrib, $value ) = @_;
-
- if ( $attrib eq "sql_identifier_case" || $attrib eq "sql_quoted_identifier_case"
- and $value < 1 || $value > 4 )
- {
- croak "attribute '$attrib' must have a value from 1 .. 4 (SQL_IC_UPPER .. SQL_IC_MIXED)";
- # XXX correctly a remap of all entries in sql_meta/sql_meta_map is required here
- }
-
- ( my $drv_class = $dbh->{ImplementorClass} ) =~ s/::db$//;
- my $drv_prefix = DBI->driver_prefix($drv_class);
-
- exists $dbh->{ $drv_prefix . "meta" }
- and $attrib eq $dbh->{ $drv_prefix . "meta" }
- and $attrib = "sql_meta";
-
- return ( $attrib, $value );
-}
-
-# the ::db::STORE method is what gets called when you set
-# a lower-cased database handle attribute such as $dbh->{somekey}=$someval;
-#
-# STORE should check to make sure that "somekey" is a valid attribute name
-# but only if it is really one of our attributes (starts with dbm_ or foo_)
-# You can also check for valid values for the attributes if needed
-# and/or perform other operations
-#
-sub STORE ($$$)
-{
- my ( $dbh, $attrib, $value ) = @_;
-
- if ( $attrib eq "AutoCommit" )
- {
- $value and return 1; # is already set
- croak "Can't disable AutoCommit";
- }
-
- if ( $attrib eq lc $attrib )
- {
- # Driver private attributes are lower cased
-
- ( $attrib, $value ) = $dbh->func( $attrib, $value, "validate_STORE_attr" );
- $attrib or return;
-
- my $attr_prefix;
- $attrib =~ m/^([a-z]+_)/ and $attr_prefix = $1;
- unless ($attr_prefix)
- {
- ( my $drv_class = $dbh->{ImplementorClass} ) =~ s/::db$//;
- $attr_prefix = DBI->driver_prefix($drv_class);
- $attrib = $attr_prefix . $attrib;
- }
- my $valid_attrs = $attr_prefix . "valid_attrs";
- my $ro_attrs = $attr_prefix . "readonly_attrs";
-
- exists $dbh->{$valid_attrs}
- and ( $dbh->{$valid_attrs}{$attrib}
- or return $dbh->set_err( $DBI::stderr, "Invalid attribute '$attrib'" ) );
- exists $dbh->{$ro_attrs}
- and $dbh->{$ro_attrs}{$attrib}
- and defined $dbh->{$attrib}
- and return $dbh->set_err( $DBI::stderr,
- "attribute '$attrib' is readonly and must not be modified" );
-
- if ( $attrib eq "sql_meta" )
- {
- while ( my ( $k, $v ) = each %$value )
- {
- $dbh->{$attrib}{$k} = $v;
- }
- }
- else
- {
- $dbh->{$attrib} = $value;
- }
-
- return 1;
- }
-
- return $dbh->SUPER::STORE( $attrib, $value );
-} # STORE
-
-sub get_driver_versions
-{
- my ( $dbh, $table ) = @_;
- my %vsn = (
- OS => "$^O ($Config::Config{osvers})",
- Perl => "$] ($Config::Config{archname})",
- DBI => $DBI::VERSION,
- );
- my %vmp;
-
- my $sql_engine_verinfo =
- join " ",
- $dbh->{sql_engine_version}, "using", $dbh->{sql_handler},
- $dbh->{sql_handler} eq "SQL::Statement"
- ? $dbh->{sql_statement_version}
- : $dbh->{sql_nano_version};
-
- my $indent = 0;
- my @deriveds = ( $dbh->{ImplementorClass} );
- while (@deriveds)
- {
- my $derived = shift @deriveds;
- $derived eq "DBI::DBD::SqlEngine::db" and last;
- $derived->isa("DBI::DBD::SqlEngine::db") or next;
- #no strict 'refs';
- eval "push \@deriveds, \@${derived}::ISA";
- #use strict;
- ( my $drv_class = $derived ) =~ s/::db$//;
- my $drv_prefix = DBI->driver_prefix($drv_class);
- my $ddgv = $dbh->{ImplementorClass}->can("get_${drv_prefix}versions");
- my $drv_version = $ddgv ? &$ddgv( $dbh, $table ) : $dbh->{ $drv_prefix . "version" };
- $drv_version ||=
- eval { $derived->VERSION() }; # XXX access $drv_class::VERSION via symbol table
- $vsn{$drv_class} = $drv_version;
- $indent and $vmp{$drv_class} = " " x $indent . $drv_class;
- $indent += 2;
- }
-
- $vsn{"DBI::DBD::SqlEngine"} = $sql_engine_verinfo;
- $indent and $vmp{"DBI::DBD::SqlEngine"} = " " x $indent . "DBI::DBD::SqlEngine";
-
- $DBI::PurePerl and $vsn{"DBI::PurePerl"} = $DBI::PurePerl::VERSION;
-
- $indent += 20;
- my @versions = map { sprintf "%-${indent}s %s", $vmp{$_} || $_, $vsn{$_} }
- sort {
- $a->isa($b) and return -1;
- $b->isa($a) and return 1;
- $a->isa("DBI::DBD::SqlEngine") and return -1;
- $b->isa("DBI::DBD::SqlEngine") and return 1;
- return $a cmp $b;
- } keys %vsn;
-
- return wantarray ? @versions : join "\n", @versions;
-} # get_versions
-
-sub get_single_table_meta
-{
- my ( $dbh, $table, $attr ) = @_;
- my $meta;
-
- $table eq "."
- and return $dbh->FETCH($attr);
-
- ( my $class = $dbh->{ImplementorClass} ) =~ s/::db$/::Table/;
- ( undef, $meta ) = $class->get_table_meta( $dbh, $table, 1 );
- $meta or croak "No such table '$table'";
-
- # prevent creation of undef attributes
- return $class->get_table_meta_attr( $meta, $attr );
-} # get_single_table_meta
-
-sub get_sql_engine_meta
-{
- my ( $dbh, $table, $attr ) = @_;
-
- my $gstm = $dbh->{ImplementorClass}->can("get_single_table_meta");
-
- $table eq "*"
- and $table = [ ".", keys %{ $dbh->{sql_meta} } ];
- $table eq "+"
- and $table = [ grep { m/^[_A-Za-z0-9]+$/ } keys %{ $dbh->{sql_meta} } ];
- ref $table eq "Regexp"
- and $table = [ grep { $_ =~ $table } keys %{ $dbh->{sql_meta} } ];
-
- ref $table || ref $attr
- or return $gstm->( $dbh, $table, $attr );
-
- ref $table or $table = [$table];
- ref $attr or $attr = [$attr];
- "ARRAY" eq ref $table
- or return
- $dbh->set_err( $DBI::stderr,
- "Invalid argument for \$table - SCALAR, Regexp or ARRAY expected but got " . ref $table );
- "ARRAY" eq ref $attr
- or return $dbh->set_err(
- "Invalid argument for \$attr - SCALAR or ARRAY expected but got " . ref $attr );
-
- my %results;
- foreach my $tname ( @{$table} )
- {
- my %tattrs;
- foreach my $aname ( @{$attr} )
- {
- $tattrs{$aname} = $gstm->( $dbh, $tname, $aname );
- }
- $results{$tname} = \%tattrs;
- }
-
- return \%results;
-} # get_sql_engine_meta
-
-sub new_sql_engine_meta
-{
- my ( $dbh, $table, $values ) = @_;
- my $respect_case = 0;
-
- "HASH" eq ref $values
- or croak "Invalid argument for \$values - SCALAR or HASH expected but got " . ref $values;
-
- $table =~ s/^\"// and $respect_case = 1; # handle quoted identifiers
- $table =~ s/\"$//;
-
- unless ($respect_case)
- {
- defined $dbh->{sql_meta_map}{$table} and $table = $dbh->{sql_meta_map}{$table};
- }
-
- $dbh->{sql_meta}{$table} = { %{$values} };
- my $class;
- defined $values->{sql_table_class} and $class = $values->{sql_table_class};
- defined $class or ( $class = $dbh->{ImplementorClass} ) =~ s/::db$/::Table/;
- # XXX we should never hit DBD::File::Table::get_table_meta here ...
- my ( undef, $meta ) = $class->get_table_meta( $dbh, $table, $respect_case );
- 1;
-} # new_sql_engine_meta
-
-sub set_single_table_meta
-{
- my ( $dbh, $table, $attr, $value ) = @_;
- my $meta;
-
- $table eq "."
- and return $dbh->STORE( $attr, $value );
-
- ( my $class = $dbh->{ImplementorClass} ) =~ s/::db$/::Table/;
- ( undef, $meta ) = $class->get_table_meta( $dbh, $table, 1 ); # 1 means: respect case
- $meta or croak "No such table '$table'";
- $class->set_table_meta_attr( $meta, $attr, $value );
-
- return $dbh;
-} # set_single_table_meta
-
-sub set_sql_engine_meta
-{
- my ( $dbh, $table, $attr, $value ) = @_;
-
- my $sstm = $dbh->{ImplementorClass}->can("set_single_table_meta");
-
- $table eq "*"
- and $table = [ ".", keys %{ $dbh->{sql_meta} } ];
- $table eq "+"
- and $table = [ grep { m/^[_A-Za-z0-9]+$/ } keys %{ $dbh->{sql_meta} } ];
- ref($table) eq "Regexp"
- and $table = [ grep { $_ =~ $table } keys %{ $dbh->{sql_meta} } ];
-
- ref $table || ref $attr
- or return $sstm->( $dbh, $table, $attr, $value );
-
- ref $table or $table = [$table];
- ref $attr or $attr = { $attr => $value };
- "ARRAY" eq ref $table
- or croak "Invalid argument for \$table - SCALAR, Regexp or ARRAY expected but got "
- . ref $table;
- "HASH" eq ref $attr
- or croak "Invalid argument for \$attr - SCALAR or HASH expected but got " . ref $attr;
-
- foreach my $tname ( @{$table} )
- {
- while ( my ( $aname, $aval ) = each %$attr )
- {
- $sstm->( $dbh, $tname, $aname, $aval );
- }
- }
-
- return $dbh;
-} # set_file_meta
-
-sub clear_sql_engine_meta
-{
- my ( $dbh, $table ) = @_;
-
- ( my $class = $dbh->{ImplementorClass} ) =~ s/::db$/::Table/;
- my ( undef, $meta ) = $class->get_table_meta( $dbh, $table, 1 );
- $meta and %{$meta} = ();
-
- return;
-} # clear_file_meta
-
-sub DESTROY ($)
-{
- my $dbh = shift;
- $dbh->SUPER::FETCH("Active") and $dbh->disconnect;
- undef $dbh->{sql_parser_object};
-} # DESTROY
-
-sub type_info_all ($)
-{
- [
- {
- TYPE_NAME => 0,
- DATA_TYPE => 1,
- PRECISION => 2,
- LITERAL_PREFIX => 3,
- LITERAL_SUFFIX => 4,
- CREATE_PARAMS => 5,
- NULLABLE => 6,
- CASE_SENSITIVE => 7,
- SEARCHABLE => 8,
- UNSIGNED_ATTRIBUTE => 9,
- MONEY => 10,
- AUTO_INCREMENT => 11,
- LOCAL_TYPE_NAME => 12,
- MINIMUM_SCALE => 13,
- MAXIMUM_SCALE => 14,
- },
- [
- "VARCHAR", DBI::SQL_VARCHAR(), undef, "'", "'", undef, 0, 1, 1, 0, 0, 0, undef, 1, 999999,
- ],
- [ "CHAR", DBI::SQL_CHAR(), undef, "'", "'", undef, 0, 1, 1, 0, 0, 0, undef, 1, 999999, ],
- [ "INTEGER", DBI::SQL_INTEGER(), undef, "", "", undef, 0, 0, 1, 0, 0, 0, undef, 0, 0, ],
- [ "REAL", DBI::SQL_REAL(), undef, "", "", undef, 0, 0, 1, 0, 0, 0, undef, 0, 0, ],
- [
- "BLOB", DBI::SQL_LONGVARBINARY(), undef, "'", "'", undef, 0, 1, 1, 0, 0, 0, undef, 1,
- 999999,
- ],
- [
- "BLOB", DBI::SQL_LONGVARBINARY(), undef, "'", "'", undef, 0, 1, 1, 0, 0, 0, undef, 1,
- 999999,
- ],
- [
- "TEXT", DBI::SQL_LONGVARCHAR(), undef, "'", "'", undef, 0, 1, 1, 0, 0, 0, undef, 1,
- 999999,
- ],
- ];
-} # type_info_all
-
-sub get_avail_tables
-{
- my $dbh = $_[0];
- my @tables = ();
-
- if ( $dbh->{sql_handler} eq "SQL::Statement" and $dbh->{sql_ram_tables} )
- {
- # XXX map +[ undef, undef, $_, "TABLE", "TEMP" ], keys %{...}
- foreach my $table ( keys %{ $dbh->{sql_ram_tables} } )
- {
- push @tables, [ undef, undef, $table, "TABLE", "TEMP" ];
- }
- }
-
- my $tbl_src;
- defined $dbh->{sql_table_source}
- and $dbh->{sql_table_source}->isa('DBI::DBD::SqlEngine::TableSource')
- and $tbl_src = $dbh->{sql_table_source};
-
- !defined($tbl_src)
- and $dbh->{Driver}->{ImplementorClass}->can('default_table_source')
- and $tbl_src = $dbh->{Driver}->{ImplementorClass}->default_table_source();
- defined($tbl_src) and push( @tables, $tbl_src->avail_tables($dbh) );
-
- return @tables;
-} # get_avail_tables
-
-{
- my $names = [qw( TABLE_QUALIFIER TABLE_OWNER TABLE_NAME TABLE_TYPE REMARKS )];
-
- sub table_info ($)
- {
- my $dbh = shift;
-
- my @tables = $dbh->func("get_avail_tables");
-
- # Temporary kludge: DBD::Sponge dies if @tables is empty. :-(
- # this no longer seems to be true @tables or return;
-
- my $dbh2 = $dbh->func("sql_sponge_driver");
- my $sth = $dbh2->prepare(
- "TABLE_INFO",
- {
- rows => \@tables,
- NAME => $names,
- }
- );
- $sth or return $dbh->set_err( $DBI::stderr, $dbh2->errstr );
- $sth->execute or return;
- return $sth;
- } # table_info
-}
-
-sub list_tables ($)
-{
- my $dbh = shift;
- my @table_list;
-
- my @tables = $dbh->func("get_avail_tables") or return;
- foreach my $ref (@tables)
- {
- # rt69260 and rt67223 - the same issue in 2 different queues
- push @table_list, $ref->[2];
- }
-
- return @table_list;
-} # list_tables
-
-sub quote ($$;$)
-{
- my ( $self, $str, $type ) = @_;
- defined $str or return "NULL";
- defined $type && ( $type == DBI::SQL_NUMERIC()
- || $type == DBI::SQL_DECIMAL()
- || $type == DBI::SQL_INTEGER()
- || $type == DBI::SQL_SMALLINT()
- || $type == DBI::SQL_FLOAT()
- || $type == DBI::SQL_REAL()
- || $type == DBI::SQL_DOUBLE()
- || $type == DBI::SQL_TINYINT() )
- and return $str;
-
- $str =~ s/\\/\\\\/sg;
- $str =~ s/\0/\\0/sg;
- $str =~ s/\'/\\\'/sg;
- $str =~ s/\n/\\n/sg;
- $str =~ s/\r/\\r/sg;
- return "'$str'";
-} # quote
-
-sub commit ($)
-{
- my $dbh = shift;
- $dbh->FETCH("Warn")
- and carp "Commit ineffective while AutoCommit is on", -1;
- return 1;
-} # commit
-
-sub rollback ($)
-{
- my $dbh = shift;
- $dbh->FETCH("Warn")
- and carp "Rollback ineffective while AutoCommit is on", -1;
- return 0;
-} # rollback
-
-# ====== Tie-Meta ==============================================================
-
-package DBI::DBD::SqlEngine::TieMeta;
-
-use Carp qw(croak);
-require Tie::Hash;
-@DBI::DBD::SqlEngine::TieMeta::ISA = qw(Tie::Hash);
-
-sub TIEHASH
-{
- my ( $class, $tblClass, $tblMeta ) = @_;
-
- my $self = bless(
- {
- tblClass => $tblClass,
- tblMeta => $tblMeta,
- },
- $class
- );
- return $self;
-} # new
-
-sub STORE
-{
- my ( $self, $meta_attr, $meta_val ) = @_;
-
- $self->{tblClass}->set_table_meta_attr( $self->{tblMeta}, $meta_attr, $meta_val );
-
- return;
-} # STORE
-
-sub FETCH
-{
- my ( $self, $meta_attr ) = @_;
-
- return $self->{tblClass}->get_table_meta_attr( $self->{tblMeta}, $meta_attr );
-} # FETCH
-
-sub FIRSTKEY
-{
- my $a = scalar keys %{ $_[0]->{tblMeta} };
- each %{ $_[0]->{tblMeta} };
-} # FIRSTKEY
-
-sub NEXTKEY
-{
- each %{ $_[0]->{tblMeta} };
-} # NEXTKEY
-
-sub EXISTS
-{
- exists $_[0]->{tblMeta}{ $_[1] };
-} # EXISTS
-
-sub DELETE
-{
- croak "Can't delete single attributes from table meta structure";
-} # DELETE
-
-sub CLEAR
-{
- %{ $_[0]->{tblMeta} } = ();
-} # CLEAR
-
-sub SCALAR
-{
- scalar %{ $_[0]->{tblMeta} };
-} # SCALAR
-
-# ====== Tie-Tables ============================================================
-
-package DBI::DBD::SqlEngine::TieTables;
-
-use Carp qw(croak);
-require Tie::Hash;
-@DBI::DBD::SqlEngine::TieTables::ISA = qw(Tie::Hash);
-
-sub TIEHASH
-{
- my ( $class, $dbh ) = @_;
-
- ( my $tbl_class = $dbh->{ImplementorClass} ) =~ s/::db$/::Table/;
- my $self = bless(
- {
- dbh => $dbh,
- tblClass => $tbl_class,
- },
- $class
- );
- return $self;
-} # new
-
-sub STORE
-{
- my ( $self, $table, $tbl_meta ) = @_;
-
- "HASH" eq ref $tbl_meta
- or croak "Invalid data for storing as table meta data (must be hash)";
-
- ( undef, my $meta ) = $self->{tblClass}->get_table_meta( $self->{dbh}, $table, 1 );
- $meta or croak "Invalid table name '$table'";
-
- while ( my ( $meta_attr, $meta_val ) = each %$tbl_meta )
- {
- $self->{tblClass}->set_table_meta_attr( $meta, $meta_attr, $meta_val );
- }
-
- return;
-} # STORE
-
-sub FETCH
-{
- my ( $self, $table ) = @_;
-
- ( undef, my $meta ) = $self->{tblClass}->get_table_meta( $self->{dbh}, $table, 1 );
- $meta or croak "Invalid table name '$table'";
-
- my %h;
- tie %h, "DBI::DBD::SqlEngine::TieMeta", $self->{tblClass}, $meta;
-
- return \%h;
-} # FETCH
-
-sub FIRSTKEY
-{
- my $a = scalar keys %{ $_[0]->{dbh}->{sql_meta} };
- each %{ $_[0]->{dbh}->{sql_meta} };
-} # FIRSTKEY
-
-sub NEXTKEY
-{
- each %{ $_[0]->{dbh}->{sql_meta} };
-} # NEXTKEY
-
-sub EXISTS
-{
- exists $_[0]->{dbh}->{sql_meta}->{ $_[1] }
- or exists $_[0]->{dbh}->{sql_meta_map}->{ $_[1] };
-} # EXISTS
-
-sub DELETE
-{
- my ( $self, $table ) = @_;
-
- ( undef, my $meta ) = $self->{tblClass}->get_table_meta( $self->{dbh}, $table, 1 );
- $meta or croak "Invalid table name '$table'";
-
- delete $_[0]->{dbh}->{sql_meta}->{ $meta->{table_name} };
-} # DELETE
-
-sub CLEAR
-{
- %{ $_[0]->{dbh}->{sql_meta} } = ();
- %{ $_[0]->{dbh}->{sql_meta_map} } = ();
-} # CLEAR
-
-sub SCALAR
-{
- scalar %{ $_[0]->{dbh}->{sql_meta} };
-} # SCALAR
-
-# ====== STATEMENT =============================================================
-
-package DBI::DBD::SqlEngine::st;
-
-use strict;
-use warnings;
-
-use vars qw(@ISA $imp_data_size);
-
-$imp_data_size = 0;
-
-sub bind_param ($$$;$)
-{
- my ( $sth, $pNum, $val, $attr ) = @_;
- if ( $attr && defined $val )
- {
- my $type = ref $attr eq "HASH" ? $attr->{TYPE} : $attr;
- if ( $type == DBI::SQL_BIGINT()
- || $type == DBI::SQL_INTEGER()
- || $type == DBI::SQL_SMALLINT()
- || $type == DBI::SQL_TINYINT() )
- {
- $val += 0;
- }
- elsif ( $type == DBI::SQL_DECIMAL()
- || $type == DBI::SQL_DOUBLE()
- || $type == DBI::SQL_FLOAT()
- || $type == DBI::SQL_NUMERIC()
- || $type == DBI::SQL_REAL() )
- {
- $val += 0.;
- }
- else
- {
- $val = "$val";
- }
- }
- $sth->{sql_params}[ $pNum - 1 ] = $val;
- return 1;
-} # bind_param
-
-sub execute
-{
- my $sth = shift;
- my $params = @_ ? ( $sth->{sql_params} = [@_] ) : $sth->{sql_params};
-
- $sth->finish;
- my $stmt = $sth->{sql_stmt};
-
- # must not proved when already executed - SQL::Statement modifies
- # received params
- unless ( $sth->{sql_params_checked}++ )
- {
- # SQL::Statement and DBI::SQL::Nano will return the list of required params
- # when called in list context. Do not look into the several items, they're
- # implementation specific and may change without warning
- unless ( ( my $req_prm = $stmt->params() ) == ( my $nparm = @$params ) )
- {
- my $msg = "You passed $nparm parameters where $req_prm required";
- return $sth->set_err( $DBI::stderr, $msg );
- }
- }
-
- my @err;
- my $result;
- eval {
- local $SIG{__WARN__} = sub { push @err, @_ };
- $result = $stmt->execute( $sth, $params );
- };
- unless ( defined $result )
- {
- $sth->set_err( $DBI::stderr, $@ || $stmt->{errstr} || $err[0] );
- return;
- }
-
- if ( $stmt->{NUM_OF_FIELDS} )
- { # is a SELECT statement
- $sth->STORE( Active => 1 );
- $sth->FETCH("NUM_OF_FIELDS")
- or $sth->STORE( "NUM_OF_FIELDS", $stmt->{NUM_OF_FIELDS} );
- }
- return $result;
-} # execute
-
-sub finish
-{
- my $sth = $_[0];
- $sth->SUPER::STORE( Active => 0 );
- delete $sth->{sql_stmt}{data};
- return 1;
-} # finish
-
-sub fetch ($)
-{
- my $sth = $_[0];
- my $data = $sth->{sql_stmt}{data};
- if ( !$data || ref $data ne "ARRAY" )
- {
- $sth->set_err(
- $DBI::stderr,
- "Attempt to fetch row without a preceding execute () call or from a non-SELECT statement"
- );
- return;
- }
- my $dav = shift @$data;
- unless ($dav)
- {
- $sth->finish;
- return;
- }
- if ( $sth->FETCH("ChopBlanks") ) # XXX: (TODO) Only chop on CHAR fields,
- { # not on VARCHAR or NUMERIC (see DBI docs)
- $_ && $_ =~ s/ +$// for @$dav;
- }
- return $sth->_set_fbav($dav);
-} # fetch
-
-no warnings 'once';
-*fetchrow_arrayref = \&fetch;
-
-use warnings;
-
-sub sql_get_colnames
-{
- my $sth = $_[0];
- # Being a bit dirty here, as neither SQL::Statement::Structure nor
- # DBI::SQL::Nano::Statement_ does not offer an interface to the
- # required data
- my @colnames;
- if ( $sth->{sql_stmt}->{NAME} and "ARRAY" eq ref( $sth->{sql_stmt}->{NAME} ) )
- {
- @colnames = @{ $sth->{sql_stmt}->{NAME} };
- }
- elsif ( $sth->{sql_stmt}->isa('SQL::Statement') )
- {
- my $stmt = $sth->{sql_stmt} || {};
- my @coldefs = @{ $stmt->{column_defs} || [] };
- @colnames = map { $_->{name} || $_->{value} } @coldefs;
- }
- @colnames = $sth->{sql_stmt}->column_names() unless (@colnames);
-
- @colnames = () if ( grep { m/\*/ } @colnames );
-
- return @colnames;
-}
-
-sub FETCH ($$)
-{
- my ( $sth, $attrib ) = @_;
-
- $attrib eq "NAME" and return [ $sth->sql_get_colnames() ];
-
- $attrib eq "TYPE" and return [ ( DBI::SQL_VARCHAR() ) x scalar $sth->sql_get_colnames() ];
- $attrib eq "TYPE_NAME" and return [ ("VARCHAR") x scalar $sth->sql_get_colnames() ];
- $attrib eq "PRECISION" and return [ (0) x scalar $sth->sql_get_colnames() ];
- $attrib eq "NULLABLE" and return [ (1) x scalar $sth->sql_get_colnames() ];
-
- if ( $attrib eq lc $attrib )
- {
- # Private driver attributes are lower cased
- return $sth->{$attrib};
- }
-
- # else pass up to DBI to handle
- return $sth->SUPER::FETCH($attrib);
-} # FETCH
-
-sub STORE ($$$)
-{
- my ( $sth, $attrib, $value ) = @_;
- if ( $attrib eq lc $attrib ) # Private driver attributes are lower cased
- {
- $sth->{$attrib} = $value;
- return 1;
- }
- return $sth->SUPER::STORE( $attrib, $value );
-} # STORE
-
-sub DESTROY ($)
-{
- my $sth = shift;
- $sth->SUPER::FETCH("Active") and $sth->finish;
- undef $sth->{sql_stmt};
- undef $sth->{sql_params};
-} # DESTROY
-
-sub rows ($)
-{
- return $_[0]->{sql_stmt}{NUM_OF_ROWS};
-} # rows
-
-# ====== TableSource ===========================================================
-
-package DBI::DBD::SqlEngine::TableSource;
-
-use strict;
-use warnings;
-
-use Carp;
-
-sub data_sources ($;$)
-{
- my ( $class, $drh, $attrs ) = @_;
- croak( ( ref( $_[0] ) ? ref( $_[0] ) : $_[0] ) . " must implement data_sources" );
-}
-
-sub avail_tables
-{
- my ( $self, $dbh ) = @_;
- croak( ( ref( $_[0] ) ? ref( $_[0] ) : $_[0] ) . " must implement avail_tables" );
-}
-
-# ====== DataSource ============================================================
-
-package DBI::DBD::SqlEngine::DataSource;
-
-use strict;
-use warnings;
-
-use Carp;
-
-sub complete_table_name ($$;$)
-{
- my ( $self, $meta, $table, $respect_case ) = @_;
- croak( ( ref( $_[0] ) ? ref( $_[0] ) : $_[0] ) . " must implement complete_table_name" );
-}
-
-sub open_data ($)
-{
- my ( $self, $meta, $attrs, $flags ) = @_;
- croak( ( ref( $_[0] ) ? ref( $_[0] ) : $_[0] ) . " must implement open_data" );
-}
-
-# ====== SQL::STATEMENT ========================================================
-
-package DBI::DBD::SqlEngine::Statement;
-
-use strict;
-use warnings;
-
-use Carp;
-
-@DBI::DBD::SqlEngine::Statement::ISA = qw(DBI::SQL::Nano::Statement);
-
-sub open_table ($$$$$)
-{
- my ( $self, $data, $table, $createMode, $lockMode ) = @_;
-
- my $class = ref $self;
- $class =~ s/::Statement/::Table/;
-
- my $flags = {
- createMode => $createMode,
- lockMode => $lockMode,
- };
- $self->{command} eq "DROP" and $flags->{dropMode} = 1;
-
- my ( $tblnm, $table_meta ) = $class->get_table_meta( $data->{Database}, $table, 1 )
- or croak "Cannot find appropriate meta for table '$table'";
-
- defined $table_meta->{sql_table_class} and $class = $table_meta->{sql_table_class};
-
- # because column name mapping is initialized in constructor ...
- # and therefore specific opening operations might be done before
- # reaching DBI::DBD::SqlEngine::Table->new(), we need to intercept
- # ReadOnly here
- my $write_op = $createMode || $lockMode || $flags->{dropMode};
- if ($write_op)
- {
- $table_meta->{readonly}
- and croak "Table '$table' is marked readonly - "
- . $self->{command}
- . ( $lockMode ? " with locking" : "" )
- . " command forbidden";
- }
-
- return $class->new( $data, { table => $table }, $flags );
-} # open_table
-
-# ====== SQL::TABLE ============================================================
-
-package DBI::DBD::SqlEngine::Table;
-
-use strict;
-use warnings;
-
-use Carp;
-
-@DBI::DBD::SqlEngine::Table::ISA = qw(DBI::SQL::Nano::Table);
-
-sub bootstrap_table_meta
-{
- my ( $self, $dbh, $meta, $table ) = @_;
-
- defined $dbh->{ReadOnly}
- and !defined( $meta->{readonly} )
- and $meta->{readonly} = $dbh->{ReadOnly};
- defined $meta->{sql_identifier_case}
- or $meta->{sql_identifier_case} = $dbh->{sql_identifier_case};
-
- exists $meta->{sql_data_source} or $meta->{sql_data_source} = $dbh->{sql_data_source};
-
- $meta;
-}
-
-sub init_table_meta
-{
- my ( $self, $dbh, $meta, $table ) = @_ if (0);
-
- return;
-} # init_table_meta
-
-sub get_table_meta ($$$;$)
-{
- my ( $self, $dbh, $table, $respect_case, @other ) = @_;
- unless ( defined $respect_case )
- {
- $respect_case = 0;
- $table =~ s/^\"// and $respect_case = 1; # handle quoted identifiers
- $table =~ s/\"$//;
- }
-
- unless ($respect_case)
- {
- defined $dbh->{sql_meta_map}{$table} and $table = $dbh->{sql_meta_map}{$table};
- }
-
- my $meta = {};
- defined $dbh->{sql_meta}{$table} and $meta = $dbh->{sql_meta}{$table};
-
- do_initialize:
- unless ( $meta->{initialized} )
- {
- $self->bootstrap_table_meta( $dbh, $meta, $table, @other );
- $meta->{sql_data_source}->complete_table_name( $meta, $table, $respect_case, @other )
- or return;
-
- if ( defined $meta->{table_name} and $table ne $meta->{table_name} )
- {
- $dbh->{sql_meta_map}{$table} = $meta->{table_name};
- $table = $meta->{table_name};
- }
-
- # now we know a bit more - let's check if user can't use consequent spelling
- # XXX add know issue about reset sql_identifier_case here ...
- if ( defined $dbh->{sql_meta}{$table} )
- {
- $meta = delete $dbh->{sql_meta}{$table}; # avoid endless loop
- $meta->{initialized}
- or goto do_initialize;
- #or $meta->{sql_data_source}->complete_table_name( $meta, $table, $respect_case, @other )
- #or return;
- }
-
- unless ( $dbh->{sql_meta}{$table}{initialized} )
- {
- $self->init_table_meta( $dbh, $meta, $table );
- $meta->{initialized} = 1;
- $dbh->{sql_meta}{$table} = $meta;
- }
- }
-
- return ( $table, $meta );
-} # get_table_meta
-
-my %reset_on_modify = ();
-my %compat_map = ();
-
-sub register_reset_on_modify
-{
- my ( $proto, $extra_resets ) = @_;
- foreach my $cv ( keys %$extra_resets )
- {
- #%reset_on_modify = ( %reset_on_modify, %$extra_resets );
- push @{ $reset_on_modify{$cv} },
- ref $extra_resets->{$cv} ? @{ $extra_resets->{$cv} } : ( $extra_resets->{$cv} );
- }
- return;
-} # register_reset_on_modify
-
-sub register_compat_map
-{
- my ( $proto, $extra_compat_map ) = @_;
- %compat_map = ( %compat_map, %$extra_compat_map );
- return;
-} # register_compat_map
-
-sub get_table_meta_attr
-{
- my ( $class, $meta, $attrib ) = @_;
- exists $compat_map{$attrib}
- and $attrib = $compat_map{$attrib};
- exists $meta->{$attrib}
- and return $meta->{$attrib};
- return;
-} # get_table_meta_attr
-
-sub set_table_meta_attr
-{
- my ( $class, $meta, $attrib, $value ) = @_;
- exists $compat_map{$attrib}
- and $attrib = $compat_map{$attrib};
- $class->table_meta_attr_changed( $meta, $attrib, $value );
- $meta->{$attrib} = $value;
-} # set_table_meta_attr
-
-sub table_meta_attr_changed
-{
- my ( $class, $meta, $attrib, $value ) = @_;
- defined $reset_on_modify{$attrib}
- and delete @$meta{ @{ $reset_on_modify{$attrib} } }
- and $meta->{initialized} = 0;
-} # table_meta_attr_changed
-
-sub open_data
-{
- my ( $self, $meta, $attrs, $flags ) = @_;
-
- $meta->{sql_data_source}
- or croak "Table " . $meta->{table_name} . " not completely initialized";
- $meta->{sql_data_source}->open_data( $meta, $attrs, $flags );
-
- return;
-} # open_data
-
-# ====== SQL::Eval API =========================================================
-
-sub new
-{
- my ( $className, $data, $attrs, $flags ) = @_;
- my $dbh = $data->{Database};
-
- my ( $tblnm, $meta ) = $className->get_table_meta( $dbh, $attrs->{table}, 1 )
- or croak "Cannot find appropriate table '$attrs->{table}'";
- $attrs->{table} = $tblnm;
-
- # Being a bit dirty here, as SQL::Statement::Structure does not offer
- # me an interface to the data I want
- $flags->{createMode} && $data->{sql_stmt}{table_defs}
- and $meta->{table_defs} = $data->{sql_stmt}{table_defs};
-
- # open_file must be called before inherited new is invoked
- # because column name mapping is initialized in constructor ...
- $className->open_data( $meta, $attrs, $flags );
-
- my $tbl = {
- %{$attrs},
- meta => $meta,
- col_names => $meta->{col_names} || [],
- };
- return $className->SUPER::new($tbl);
-} # new
-
-sub DESTROY
-{
- my $self = shift;
- my $meta = $self->{meta};
- $self->{row} and undef $self->{row};
- ()
-}
-
-1;
-
-=pod
-
-=head1 NAME
-
-DBI::DBD::SqlEngine - Base class for DBI drivers without their own SQL engine
-
-=head1 SYNOPSIS
-
- package DBD::myDriver;
-
- use base qw(DBI::DBD::SqlEngine);
-
- sub driver
- {
- ...
- my $drh = $proto->SUPER::driver($attr);
- ...
- return $drh->{class};
- }
-
- package DBD::myDriver::dr;
-
- @ISA = qw(DBI::DBD::SqlEngine::dr);
-
- sub data_sources { ... }
- ...
-
- package DBD::myDriver::db;
-
- @ISA = qw(DBI::DBD::SqlEngine::db);
-
- sub init_valid_attributes { ... }
- sub init_default_attributes { ... }
- sub set_versions { ... }
- sub validate_STORE_attr { my ($dbh, $attrib, $value) = @_; ... }
- sub validate_FETCH_attr { my ($dbh, $attrib) = @_; ... }
- sub get_myd_versions { ... }
- sub get_avail_tables { ... }
-
- package DBD::myDriver::st;
-
- @ISA = qw(DBI::DBD::SqlEngine::st);
-
- sub FETCH { ... }
- sub STORE { ... }
-
- package DBD::myDriver::Statement;
-
- @ISA = qw(DBI::DBD::SqlEngine::Statement);
-
- sub open_table { ... }
-
- package DBD::myDriver::Table;
-
- @ISA = qw(DBI::DBD::SqlEngine::Table);
-
- sub new { ... }
-
-=head1 DESCRIPTION
-
-DBI::DBD::SqlEngine abstracts the usage of SQL engines from the
-DBD. DBD authors can concentrate on the data retrieval they want to
-provide.
-
-It is strongly recommended that you read L<DBD::File::Developers> and
-L<DBD::File::Roadmap>, because many of the DBD::File API is provided
-by DBI::DBD::SqlEngine.
-
-Currently the API of DBI::DBD::SqlEngine is experimental and will
-likely change in the near future to provide the table meta data basics
-like DBD::File.
-
-DBI::DBD::SqlEngine expects that any driver in inheritance chain has
-a L<DBI prefix|DBI::DBD/The_database_handle_constructor>.
-
-=head2 Metadata
-
-The following attributes are handled by DBI itself and not by
-DBI::DBD::SqlEngine, thus they all work as expected:
-
- Active
- ActiveKids
- CachedKids
- CompatMode (Not used)
- InactiveDestroy
- AutoInactiveDestroy
- Kids
- PrintError
- RaiseError
- Warn (Not used)
-
-=head3 The following DBI attributes are handled by DBI::DBD::SqlEngine:
-
-=head4 AutoCommit
-
-Always on.
-
-=head4 ChopBlanks
-
-Works.
-
-=head4 NUM_OF_FIELDS
-
-Valid after C<< $sth->execute >>.
-
-=head4 NUM_OF_PARAMS
-
-Valid after C<< $sth->prepare >>.
-
-=head4 NAME
-
-Valid after C<< $sth->execute >>; probably undef for Non-Select statements.
-
-=head4 NULLABLE
-
-Not really working, always returns an array ref of ones, as DBD::CSV
-does not verify input data. Valid after C<< $sth->execute >>; undef for
-non-select statements.
-
-=head3 The following DBI attributes and methods are not supported:
-
-=over 4
-
-=item bind_param_inout
-
-=item CursorName
-
-=item LongReadLen
-
-=item LongTruncOk
-
-=back
-
-=head3 DBI::DBD::SqlEngine specific attributes
-
-In addition to the DBI attributes, you can use the following dbh
-attributes:
-
-=head4 sql_engine_version
-
-Contains the module version of this driver (B<readonly>)
-
-=head4 sql_nano_version
-
-Contains the module version of DBI::SQL::Nano (B<readonly>)
-
-=head4 sql_statement_version
-
-Contains the module version of SQL::Statement, if available (B<readonly>)
-
-=head4 sql_handler
-
-Contains the SQL Statement engine, either DBI::SQL::Nano or SQL::Statement
-(B<readonly>).
-
-=head4 sql_parser_object
-
-Contains an instantiated instance of SQL::Parser (B<readonly>).
-This is filled when used first time (only when used with SQL::Statement).
-
-=head4 sql_sponge_driver
-
-Contains an internally used DBD::Sponge handle (B<readonly>).
-
-=head4 sql_valid_attrs
-
-Contains the list of valid attributes for each DBI::DBD::SqlEngine based
-driver (B<readonly>).
-
-=head4 sql_readonly_attrs
-
-Contains the list of those attributes which are readonly (B<readonly>).
-
-=head4 sql_identifier_case
-
-Contains how DBI::DBD::SqlEngine deals with non-quoted SQL identifiers:
-
- * SQL_IC_UPPER (1) means all identifiers are internally converted
- into upper-cased pendants
- * SQL_IC_LOWER (2) means all identifiers are internally converted
- into lower-cased pendants
- * SQL_IC_MIXED (4) means all identifiers are taken as they are
-
-These conversions happen if (and only if) no existing identifier matches.
-Once existing identifier is used as known.
-
-The SQL statement execution classes doesn't have to care, so don't expect
-C<sql_identifier_case> affects column names in statements like
-
- SELECT * FROM foo
-
-=head4 sql_quoted_identifier_case
-
-Contains how DBI::DBD::SqlEngine deals with quoted SQL identifiers
-(B<readonly>). It's fixated to SQL_IC_SENSITIVE (3), which is interpreted
-as SQL_IC_MIXED.
-
-=head4 sql_flags
-
-Contains additional flags to instantiate an SQL::Parser. Because an
-SQL::Parser is instantiated only once, it's recommended to set this flag
-before any statement is executed.
-
-=head4 sql_dialect
-
-Controls the dialect understood by SQL::Parser. Possible values (delivery
-state of SQL::Statement):
-
- * ANSI
- * CSV
- * AnyData
-
-Defaults to "CSV". Because an SQL::Parser is instantiated only once and
-SQL::Parser doesn't allow one to modify the dialect once instantiated,
-it's strongly recommended to set this flag before any statement is
-executed (best place is connect attribute hash).
-
-=head4 sql_engine_in_gofer
-
-This value has a true value in case of this driver is operated via
-L<DBD::Gofer>. The impact of being operated via Gofer is a read-only
-driver (not read-only databases!), so you cannot modify any attributes
-later - neither any table settings. B<But> you won't get an error in
-cases you modify table attributes, so please carefully watch
-C<sql_engine_in_gofer>.
-
-=head4 sql_meta
-
-Private data area which contains information about the tables this
-module handles. Table meta data might not be available until the
-table has been accessed for the first time e.g., by issuing a select
-on it however it is possible to pre-initialize attributes for each table
-you use.
-
-DBI::DBD::SqlEngine recognizes the (public) attributes C<col_names>,
-C<table_name>, C<readonly>, C<sql_data_source> and C<sql_identifier_case>.
-Be very careful when modifying attributes you do not know, the consequence
-might be a destroyed or corrupted table.
-
-While C<sql_meta> is a private and readonly attribute (which means, you
-cannot modify it's values), derived drivers might provide restricted
-write access through another attribute. Well known accessors are
-C<csv_tables> for L<DBD::CSV>, C<ad_tables> for L<DBD::AnyData> and
-C<dbm_tables> for L<DBD::DBM>.
-
-=head4 sql_table_source
-
-Controls the class which will be used for fetching available tables.
-
-See L</DBI::DBD::SqlEngine::TableSource> for details.
-
-=head4 sql_data_source
-
-Contains the class name to be used for opening tables.
-
-See L</DBI::DBD::SqlEngine::DataSource> for details.
-
-=head2 Driver private methods
-
-=head3 Default DBI methods
-
-=head4 data_sources
-
-The C<data_sources> method returns a list of subdirectories of the current
-directory in the form "dbi:CSV:f_dir=$dirname".
-
-If you want to read the subdirectories of another directory, use
-
- my ($drh) = DBI->install_driver ("CSV");
- my (@list) = $drh->data_sources (f_dir => "/usr/local/csv_data");
-
-=head4 list_tables
-
-This method returns a list of file names inside $dbh->{f_dir}.
-Example:
-
- my ($dbh) = DBI->connect ("dbi:CSV:f_dir=/usr/local/csv_data");
- my (@list) = $dbh->func ("list_tables");
-
-Note that the list includes all files contained in the directory, even
-those that have non-valid table names, from the view of SQL.
-
-=head3 Additional methods
-
-The following methods are only available via their documented name when
-DBI::DBD::SQlEngine is used directly. Because this is only reasonable for
-testing purposes, the real names must be used instead. Those names can be
-computed by replacing the C<sql_> in the method name with the driver prefix.
-
-=head4 sql_versions
-
-Signature:
-
- sub sql_versions (;$) {
- my ($table_name) = @_;
- $table_name ||= ".";
- ...
- }
-
-Returns the versions of the driver, including the DBI version, the Perl
-version, DBI::PurePerl version (if DBI::PurePerl is active) and the version
-of the SQL engine in use.
-
- my $dbh = DBI->connect ("dbi:File:");
- my $sql_versions = $dbh->func( "sql_versions" );
- print "$sql_versions\n";
- __END__
- # DBI::DBD::SqlEngine 0.05 using SQL::Statement 1.402
- # DBI 1.623
- # OS netbsd (6.99.12)
- # Perl 5.016002 (x86_64-netbsd-thread-multi)
-
-Called in list context, sql_versions will return an array containing each
-line as single entry.
-
-Some drivers might use the optional (table name) argument and modify
-version information related to the table (e.g. DBD::DBM provides storage
-backend information for the requested table, when it has a table name).
-
-=head4 sql_get_meta
-
-Signature:
-
- sub sql_get_meta ($$)
- {
- my ($table_name, $attrib) = @_;
- ...
- }
-
-Returns the value of a meta attribute set for a specific table, if any.
-See L<sql_meta> for the possible attributes.
-
-A table name of C<"."> (single dot) is interpreted as the default table.
-This will retrieve the appropriate attribute globally from the dbh.
-This has the same restrictions as C<< $dbh->{$attrib} >>.
-
-=head4 sql_set_meta
-
-Signature:
-
- sub sql_set_meta ($$$)
- {
- my ($table_name, $attrib, $value) = @_;
- ...
- }
-
-Sets the value of a meta attribute set for a specific table.
-See L<sql_meta> for the possible attributes.
-
-A table name of C<"."> (single dot) is interpreted as the default table
-which will set the specified attribute globally for the dbh.
-This has the same restrictions as C<< $dbh->{$attrib} = $value >>.
-
-=head4 sql_clear_meta
-
-Signature:
-
- sub sql_clear_meta ($)
- {
- my ($table_name) = @_;
- ...
- }
-
-Clears the table specific meta information in the private storage of the
-dbh.
-
-=head2 Extensibility
-
-=head3 DBI::DBD::SqlEngine::TableSource
-
-Provides data sources and table information on database driver and database
-handle level.
-
- package DBI::DBD::SqlEngine::TableSource;
-
- sub data_sources ($;$)
- {
- my ( $class, $drh, $attrs ) = @_;
- ...
- }
-
- sub avail_tables
- {
- my ( $class, $drh ) = @_;
- ...
- }
-
-The C<data_sources> method is called when the user invokes any of the
-following:
-
- @ary = DBI->data_sources($driver);
- @ary = DBI->data_sources($driver, \%attr);
-
- @ary = $dbh->data_sources();
- @ary = $dbh->data_sources(\%attr);
-
-The C<avail_tables> method is called when the user invokes any of the
-following:
-
- @names = $dbh->tables( $catalog, $schema, $table, $type );
-
- $sth = $dbh->table_info( $catalog, $schema, $table, $type );
- $sth = $dbh->table_info( $catalog, $schema, $table, $type, \%attr );
-
- $dbh->func( "list_tables" );
-
-Every time where an C<\%attr> argument can be specified, this C<\%attr>
-object's C<sql_table_source> attribute is preferred over the C<$dbh>
-attribute or the driver default, eg.
-
- @ary = DBI->data_sources("dbi:CSV:", {
- f_dir => "/your/csv/tables",
- # note: this class doesn't comes with DBI
- sql_table_source => "DBD::File::Archive::Tar::TableSource",
- # scan tarballs instead of directories
- });
-
-When you're going to implement such a DBD::File::Archive::Tar::TableSource
-class, remember to add correct attributes (including C<sql_table_source>
-and C<sql_data_source>) to the returned DSN's.
-
-=head3 DBI::DBD::SqlEngine::DataSource
-
-Provides base functionality for dealing with tables. It is primarily
-designed for allowing transparent access to files on disk or already
-opened (file-)streams (eg. for DBD::CSV).
-
-Derived classes shall be restricted to similar functionality, too (eg.
-opening streams from an archive, transparently compress/uncompress
-log files before parsing them,
-
- package DBI::DBD::SqlEngine::DataSource;
-
- sub complete_table_name ($$;$)
- {
- my ( $self, $meta, $table, $respect_case ) = @_;
- ...
- }
-
-The method C<complete_table_name> is called when first setting up the
-I<meta information> for a table:
-
- "SELECT user.id, user.name, user.shell FROM user WHERE ..."
-
-results in opening the table C<user>. First step of the table open
-process is completing the name. Let's imagine you're having a L<DBD::CSV>
-handle with following settings:
-
- $dbh->{sql_identifier_case} = SQL_IC_LOWER;
- $dbh->{f_ext} = '.lst';
- $dbh->{f_dir} = '/data/web/adrmgr';
-
-Those settings will result in looking for files matching
-C<[Uu][Ss][Ee][Rr](\.lst)?$> in C</data/web/adrmgr/>. The scanning of the
-directory C</data/web/adrmgr/> and the pattern match check will be done
-in C<DBD::File::DataSource::File> by the C<complete_table_name> method.
-
-If you intend to provide other sources of data streams than files, in
-addition to provide an appropriate C<complete_table_name> method, a method
-to open the resource is required:
-
- package DBI::DBD::SqlEngine::DataSource;
-
- sub open_data ($)
- {
- my ( $self, $meta, $attrs, $flags ) = @_;
- ...
- }
-
-After the method C<open_data> has been run successfully, the table's meta
-information are in a state which allowes the table's data accessor methods
-will be able to fetch/store row information. Implementation details heavily
-depends on the table implementation, whereby the most famous is surely
-L<DBD::File::Table|DBD::File/DBD::File::Table>.
-
-=head1 SQL ENGINES
-
-DBI::DBD::SqlEngine currently supports two SQL engines:
-L<SQL::Statement|SQL::Statement> and
-L<DBI::SQL::Nano::Statement_|DBI::SQL::Nano>. DBI::SQL::Nano supports a
-I<very> limited subset of SQL statements, but it might be faster for some
-very simple tasks. SQL::Statement in contrast supports a much larger subset
-of ANSI SQL.
-
-To use SQL::Statement, you need at least version 1.401 of
-SQL::Statement and the environment variable C<DBI_SQL_NANO> must not
-be set to a true value.
-
-=head1 SUPPORT
-
-You can find documentation for this module with the perldoc command.
-
- perldoc DBI::DBD::SqlEngine
-
-You can also look for information at:
-
-=over 4
-
-=item * RT: CPAN's request tracker
-
-L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=DBI>
-L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=SQL-Statement>
-
-=item * AnnoCPAN: Annotated CPAN documentation
-
-L<http://annocpan.org/dist/DBI>
-L<http://annocpan.org/dist/SQL-Statement>
-
-=item * CPAN Ratings
-
-L<http://cpanratings.perl.org/d/DBI>
-
-=item * Search CPAN
-
-L<http://search.cpan.org/dist/DBI/>
-
-=back
-
-=head2 Where can I go for more help?
-
-For questions about installation or usage, please ask on the
-dbi-dev@perl.org mailing list.
-
-If you have a bug report, patch or suggestion, please open
-a new report ticket on CPAN, if there is not already one for
-the issue you want to report. Of course, you can mail any of the
-module maintainers, but it is less likely to be missed if
-it is reported on RT.
-
-Report tickets should contain a detailed description of the bug or
-enhancement request you want to report and at least an easy way to
-verify/reproduce the issue and any supplied fix. Patches are always
-welcome, too.
-
-=head1 ACKNOWLEDGEMENTS
-
-Thanks to Tim Bunce, Martin Evans and H.Merijn Brand for their continued
-support while developing DBD::File, DBD::DBM and DBD::AnyData.
-Their support, hints and feedback helped to design and implement this
-module.
-
-=head1 AUTHOR
-
-This module is currently maintained by
-
-H.Merijn Brand < h.m.brand at xs4all.nl > and
-Jens Rehsack < rehsack at googlemail.com >
-
-The original authors are Jochen Wiedmann and Jeff Zucker.
-
-=head1 COPYRIGHT AND LICENSE
-
- Copyright (C) 2009-2013 by H.Merijn Brand & Jens Rehsack
- Copyright (C) 2004-2009 by Jeff Zucker
- Copyright (C) 1998-2004 by Jochen Wiedmann
-
-All rights reserved.
-
-You may freely distribute and/or modify this module under the terms of
-either the GNU General Public License (GPL) or the Artistic License, as
-specified in the Perl README file.
-
-=head1 SEE ALSO
-
-L<DBI>, L<DBD::File>, L<DBD::AnyData> and L<DBD::Sys>.
-
-=cut
+++ /dev/null
-=head1 NAME
-
-DBI::DBD::SqlEngine::Developers - Developers documentation for DBI::DBD::SqlEngine
-
-=head1 SYNOPSIS
-
- package DBD::myDriver;
-
- use base qw(DBI::DBD::SqlEngine);
-
- sub driver
- {
- ...
- my $drh = $proto->SUPER::driver($attr);
- ...
- return $drh->{class};
- }
-
- sub CLONE { ... }
-
- package DBD::myDriver::dr;
-
- @ISA = qw(DBI::DBD::SqlEngine::dr);
-
- sub data_sources { ... }
- ...
-
- package DBD::myDriver::db;
-
- @ISA = qw(DBI::DBD::SqlEngine::db);
-
- sub init_valid_attributes { ... }
- sub init_default_attributes { ... }
- sub set_versions { ... }
- sub validate_STORE_attr { my ($dbh, $attrib, $value) = @_; ... }
- sub validate_FETCH_attr { my ($dbh, $attrib) = @_; ... }
- sub get_myd_versions { ... }
- sub get_avail_tables { ... }
-
- package DBD::myDriver::st;
-
- @ISA = qw(DBI::DBD::SqlEngine::st);
-
- sub FETCH { ... }
- sub STORE { ... }
-
- package DBD::myDriver::Statement;
-
- @ISA = qw(DBI::DBD::SqlEngine::Statement);
-
- sub open_table { ... }
-
- package DBD::myDriver::Table;
-
- @ISA = qw(DBI::DBD::SqlEngine::Table);
-
- my %reset_on_modify = (
- myd_abc => "myd_foo",
- myd_mno => "myd_bar",
- );
- __PACKAGE__->register_reset_on_modify( \%reset_on_modify );
- my %compat_map = (
- abc => 'foo_abc',
- xyz => 'foo_xyz',
- );
- __PACKAGE__->register_compat_map( \%compat_map );
-
- sub bootstrap_table_meta { ... }
- sub init_table_meta { ... }
- sub table_meta_attr_changed { ... }
- sub open_data { ... }
-
- sub new { ... }
-
- sub fetch_row { ... }
- sub push_row { ... }
- sub push_names { ... }
- sub seek { ... }
- sub truncate { ... }
- sub drop { ... }
-
- # optimize the SQL engine by add one or more of
- sub update_current_row { ... }
- # or
- sub update_specific_row { ... }
- # or
- sub update_one_row { ... }
- # or
- sub insert_new_row { ... }
- # or
- sub delete_current_row { ... }
- # or
- sub delete_one_row { ... }
-
-=head1 DESCRIPTION
-
-This document describes the interface of DBI::DBD::SqlEngine for DBD
-developers who write DBI::DBD::SqlEngine based DBI drivers. It supplements
-L<DBI::DBD> and L<DBI::DBD::SqlEngine::HowTo>, which you should read first.
-
-=head1 CLASSES
-
-Each DBI driver must provide a package global C<< driver >> method and
-three DBI related classes:
-
-=over 4
-
-=item DBI::DBD::SqlEngine::dr
-
-Driver package, contains the methods DBI calls indirectly via DBI
-interface:
-
- DBI->connect ('DBI:DBM:', undef, undef, {})
-
- # invokes
- package DBD::DBM::dr;
- @DBD::DBM::dr::ISA = qw(DBI::DBD::SqlEngine::dr);
-
- sub connect ($$;$$$)
- {
- ...
- }
-
-Similar for C<data_sources ()> and C<disconnect_all()>.
-
-Pure Perl DBI drivers derived from DBI::DBD::SqlEngine usually don't need to
-override any of the methods provided through the DBD::XXX::dr package.
-However if you need additional initialization not fitting in
-C<init_valid_attributes()> and C<init_default_attributes()> of you're ::db
-class, the connect method might be the final place to be modified.
-
-=item DBI::DBD::SqlEngine::db
-
-Contains the methods which are called through DBI database handles
-(C<< $dbh >>). e.g.,
-
- $sth = $dbh->prepare ("select * from foo");
- # returns the f_encoding setting for table foo
- $dbh->csv_get_meta ("foo", "f_encoding");
-
-DBI::DBD::SqlEngine provides the typical methods required here. Developers who
-write DBI drivers based on DBI::DBD::SqlEngine need to override the methods
-C<< set_versions >> and C<< init_valid_attributes >>.
-
-=item DBI::DBD::SqlEngine::TieMeta;
-
-Provides the tie-magic for C<< $dbh->{$drv_pfx . "_meta"} >>. Routes
-C<STORE> through C<< $drv->set_sql_engine_meta() >> and C<FETCH> through
-C<< $drv->get_sql_engine_meta() >>. C<DELETE> is not supported, you have
-to execute a C<DROP TABLE> statement, where applicable.
-
-=item DBI::DBD::SqlEngine::TieTables;
-
-Provides the tie-magic for tables in C<< $dbh->{$drv_pfx . "_meta"} >>.
-Routes C<STORE> though C<< $tblClass->set_table_meta_attr() >> and C<FETCH>
-though C<< $tblClass->get_table_meta_attr() >>. C<DELETE> removes an
-attribute from the I<meta object> retrieved by
-C<< $tblClass->get_table_meta() >>.
-
-=item DBI::DBD::SqlEngine::st
-
-Contains the methods to deal with prepared statement handles. e.g.,
-
- $sth->execute () or die $sth->errstr;
-
-=item DBI::DBD::SqlEngine::TableSource;
-
-Base class for 3rd party table sources:
-
- $dbh->{sql_table_source} = "DBD::Foo::TableSource";
-
-=item DBI::DBD::SqlEngine::DataSource;
-
-Base class for 3rd party data sources:
-
- $dbh->{sql_data_source} = "DBD::Foo::DataSource";
-
-=item DBI::DBD::SqlEngine::Statement;
-
-Base class for derived drivers statement engine. Implements C<open_table>.
-
-=item DBI::DBD::SqlEngine::Table;
-
-Contains tailoring between SQL engine's requirements and
-C<DBI::DBD::SqlEngine> magic for finding the right tables and storage.
-Builds bridges between C<sql_meta> handling of C<DBI::DBD::SqlEngine::db>,
-table initialization for SQL engines and I<meta object>'s attribute
-management for derived drivers.
-
-=back
-
-=head2 DBI::DBD::SqlEngine
-
-This is the main package containing the routines to initialize
-DBI::DBD::SqlEngine based DBI drivers. Primarily the
-C<< DBI::DBD::SqlEngine::driver >> method is invoked, either directly
-from DBI when the driver is initialized or from the derived class.
-
- package DBD::DBM;
-
- use base qw( DBI::DBD::SqlEngine );
-
- sub driver
- {
- my ( $class, $attr ) = @_;
- ...
- my $drh = $class->SUPER::driver( $attr );
- ...
- return $drh;
- }
-
-It is not necessary to implement your own driver method as long as
-additional initialization (e.g. installing more private driver
-methods) is not required. You do not need to call C<< setup_driver >>
-as DBI::DBD::SqlEngine takes care of it.
-
-=head2 DBI::DBD::SqlEngine::dr
-
-The driver package contains the methods DBI calls indirectly via the DBI
-interface (see L<DBI/DBI Class Methods>).
-
-DBI::DBD::SqlEngine based DBI drivers usually do not need to implement anything here,
-it is enough to do the basic initialization:
-
- package DBD:XXX::dr;
-
- @DBD::XXX::dr::ISA = qw (DBI::DBD::SqlEngine::dr);
- $DBD::XXX::dr::imp_data_size = 0;
- $DBD::XXX::dr::data_sources_attr = undef;
- $DBD::XXX::ATTRIBUTION = "DBD::XXX $DBD::XXX::VERSION by Hans Mustermann";
-
-=head3 Methods provided by C<< DBI::DBD::SqlEngine::dr >>:
-
-=over 4
-
-=item connect
-
-Supervises the driver bootstrap when calling
-
- DBI->connect( "dbi:Foo", , , { ... } );
-
-First it instantiates a new driver using C<DBI::_new_dbh>. After that,
-initial bootstrap of the newly instantiated driver is done by
-
- $dbh->func( 0, "init_default_attributes" );
-
-The first argument (C<0>) signals that this is the very first call to
-C<init_default_attributes>. Modern drivers understand that and do early
-stage setup here after calling
-
- package DBD::Foo::db;
- our @DBD::Foo::db::ISA = qw(DBI::DBD::SqlEngine::db);
-
- sub init_default_attributes
- {
- my ($dbh, $phase) = @_;
- $dbh->SUPER::init_default_attributes($phase);
- ...; # own setup code, maybe separated by phases
- }
-
-When the C<$phase> argument is passed down until
-C<DBI::DBD::SqlEngine::db::init_default_attributes>, C<connect()> recognizes
-a I<modern> driver and initializes the attributes from I<DSN> and I<$attr>
-arguments passed via C<< DBI->connect( $dsn, $user, $pass, \%attr ) >>.
-
-At the end of the attribute initialization after I<phase 0>, C<connect()>
-invoked C<init_default_attributes> again for I<phase 1>:
-
- $dbh->func( 1, "init_default_attributes" );
-
-=item data_sources
-
-Returns a list of I<DSN>'s using the C<data_sources> method of the
-class specified in C<< $dbh->{sql_table_source} >> or via C<\%attr>:
-
- @ary = DBI->data_sources($driver);
- @ary = DBI->data_sources($driver, \%attr);
-
-=item disconnect_all
-
-C<DBI::DBD::SqlEngine> doesn't have an overall driver cache, so nothing
-happens here at all.
-
-=back
-
-=head2 DBI::DBD::SqlEngine::db
-
-This package defines the database methods, which are called via the DBI
-database handle C<< $dbh >>.
-
-=head3 Methods provided by C<< DBI::DBD::SqlEngine::db >>:
-
-=over 4
-
-=item ping
-
-Simply returns the content of the C<< Active >> attribute. Override
-when your driver needs more complicated actions here.
-
-=item prepare
-
-Prepares a new SQL statement to execute. Returns a statement handle,
-C<< $sth >> - instance of the DBD:XXX::st. It is neither required nor
-recommended to override this method.
-
-=item validate_FETCH_attr
-
-Called by C<FETCH> to allow inherited drivers do their own attribute
-name validation. Calling convention is similar to C<FETCH> and the
-return value is the approved attribute name.
-
- return $validated_attribute_name;
-
-In case of validation fails (e.g. accessing private attribute or similar),
-C<validate_FETCH_attr> is permitted to throw an exception.
-
-=item FETCH
-
-Fetches an attribute of a DBI database object. Private handle attributes
-must have a prefix (this is mandatory). If a requested attribute is
-detected as a private attribute without a valid prefix, the driver prefix
-(written as C<$drv_prefix>) is added.
-
-The driver prefix is extracted from the attribute name and verified against
-C<< $dbh->{ $drv_prefix . "valid_attrs" } >> (when it exists). If the
-requested attribute value is not listed as a valid attribute, this method
-croaks. If the attribute is valid and readonly (listed in C<< $dbh->{
-$drv_prefix . "readonly_attrs" } >> when it exists), a real copy of the
-attribute value is returned. So it's not possible to modify
-C<f_valid_attrs> from outside of DBI::DBD::SqlEngine::db or a derived class.
-
-=item validate_STORE_attr
-
-Called by C<STORE> to allow inherited drivers do their own attribute
-name validation. Calling convention is similar to C<STORE> and the
-return value is the approved attribute name followed by the approved
-new value.
-
- return ($validated_attribute_name, $validated_attribute_value);
-
-In case of validation fails (e.g. accessing private attribute or similar),
-C<validate_STORE_attr> is permitted to throw an exception
-(C<DBI::DBD::SqlEngine::db::validate_STORE_attr> throws an exception when
-someone tries to assign value other than C<SQL_IC_UPPER .. SQL_IC_MIXED>
-to C<< $dbh->{sql_identifier_case} >> or
-C<< $dbh->{sql_quoted_identifier_case} >>).
-
-=item STORE
-
-Stores a database private attribute. Private handle attributes must have a
-prefix (this is mandatory). If a requested attribute is detected as a private
-attribute without a valid prefix, the driver prefix (written as
-C<$drv_prefix>) is added. If the database handle has an attribute
-C<${drv_prefix}_valid_attrs> - for attribute names which are not listed in
-that hash, this method croaks. If the database handle has an attribute
-C<${drv_prefix}_readonly_attrs>, only attributes which are not listed there
-can be stored (once they are initialized). Trying to overwrite such an
-immutable attribute forces this method to croak.
-
-An example of a valid attributes list can be found in
-C<< DBI::DBD::SqlEngine::db::init_valid_attributes >>.
-
-=item set_versions
-
-This method sets the attributes C<< f_version >>, C<< sql_nano_version >>,
-C<< sql_statement_version >> and (if not prohibited by a restrictive
-C<< ${prefix}_valid_attrs >>) C<< ${prefix}_version >>.
-
-This method is called at the end of the C<< connect () >> phase.
-
-When overriding this method, do not forget to invoke the superior one.
-
-=item init_valid_attributes
-
-This method is called after the database handle is instantiated as the
-first attribute initialization.
-
-C<< DBI::DBD::SqlEngine::db::init_valid_attributes >> initializes the
-attributes C<sql_valid_attrs> and C<sql_readonly_attrs>.
-
-When overriding this method, do not forget to invoke the superior one,
-preferably before doing anything else.
-
-=item init_default_attributes
-
-This method is called after the database handle is instantiated to
-initialize the default attributes. It expects one argument: C<$phase>.
-If C<$phase> is not given, C<connect> of C<DBI::DBD::SqlEngine::dr>
-expects this is an old-fashioned driver which isn't capable of multi-phased
-initialization.
-
-C<< DBI::DBD::SqlEngine::db::init_default_attributes >> initializes the
-attributes C<sql_identifier_case>, C<sql_quoted_identifier_case>,
-C<sql_handler>, C<sql_init_order>, C<sql_meta>, C<sql_engine_version>,
-C<sql_nano_version> and C<sql_statement_version> when L<SQL::Statement>
-is available.
-
-It sets C<sql_init_order> to the given C<$phase>.
-
-When the derived implementor class provides the attribute to validate
-attributes (e.g. C<< $dbh->{dbm_valid_attrs} = {...}; >>) or the attribute
-containing the immutable attributes (e.g. C<< $dbh->{dbm_readonly_attrs}
-= {...}; >>), the attributes C<drv_valid_attrs>, C<drv_readonly_attrs> and
-C<drv_version> are added (when available) to the list of valid and
-immutable attributes (where C<drv_> is interpreted as the driver prefix).
-
-=item get_versions
-
-This method is called by the code injected into the instantiated driver to
-provide the user callable driver method C<< ${prefix}versions >> (e.g.
-C<< dbm_versions >>, C<< csv_versions >>, ...).
-
-The DBI::DBD::SqlEngine implementation returns all version information known by
-DBI::DBD::SqlEngine (e.g. DBI version, Perl version, DBI::DBD::SqlEngine version and
-the SQL handler version).
-
-C<get_versions> takes the C<$dbh> as the first argument and optionally a
-second argument containing a table name. The second argument is not
-evaluated in C<< DBI::DBD::SqlEngine::db::get_versions >> itself - but
-might be in the future.
-
-If the derived implementor class provides a method named
-C<get_${drv_prefix}versions>, this is invoked and the return value of
-it is associated to the derived driver name:
-
- if (my $dgv = $dbh->{ImplementorClass}->can ("get_" . $drv_prefix . "versions") {
- (my $derived_driver = $dbh->{ImplementorClass}) =~ s/::db$//;
- $versions{$derived_driver} = &$dgv ($dbh, $table);
- }
-
-Override it to add more version information about your module, (e.g.
-some kind of parser version in case of DBD::CSV, ...), if one line is not
-enough room to provide all relevant information.
-
-=item sql_parser_object
-
-Returns a L<SQL::Parser> instance, when C<< sql_handler >> is set to
-"SQL::Statement". The parser instance is stored in C<< sql_parser_object >>.
-
-It is not recommended to override this method.
-
-=item disconnect
-
-Disconnects from a database. All local table information is discarded and
-the C<< Active >> attribute is set to 0.
-
-=item type_info_all
-
-Returns information about all the types supported by DBI::DBD::SqlEngine.
-
-=item table_info
-
-Returns a statement handle which is prepared to deliver information about
-all known tables.
-
-=item list_tables
-
-Returns a list of all known table names.
-
-=item quote
-
-Quotes a string for use in SQL statements.
-
-=item commit
-
-Warns about a useless call (if warnings enabled) and returns.
-DBI::DBD::SqlEngine is typically a driver which commits every action
-instantly when executed.
-
-=item rollback
-
-Warns about a useless call (if warnings enabled) and returns.
-DBI::DBD::SqlEngine is typically a driver which commits every action
-instantly when executed.
-
-=back
-
-=head3 Attributes used by C<< DBI::DBD::SqlEngine::db >>:
-
-This section describes attributes which are important to developers of DBI
-Database Drivers derived from C<DBI::DBD::SqlEngine>.
-
-=over 4
-
-=item sql_init_order
-
-This attribute contains a hash with priorities as key and an array
-containing the C<$dbh> attributes to be initialized during before/after
-other attributes.
-
-C<DBI::DBD::SqlEngine> initializes following attributes:
-
- $dbh->{sql_init_order} = {
- 0 => [qw( Profile RaiseError PrintError AutoCommit )],
- 90 => [ "sql_meta", $dbh->{$drv_pfx_meta} ? $dbh->{$drv_pfx_meta} : () ]
- }
-
-The default priority of not listed attribute keys is C<50>. It is well
-known that a lot of attributes needed to be set before some table settings
-are initialized. For example, for L<DBD::DBM>, when using
-
- my $dbh = DBI->connect( "dbi:DBM:", undef, undef, {
- f_dir => "/path/to/dbm/databases",
- dbm_type => "BerkeleyDB",
- dbm_mldbm => "JSON", # use MLDBM::Serializer::JSON
- dbm_tables => {
- quick => {
- dbm_type => "GDBM_File",
- dbm_MLDBM => "FreezeThaw"
- }
- }
- });
-
-This defines a known table C<quick> which uses the L<GDBM_File> backend and
-L<FreezeThaw> as serializer instead of the overall default L<BerkeleyDB> and
-L<JSON>. B<But> all files containing the table data have to be searched in
-C<< $dbh->{f_dir} >>, which requires C<< $dbh->{f_dir} >> must be initialized
-before C<< $dbh->{sql_meta}->{quick} >> is initialized by
-C<bootstrap_table_meta> method of L</DBI::DBD::SqlEngine::Table> to get
-C<< $dbh->{sql_meta}->{quick}->{f_dir} >> being initialized properly.
-
-=item sql_init_phase
-
-This attribute is only set during the initialization steps of the DBI
-Database Driver. It contains the value of the currently run initialization
-phase. Currently supported phases are I<phase 0> and I<phase 1>. This
-attribute is set in C<init_default_attributes> and removed in C<init_done>.
-
-=item sql_engine_in_gofer
-
-This value has a true value in case of this driver is operated via
-L<DBD::Gofer>. The impact of being operated via Gofer is a read-only
-driver (not read-only databases!), so you cannot modify any attributes
-later - neither any table settings. B<But> you won't get an error in
-cases you modify table attributes, so please carefully watch
-C<sql_engine_in_gofer>.
-
-=item sql_table_source
-
-Names a class which is responsible for delivering I<data sources> and
-I<available tables> (Database Driver related). I<data sources> here
-refers to L<DBI/data_sources>, not C<sql_data_source>.
-
-See L</DBI::DBD::SqlEngine::TableSource> for details.
-
-=item sql_data_source
-
-Name a class which is responsible for handling table resources open
-and completing table names requested via SQL statements.
-
-See L</DBI::DBD::SqlEngine::DataSource> for details.
-
-=item sql_dialect
-
-Controls the dialect understood by SQL::Parser. Possible values (delivery
-state of SQL::Statement):
-
- * ANSI
- * CSV
- * AnyData
-
-Defaults to "CSV". Because an SQL::Parser is instantiated only once and
-SQL::Parser doesn't allow one to modify the dialect once instantiated,
-it's strongly recommended to set this flag before any statement is
-executed (best place is connect attribute hash).
-
-=back
-
-=head2 DBI::DBD::SqlEngine::st
-
-Contains the methods to deal with prepared statement handles:
-
-=over 4
-
-=item bind_param
-
-Common routine to bind placeholders to a statement for execution. It
-is dangerous to override this method without detailed knowledge about
-the DBI::DBD::SqlEngine internal storage structure.
-
-=item execute
-
-Executes a previously prepared statement (with placeholders, if any).
-
-=item finish
-
-Finishes a statement handle, discards all buffered results. The prepared
-statement is not discarded so the statement can be executed again.
-
-=item fetch
-
-Fetches the next row from the result-set. This method may be rewritten
-in a later version and if it's overridden in a derived class, the
-derived implementation should not rely on the storage details.
-
-=item fetchrow_arrayref
-
-Alias for C<< fetch >>.
-
-=item FETCH
-
-Fetches statement handle attributes. Supported attributes (for full overview
-see L<DBI/Statement Handle Attributes>) are C<NAME>, C<TYPE>, C<PRECISION>
-and C<NULLABLE>. Each column is returned as C<NULLABLE> which might be wrong
-depending on the derived backend storage. If the statement handle has
-private attributes, they can be fetched using this method, too. B<Note> that
-statement attributes are not associated with any table used in this statement.
-
-This method usually requires extending in a derived implementation.
-See L<DBD::CSV> or L<DBD::DBM> for some example.
-
-=item STORE
-
-Allows storing of statement private attributes. No special handling is
-currently implemented here.
-
-=item rows
-
-Returns the number of rows affected by the last execute. This method might
-return C<undef>.
-
-=back
-
-=head2 DBI::DBD::SqlEngine::TableSource
-
-Provides data sources and table information on database driver and database
-handle level.
-
- package DBI::DBD::SqlEngine::TableSource;
-
- sub data_sources ($;$)
- {
- my ( $class, $drh, $attrs ) = @_;
- ...
- }
-
- sub avail_tables
- {
- my ( $class, $drh ) = @_;
- ...
- }
-
-The C<data_sources> method is called when the user invokes any of the
-following:
-
- @ary = DBI->data_sources($driver);
- @ary = DBI->data_sources($driver, \%attr);
-
- @ary = $dbh->data_sources();
- @ary = $dbh->data_sources(\%attr);
-
-The C<avail_tables> method is called when the user invokes any of the
-following:
-
- @names = $dbh->tables( $catalog, $schema, $table, $type );
-
- $sth = $dbh->table_info( $catalog, $schema, $table, $type );
- $sth = $dbh->table_info( $catalog, $schema, $table, $type, \%attr );
-
- $dbh->func( "list_tables" );
-
-Every time where an C<\%attr> argument can be specified, this C<\%attr>
-object's C<sql_table_source> attribute is preferred over the C<$dbh>
-attribute or the driver default.
-
-=head2 DBI::DBD::SqlEngine::DataSource
-
-Provides base functionality for dealing with tables. It is primarily
-designed for allowing transparent access to files on disk or already
-opened (file-)streams (e.g. for DBD::CSV).
-
-Derived classes shall be restricted to similar functionality, too (e.g.
-opening streams from an archive, transparently compress/uncompress
-log files before parsing them,
-
- package DBI::DBD::SqlEngine::DataSource;
-
- sub complete_table_name ($$;$)
- {
- my ( $self, $meta, $table, $respect_case ) = @_;
- ...
- }
-
-The method C<complete_table_name> is called when first setting up the
-I<meta information> for a table:
-
- "SELECT user.id, user.name, user.shell FROM user WHERE ..."
-
-results in opening the table C<user>. First step of the table open
-process is completing the name. Let's imagine you're having a L<DBD::CSV>
-handle with following settings:
-
- $dbh->{sql_identifier_case} = SQL_IC_LOWER;
- $dbh->{f_ext} = '.lst';
- $dbh->{f_dir} = '/data/web/adrmgr';
-
-Those settings will result in looking for files matching
-C<[Uu][Ss][Ee][Rr](\.lst)?$> in C</data/web/adrmgr/>. The scanning of the
-directory C</data/web/adrmgr/> and the pattern match check will be done
-in C<DBD::File::DataSource::File> by the C<complete_table_name> method.
-
-If you intend to provide other sources of data streams than files, in
-addition to provide an appropriate C<complete_table_name> method, a method
-to open the resource is required:
-
- package DBI::DBD::SqlEngine::DataSource;
-
- sub open_data ($)
- {
- my ( $self, $meta, $attrs, $flags ) = @_;
- ...
- }
-
-After the method C<open_data> has been run successfully, the table's meta
-information are in a state which allows the table's data accessor methods
-will be able to fetch/store row information. Implementation details heavily
-depends on the table implementation, whereby the most famous is surely
-L<DBD::File::Table|DBD::File/DBD::File::Table>.
-
-=head2 DBI::DBD::SqlEngine::Statement
-
-Derives from DBI::SQL::Nano::Statement for unified naming when deriving
-new drivers. No additional feature is provided from here.
-
-=head2 DBI::DBD::SqlEngine::Table
-
-Derives from DBI::SQL::Nano::Table for unified naming when deriving
-new drivers.
-
-You should consult the documentation of C<< SQL::Eval::Table >> (see
-L<SQL::Eval>) to get more information about the abstract methods of the
-table's base class you have to override and a description of the table
-meta information expected by the SQL engines.
-
-=over 4
-
-=item bootstrap_table_meta
-
-Initializes a table meta structure. Can be safely overridden in a
-derived class, as long as the C<< SUPER >> method is called at the end
-of the overridden method.
-
-It copies the following attributes from the database into the table meta data
-C<< $dbh->{ReadOnly} >> into C<< $meta->{readonly} >>, C<sql_identifier_case>
-and C<sql_data_source> and makes them sticky to the table.
-
-This method should be called before you attempt to map between file
-name and table name to ensure the correct directory, extension etc. are
-used.
-
-=item init_table_meta
-
-Initializes more attributes of the table meta data - usually more
-expensive ones (e.g. those which require class instantiations) - when
-the file name and the table name could mapped.
-
-=item get_table_meta
-
-Returns the table meta data. If there are none for the required table,
-a new one is initialized. When after bootstrapping a new I<table_meta>
-and L<completing the table name|/DBI::DBD::SqlEngine::DataSource> a
-mapping can be established between an existing I<table_meta> and the
-new bootstrapped one, the already existing is used and a mapping
-shortcut between the recent used table name and the already known
-table name is hold in C<< $dbh->{sql_meta_map} >>. When it fails,
-nothing is returned. On success, the name of the table and the meta data
-structure is returned.
-
-=item get_table_meta_attr
-
-Returns a single attribute from the table meta data. If the attribute
-name appears in C<%compat_map>, the attribute name is updated from
-there.
-
-=item set_table_meta_attr
-
-Sets a single attribute in the table meta data. If the attribute
-name appears in C<%compat_map>, the attribute name is updated from
-there.
-
-=item table_meta_attr_changed
-
-Called when an attribute of the meta data is modified.
-
-If the modified attribute requires to reset a calculated attribute, the
-calculated attribute is reset (deleted from meta data structure) and
-the I<initialized> flag is removed, too. The decision is made based on
-C<%register_reset_on_modify>.
-
-=item register_reset_on_modify
-
-Allows C<set_table_meta_attr> to reset meta attributes when special
-attributes are modified. For DBD::File, modifying one of C<f_file>, C<f_dir>,
-C<f_ext> or C<f_lockfile> will reset C<f_fqfn>. DBD::DBM extends the
-list for C<dbm_type> and C<dbm_mldbm> to reset the value of C<dbm_tietype>.
-
-If your DBD has calculated values in the meta data area, then call
-C<register_reset_on_modify>:
-
- my %reset_on_modify = ( "xxx_foo" => "xxx_bar" );
- __PACKAGE__->register_reset_on_modify( \%reset_on_modify );
-
-=item register_compat_map
-
-Allows C<get_table_meta_attr> and C<set_table_meta_attr> to update the
-attribute name to the current favored one:
-
- # from DBD::DBM
- my %compat_map = ( "dbm_ext" => "f_ext" );
- __PACKAGE__->register_compat_map( \%compat_map );
-
-=item open_data
-
-Called to open the table's data storage. This is silently forwarded
-to C<< $meta->{sql_data_source}->open_data() >>.
-
-After this is done, a derived class might add more steps in an overridden
-C<< open_file >> method.
-
-=item new
-
-Instantiates the table. This is done in 3 steps:
-
- 1. get the table meta data
- 2. open the data file
- 3. bless the table data structure using inherited constructor new
-
-It is not recommended to override the constructor of the table class.
-Find a reasonable place to add you extensions in one of the above four
-methods.
-
-=back
-
-=head1 AUTHOR
-
-The module DBI::DBD::SqlEngine is currently maintained by
-
-H.Merijn Brand < h.m.brand at xs4all.nl > and
-Jens Rehsack < rehsack at googlemail.com >
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright (C) 2010 by H.Merijn Brand & Jens Rehsack
-
-All rights reserved.
-
-You may freely distribute and/or modify this module under the terms of
-either the GNU General Public License (GPL) or the Artistic License, as
-specified in the Perl README file.
-
-=cut
+++ /dev/null
-=head1 NAME
-
-DBI::DBD::SqlEngine::HowTo - Guide to create DBI::DBD::SqlEngine based driver
-
-=head1 SYNOPSIS
-
- perldoc DBI::DBD::SqlEngine::HowTo
- perldoc DBI
- perldoc DBI::DBD
- perldoc DBI::DBD::SqlEngine::Developers
- perldoc SQL::Eval
- perldoc DBI::DBD::SqlEngine
- perldoc DBI::DBD::SqlEngine::HowTo
- perldoc SQL::Statement::Embed
-
-=head1 DESCRIPTION
-
-This document provides a step-by-step guide, how to create a new
-C<DBI::DBD::SqlEngine> based DBD. It expects that you carefully read the
-L<DBI> documentation and that you're familiar with L<DBI::DBD> and had
-read and understood L<DBD::ExampleP>.
-
-This document addresses experienced developers who are really sure that
-they need to invest time when writing a new DBI Driver. Writing a DBI
-Driver is neither a weekend project nor an easy job for hobby coders
-after work. Expect one or two man-month of time for the first start.
-
-Those who are still reading, should be able to sing the rules of
-L<DBI::DBD/CREATING A NEW DRIVER>.
-
-=head1 CREATING DRIVER CLASSES
-
-Do you have an entry in DBI's DBD registry? DBI::DBD::SqlEngine expect
-having a unique prefix for every driver class in inheritance chain.
-
-It's easy to get a prefix - just drop the DBI team a note
-(L<DBI/GETTING_HELP>). If you want for some reason hide your work, take
-a look at L<Class::Method::Modifiers> how to wrap a private prefix method
-around existing C<driver_prefix>.
-
-For this guide, a prefix of C<foo_> is assumed.
-
-=head2 Sample Skeleton
-
- package DBD::Foo;
-
- use strict;
- use warnings;
- use vars qw($VERSION);
- use base qw(DBI::DBD::SqlEngine);
-
- use DBI ();
-
- $VERSION = "0.001";
-
- package DBD::Foo::dr;
-
- use vars qw(@ISA $imp_data_size);
-
- @ISA = qw(DBI::DBD::SqlEngine::dr);
- $imp_data_size = 0;
-
- package DBD::Foo::db;
-
- use vars qw(@ISA $imp_data_size);
-
- @ISA = qw(DBI::DBD::SqlEngine::db);
- $imp_data_size = 0;
-
- package DBD::Foo::st;
-
- use vars qw(@ISA $imp_data_size);
-
- @ISA = qw(DBI::DBD::SqlEngine::st);
- $imp_data_size = 0;
-
- package DBD::Foo::Statement;
-
- use vars qw(@ISA);
-
- @ISA = qw(DBI::DBD::SqlEngine::Statement);
-
- package DBD::Foo::Table;
-
- use vars qw(@ISA);
-
- @ISA = qw(DBI::DBD::SqlEngine::Table);
-
- 1;
-
-Tiny, eh? And all you have now is a DBD named foo which will is able to
-deal with temporary tables, as long as you use L<SQL::Statement>. In
-L<DBI::SQL::Nano> environments, this DBD can do nothing.
-
-=head2 Deal with own attributes
-
-Before we start doing usable stuff with our DBI driver, we need to think
-about what we want to do and how we want to do it.
-
-Do we need tunable knobs accessible by users? Do we need status
-information? All this is handled in attributes of the database handles (be
-careful when your DBD is running "behind" a L<DBD::Gofer> proxy).
-
-How come the attributes into the DBD and how are they fetchable by the
-user? Good question, but you should know because you've read the L<DBI>
-documentation.
-
-C<DBI::DBD::SqlEngine::db::FETCH> and C<DBI::DBD::SqlEngine::db::STORE>
-taking care for you - all they need to know is which attribute names
-are valid and mutable or immutable. Tell them by adding
-C<init_valid_attributes> to your db class:
-
- sub init_valid_attributes
- {
- my $dbh = $_[0];
-
- $dbh->SUPER::init_valid_attributes ();
-
- $dbh->{foo_valid_attrs} = {
- foo_version => 1, # contains version of this driver
- foo_valid_attrs => 1, # contains the valid attributes of foo drivers
- foo_readonly_attrs => 1, # contains immutable attributes of foo drivers
- foo_bar => 1, # contains the bar attribute
- foo_baz => 1, # contains the baz attribute
- foo_manager => 1, # contains the manager of the driver instance
- foo_manager_type => 1, # contains the manager class of the driver instance
- };
- $dbh->{foo_readonly_attrs} = {
- foo_version => 1, # ensure no-one modifies the driver version
- foo_valid_attrs => 1, # do not permit one to add more valid attributes ...
- foo_readonly_attrs => 1, # ... or make the immutable mutable
- foo_manager => 1, # manager is set internally only
- };
-
- return $dbh;
- }
-
-Woooho - but now the user cannot assign new managers? This is intended,
-overwrite C<STORE> to handle it!
-
- sub STORE ($$$)
- {
- my ( $dbh, $attrib, $value ) = @_;
-
- $dbh->SUPER::STORE( $attrib, $value );
-
- # we're still alive, so no exception is thrown ...
- # by DBI::DBD::SqlEngine::db::STORE
- if ( $attrib eq "foo_manager_type" )
- {
- $dbh->{foo_manager} = $dbh->{foo_manager_type}->new();
- # ... probably correct some states based on the new
- # foo_manager_type - see DBD::Sys for an example
- }
- }
-
-But ... my driver runs without a manager until someone first assignes
-a C<foo_manager_type>. Well, no - there're two places where you can
-initialize defaults:
-
- sub init_default_attributes
- {
- my ($dbh, $phase) = @_;
-
- $dbh->SUPER::init_default_attributes($phase);
-
- if( 0 == $phase )
- {
- # init all attributes which have no knowledge about
- # user settings from DSN or the attribute hash
- $dbh->{foo_manager_type} = "DBD::Foo::Manager";
- }
- elsif( 1 == $phase )
- {
- # init phase with more knowledge from DSN or attribute
- # hash
- $dbh->{foo_manager} = $dbh->{foo_manager_type}->new();
- }
-
- return $dbh;
- }
-
-So far we can prevent the users to use our database driver as data
-storage for anything and everything. We care only about the real important
-stuff for peace on earth and alike attributes. But in fact, the driver
-still can't do anything. It can do less than nothing - meanwhile it's
-not a stupid storage area anymore.
-
-=head2 User comfort
-
-C<DBI::DBD::SqlEngine> since C<0.05> consolidates all persistent meta data
-of a table into a single structure stored in C<< $dbh->{sql_meta} >>. While
-DBI::DBD::SqlEngine provides only readonly access to this structure,
-modifications are still allowed.
-
-Primarily DBI::DBD::SqlEngine provides access via the setters
-C<new_sql_engine_meta>, C<get_sql_engine_meta>, C<get_single_table_meta>,
-C<set_single_table_meta>, C<set_sql_engine_meta> and C<clear_sql_engine_meta>.
-Those methods are easily accessible by the users via the C<< $dbh->func () >>
-interface provided by DBI. Well, many users don't feel comfortize when calling
-
- # don't require extension for tables cars
- $dbh->func ("cars", "f_ext", ".csv", "set_sql_engine_meta");
-
-DBI::DBD::SqlEngine will inject a method into your driver to increase the
-user comfort to allow:
-
- # don't require extension for tables cars
- $dbh->foo_set_meta ("cars", "f_ext", ".csv");
-
-Better, but here and there users likes to do:
-
- # don't require extension for tables cars
- $dbh->{foo_tables}->{cars}->{f_ext} = ".csv";
-
-This interface is provided when derived DBD's define following in
-C<init_valid_attributes> (re-capture L</Deal with own attributes>):
-
- sub init_valid_attributes
- {
- my $dbh = $_[0];
-
- $dbh->SUPER::init_valid_attributes ();
-
- $dbh->{foo_valid_attrs} = {
- foo_version => 1, # contains version of this driver
- foo_valid_attrs => 1, # contains the valid attributes of foo drivers
- foo_readonly_attrs => 1, # contains immutable attributes of foo drivers
- foo_bar => 1, # contains the bar attribute
- foo_baz => 1, # contains the baz attribute
- foo_manager => 1, # contains the manager of the driver instance
- foo_manager_type => 1, # contains the manager class of the driver instance
- foo_meta => 1, # contains the public interface to modify table meta attributes
- };
- $dbh->{foo_readonly_attrs} = {
- foo_version => 1, # ensure no-one modifies the driver version
- foo_valid_attrs => 1, # do not permit one to add more valid attributes ...
- foo_readonly_attrs => 1, # ... or make the immutable mutable
- foo_manager => 1, # manager is set internally only
- foo_meta => 1, # ensure public interface to modify table meta attributes are immutable
- };
-
- $dbh->{foo_meta} = "foo_tables";
-
- return $dbh;
- }
-
-This provides a tied hash in C<< $dbh->{foo_tables} >> and a tied hash for
-each table's meta data in C<< $dbh->{foo_tables}->{$table_name} >>.
-Modifications on the table meta attributes are done using the table
-methods:
-
- sub get_table_meta_attr { ... }
- sub set_table_meta_attr { ... }
-
-Both methods can adjust the attribute name for compatibility reasons, e.g.
-when former versions of the DBD allowed different names to be used for the
-same flag:
-
- my %compat_map = (
- abc => 'foo_abc',
- xyz => 'foo_xyz',
- );
- __PACKAGE__->register_compat_map( \%compat_map );
-
-If any user modification on a meta attribute needs reinitialization of
-the meta structure (in case of C<DBI::DBD::SqlEngine> these are the attributes
-C<f_file>, C<f_dir>, C<f_ext> and C<f_lockfile>), inform DBI::DBD::SqlEngine by
-doing
-
- my %reset_on_modify = (
- foo_xyz => "foo_bar",
- foo_abc => "foo_bar",
- );
- __PACKAGE__->register_reset_on_modify( \%reset_on_modify );
-
-The next access to the table meta data will force DBI::DBD::SqlEngine to re-do the
-entire meta initialization process.
-
-Any further action which needs to be taken can handled in
-C<table_meta_attr_changed>:
-
- sub table_meta_attr_changed
- {
- my ($class, $meta, $attrib, $value) = @_;
- ...
- $class->SUPER::table_meta_attr_changed ($meta, $attrib, $value);
- }
-
-This is done before the new value is set in C<$meta>, so the attribute
-changed handler can act depending on the old value.
-
-=head2 Dealing with Tables
-
-Let's put some life into it - it's going to be time for it.
-
-This is a good point where a quick side step to L<SQL::Statement::Embed>
-will help to shorten the next paragraph. The documentation in
-SQL::Statement::Embed regarding embedding in own DBD's works pretty
-fine with SQL::Statement and DBI::SQL::Nano.
-
-Second look should go to L<DBI::DBD::SqlEngine::Developers> to get a
-picture over the driver part of the table API. Usually there isn't much
-to do for an easy driver.
-
-=head2 Testing
-
-Now you should have your first own DBD. Was easy, wasn't it? But does
-it work well? Prove it by writing tests and remember to use
-dbd_edit_mm_attribs from L<DBI::DBD> to ensure testing even rare cases.
-
-=head1 AUTHOR
-
-This guide is written by Jens Rehsack. DBI::DBD::SqlEngine is written by
-Jens Rehsack using code from DBD::File originally written by Jochen
-Wiedmann and Jeff Zucker.
-
-The module DBI::DBD::SqlEngine is currently maintained by
-
-H.Merijn Brand < h.m.brand at xs4all.nl > and
-Jens Rehsack < rehsack at googlemail.com >
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright (C) 2010 by H.Merijn Brand & Jens Rehsack
-
-All rights reserved.
-
-You may freely distribute and/or modify this module under the terms of
-either the GNU General Public License (GPL) or the Artistic License, as
-specified in the Perl README file.
-
-=cut
+++ /dev/null
-package DBI::Gofer::Execute;
-
-# $Id: Execute.pm 14282 2010-07-26 00:12:54Z David $
-#
-# Copyright (c) 2007, Tim Bunce, Ireland
-#
-# You may distribute under the terms of either the GNU General Public
-# License or the Artistic License, as specified in the Perl README file.
-
-use strict;
-use warnings;
-
-use Carp;
-
-use DBI qw(dbi_time);
-use DBI::Gofer::Request;
-use DBI::Gofer::Response;
-
-use base qw(DBI::Util::_accessor);
-
-our $VERSION = "0.014283";
-
-our @all_dbh_methods = sort map { keys %$_ } $DBI::DBI_methods{db}, $DBI::DBI_methods{common};
-our %all_dbh_methods = map { $_ => (DBD::_::db->can($_)||undef) } @all_dbh_methods;
-
-our $local_log = $ENV{DBI_GOFER_LOCAL_LOG}; # do extra logging to stderr
-
-our $current_dbh; # the dbh we're using for this request
-
-
-# set trace for server-side gofer
-# Could use DBI_TRACE env var when it's an unrelated separate process
-# but using DBI_GOFER_TRACE makes testing easier for subprocesses (eg stream)
-DBI->trace(split /=/, $ENV{DBI_GOFER_TRACE}, 2) if $ENV{DBI_GOFER_TRACE};
-
-
-# define valid configuration attributes (args to new())
-# the values here indicate the basic type of values allowed
-my %configuration_attributes = (
- gofer_execute_class => 1,
- default_connect_dsn => 1,
- forced_connect_dsn => 1,
- default_connect_attributes => {},
- forced_connect_attributes => {},
- track_recent => 1,
- check_request_sub => sub {},
- check_response_sub => sub {},
- forced_single_resultset => 1,
- max_cached_dbh_per_drh => 1,
- max_cached_sth_per_dbh => 1,
- forced_response_attributes => {},
- forced_gofer_random => 1,
- stats => {},
-);
-
-__PACKAGE__->mk_accessors(
- keys %configuration_attributes
-);
-
-
-
-sub new {
- my ($self, $args) = @_;
- $args->{default_connect_attributes} ||= {};
- $args->{forced_connect_attributes} ||= {};
- $args->{max_cached_sth_per_dbh} ||= 1000;
- $args->{stats} ||= {};
- return $self->SUPER::new($args);
-}
-
-
-sub valid_configuration_attributes {
- my $self = shift;
- return { %configuration_attributes };
-}
-
-
-my %extra_attr = (
- # Only referenced if the driver doesn't support private_attribute_info method.
- # What driver-specific attributes should be returned for the driver being used?
- # keyed by $dbh->{Driver}{Name}
- # XXX for sth should split into attr specific to resultsets (where NUM_OF_FIELDS > 0) and others
- # which would reduce processing/traffic for non-select statements
- mysql => {
- dbh => [qw(
- mysql_errno mysql_error mysql_hostinfo mysql_info mysql_insertid
- mysql_protoinfo mysql_serverinfo mysql_stat mysql_thread_id
- )],
- sth => [qw(
- mysql_is_blob mysql_is_key mysql_is_num mysql_is_pri_key mysql_is_auto_increment
- mysql_length mysql_max_length mysql_table mysql_type mysql_type_name mysql_insertid
- )],
- # XXX this dbh_after_sth stuff is a temporary, but important, hack.
- # should be done via hash instead of arrays where the hash value contains
- # flags that can indicate which attributes need to be handled in this way
- dbh_after_sth => [qw(
- mysql_insertid
- )],
- },
- Pg => {
- dbh => [qw(
- pg_protocol pg_lib_version pg_server_version
- pg_db pg_host pg_port pg_default_port
- pg_options pg_pid
- )],
- sth => [qw(
- pg_size pg_type pg_oid_status pg_cmd_status
- )],
- },
- Sybase => {
- dbh => [qw(
- syb_dynamic_supported syb_oc_version syb_server_version syb_server_version_string
- )],
- sth => [qw(
- syb_types syb_proc_status syb_result_type
- )],
- },
- SQLite => {
- dbh => [qw(
- sqlite_version
- )],
- sth => [qw(
- )],
- },
- ExampleP => {
- dbh => [qw(
- examplep_private_dbh_attrib
- )],
- sth => [qw(
- examplep_private_sth_attrib
- )],
- dbh_after_sth => [qw(
- examplep_insertid
- )],
- },
-);
-
-
-sub _connect {
- my ($self, $request) = @_;
-
- my $stats = $self->{stats};
-
- # discard CachedKids from time to time
- if (++$stats->{_requests_served} % 1000 == 0 # XXX config?
- and my $max_cached_dbh_per_drh = $self->{max_cached_dbh_per_drh}
- ) {
- my %drivers = DBI->installed_drivers();
- while ( my ($driver, $drh) = each %drivers ) {
- next unless my $CK = $drh->{CachedKids};
- next unless keys %$CK > $max_cached_dbh_per_drh;
- next if $driver eq 'Gofer'; # ie transport=null when testing
- DBI->trace_msg(sprintf "Clearing %d cached dbh from $driver",
- scalar keys %$CK, $self->{max_cached_dbh_per_drh});
- $_->{Active} && $_->disconnect for values %$CK;
- %$CK = ();
- }
- }
-
- # local $ENV{...} can leak, so only do it if required
- local $ENV{DBI_AUTOPROXY} if $ENV{DBI_AUTOPROXY};
-
- my ($connect_method, $dsn, $username, $password, $attr) = @{ $request->dbh_connect_call };
- $connect_method ||= 'connect_cached';
- $stats->{method_calls_dbh}->{$connect_method}++;
-
- # delete attributes we don't want to affect the server-side
- # (Could just do this on client-side and trust the client. DoS?)
- delete @{$attr}{qw(Profile InactiveDestroy AutoInactiveDestroy HandleError HandleSetErr TraceLevel Taint TaintIn TaintOut)};
-
- $dsn = $self->forced_connect_dsn || $dsn || $self->default_connect_dsn
- or die "No forced_connect_dsn, requested dsn, or default_connect_dsn for request";
-
- my $random = $self->{forced_gofer_random} || $ENV{DBI_GOFER_RANDOM} || '';
-
- my $connect_attr = {
-
- # the configured default attributes, if any
- %{ $self->default_connect_attributes },
-
- # pass username and password as attributes
- # then they can be overridden by forced_connect_attributes
- Username => $username,
- Password => $password,
-
- # the requested attributes
- %$attr,
-
- # force some attributes the way we'd like them
- PrintWarn => $local_log,
- PrintError => $local_log,
-
- # the configured default attributes, if any
- %{ $self->forced_connect_attributes },
-
- # RaiseError must be enabled
- RaiseError => 1,
-
- # reset Executed flag (of the cached handle) so we can use it to tell
- # if errors happened before the main part of the request was executed
- Executed => 0,
-
- # ensure this connect_cached doesn't have the same args as the client
- # because that causes subtle issues if in the same process (ie transport=null)
- # include pid to avoid problems with forking (ie null transport in mod_perl)
- # include gofer-random to avoid random behaviour leaking to other handles
- dbi_go_execute_unique => join("|", __PACKAGE__, $$, $random),
- };
-
- # XXX implement our own private connect_cached method? (with rate-limited ping)
- my $dbh = DBI->$connect_method($dsn, undef, undef, $connect_attr);
-
- $dbh->{ShowErrorStatement} = 1 if $local_log;
-
- # XXX should probably just be a Callbacks => arg to connect_cached
- # with a cache of pre-built callback hooks (memoized, without $self)
- if (my $random = $self->{forced_gofer_random} || $ENV{DBI_GOFER_RANDOM}) {
- $self->_install_rand_callbacks($dbh, $random);
- }
-
- my $CK = $dbh->{CachedKids};
- if ($CK && keys %$CK > $self->{max_cached_sth_per_dbh}) {
- %$CK = (); # clear all statement handles
- }
-
- #$dbh->trace(0);
- $current_dbh = $dbh;
- return $dbh;
-}
-
-
-sub reset_dbh {
- my ($self, $dbh) = @_;
- $dbh->set_err(undef, undef); # clear any error state
-}
-
-
-sub new_response_with_err {
- my ($self, $rv, $eval_error, $dbh) = @_;
- # this is the usual way to create a response for both success and failure
- # capture err+errstr etc and merge in $eval_error ($@)
-
- my ($err, $errstr, $state) = ($DBI::err, $DBI::errstr, $DBI::state);
-
- if ($eval_error) {
- $err ||= $DBI::stderr || 1; # ensure err is true
- if ($errstr) {
- $eval_error =~ s/(?: : \s)? \Q$errstr//x if $errstr;
- chomp $errstr;
- $errstr .= "; $eval_error";
- }
- else {
- $errstr = $eval_error;
- }
- }
- chomp $errstr if $errstr;
-
- my $flags;
- # (XXX if we ever add transaction support then we'll need to take extra
- # steps because the commit/rollback would reset Executed before we get here)
- $flags |= GOf_RESPONSE_EXECUTED if $dbh && $dbh->{Executed};
-
- my $response = DBI::Gofer::Response->new({
- rv => $rv,
- err => $err,
- errstr => $errstr,
- state => $state,
- flags => $flags,
- });
-
- return $response;
-}
-
-
-sub execute_request {
- my ($self, $request) = @_;
- # should never throw an exception
-
- DBI->trace_msg("-----> execute_request\n");
-
- my @warnings;
- local $SIG{__WARN__} = sub {
- push @warnings, @_;
- warn @_ if $local_log;
- };
-
- my $response = eval {
-
- if (my $check_request_sub = $self->check_request_sub) {
- $request = $check_request_sub->($request, $self)
- or die "check_request_sub failed";
- }
-
- my $version = $request->version || 0;
- die ref($request)." version $version is not supported"
- if $version < 0.009116 or $version >= 1;
-
- ($request->is_sth_request)
- ? $self->execute_sth_request($request)
- : $self->execute_dbh_request($request);
- };
- $response ||= $self->new_response_with_err(undef, $@, $current_dbh);
-
- if (my $check_response_sub = $self->check_response_sub) {
- # not protected with an eval so it can choose to throw an exception
- my $new = $check_response_sub->($response, $self, $request);
- $response = $new if ref $new;
- }
-
- undef $current_dbh;
-
- $response->warnings(\@warnings) if @warnings;
- DBI->trace_msg("<----- execute_request\n");
- return $response;
-}
-
-
-sub execute_dbh_request {
- my ($self, $request) = @_;
- my $stats = $self->{stats};
-
- my $dbh;
- my $rv_ref = eval {
- $dbh = $self->_connect($request);
- my $args = $request->dbh_method_call; # [ wantarray, 'method_name', @args ]
- my $wantarray = shift @$args;
- my $meth = shift @$args;
- $stats->{method_calls_dbh}->{$meth}++;
- my @rv = ($wantarray)
- ? $dbh->$meth(@$args)
- : scalar $dbh->$meth(@$args);
- \@rv;
- } || [];
- my $response = $self->new_response_with_err($rv_ref, $@, $dbh);
-
- return $response if not $dbh;
-
- # does this request also want any dbh attributes returned?
- if (my $dbh_attributes = $request->dbh_attributes) {
- $response->dbh_attributes( $self->gather_dbh_attributes($dbh, $dbh_attributes) );
- }
-
- if ($rv_ref and my $lid_args = $request->dbh_last_insert_id_args) {
- $stats->{method_calls_dbh}->{last_insert_id}++;
- my $id = $dbh->last_insert_id( @$lid_args );
- $response->last_insert_id( $id );
- }
-
- if ($rv_ref and UNIVERSAL::isa($rv_ref->[0],'DBI::st')) {
- # dbh_method_call was probably a metadata method like table_info
- # that returns a statement handle, so turn the $sth into resultset
- my $sth = $rv_ref->[0];
- $response->sth_resultsets( $self->gather_sth_resultsets($sth, $request, $response) );
- $response->rv("(sth)"); # don't try to return actual sth
- }
-
- # we're finished with this dbh for this request
- $self->reset_dbh($dbh);
-
- return $response;
-}
-
-
-sub gather_dbh_attributes {
- my ($self, $dbh, $dbh_attributes) = @_;
- my @req_attr_names = @$dbh_attributes;
- if ($req_attr_names[0] eq '*') { # auto include std + private
- shift @req_attr_names;
- push @req_attr_names, @{ $self->_std_response_attribute_names($dbh) };
- }
- my %dbh_attr_values;
- @dbh_attr_values{@req_attr_names} = $dbh->FETCH_many(@req_attr_names);
-
- # XXX piggyback installed_methods onto dbh_attributes for now
- $dbh_attr_values{dbi_installed_methods} = { DBI->installed_methods };
-
- # XXX piggyback default_methods onto dbh_attributes for now
- $dbh_attr_values{dbi_default_methods} = _get_default_methods($dbh);
-
- return \%dbh_attr_values;
-}
-
-
-sub _std_response_attribute_names {
- my ($self, $h) = @_;
- $h = tied(%$h) || $h; # switch to inner handle
-
- # cache the private_attribute_info data for each handle
- # XXX might be better to cache it in the executor
- # as it's unlikely to change
- # or perhaps at least cache it in the dbh even for sth
- # as the sth are typically very short lived
-
- my ($dbh, $h_type, $driver_name, @attr_names);
-
- if ($dbh = $h->{Database}) { # is an sth
-
- # does the dbh already have the answer cached?
- return $dbh->{private_gofer_std_attr_names_sth} if $dbh->{private_gofer_std_attr_names_sth};
-
- ($h_type, $driver_name) = ('sth', $dbh->{Driver}{Name});
- push @attr_names, qw(NUM_OF_PARAMS NUM_OF_FIELDS NAME TYPE NULLABLE PRECISION SCALE);
- }
- else { # is a dbh
- return $h->{private_gofer_std_attr_names_dbh} if $h->{private_gofer_std_attr_names_dbh};
-
- ($h_type, $driver_name, $dbh) = ('dbh', $h->{Driver}{Name}, $h);
- # explicitly add these because drivers may have different defaults
- # add Name so the client gets the real Name of the connection
- push @attr_names, qw(ChopBlanks LongReadLen LongTruncOk ReadOnly Name);
- }
-
- if (my $pai = $h->private_attribute_info) {
- push @attr_names, keys %$pai;
- }
- else {
- push @attr_names, @{ $extra_attr{ $driver_name }{$h_type} || []};
- }
- if (my $fra = $self->{forced_response_attributes}) {
- push @attr_names, @{ $fra->{ $driver_name }{$h_type} || []}
- }
- $dbh->trace_msg("_std_response_attribute_names for $driver_name $h_type: @attr_names\n");
-
- # cache into the dbh even for sth, as the dbh is usually longer lived
- return $dbh->{"private_gofer_std_attr_names_$h_type"} = \@attr_names;
-}
-
-
-sub execute_sth_request {
- my ($self, $request) = @_;
- my $dbh;
- my $sth;
- my $last_insert_id;
- my $stats = $self->{stats};
-
- my $rv = eval {
- $dbh = $self->_connect($request);
-
- my $args = $request->dbh_method_call; # [ wantarray, 'method_name', @args ]
- shift @$args; # discard wantarray
- my $meth = shift @$args;
- $stats->{method_calls_sth}->{$meth}++;
- $sth = $dbh->$meth(@$args);
- my $last = '(sth)'; # a true value (don't try to return actual sth)
-
- # execute methods on the sth, e.g., bind_param & execute
- if (my $calls = $request->sth_method_calls) {
- for my $meth_call (@$calls) {
- my $method = shift @$meth_call;
- $stats->{method_calls_sth}->{$method}++;
- $last = $sth->$method(@$meth_call);
- }
- }
-
- if (my $lid_args = $request->dbh_last_insert_id_args) {
- $stats->{method_calls_sth}->{last_insert_id}++;
- $last_insert_id = $dbh->last_insert_id( @$lid_args );
- }
-
- $last;
- };
- my $response = $self->new_response_with_err($rv, $@, $dbh);
-
- return $response if not $dbh;
-
- $response->last_insert_id( $last_insert_id )
- if defined $last_insert_id;
-
- # even if the eval failed we still want to try to gather attribute values
- # (XXX would be nice to be able to support streaming of results.
- # which would reduce memory usage and latency for large results)
- if ($sth) {
- $response->sth_resultsets( $self->gather_sth_resultsets($sth, $request, $response) );
- $sth->finish;
- }
-
- # does this request also want any dbh attributes returned?
- my $dbh_attr_set;
- if (my $dbh_attributes = $request->dbh_attributes) {
- $dbh_attr_set = $self->gather_dbh_attributes($dbh, $dbh_attributes);
- }
- # XXX needs to be integrated with private_attribute_info() etc
- if (my $dbh_attr = $extra_attr{$dbh->{Driver}{Name}}{dbh_after_sth}) {
- @{$dbh_attr_set}{@$dbh_attr} = $dbh->FETCH_many(@$dbh_attr);
- }
- $response->dbh_attributes($dbh_attr_set) if $dbh_attr_set && %$dbh_attr_set;
-
- $self->reset_dbh($dbh);
-
- return $response;
-}
-
-
-sub gather_sth_resultsets {
- my ($self, $sth, $request, $response) = @_;
- my $resultsets = eval {
-
- my $attr_names = $self->_std_response_attribute_names($sth);
- my $sth_attr = {};
- $sth_attr->{$_} = 1 for @$attr_names;
-
- # let the client add/remove sth attributes
- if (my $sth_result_attr = $request->sth_result_attr) {
- $sth_attr->{$_} = $sth_result_attr->{$_}
- for keys %$sth_result_attr;
- }
- my @sth_attr = grep { $sth_attr->{$_} } keys %$sth_attr;
-
- my $row_count = 0;
- my $rs_list = [];
- while (1) {
- my $rs = $self->fetch_result_set($sth, \@sth_attr);
- push @$rs_list, $rs;
- if (my $rows = $rs->{rowset}) {
- $row_count += @$rows;
- }
- last if $self->{forced_single_resultset};
- last if !($sth->more_results || $sth->{syb_more_results});
- }
-
- my $stats = $self->{stats};
- $stats->{rows_returned_total} += $row_count;
- $stats->{rows_returned_max} = $row_count
- if $row_count > ($stats->{rows_returned_max}||0);
-
- $rs_list;
- };
- $response->add_err(1, $@) if $@;
- return $resultsets;
-}
-
-
-sub fetch_result_set {
- my ($self, $sth, $sth_attr) = @_;
- my %meta;
- eval {
- @meta{ @$sth_attr } = $sth->FETCH_many(@$sth_attr);
- # we assume @$sth_attr contains NUM_OF_FIELDS
- $meta{rowset} = $sth->fetchall_arrayref()
- if (($meta{NUM_OF_FIELDS}||0) > 0); # is SELECT
- # the fetchall_arrayref may fail with a 'not executed' kind of error
- # because gather_sth_resultsets/fetch_result_set are called even if
- # execute() failed, or even if there was no execute() call at all.
- # The corresponding error goes into the resultset err, not the top-level
- # response err, so in most cases this resultset err is never noticed.
- };
- if ($@) {
- chomp $@;
- $meta{err} = $DBI::err || 1;
- $meta{errstr} = $DBI::errstr || $@;
- $meta{state} = $DBI::state;
- }
- return \%meta;
-}
-
-
-sub _get_default_methods {
- my ($dbh) = @_;
- # returns a ref to a hash of dbh method names for methods which the driver
- # hasn't overridden i.e., quote(). These don't need to be forwarded via gofer.
- my $ImplementorClass = $dbh->{ImplementorClass} or die;
- my %default_methods;
- for my $method (@all_dbh_methods) {
- my $dbi_sub = $all_dbh_methods{$method} || 42;
- my $imp_sub = $ImplementorClass->can($method) || 42;
- next if $imp_sub != $dbi_sub;
- #warn("default $method\n");
- $default_methods{$method} = 1;
- }
- return \%default_methods;
-}
-
-
-# XXX would be nice to make this a generic DBI module
-sub _install_rand_callbacks {
- my ($self, $dbh, $dbi_gofer_random) = @_;
-
- my $callbacks = $dbh->{Callbacks} || {};
- my $prev = $dbh->{private_gofer_rand_fail_callbacks} || {};
-
- # return if we've already setup this handle with callbacks for these specs
- return if (($callbacks->{_dbi_gofer_random_spec}||'') eq $dbi_gofer_random);
- #warn "$dbh # $callbacks->{_dbi_gofer_random_spec}";
- $callbacks->{_dbi_gofer_random_spec} = $dbi_gofer_random;
-
- my ($fail_percent, $fail_err, $delay_percent, $delay_duration, %spec_part, @spec_note);
- my @specs = split /,/, $dbi_gofer_random;
- for my $spec (@specs) {
- if ($spec =~ m/^fail=(-?[.\d]+)%?$/) {
- $fail_percent = $1;
- $spec_part{fail} = $spec;
- next;
- }
- if ($spec =~ m/^err=(-?\d+)$/) {
- $fail_err = $1;
- $spec_part{err} = $spec;
- next;
- }
- if ($spec =~ m/^delay([.\d]+)=(-?[.\d]+)%?$/) {
- $delay_duration = $1;
- $delay_percent = $2;
- $spec_part{delay} = $spec;
- next;
- }
- elsif ($spec !~ m/^(\w+|\*)$/) {
- warn "Ignored DBI_GOFER_RANDOM item '$spec' which isn't a config or a dbh method name";
- next;
- }
-
- my $method = $spec;
- if ($callbacks->{$method} && $prev->{$method} && $callbacks->{$method} != $prev->{$method}) {
- warn "Callback for $method method already installed so DBI_GOFER_RANDOM callback not installed\n";
- next;
- }
- unless (defined $fail_percent or defined $delay_percent) {
- warn "Ignored DBI_GOFER_RANDOM item '$spec' because not preceded by 'fail=N' and/or 'delayN=N'";
- next;
- }
-
- push @spec_note, join(",", values(%spec_part), $method);
- $callbacks->{$method} = $self->_mk_rand_callback($method, $fail_percent, $delay_percent, $delay_duration, $fail_err);
- }
- warn "DBI_GOFER_RANDOM failures/delays enabled: @spec_note\n"
- if @spec_note;
- $dbh->{Callbacks} = $callbacks;
- $dbh->{private_gofer_rand_fail_callbacks} = $callbacks;
-}
-
-my %_mk_rand_callback_seqn;
-
-sub _mk_rand_callback {
- my ($self, $method, $fail_percent, $delay_percent, $delay_duration, $fail_err) = @_;
- my ($fail_modrate, $delay_modrate);
- $fail_percent ||= 0; $fail_modrate = int(1/(-$fail_percent )*100) if $fail_percent;
- $delay_percent ||= 0; $delay_modrate = int(1/(-$delay_percent)*100) if $delay_percent;
- # note that $method may be "*" but that's not recommended or documented or wise
- return sub {
- my ($h) = @_;
- my $seqn = ++$_mk_rand_callback_seqn{$method};
- my $delay = ($delay_percent > 0) ? rand(100) < $delay_percent :
- ($delay_percent < 0) ? !($seqn % $delay_modrate): 0;
- my $fail = ($fail_percent > 0) ? rand(100) < $fail_percent :
- ($fail_percent < 0) ? !($seqn % $fail_modrate) : 0;
- #no warnings 'uninitialized';
- #warn "_mk_rand_callback($fail_percent:$fail_modrate, $delay_percent:$delay_modrate): seqn=$seqn fail=$fail delay=$delay";
- if ($delay) {
- my $msg = "DBI_GOFER_RANDOM delaying execution of $method() by $delay_duration seconds\n";
- # Note what's happening in a trace message. If the delay percent is an even
- # number then use warn() instead so it's sent back to the client.
- ($delay_percent % 2 == 1) ? warn($msg) : $h->trace_msg($msg);
- select undef, undef, undef, $delay_duration; # allows floating point value
- }
- if ($fail) {
- undef $_; # tell DBI to not call the method
- # the "induced by DBI_GOFER_RANDOM" is special and must be included in errstr
- # as it's checked for in a few places, such as the gofer retry logic
- return $h->set_err($fail_err || $DBI::stderr,
- "fake error from $method method induced by DBI_GOFER_RANDOM env var ($fail_percent%)");
- }
- return;
- }
-}
-
-
-sub update_stats {
- my ($self,
- $request, $response,
- $frozen_request, $frozen_response,
- $time_received,
- $store_meta, $other_meta,
- ) = @_;
-
- # should always have a response object here
- carp("No response object provided") unless $request;
-
- my $stats = $self->{stats};
- $stats->{frozen_request_max_bytes} = length($frozen_request)
- if $frozen_request
- && length($frozen_request) > ($stats->{frozen_request_max_bytes}||0);
- $stats->{frozen_response_max_bytes} = length($frozen_response)
- if $frozen_response
- && length($frozen_response) > ($stats->{frozen_response_max_bytes}||0);
-
- my $recent;
- if (my $track_recent = $self->{track_recent}) {
- $recent = {
- request => $frozen_request,
- response => $frozen_response,
- time_received => $time_received,
- duration => dbi_time()-$time_received,
- # for any other info
- ($store_meta) ? (meta => $store_meta) : (),
- };
- $recent->{request_object} = $request
- if !$frozen_request && $request;
- $recent->{response_object} = $response
- if !$frozen_response;
- my @queues = ($stats->{recent_requests} ||= []);
- push @queues, ($stats->{recent_errors} ||= [])
- if !$response or $response->err;
- for my $queue (@queues) {
- push @$queue, $recent;
- shift @$queue if @$queue > $track_recent;
- }
- }
- return $recent;
-}
-
-
-1;
-__END__
-
-=head1 NAME
-
-DBI::Gofer::Execute - Executes Gofer requests and returns Gofer responses
-
-=head1 SYNOPSIS
-
- $executor = DBI::Gofer::Execute->new( { ...config... });
-
- $response = $executor->execute_request( $request );
-
-=head1 DESCRIPTION
-
-Accepts a DBI::Gofer::Request object, executes the requested DBI method calls,
-and returns a DBI::Gofer::Response object.
-
-Any error, including any internal 'fatal' errors are caught and converted into
-a DBI::Gofer::Response object.
-
-This module is usually invoked by a 'server-side' Gofer transport module.
-They usually have names in the "C<DBI::Gofer::Transport::*>" namespace.
-Examples include: L<DBI::Gofer::Transport::stream> and L<DBI::Gofer::Transport::mod_perl>.
-
-=head1 CONFIGURATION
-
-=head2 check_request_sub
-
-If defined, it must be a reference to a subroutine that will 'check' the request.
-It is passed the request object and the executor as its only arguments.
-
-The subroutine can either return the original request object or die with a
-suitable error message (which will be turned into a Gofer response).
-
-It can also construct and return a new request that should be executed instead
-of the original request.
-
-=head2 check_response_sub
-
-If defined, it must be a reference to a subroutine that will 'check' the response.
-It is passed the response object, the executor, and the request object.
-The sub may alter the response object and return undef, or return a new response object.
-
-This mechanism can be used to, for example, terminate the service if specific
-database errors are seen.
-
-=head2 forced_connect_dsn
-
-If set, this DSN is always used instead of the one in the request.
-
-=head2 default_connect_dsn
-
-If set, this DSN is used if C<forced_connect_dsn> is not set and the request does not contain a DSN itself.
-
-=head2 forced_connect_attributes
-
-A reference to a hash of connect() attributes. Individual attributes in
-C<forced_connect_attributes> will take precedence over corresponding attributes
-in the request.
-
-=head2 default_connect_attributes
-
-A reference to a hash of connect() attributes. Individual attributes in the
-request take precedence over corresponding attributes in C<default_connect_attributes>.
-
-=head2 max_cached_dbh_per_drh
-
-If set, the loaded drivers will be checked to ensure they don't have more than
-this number of cached connections. There is no default value. This limit is not
-enforced for every request.
-
-=head2 max_cached_sth_per_dbh
-
-If set, all the cached statement handles will be cleared once the number of
-cached statement handles rises above this limit. The default is 1000.
-
-=head2 forced_single_resultset
-
-If true, then only the first result set will be fetched and returned in the response.
-
-=head2 forced_response_attributes
-
-A reference to a data structure that can specify extra attributes to be returned in responses.
-
- forced_response_attributes => {
- DriverName => {
- dbh => [ qw(dbh_attrib_name) ],
- sth => [ qw(sth_attrib_name) ],
- },
- },
-
-This can be useful in cases where the driver has not implemented the
-private_attribute_info() method and DBI::Gofer::Execute's own fallback list of
-private attributes doesn't include the driver or attributes you need.
-
-=head2 track_recent
-
-If set, specifies the number of recent requests and responses that should be
-kept by the update_stats() method for diagnostics. See L<DBI::Gofer::Transport::mod_perl>.
-
-Note that this setting can significantly increase memory use. Use with caution.
-
-=head2 forced_gofer_random
-
-Enable forced random failures and/or delays for testing. See L</DBI_GOFER_RANDOM> below.
-
-=head1 DRIVER-SPECIFIC ISSUES
-
-Gofer needs to know about any driver-private attributes that should have their
-values sent back to the client.
-
-If the driver doesn't support private_attribute_info() method, and very few do,
-then the module fallsback to using some hard-coded details, if available, for
-the driver being used. Currently hard-coded details are available for the
-mysql, Pg, Sybase, and SQLite drivers.
-
-=head1 TESTING
-
-DBD::Gofer, DBD::Execute and related packages are well tested by executing the
-DBI test suite with DBI_AUTOPROXY configured to route all DBI calls via DBD::Gofer.
-
-Because Gofer includes timeout and 'retry on error' mechanisms there is a need
-for some way to trigger delays and/or errors. This can be done via the
-C<forced_gofer_random> configuration item, or else the DBI_GOFER_RANDOM environment
-variable.
-
-=head2 DBI_GOFER_RANDOM
-
-The value of the C<forced_gofer_random> configuration item (or else the
-DBI_GOFER_RANDOM environment variable) is treated as a series of tokens
-separated by commas.
-
-The tokens can be one of three types:
-
-=over 4
-
-=item fail=R%
-
-Set the current failure rate to R where R is a percentage.
-The value R can be floating point, e.g., C<fail=0.05%>.
-Negative values for R have special meaning, see below.
-
-=item err=N
-
-Sets the current failure err value to N (instead of the DBI's default 'standard
-err value' of 2000000000). This is useful when you want to simulate a
-specific error.
-
-=item delayN=R%
-
-Set the current random delay rate to R where R is a percentage, and set the
-current delay duration to N seconds. The values of R and N can be floating point,
-e.g., C<delay0.5=0.2%>. Negative values for R have special meaning, see below.
-
-If R is an odd number (R % 2 == 1) then a message is logged via warn() which
-will be returned to, and echoed at, the client.
-
-=item methodname
-
-Applies the current fail, err, and delay values to the named method.
-If neither a fail nor delay have been set yet then a warning is generated.
-
-=back
-
-For example:
-
- $executor = DBI::Gofer::Execute->new( {
- forced_gofer_random => "fail=0.01%,do,delay60=1%,execute",
- });
-
-will cause the do() method to fail for 0.01% of calls, and the execute() method to
-fail 0.01% of calls and be delayed by 60 seconds on 1% of calls.
-
-If the percentage value (C<R>) is negative then instead of the failures being
-triggered randomly (via the rand() function) they are triggered via a sequence
-number. In other words "C<fail=-20%>" will mean every fifth call will fail.
-Each method has a distinct sequence number.
-
-=head1 AUTHOR
-
-Tim Bunce, L<http://www.tim.bunce.name>
-
-=head1 LICENCE AND COPYRIGHT
-
-Copyright (c) 2007, Tim Bunce, Ireland. All rights reserved.
-
-This module is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself. See L<perlartistic>.
-
-=cut
+++ /dev/null
-package DBI::Gofer::Request;
-
-# $Id: Request.pm 12536 2009-02-24 22:37:09Z Tim $
-#
-# Copyright (c) 2007, Tim Bunce, Ireland
-#
-# You may distribute under the terms of either the GNU General Public
-# License or the Artistic License, as specified in the Perl README file.
-
-use strict;
-
-use DBI qw(neat neat_list);
-
-use base qw(DBI::Util::_accessor);
-
-our $VERSION = "0.012537";
-
-use constant GOf_REQUEST_IDEMPOTENT => 0x0001;
-use constant GOf_REQUEST_READONLY => 0x0002;
-
-our @EXPORT = qw(GOf_REQUEST_IDEMPOTENT GOf_REQUEST_READONLY);
-
-
-__PACKAGE__->mk_accessors(qw(
- version
- flags
- dbh_connect_call
- dbh_method_call
- dbh_attributes
- dbh_last_insert_id_args
- sth_method_calls
- sth_result_attr
-));
-__PACKAGE__->mk_accessors_using(make_accessor_autoviv_hashref => qw(
- meta
-));
-
-
-sub new {
- my ($self, $args) = @_;
- $args->{version} ||= $VERSION;
- return $self->SUPER::new($args);
-}
-
-
-sub reset {
- my ($self, $flags) = @_;
- # remove everything except connect and version
- %$self = (
- version => $self->{version},
- dbh_connect_call => $self->{dbh_connect_call},
- );
- $self->{flags} = $flags if $flags;
-}
-
-
-sub init_request {
- my ($self, $method_and_args, $dbh) = @_;
- $self->reset( $dbh->{ReadOnly} ? GOf_REQUEST_READONLY : 0 );
- $self->dbh_method_call($method_and_args);
-}
-
-
-sub is_sth_request {
- return shift->{sth_result_attr};
-}
-
-
-sub statements {
- my $self = shift;
- my @statements;
- if (my $dbh_method_call = $self->dbh_method_call) {
- my $statement_method_regex = qr/^(?:do|prepare)$/;
- my (undef, $method, $arg1) = @$dbh_method_call;
- push @statements, $arg1 if $method && $method =~ $statement_method_regex;
- }
- return @statements;
-}
-
-
-sub is_idempotent {
- my $self = shift;
-
- if (my $flags = $self->flags) {
- return 1 if $flags & (GOf_REQUEST_IDEMPOTENT|GOf_REQUEST_READONLY);
- }
-
- # else check if all statements are SELECT statement that don't include FOR UPDATE
- my @statements = $self->statements;
- # XXX this is very minimal for now, doesn't even allow comments before the select
- # (and can't ever work for "exec stored_procedure_name" kinds of statements)
- # XXX it also doesn't deal with multiple statements: prepare("select foo; update bar")
- return 1 if @statements == grep {
- m/^ \s* SELECT \b /xmsi && !m/ \b FOR \s+ UPDATE \b /xmsi
- } @statements;
-
- return 0;
-}
-
-
-sub summary_as_text {
- my $self = shift;
- my ($context) = @_;
- my @s = '';
-
- if ($context && %$context) {
- my @keys = sort keys %$context;
- push @s, join(", ", map { "$_=>".$context->{$_} } @keys);
- }
-
- my ($method, $dsn, $user, $pass, $attr) = @{ $self->dbh_connect_call };
- $method ||= 'connect_cached';
- $pass = '***' if defined $pass;
- my $tmp = '';
- if ($attr) {
- $tmp = { %{$attr||{}} }; # copy so we can edit
- $tmp->{Password} = '***' if exists $tmp->{Password};
- $tmp = "{ ".neat_list([ %$tmp ])." }";
- }
- push @s, sprintf "dbh= $method(%s, %s)", neat_list([$dsn, $user, $pass]), $tmp;
-
- if (my $flags = $self->flags) {
- push @s, sprintf "flags: 0x%x", $flags;
- }
-
- if (my $dbh_attr = $self->dbh_attributes) {
- push @s, sprintf "dbh->FETCH: %s", @$dbh_attr
- if @$dbh_attr;
- }
-
- my ($wantarray, $meth, @args) = @{ $self->dbh_method_call };
- my $args = neat_list(\@args);
- $args =~ s/\n+/ /g;
- push @s, sprintf "dbh->%s(%s)", $meth, $args;
-
- if (my $lii_args = $self->dbh_last_insert_id_args) {
- push @s, sprintf "dbh->last_insert_id(%s)", neat_list($lii_args);
- }
-
- for my $call (@{ $self->sth_method_calls || [] }) {
- my ($meth, @args) = @$call;
- ($args = neat_list(\@args)) =~ s/\n+/ /g;
- push @s, sprintf "sth->%s(%s)", $meth, $args;
- }
-
- if (my $sth_attr = $self->sth_result_attr) {
- push @s, sprintf "sth->FETCH: %s", %$sth_attr
- if %$sth_attr;
- }
-
- return join("\n\t", @s) . "\n";
-}
-
-
-sub outline_as_text { # one-line version of summary_as_text
- my $self = shift;
- my @s = '';
- my $neatlen = 80;
-
- if (my $flags = $self->flags) {
- push @s, sprintf "flags=0x%x", $flags;
- }
-
- my (undef, $meth, @args) = @{ $self->dbh_method_call };
- push @s, sprintf "%s(%s)", $meth, neat_list(\@args, $neatlen);
-
- for my $call (@{ $self->sth_method_calls || [] }) {
- my ($meth, @args) = @$call;
- push @s, sprintf "%s(%s)", $meth, neat_list(\@args, $neatlen);
- }
-
- my ($method, $dsn) = @{ $self->dbh_connect_call };
- push @s, "$method($dsn,...)"; # dsn last as it's usually less interesting
-
- (my $outline = join("; ", @s)) =~ s/\s+/ /g; # squish whitespace, incl newlines
- return $outline;
-}
-
-1;
-
-=head1 NAME
-
-DBI::Gofer::Request - Encapsulate a request from DBD::Gofer to DBI::Gofer::Execute
-
-=head1 DESCRIPTION
-
-This is an internal class.
-
-=head1 AUTHOR
-
-Tim Bunce, L<http://www.tim.bunce.name>
-
-=head1 LICENCE AND COPYRIGHT
-
-Copyright (c) 2007, Tim Bunce, Ireland. All rights reserved.
-
-This module is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself. See L<perlartistic>.
-
-=cut
+++ /dev/null
-package DBI::Gofer::Response;
-
-# $Id: Response.pm 11565 2008-07-22 20:17:33Z Tim $
-#
-# Copyright (c) 2007, Tim Bunce, Ireland
-#
-# You may distribute under the terms of either the GNU General Public
-# License or the Artistic License, as specified in the Perl README file.
-
-use strict;
-
-use Carp;
-use DBI qw(neat neat_list);
-
-use base qw(DBI::Util::_accessor Exporter);
-
-our $VERSION = "0.011566";
-
-use constant GOf_RESPONSE_EXECUTED => 0x0001;
-
-our @EXPORT = qw(GOf_RESPONSE_EXECUTED);
-
-
-__PACKAGE__->mk_accessors(qw(
- version
- rv
- err
- errstr
- state
- flags
- last_insert_id
- dbh_attributes
- sth_resultsets
- warnings
-));
-__PACKAGE__->mk_accessors_using(make_accessor_autoviv_hashref => qw(
- meta
-));
-
-
-sub new {
- my ($self, $args) = @_;
- $args->{version} ||= $VERSION;
- chomp $args->{errstr} if $args->{errstr};
- return $self->SUPER::new($args);
-}
-
-
-sub err_errstr_state {
- my $self = shift;
- return @{$self}{qw(err errstr state)};
-}
-
-sub executed_flag_set {
- my $flags = shift->flags
- or return 0;
- return $flags & GOf_RESPONSE_EXECUTED;
-}
-
-
-sub add_err {
- my ($self, $err, $errstr, $state, $trace) = @_;
-
- # acts like the DBI's set_err method.
- # this code copied from DBI::PurePerl's set_err method.
-
- chomp $errstr if $errstr;
- $state ||= '';
- carp ref($self)."->add_err($err, $errstr, $state)"
- if $trace and defined($err) || $errstr;
-
- my ($r_err, $r_errstr, $r_state) = ($self->{err}, $self->{errstr}, $self->{state});
-
- if ($r_errstr) {
- $r_errstr .= sprintf " [err was %s now %s]", $r_err, $err
- if $r_err && $err && $r_err ne $err;
- $r_errstr .= sprintf " [state was %s now %s]", $r_state, $state
- if $r_state and $r_state ne "S1000" && $state && $r_state ne $state;
- $r_errstr .= "\n$errstr" if $r_errstr ne $errstr;
- }
- else {
- $r_errstr = $errstr;
- }
-
- # assign if higher priority: err > "0" > "" > undef
- my $err_changed;
- if ($err # new error: so assign
- or !defined $r_err # no existing warn/info: so assign
- # new warn ("0" len 1) > info ("" len 0): so assign
- or defined $err && length($err) > length($r_err)
- ) {
- $r_err = $err;
- ++$err_changed;
- }
-
- $r_state = ($state eq "00000") ? "" : $state
- if $state && $err_changed;
-
- ($self->{err}, $self->{errstr}, $self->{state}) = ($r_err, $r_errstr, $r_state);
-
- return undef;
-}
-
-
-sub summary_as_text {
- my $self = shift;
- my ($context) = @_;
-
- my ($rv, $err, $errstr, $state) = ($self->{rv}, $self->{err}, $self->{errstr}, $self->{state});
-
- my @s = sprintf("\trv=%s", (ref $rv) ? "[".neat_list($rv)."]" : neat($rv));
- $s[-1] .= sprintf(", err=%s, errstr=%s", $err, neat($errstr))
- if defined $err;
- $s[-1] .= sprintf(", flags=0x%x", $self->{flags})
- if defined $self->{flags};
-
- push @s, "last_insert_id=%s", $self->last_insert_id
- if defined $self->last_insert_id;
-
- if (my $dbh_attr = $self->dbh_attributes) {
- my @keys = sort keys %$dbh_attr;
- push @s, sprintf "dbh= { %s }", join(", ", map { "$_=>".neat($dbh_attr->{$_},100) } @keys)
- if @keys;
- }
-
- for my $rs (@{$self->sth_resultsets || []}) {
- my ($rowset, $err, $errstr, $state)
- = @{$rs}{qw(rowset err errstr state)};
- my $summary = "rowset: ";
- my $NUM_OF_FIELDS = $rs->{NUM_OF_FIELDS} || 0;
- my $rows = $rowset ? @$rowset : 0;
- if ($rowset || $NUM_OF_FIELDS > 0) {
- $summary .= sprintf "%d rows, %d columns", $rows, $NUM_OF_FIELDS;
- }
- $summary .= sprintf ", err=%s, errstr=%s", $err, neat($errstr) if defined $err;
- if ($rows) {
- my $NAME = $rs->{NAME};
- # generate
- my @colinfo = map { "$NAME->[$_]=".neat($rowset->[0][$_], 30) } 0..@{$NAME}-1;
- $summary .= sprintf " [%s]", join ", ", @colinfo;
- $summary .= ",..." if $rows > 1;
- # we can be a little more helpful for Sybase/MSSQL user
- $summary .= " syb_result_type=$rs->{syb_result_type}"
- if $rs->{syb_result_type} and $rs->{syb_result_type} != 4040;
- }
- push @s, $summary;
- }
- for my $w (@{$self->warnings || []}) {
- chomp $w;
- push @s, "warning: $w";
- }
- if ($context && %$context) {
- my @keys = sort keys %$context;
- push @s, join(", ", map { "$_=>".$context->{$_} } @keys);
- }
- return join("\n\t", @s). "\n";
-}
-
-
-sub outline_as_text { # one-line version of summary_as_text
- my $self = shift;
- my ($context) = @_;
-
- my ($rv, $err, $errstr, $state) = ($self->{rv}, $self->{err}, $self->{errstr}, $self->{state});
-
- my $s = sprintf("rv=%s", (ref $rv) ? "[".neat_list($rv)."]" : neat($rv));
- $s .= sprintf(", err=%s %s", $err, neat($errstr))
- if defined $err;
- $s .= sprintf(", flags=0x%x", $self->{flags})
- if $self->{flags};
-
- if (my $sth_resultsets = $self->sth_resultsets) {
- $s .= sprintf(", %d resultsets ", scalar @$sth_resultsets);
-
- my @rs;
- for my $rs (@{$self->sth_resultsets || []}) {
- my $summary = "";
- my ($rowset, $err, $errstr)
- = @{$rs}{qw(rowset err errstr)};
- my $NUM_OF_FIELDS = $rs->{NUM_OF_FIELDS} || 0;
- my $rows = $rowset ? @$rowset : 0;
- if ($rowset || $NUM_OF_FIELDS > 0) {
- $summary .= sprintf "%dr x %dc", $rows, $NUM_OF_FIELDS;
- }
- $summary .= sprintf "%serr %s %s", ($summary?", ":""), $err, neat($errstr)
- if defined $err;
- push @rs, $summary;
- }
- $s .= join "; ", map { "[$_]" } @rs;
- }
-
- return $s;
-}
-
-
-1;
-
-=head1 NAME
-
-DBI::Gofer::Response - Encapsulate a response from DBI::Gofer::Execute to DBD::Gofer
-
-=head1 DESCRIPTION
-
-This is an internal class.
-
-=head1 AUTHOR
-
-Tim Bunce, L<http://www.tim.bunce.name>
-
-=head1 LICENCE AND COPYRIGHT
-
-Copyright (c) 2007, Tim Bunce, Ireland. All rights reserved.
-
-This module is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself. See L<perlartistic>.
-
-=cut
-
+++ /dev/null
-package DBI::Gofer::Serializer::Base;
-
-# $Id: Base.pm 9949 2007-09-18 09:38:15Z Tim $
-#
-# Copyright (c) 2007, Tim Bunce, Ireland
-#
-# You may distribute under the terms of either the GNU General Public
-# License or the Artistic License, as specified in the Perl README file.
-
-=head1 NAME
-
-DBI::Gofer::Serializer::Base - base class for Gofer serialization
-
-=head1 SYNOPSIS
-
- $serializer = $serializer_class->new();
-
- $string = $serializer->serialize( $data );
- ($string, $deserializer_class) = $serializer->serialize( $data );
-
- $data = $serializer->deserialize( $string );
-
-=head1 DESCRIPTION
-
-DBI::Gofer::Serializer::* classes implement a very minimal subset of the L<Data::Serializer> API.
-
-Gofer serializers are expected to be very fast and are not required to deal
-with anything other than non-blessed references to arrays and hashes, and plain scalars.
-
-=cut
-
-
-use strict;
-use warnings;
-
-use Carp qw(croak);
-
-our $VERSION = "0.009950";
-
-
-sub new {
- my $class = shift;
- my $deserializer_class = $class->deserializer_class;
- return bless { deserializer_class => $deserializer_class } => $class;
-}
-
-sub deserializer_class {
- my $self = shift;
- my $class = ref($self) || $self;
- $class =~ s/^DBI::Gofer::Serializer:://;
- return $class;
-}
-
-sub serialize {
- my $self = shift;
- croak ref($self)." has not implemented the serialize method";
-}
-
-sub deserialize {
- my $self = shift;
- croak ref($self)." has not implemented the deserialize method";
-}
-
-1;
+++ /dev/null
-package DBI::Gofer::Serializer::DataDumper;
-
-use strict;
-use warnings;
-
-our $VERSION = "0.009950";
-
-# $Id: DataDumper.pm 9949 2007-09-18 09:38:15Z Tim $
-#
-# Copyright (c) 2007, Tim Bunce, Ireland
-#
-# You may distribute under the terms of either the GNU General Public
-# License or the Artistic License, as specified in the Perl README file.
-
-=head1 NAME
-
-DBI::Gofer::Serializer::DataDumper - Gofer serialization using DataDumper
-
-=head1 SYNOPSIS
-
- $serializer = DBI::Gofer::Serializer::DataDumper->new();
-
- $string = $serializer->serialize( $data );
-
-=head1 DESCRIPTION
-
-Uses DataDumper to serialize. Deserialization is not supported.
-The output of this class is only meant for human consumption.
-
-See also L<DBI::Gofer::Serializer::Base>.
-
-=cut
-
-use Data::Dumper;
-
-use base qw(DBI::Gofer::Serializer::Base);
-
-
-sub serialize {
- my $self = shift;
- local $Data::Dumper::Indent = 1;
- local $Data::Dumper::Terse = 1;
- local $Data::Dumper::Useqq = 0; # enabling this disables xs
- local $Data::Dumper::Sortkeys = 1;
- local $Data::Dumper::Quotekeys = 0;
- local $Data::Dumper::Deparse = 0;
- local $Data::Dumper::Purity = 0;
- my $frozen = Data::Dumper::Dumper(shift);
- return $frozen unless wantarray;
- return ($frozen, $self->{deserializer_class});
-}
-
-1;
+++ /dev/null
-package DBI::Gofer::Serializer::Storable;
-
-use strict;
-use warnings;
-
-use base qw(DBI::Gofer::Serializer::Base);
-
-# $Id: Storable.pm 15585 2013-03-22 20:31:22Z Tim $
-#
-# Copyright (c) 2007, Tim Bunce, Ireland
-#
-# You may distribute under the terms of either the GNU General Public
-# License or the Artistic License, as specified in the Perl README file.
-
-=head1 NAME
-
-DBI::Gofer::Serializer::Storable - Gofer serialization using Storable
-
-=head1 SYNOPSIS
-
- $serializer = DBI::Gofer::Serializer::Storable->new();
-
- $string = $serializer->serialize( $data );
- ($string, $deserializer_class) = $serializer->serialize( $data );
-
- $data = $serializer->deserialize( $string );
-
-=head1 DESCRIPTION
-
-Uses Storable::nfreeze() to serialize and Storable::thaw() to deserialize.
-
-The serialize() method sets local $Storable::forgive_me = 1; so it doesn't
-croak if it encounters any data types that can't be serialized, such as code refs.
-
-See also L<DBI::Gofer::Serializer::Base>.
-
-=cut
-
-use Storable qw(nfreeze thaw);
-
-our $VERSION = "0.015586";
-
-use base qw(DBI::Gofer::Serializer::Base);
-
-
-sub serialize {
- my $self = shift;
- local $Storable::forgive_me = 1; # for CODE refs etc
- local $Storable::canonical = 1; # for go_cache
- my $frozen = nfreeze(shift);
- return $frozen unless wantarray;
- return ($frozen, $self->{deserializer_class});
-}
-
-sub deserialize {
- my $self = shift;
- return thaw(shift);
-}
-
-1;
+++ /dev/null
-package DBI::Gofer::Transport::Base;
-
-# $Id: Base.pm 12536 2009-02-24 22:37:09Z Tim $
-#
-# Copyright (c) 2007, Tim Bunce, Ireland
-#
-# You may distribute under the terms of either the GNU General Public
-# License or the Artistic License, as specified in the Perl README file.
-
-use strict;
-use warnings;
-
-use DBI;
-
-use base qw(DBI::Util::_accessor);
-
-use DBI::Gofer::Serializer::Storable;
-use DBI::Gofer::Serializer::DataDumper;
-
-our $VERSION = "0.012537";
-
-__PACKAGE__->mk_accessors(qw(
- trace
- keep_meta_frozen
- serializer_obj
-));
-
-
-# see also $ENV{DBI_GOFER_TRACE} in DBI::Gofer::Execute
-sub _init_trace { (split(/=/,$ENV{DBI_GOFER_TRACE}||0))[0] }
-
-
-sub new {
- my ($class, $args) = @_;
- $args->{trace} ||= $class->_init_trace;
- $args->{serializer_obj} ||= DBI::Gofer::Serializer::Storable->new();
- my $self = bless {}, $class;
- $self->$_( $args->{$_} ) for keys %$args;
- $self->trace_msg("$class->new({ @{[ %$args ]} })\n") if $self->trace;
- return $self;
-}
-
-my $packet_header_text = "GoFER1:";
-my $packet_header_regex = qr/^GoFER(\d+):/;
-
-
-sub _freeze_data {
- my ($self, $data, $serializer, $skip_trace) = @_;
- my $frozen = eval {
- $self->_dump("freezing $self->{trace} ".ref($data), $data)
- if !$skip_trace and $self->trace;
-
- local $data->{meta}; # don't include meta in serialization
- $serializer ||= $self->{serializer_obj};
- my ($data, $deserializer_class) = $serializer->serialize($data);
-
- $packet_header_text . $data;
- };
- if ($@) {
- chomp $@;
- die "Error freezing ".ref($data)." object: $@";
- }
-
- # stash the frozen data into the data structure itself
- # to make life easy for the client caching code in DBD::Gofer::Transport::Base
- $data->{meta}{frozen} = $frozen if $self->keep_meta_frozen;
-
- return $frozen;
-}
-# public aliases used by subclasses
-*freeze_request = \&_freeze_data;
-*freeze_response = \&_freeze_data;
-
-
-sub _thaw_data {
- my ($self, $frozen_data, $serializer, $skip_trace) = @_;
- my $data;
- eval {
- # check for and extract our gofer header and the info it contains
- (my $frozen = $frozen_data) =~ s/$packet_header_regex//o
- or die "does not have gofer header\n";
- my ($t_version) = $1;
- $serializer ||= $self->{serializer_obj};
- $data = $serializer->deserialize($frozen);
- die ref($serializer)."->deserialize didn't return a reference"
- unless ref $data;
- $data->{_transport}{version} = $t_version;
-
- $data->{meta}{frozen} = $frozen_data if $self->keep_meta_frozen;
- };
- if ($@) {
- chomp(my $err = $@);
- # remove extra noise from Storable
- $err =~ s{ at \S+?/Storable.pm \(autosplit into \S+?/Storable/thaw.al\) line \d+(, \S+ line \d+)?}{};
- my $msg = sprintf "Error thawing: %s (data=%s)", $err, DBI::neat($frozen_data,50);
- Carp::cluck("$msg, pid $$ stack trace follows:"); # XXX if $self->trace;
- die $msg;
- }
- $self->_dump("thawing $self->{trace} ".ref($data), $data)
- if !$skip_trace and $self->trace;
-
- return $data;
-}
-# public aliases used by subclasses
-*thaw_request = \&_thaw_data;
-*thaw_response = \&_thaw_data;
-
-
-# this should probably live in the request and response classes
-# and the tace level passed in
-sub _dump {
- my ($self, $label, $data) = @_;
-
- # don't dump the binary
- local $data->{meta}{frozen} if $data->{meta} && $data->{meta}{frozen};
-
- my $trace_level = $self->trace;
- my $summary;
- if ($trace_level >= 4) {
- require Data::Dumper;
- local $Data::Dumper::Indent = 1;
- local $Data::Dumper::Terse = 1;
- local $Data::Dumper::Useqq = 0;
- local $Data::Dumper::Sortkeys = 1;
- local $Data::Dumper::Quotekeys = 0;
- local $Data::Dumper::Deparse = 0;
- local $Data::Dumper::Purity = 0;
- $summary = Data::Dumper::Dumper($data);
- }
- elsif ($trace_level >= 2) {
- $summary = eval { $data->summary_as_text } || $@ || "no summary available\n";
- }
- else {
- $summary = eval { $data->outline_as_text."\n" } || $@ || "no summary available\n";
- }
- $self->trace_msg("$label: $summary");
-}
-
-
-sub trace_msg {
- my ($self, $msg, $min_level) = @_;
- $min_level = 1 unless defined $min_level;
- # transport trace level can override DBI's trace level
- $min_level = 0 if $self->trace >= $min_level;
- return DBI->trace_msg("gofer ".$msg, $min_level);
-}
-
-1;
-
-=head1 NAME
-
-DBI::Gofer::Transport::Base - Base class for Gofer transports
-
-=head1 DESCRIPTION
-
-This is the base class for server-side Gofer transports.
-
-It's also the base class for the client-side base class L<DBD::Gofer::Transport::Base>.
-
-This is an internal class.
-
-=head1 AUTHOR
-
-Tim Bunce, L<http://www.tim.bunce.name>
-
-=head1 LICENCE AND COPYRIGHT
-
-Copyright (c) 2007, Tim Bunce, Ireland. All rights reserved.
-
-This module is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself. See L<perlartistic>.
-
-=cut
-
+++ /dev/null
-package DBI::Gofer::Transport::pipeone;
-
-# $Id: pipeone.pm 12536 2009-02-24 22:37:09Z Tim $
-#
-# Copyright (c) 2007, Tim Bunce, Ireland
-#
-# You may distribute under the terms of either the GNU General Public
-# License or the Artistic License, as specified in the Perl README file.
-
-use strict;
-use warnings;
-
-use DBI::Gofer::Execute;
-
-use base qw(DBI::Gofer::Transport::Base Exporter);
-
-our $VERSION = "0.012537";
-
-our @EXPORT = qw(run_one_stdio);
-
-my $executor = DBI::Gofer::Execute->new();
-
-sub run_one_stdio {
-
- binmode STDIN;
- binmode STDOUT;
-
- my $transport = DBI::Gofer::Transport::pipeone->new();
-
- my $frozen_request = do { local $/; <STDIN> };
-
- my $response = $executor->execute_request( $transport->thaw_request($frozen_request) );
-
- my $frozen_response = $transport->freeze_response($response);
-
- print $frozen_response;
-
- # no point calling $executor->update_stats(...) for pipeONE
-}
-
-1;
-__END__
-
-=head1 NAME
-
-DBI::Gofer::Transport::pipeone - DBD::Gofer server-side transport for pipeone
-
-=head1 SYNOPSIS
-
-See L<DBD::Gofer::Transport::pipeone>.
-
-=head1 AUTHOR
-
-Tim Bunce, L<http://www.tim.bunce.name>
-
-=head1 LICENCE AND COPYRIGHT
-
-Copyright (c) 2007, Tim Bunce, Ireland. All rights reserved.
-
-This module is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself. See L<perlartistic>.
-
-=cut
-
+++ /dev/null
-package DBI::Gofer::Transport::stream;
-
-# $Id: stream.pm 12536 2009-02-24 22:37:09Z Tim $
-#
-# Copyright (c) 2007, Tim Bunce, Ireland
-#
-# You may distribute under the terms of either the GNU General Public
-# License or the Artistic License, as specified in the Perl README file.
-
-use strict;
-use warnings;
-
-use DBI qw(dbi_time);
-use DBI::Gofer::Execute;
-
-use base qw(DBI::Gofer::Transport::pipeone Exporter);
-
-our $VERSION = "0.012537";
-
-our @EXPORT = qw(run_stdio_hex);
-
-my $executor = DBI::Gofer::Execute->new();
-
-sub run_stdio_hex {
-
- my $transport = DBI::Gofer::Transport::stream->new();
- local $| = 1;
-
- DBI->trace_msg("$0 started (pid $$)\n");
-
- local $\; # OUTPUT_RECORD_SEPARATOR
- local $/ = "\012"; # INPUT_RECORD_SEPARATOR
- while ( defined( my $encoded_request = <STDIN> ) ) {
- my $time_received = dbi_time();
- $encoded_request =~ s/\015?\012$//;
-
- my $frozen_request = pack "H*", $encoded_request;
- my $request = $transport->thaw_request( $frozen_request );
-
- my $response = $executor->execute_request( $request );
-
- my $frozen_response = $transport->freeze_response($response);
- my $encoded_response = unpack "H*", $frozen_response;
-
- print $encoded_response, "\015\012"; # autoflushed due to $|=1
-
- # there's no way to access the stats currently
- # so this just serves as a basic test and illustration of update_stats()
- $executor->update_stats($request, $response, $frozen_request, $frozen_response, $time_received, 1);
- }
- DBI->trace_msg("$0 ending (pid $$)\n");
-}
-
-1;
-__END__
-
-=head1 NAME
-
-DBI::Gofer::Transport::stream - DBD::Gofer server-side transport for stream
-
-=head1 SYNOPSIS
-
-See L<DBD::Gofer::Transport::stream>.
-
-=head1 AUTHOR
-
-Tim Bunce, L<http://www.tim.bunce.name>
-
-=head1 LICENCE AND COPYRIGHT
-
-Copyright (c) 2007, Tim Bunce, Ireland. All rights reserved.
-
-This module is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself. See L<perlartistic>.
-
-=cut
+++ /dev/null
-package DBI::Profile;
-
-=head1 NAME
-
-DBI::Profile - Performance profiling and benchmarking for the DBI
-
-=head1 SYNOPSIS
-
-The easiest way to enable DBI profiling is to set the DBI_PROFILE
-environment variable to 2 and then run your code as usual:
-
- DBI_PROFILE=2 prog.pl
-
-This will profile your program and then output a textual summary
-grouped by query when the program exits. You can also enable profiling by
-setting the Profile attribute of any DBI handle:
-
- $dbh->{Profile} = 2;
-
-Then the summary will be printed when the handle is destroyed.
-
-Many other values apart from are possible - see L<"ENABLING A PROFILE"> below.
-
-=head1 DESCRIPTION
-
-The DBI::Profile module provides a simple interface to collect and
-report performance and benchmarking data from the DBI.
-
-For a more elaborate interface, suitable for larger programs, see
-L<DBI::ProfileDumper|DBI::ProfileDumper> and L<dbiprof|dbiprof>.
-For Apache/mod_perl applications see
-L<DBI::ProfileDumper::Apache|DBI::ProfileDumper::Apache>.
-
-=head1 OVERVIEW
-
-Performance data collection for the DBI is built around several
-concepts which are important to understand clearly.
-
-=over 4
-
-=item Method Dispatch
-
-Every method call on a DBI handle passes through a single 'dispatch'
-function which manages all the common aspects of DBI method calls,
-such as handling the RaiseError attribute.
-
-=item Data Collection
-
-If profiling is enabled for a handle then the dispatch code takes
-a high-resolution timestamp soon after it is entered. Then, after
-calling the appropriate method and just before returning, it takes
-another high-resolution timestamp and calls a function to record
-the information. That function is passed the two timestamps
-plus the DBI handle and the name of the method that was called.
-That data about a single DBI method call is called a I<profile sample>.
-
-=item Data Filtering
-
-If the method call was invoked by the DBI or by a driver then the call is
-ignored for profiling because the time spent will be accounted for by the
-original 'outermost' call for your code.
-
-For example, the calls that the selectrow_arrayref() method makes
-to prepare() and execute() etc. are not counted individually
-because the time spent in those methods is going to be allocated
-to the selectrow_arrayref() method when it returns. If this was not
-done then it would be very easy to double count time spent inside
-the DBI.
-
-=item Data Storage Tree
-
-The profile data is accumulated as 'leaves on a tree'. The 'path' through the
-branches of the tree to a particular leaf is determined dynamically for each sample.
-This is a key feature of DBI profiling.
-
-For each profiled method call the DBI walks along the Path and uses each value
-in the Path to step into and grow the Data tree.
-
-For example, if the Path is
-
- [ 'foo', 'bar', 'baz' ]
-
-then the new profile sample data will be I<merged> into the tree at
-
- $h->{Profile}->{Data}->{foo}->{bar}->{baz}
-
-But it's not very useful to merge all the call data into one leaf node (except
-to get an overall 'time spent inside the DBI' total). It's more common to want
-the Path to include dynamic values such as the current statement text and/or
-the name of the method called to show what the time spent inside the DBI was for.
-
-The Path can contain some 'magic cookie' values that are automatically replaced
-by corresponding dynamic values when they're used. These magic cookies always
-start with a punctuation character.
-
-For example a value of 'C<!MethodName>' in the Path causes the corresponding
-entry in the Data to be the name of the method that was called.
-For example, if the Path was:
-
- [ 'foo', '!MethodName', 'bar' ]
-
-and the selectall_arrayref() method was called, then the profile sample data
-for that call will be merged into the tree at:
-
- $h->{Profile}->{Data}->{foo}->{selectall_arrayref}->{bar}
-
-=item Profile Data
-
-Profile data is stored at the 'leaves' of the tree as references
-to an array of numeric values. For example:
-
- [
- 106, # 0: count of samples at this node
- 0.0312958955764771, # 1: total duration
- 0.000490069389343262, # 2: first duration
- 0.000176072120666504, # 3: shortest duration
- 0.00140702724456787, # 4: longest duration
- 1023115819.83019, # 5: time of first sample
- 1023115819.86576, # 6: time of last sample
- ]
-
-After the first sample, later samples always update elements 0, 1, and 6, and
-may update 3 or 4 depending on the duration of the sampled call.
-
-=back
-
-=head1 ENABLING A PROFILE
-
-Profiling is enabled for a handle by assigning to the Profile
-attribute. For example:
-
- $h->{Profile} = DBI::Profile->new();
-
-The Profile attribute holds a blessed reference to a hash object
-that contains the profile data and attributes relating to it.
-
-The class the Profile object is blessed into is expected to
-provide at least a DESTROY method which will dump the profile data
-to the DBI trace file handle (STDERR by default).
-
-All these examples have the same effect as each other:
-
- $h->{Profile} = 0;
- $h->{Profile} = "/DBI::Profile";
- $h->{Profile} = DBI::Profile->new();
- $h->{Profile} = {};
- $h->{Profile} = { Path => [] };
-
-Similarly, these examples have the same effect as each other:
-
- $h->{Profile} = 6;
- $h->{Profile} = "6/DBI::Profile";
- $h->{Profile} = "!Statement:!MethodName/DBI::Profile";
- $h->{Profile} = { Path => [ '!Statement', '!MethodName' ] };
-
-If a non-blessed hash reference is given then the DBI::Profile
-module is automatically C<require>'d and the reference is blessed
-into that class.
-
-If a string is given then it is processed like this:
-
- ($path, $module, $args) = split /\//, $string, 3
-
- @path = split /:/, $path
- @args = split /:/, $args
-
- eval "require $module" if $module
- $module ||= "DBI::Profile"
-
- $module->new( Path => \@Path, @args )
-
-So the first value is used to select the Path to be used (see below).
-The second value, if present, is used as the name of a module which
-will be loaded and it's C<new> method called. If not present it
-defaults to DBI::Profile. Any other values are passed as arguments
-to the C<new> method. For example: "C<2/DBIx::OtherProfile/Foo:42>".
-
-Numbers can be used as a shorthand way to enable common Path values.
-The simplest way to explain how the values are interpreted is to show the code:
-
- push @Path, "DBI" if $path_elem & 0x01;
- push @Path, "!Statement" if $path_elem & 0x02;
- push @Path, "!MethodName" if $path_elem & 0x04;
- push @Path, "!MethodClass" if $path_elem & 0x08;
- push @Path, "!Caller2" if $path_elem & 0x10;
-
-So "2" is the same as "!Statement" and "6" (2+4) is the same as
-"!Statement:!Method". Those are the two most commonly used values. Using a
-negative number will reverse the path. Thus "-6" will group by method name then
-statement.
-
-The splitting and parsing of string values assigned to the Profile
-attribute may seem a little odd, but there's a good reason for it.
-Remember that attributes can be embedded in the Data Source Name
-string which can be passed in to a script as a parameter. For
-example:
-
- dbi:DriverName(Profile=>2):dbname
- dbi:DriverName(Profile=>{Username}:!Statement/MyProfiler/Foo:42):dbname
-
-And also, if the C<DBI_PROFILE> environment variable is set then
-The DBI arranges for every driver handle to share the same profile
-object. When perl exits a single profile summary will be generated
-that reflects (as nearly as practical) the total use of the DBI by
-the application.
-
-
-=head1 THE PROFILE OBJECT
-
-The DBI core expects the Profile attribute value to be a hash
-reference and if the following values don't exist it will create
-them as needed:
-
-=head2 Data
-
-A reference to a hash containing the collected profile data.
-
-=head2 Path
-
-The Path value is a reference to an array. Each element controls the
-value to use at the corresponding level of the profile Data tree.
-
-If the value of Path is anything other than an array reference,
-it is treated as if it was:
-
- [ '!Statement' ]
-
-The elements of Path array can be one of the following types:
-
-=head3 Special Constant
-
-B<!Statement>
-
-Use the current Statement text. Typically that's the value of the Statement
-attribute for the handle the method was called with. Some methods, like
-commit() and rollback(), are unrelated to a particular statement. For those
-methods !Statement records an empty string.
-
-For statement handles this is always simply the string that was
-given to prepare() when the handle was created. For database handles
-this is the statement that was last prepared or executed on that
-database handle. That can lead to a little 'fuzzyness' because, for
-example, calls to the quote() method to build a new statement will
-typically be associated with the previous statement. In practice
-this isn't a significant issue and the dynamic Path mechanism can
-be used to setup your own rules.
-
-B<!MethodName>
-
-Use the name of the DBI method that the profile sample relates to.
-
-B<!MethodClass>
-
-Use the fully qualified name of the DBI method, including
-the package, that the profile sample relates to. This shows you
-where the method was implemented. For example:
-
- 'DBD::_::db::selectrow_arrayref' =>
- 0.022902s
- 'DBD::mysql::db::selectrow_arrayref' =>
- 2.244521s / 99 = 0.022445s avg (first 0.022813s, min 0.022051s, max 0.028932s)
-
-The "DBD::_::db::selectrow_arrayref" shows that the driver has
-inherited the selectrow_arrayref method provided by the DBI.
-
-But you'll note that there is only one call to
-DBD::_::db::selectrow_arrayref but another 99 to
-DBD::mysql::db::selectrow_arrayref. Currently the first
-call doesn't record the true location. That may change.
-
-B<!Caller>
-
-Use a string showing the filename and line number of the code calling the method.
-
-B<!Caller2>
-
-Use a string showing the filename and line number of the code calling the
-method, as for !Caller, but also include filename and line number of the code
-that called that. Calls from DBI:: and DBD:: packages are skipped.
-
-B<!File>
-
-Same as !Caller above except that only the filename is included, not the line number.
-
-B<!File2>
-
-Same as !Caller2 above except that only the filenames are included, not the line number.
-
-B<!Time>
-
-Use the current value of time(). Rarely used. See the more useful C<!Time~N> below.
-
-B<!Time~N>
-
-Where C<N> is an integer. Use the current value of time() but with reduced precision.
-The value used is determined in this way:
-
- int( time() / N ) * N
-
-This is a useful way to segregate a profile into time slots. For example:
-
- [ '!Time~60', '!Statement' ]
-
-=head3 Code Reference
-
-The subroutine is passed the handle it was called on and the DBI method name.
-The current Statement is in $_. The statement string should not be modified,
-so most subs start with C<local $_ = $_;>.
-
-The list of values it returns is used at that point in the Profile Path.
-Any undefined values are treated as the string "C<undef>".
-
-The sub can 'veto' (reject) a profile sample by including a reference to undef
-(C<\undef>) in the returned list. That can be useful when you want to only profile
-statements that match a certain pattern, or only profile certain methods.
-
-=head3 Subroutine Specifier
-
-A Path element that begins with 'C<&>' is treated as the name of a subroutine
-in the DBI::ProfileSubs namespace and replaced with the corresponding code reference.
-
-Currently this only works when the Path is specified by the C<DBI_PROFILE>
-environment variable.
-
-Also, currently, the only subroutine in the DBI::ProfileSubs namespace is
-C<'&norm_std_n3'>. That's a very handy subroutine when profiling code that
-doesn't use placeholders. See L<DBI::ProfileSubs> for more information.
-
-=head3 Attribute Specifier
-
-A string enclosed in braces, such as 'C<{Username}>', specifies that the current
-value of the corresponding database handle attribute should be used at that
-point in the Path.
-
-=head3 Reference to a Scalar
-
-Specifies that the current value of the referenced scalar be used at that point
-in the Path. This provides an efficient way to get 'contextual' values into
-your profile.
-
-=head3 Other Values
-
-Any other values are stringified and used literally.
-
-(References, and values that begin with punctuation characters are reserved.)
-
-
-=head1 REPORTING
-
-=head2 Report Format
-
-The current accumulated profile data can be formatted and output using
-
- print $h->{Profile}->format;
-
-To discard the profile data and start collecting fresh data
-you can do:
-
- $h->{Profile}->{Data} = undef;
-
-
-The default results format looks like this:
-
- DBI::Profile: 0.001015s 42.7% (5 calls) programname @ YYYY-MM-DD HH:MM:SS
- '' =>
- 0.000024s / 2 = 0.000012s avg (first 0.000015s, min 0.000009s, max 0.000015s)
- 'SELECT mode,size,name FROM table' =>
- 0.000991s / 3 = 0.000330s avg (first 0.000678s, min 0.000009s, max 0.000678s)
-
-Which shows the total time spent inside the DBI, with a count of
-the total number of method calls and the name of the script being
-run, then a formatted version of the profile data tree.
-
-If the results are being formatted when the perl process is exiting
-(which is usually the case when the DBI_PROFILE environment variable
-is used) then the percentage of time the process spent inside the
-DBI is also shown. If the process is not exiting then the percentage is
-calculated using the time between the first and last call to the DBI.
-
-In the example above the paths in the tree are only one level deep and
-use the Statement text as the value (that's the default behaviour).
-
-The merged profile data at the 'leaves' of the tree are presented
-as total time spent, count, average time spent (which is simply total
-time divided by the count), then the time spent on the first call,
-the time spent on the fastest call, and finally the time spent on
-the slowest call.
-
-The 'avg', 'first', 'min' and 'max' times are not particularly
-useful when the profile data path only contains the statement text.
-Here's an extract of a more detailed example using both statement
-text and method name in the path:
-
- 'SELECT mode,size,name FROM table' =>
- 'FETCH' =>
- 0.000076s
- 'fetchrow_hashref' =>
- 0.036203s / 108 = 0.000335s avg (first 0.000490s, min 0.000152s, max 0.002786s)
-
-Here you can see the 'avg', 'first', 'min' and 'max' for the
-108 calls to fetchrow_hashref() become rather more interesting.
-Also the data for FETCH just shows a time value because it was only
-called once.
-
-Currently the profile data is output sorted by branch names. That
-may change in a later version so the leaf nodes are sorted by total
-time per leaf node.
-
-
-=head2 Report Destination
-
-The default method of reporting is for the DESTROY method of the
-Profile object to format the results and write them using:
-
- DBI->trace_msg($results, 0); # see $ON_DESTROY_DUMP below
-
-to write them to the DBI trace() filehandle (which defaults to
-STDERR). To direct the DBI trace filehandle to write to a file
-without enabling tracing the trace() method can be called with a
-trace level of 0. For example:
-
- DBI->trace(0, $filename);
-
-The same effect can be achieved without changing the code by
-setting the C<DBI_TRACE> environment variable to C<0=filename>.
-
-The $DBI::Profile::ON_DESTROY_DUMP variable holds a code ref
-that's called to perform the output of the formatted results.
-The default value is:
-
- $ON_DESTROY_DUMP = sub { DBI->trace_msg($results, 0) };
-
-Apart from making it easy to send the dump elsewhere, it can also
-be useful as a simple way to disable dumping results.
-
-=head1 CHILD HANDLES
-
-Child handles inherit a reference to the Profile attribute value
-of their parent. So if profiling is enabled for a database handle
-then by default the statement handles created from it all contribute
-to the same merged profile data tree.
-
-
-=head1 PROFILE OBJECT METHODS
-
-=head2 format
-
-See L</REPORTING>.
-
-=head2 as_node_path_list
-
- @ary = $dbh->{Profile}->as_node_path_list();
- @ary = $dbh->{Profile}->as_node_path_list($node, $path);
-
-Returns the collected data ($dbh->{Profile}{Data}) restructured into a list of
-array refs, one for each leaf node in the Data tree. This 'flat' structure is
-often much simpler for applications to work with.
-
-The first element of each array ref is a reference to the leaf node.
-The remaining elements are the 'path' through the data tree to that node.
-
-For example, given a data tree like this:
-
- {key1a}{key2a}[node1]
- {key1a}{key2b}[node2]
- {key1b}{key2a}{key3a}[node3]
-
-The as_node_path_list() method will return this list:
-
- [ [node1], 'key1a', 'key2a' ]
- [ [node2], 'key1a', 'key2b' ]
- [ [node3], 'key1b', 'key2a', 'key3a' ]
-
-The nodes are ordered by key, depth-first.
-
-The $node argument can be used to focus on a sub-tree.
-If not specified it defaults to $dbh->{Profile}{Data}.
-
-The $path argument can be used to specify a list of path elements that will be
-added to each element of the returned list. If not specified it defaults to a
-ref to an empty array.
-
-=head2 as_text
-
- @txt = $dbh->{Profile}->as_text();
- $txt = $dbh->{Profile}->as_text({
- node => undef,
- path => [],
- separator => " > ",
- format => '%1$s: %11$fs / %10$d = %2$fs avg (first %12$fs, min %13$fs, max %14$fs)'."\n";
- sortsub => sub { ... },
- );
-
-Returns the collected data ($dbh->{Profile}{Data}) reformatted into a list of formatted strings.
-In scalar context the list is returned as a single concatenated string.
-
-A hashref can be used to pass in arguments, the default values are shown in the example above.
-
-The C<node> and <path> arguments are passed to as_node_path_list().
-
-The C<separator> argument is used to join the elements of the path for each leaf node.
-
-The C<sortsub> argument is used to pass in a ref to a sub that will order the list.
-The subroutine will be passed a reference to the array returned by
-as_node_path_list() and should sort the contents of the array in place.
-The return value from the sub is ignored. For example, to sort the nodes by the
-second level key you could use:
-
- sortsub => sub { my $ary=shift; @$ary = sort { $a->[2] cmp $b->[2] } @$ary }
-
-The C<format> argument is a C<sprintf> format string that specifies the format
-to use for each leaf node. It uses the explicit format parameter index
-mechanism to specify which of the arguments should appear where in the string.
-The arguments to sprintf are:
-
- 1: path to node, joined with the separator
- 2: average duration (total duration/count)
- (3 thru 9 are currently unused)
- 10: count
- 11: total duration
- 12: first duration
- 13: smallest duration
- 14: largest duration
- 15: time of first call
- 16: time of first call
-
-=head1 CUSTOM DATA MANIPULATION
-
-Recall that C<< $h->{Profile}->{Data} >> is a reference to the collected data.
-Either to a 'leaf' array (when the Path is empty, i.e., DBI_PROFILE env var is 1),
-or a reference to hash containing values that are either further hash
-references or leaf array references.
-
-Sometimes it's useful to be able to summarise some or all of the collected data.
-The dbi_profile_merge_nodes() function can be used to merge leaf node values.
-
-=head2 dbi_profile_merge_nodes
-
- use DBI qw(dbi_profile_merge_nodes);
-
- $time_in_dbi = dbi_profile_merge_nodes(my $totals=[], @$leaves);
-
-Merges profile data node. Given a reference to a destination array, and zero or
-more references to profile data, merges the profile data into the destination array.
-For example:
-
- $time_in_dbi = dbi_profile_merge_nodes(
- my $totals=[],
- [ 10, 0.51, 0.11, 0.01, 0.22, 1023110000, 1023110010 ],
- [ 15, 0.42, 0.12, 0.02, 0.23, 1023110005, 1023110009 ],
- );
-
-$totals will then contain
-
- [ 25, 0.93, 0.11, 0.01, 0.23, 1023110000, 1023110010 ]
-
-and $time_in_dbi will be 0.93;
-
-The second argument need not be just leaf nodes. If given a reference to a hash
-then the hash is recursively searched for leaf nodes and all those found
-are merged.
-
-For example, to get the time spent 'inside' the DBI during an http request,
-your logging code run at the end of the request (i.e. mod_perl LogHandler)
-could use:
-
- my $time_in_dbi = 0;
- if (my $Profile = $dbh->{Profile}) { # if DBI profiling is enabled
- $time_in_dbi = dbi_profile_merge_nodes(my $total=[], $Profile->{Data});
- $Profile->{Data} = {}; # reset the profile data
- }
-
-If profiling has been enabled then $time_in_dbi will hold the time spent inside
-the DBI for that handle (and any other handles that share the same profile data)
-since the last request.
-
-Prior to DBI 1.56 the dbi_profile_merge_nodes() function was called dbi_profile_merge().
-That name still exists as an alias.
-
-=head1 CUSTOM DATA COLLECTION
-
-=head2 Using The Path Attribute
-
- XXX example to be added later using a selectall_arrayref call
- XXX nested inside a fetch loop where the first column of the
- XXX outer loop is bound to the profile Path using
- XXX bind_column(1, \${ $dbh->{Profile}->{Path}->[0] })
- XXX so you end up with separate profiles for each loop
- XXX (patches welcome to add this to the docs :)
-
-=head2 Adding Your Own Samples
-
-The dbi_profile() function can be used to add extra sample data
-into the profile data tree. For example:
-
- use DBI;
- use DBI::Profile (dbi_profile dbi_time);
-
- my $t1 = dbi_time(); # floating point high-resolution time
-
- ... execute code you want to profile here ...
-
- my $t2 = dbi_time();
- dbi_profile($h, $statement, $method, $t1, $t2);
-
-The $h parameter is the handle the extra profile sample should be
-associated with. The $statement parameter is the string to use where
-the Path specifies !Statement. If $statement is undef
-then $h->{Statement} will be used. Similarly $method is the string
-to use if the Path specifies !MethodName. There is no
-default value for $method.
-
-The $h->{Profile}{Path} attribute is processed by dbi_profile() in
-the usual way.
-
-The $h parameter is usually a DBI handle but it can also be a reference to a
-hash, in which case the dbi_profile() acts on each defined value in the hash.
-This is an efficient way to update multiple profiles with a single sample,
-and is used by the L<DashProfiler> module.
-
-=head1 SUBCLASSING
-
-Alternate profile modules must subclass DBI::Profile to help ensure
-they work with future versions of the DBI.
-
-
-=head1 CAVEATS
-
-Applications which generate many different statement strings
-(typically because they don't use placeholders) and profile with
-!Statement in the Path (the default) will consume memory
-in the Profile Data structure for each statement. Use a code ref
-in the Path to return an edited (simplified) form of the statement.
-
-If a method throws an exception itself (not via RaiseError) then
-it won't be counted in the profile.
-
-If a HandleError subroutine throws an exception (rather than returning
-0 and letting RaiseError do it) then the method call won't be counted
-in the profile.
-
-Time spent in DESTROY is added to the profile of the parent handle.
-
-Time spent in DBI->*() methods is not counted. The time spent in
-the driver connect method, $drh->connect(), when it's called by
-DBI->connect is counted if the DBI_PROFILE environment variable is set.
-
-Time spent fetching tied variables, $DBI::errstr, is counted.
-
-Time spent in FETCH for $h->{Profile} is not counted, so getting the profile
-data doesn't alter it.
-
-DBI::PurePerl does not support profiling (though it could in theory).
-
-For asynchronous queries, time spent while the query is running on the
-backend is not counted.
-
-A few platforms don't support the gettimeofday() high resolution
-time function used by the DBI (and available via the dbi_time() function).
-In which case you'll get integer resolution time which is mostly useless.
-
-On Windows platforms the dbi_time() function is limited to millisecond
-resolution. Which isn't sufficiently fine for our needs, but still
-much better than integer resolution. This limited resolution means
-that fast method calls will often register as taking 0 time. And
-timings in general will have much more 'jitter' depending on where
-within the 'current millisecond' the start and end timing was taken.
-
-This documentation could be more clear. Probably needs to be reordered
-to start with several examples and build from there. Trying to
-explain the concepts first seems painful and to lead to just as
-many forward references. (Patches welcome!)
-
-=cut
-
-
-use strict;
-use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION);
-use Exporter ();
-use UNIVERSAL ();
-use Carp;
-
-use DBI qw(dbi_time dbi_profile dbi_profile_merge_nodes dbi_profile_merge);
-
-$VERSION = "2.015065";
-
-@ISA = qw(Exporter);
-@EXPORT = qw(
- DBIprofile_Statement
- DBIprofile_MethodName
- DBIprofile_MethodClass
- dbi_profile
- dbi_profile_merge_nodes
- dbi_profile_merge
- dbi_time
-);
-@EXPORT_OK = qw(
- format_profile_thingy
-);
-
-use constant DBIprofile_Statement => '!Statement';
-use constant DBIprofile_MethodName => '!MethodName';
-use constant DBIprofile_MethodClass => '!MethodClass';
-
-our $ON_DESTROY_DUMP = sub { DBI->trace_msg(shift, 0) };
-our $ON_FLUSH_DUMP = sub { DBI->trace_msg(shift, 0) };
-
-sub new {
- my $class = shift;
- my $profile = { @_ };
- return bless $profile => $class;
-}
-
-
-sub _auto_new {
- my $class = shift;
- my ($arg) = @_;
-
- # This sub is called by DBI internals when a non-hash-ref is
- # assigned to the Profile attribute. For example
- # dbi:mysql(RaiseError=>1,Profile=>!Statement:!MethodName/DBIx::MyProfile/arg1:arg2):dbname
- # This sub works out what to do and returns a suitable hash ref.
-
- $arg =~ s/^DBI::/2\/DBI::/
- and carp "Automatically changed old-style DBI::Profile specification to $arg";
-
- # it's a path/module/k1:v1:k2:v2:... list
- my ($path, $package, $args) = split /\//, $arg, 3;
- my @args = (defined $args) ? split(/:/, $args, -1) : ();
- my @Path;
-
- for my $element (split /:/, $path) {
- if (DBI::looks_like_number($element)) {
- my $reverse = ($element < 0) ? ($element=-$element, 1) : 0;
- my @p;
- # a single "DBI" is special-cased in format()
- push @p, "DBI" if $element & 0x01;
- push @p, DBIprofile_Statement if $element & 0x02;
- push @p, DBIprofile_MethodName if $element & 0x04;
- push @p, DBIprofile_MethodClass if $element & 0x08;
- push @p, '!Caller2' if $element & 0x10;
- push @Path, ($reverse ? reverse @p : @p);
- }
- elsif ($element =~ m/^&(\w.*)/) {
- my $name = "DBI::ProfileSubs::$1"; # capture $1 early
- require DBI::ProfileSubs;
- my $code = do { no strict; *{$name}{CODE} };
- if (defined $code) {
- push @Path, $code;
- }
- else {
- warn "$name: subroutine not found\n";
- push @Path, $element;
- }
- }
- else {
- push @Path, $element;
- }
- }
-
- eval "require $package" if $package; # silently ignores errors
- $package ||= $class;
-
- return $package->new(Path => \@Path, @args);
-}
-
-
-sub empty { # empty out profile data
- my $self = shift;
- DBI->trace_msg("profile data discarded\n",0) if $self->{Trace};
- $self->{Data} = undef;
-}
-
-sub filename { # baseclass method, see DBI::ProfileDumper
- return undef;
-}
-
-sub flush_to_disk { # baseclass method, see DBI::ProfileDumper & DashProfiler::Core
- my $self = shift;
- return unless $ON_FLUSH_DUMP;
- return unless $self->{Data};
- my $detail = $self->format();
- $ON_FLUSH_DUMP->($detail) if $detail;
-}
-
-
-sub as_node_path_list {
- my ($self, $node, $path) = @_;
- # convert the tree into an array of arrays
- # from
- # {key1a}{key2a}[node1]
- # {key1a}{key2b}[node2]
- # {key1b}{key2a}{key3a}[node3]
- # to
- # [ [node1], 'key1a', 'key2a' ]
- # [ [node2], 'key1a', 'key2b' ]
- # [ [node3], 'key1b', 'key2a', 'key3a' ]
-
- $node ||= $self->{Data} or return;
- $path ||= [];
- if (ref $node eq 'HASH') { # recurse
- $path = [ @$path, undef ];
- return map {
- $path->[-1] = $_;
- ($node->{$_}) ? $self->as_node_path_list($node->{$_}, $path) : ()
- } sort keys %$node;
- }
- return [ $node, @$path ];
-}
-
-
-sub as_text {
- my ($self, $args_ref) = @_;
- my $separator = $args_ref->{separator} || " > ";
- my $format_path_element = $args_ref->{format_path_element}
- || "%s"; # or e.g., " key%2$d='%s'"
- my $format = $args_ref->{format}
- || '%1$s: %11$fs / %10$d = %2$fs avg (first %12$fs, min %13$fs, max %14$fs)'."\n";
-
- my @node_path_list = $self->as_node_path_list(undef, $args_ref->{path});
-
- $args_ref->{sortsub}->(\@node_path_list) if $args_ref->{sortsub};
-
- my $eval = "qr/".quotemeta($separator)."/";
- my $separator_re = eval($eval) || quotemeta($separator);
- #warn "[$eval] = [$separator_re]";
- my @text;
- my @spare_slots = (undef) x 7;
- for my $node_path (@node_path_list) {
- my ($node, @path) = @$node_path;
- my $idx = 0;
- for (@path) {
- s/[\r\n]+/ /g;
- s/$separator_re/ /g;
- ++$idx;
- if ($format_path_element eq "%s") {
- $_ = sprintf $format_path_element, $_;
- } else {
- $_ = sprintf $format_path_element, $_, $idx;
- }
- }
- push @text, sprintf $format,
- join($separator, @path), # 1=path
- ($node->[0] ? $node->[1]/$node->[0] : 0), # 2=avg
- @spare_slots,
- @$node; # 10=count, 11=dur, 12=first_dur, 13=min, 14=max, 15=first_called, 16=last_called
- }
- return @text if wantarray;
- return join "", @text;
-}
-
-
-sub format {
- my $self = shift;
- my $class = ref($self) || $self;
-
- my $prologue = "$class: ";
- my $detail = $self->format_profile_thingy(
- $self->{Data}, 0, " ",
- my $path = [],
- my $leaves = [],
- )."\n";
-
- if (@$leaves) {
- dbi_profile_merge_nodes(my $totals=[], @$leaves);
- my ($count, $time_in_dbi, undef, undef, undef, $t1, $t2) = @$totals;
- (my $progname = $0) =~ s:.*/::;
- if ($count) {
- $prologue .= sprintf "%fs ", $time_in_dbi;
- my $perl_time = ($DBI::PERL_ENDING) ? time() - $^T : $t2-$t1;
- $prologue .= sprintf "%.2f%% ", $time_in_dbi/$perl_time*100 if $perl_time;
- my @lt = localtime(time);
- my $ts = sprintf "%d-%02d-%02d %02d:%02d:%02d",
- 1900+$lt[5], $lt[4]+1, @lt[3,2,1,0];
- $prologue .= sprintf "(%d calls) $progname \@ $ts\n", $count;
- }
- if (@$leaves == 1 && ref($self->{Data}) eq 'HASH' && $self->{Data}->{DBI}) {
- $detail = ""; # hide the "DBI" from DBI_PROFILE=1
- }
- }
- return ($prologue, $detail) if wantarray;
- return $prologue.$detail;
-}
-
-
-sub format_profile_leaf {
- my ($self, $thingy, $depth, $pad, $path, $leaves) = @_;
- croak "format_profile_leaf called on non-leaf ($thingy)"
- unless UNIVERSAL::isa($thingy,'ARRAY');
-
- push @$leaves, $thingy if $leaves;
- my ($count, $total_time, $first_time, $min, $max, $first_called, $last_called) = @$thingy;
- return sprintf "%s%fs\n", ($pad x $depth), $total_time
- if $count <= 1;
- return sprintf "%s%fs / %d = %fs avg (first %fs, min %fs, max %fs)\n",
- ($pad x $depth), $total_time, $count, $count ? $total_time/$count : 0,
- $first_time, $min, $max;
-}
-
-
-sub format_profile_branch {
- my ($self, $thingy, $depth, $pad, $path, $leaves) = @_;
- croak "format_profile_branch called on non-branch ($thingy)"
- unless UNIVERSAL::isa($thingy,'HASH');
- my @chunk;
- my @keys = sort keys %$thingy;
- while ( @keys ) {
- my $k = shift @keys;
- my $v = $thingy->{$k};
- push @$path, $k;
- push @chunk, sprintf "%s'%s' =>\n%s",
- ($pad x $depth), $k,
- $self->format_profile_thingy($v, $depth+1, $pad, $path, $leaves);
- pop @$path;
- }
- return join "", @chunk;
-}
-
-
-sub format_profile_thingy {
- my ($self, $thingy, $depth, $pad, $path, $leaves) = @_;
- return "undef" if not defined $thingy;
- return $self->format_profile_leaf( $thingy, $depth, $pad, $path, $leaves)
- if UNIVERSAL::isa($thingy,'ARRAY');
- return $self->format_profile_branch($thingy, $depth, $pad, $path, $leaves)
- if UNIVERSAL::isa($thingy,'HASH');
- return "$thingy\n";
-}
-
-
-sub on_destroy {
- my $self = shift;
- return unless $ON_DESTROY_DUMP;
- return unless $self->{Data};
- my $detail = $self->format();
- $ON_DESTROY_DUMP->($detail) if $detail;
- $self->{Data} = undef;
-}
-
-sub DESTROY {
- my $self = shift;
- local $@;
- DBI->trace_msg("profile data DESTROY\n",0)
- if (($self->{Trace}||0) >= 2);
- eval { $self->on_destroy };
- if ($@) {
- chomp $@;
- my $class = ref($self) || $self;
- DBI->trace_msg("$class on_destroy failed: $@", 0);
- }
-}
-
-1;
-
+++ /dev/null
-package DBI::ProfileData;
-use strict;
-
-=head1 NAME
-
-DBI::ProfileData - manipulate DBI::ProfileDumper data dumps
-
-=head1 SYNOPSIS
-
-The easiest way to use this module is through the dbiprof frontend
-(see L<dbiprof> for details):
-
- dbiprof --number 15 --sort count
-
-This module can also be used to roll your own profile analysis:
-
- # load data from dbi.prof
- $prof = DBI::ProfileData->new(File => "dbi.prof");
-
- # get a count of the records (unique paths) in the data set
- $count = $prof->count();
-
- # sort by longest overall time
- $prof->sort(field => "longest");
-
- # sort by longest overall time, least to greatest
- $prof->sort(field => "longest", reverse => 1);
-
- # exclude records with key2 eq 'disconnect'
- $prof->exclude(key2 => 'disconnect');
-
- # exclude records with key1 matching /^UPDATE/i
- $prof->exclude(key1 => qr/^UPDATE/i);
-
- # remove all records except those where key1 matches /^SELECT/i
- $prof->match(key1 => qr/^SELECT/i);
-
- # produce a formatted report with the given number of items
- $report = $prof->report(number => 10);
-
- # clone the profile data set
- $clone = $prof->clone();
-
- # get access to hash of header values
- $header = $prof->header();
-
- # get access to sorted array of nodes
- $nodes = $prof->nodes();
-
- # format a single node in the same style as report()
- $text = $prof->format($nodes->[0]);
-
- # get access to Data hash in DBI::Profile format
- $Data = $prof->Data();
-
-=head1 DESCRIPTION
-
-This module offers the ability to read, manipulate and format
-L<DBI::ProfileDumper> profile data.
-
-Conceptually, a profile consists of a series of records, or nodes,
-each of each has a set of statistics and set of keys. Each record
-must have a unique set of keys, but there is no requirement that every
-record have the same number of keys.
-
-=head1 METHODS
-
-The following methods are supported by DBI::ProfileData objects.
-
-=cut
-
-our $VERSION = "2.010008";
-
-use Carp qw(croak);
-use Symbol;
-use Fcntl qw(:flock);
-
-use DBI::Profile qw(dbi_profile_merge);
-
-# some constants for use with node data arrays
-sub COUNT () { 0 };
-sub TOTAL () { 1 };
-sub FIRST () { 2 };
-sub SHORTEST () { 3 };
-sub LONGEST () { 4 };
-sub FIRST_AT () { 5 };
-sub LAST_AT () { 6 };
-sub PATH () { 7 };
-
-
-my $HAS_FLOCK = (defined $ENV{DBI_PROFILE_FLOCK})
- ? $ENV{DBI_PROFILE_FLOCK}
- : do { local $@; eval { flock STDOUT, 0; 1 } };
-
-
-=head2 $prof = DBI::ProfileData->new(File => "dbi.prof")
-
-=head2 $prof = DBI::ProfileData->new(File => "dbi.prof", Filter => sub { ... })
-
-=head2 $prof = DBI::ProfileData->new(Files => [ "dbi.prof.1", "dbi.prof.2" ])
-
-Creates a new DBI::ProfileData object. Takes either a single file
-through the File option or a list of Files in an array ref. If
-multiple files are specified then the header data from the first file
-is used.
-
-=head3 Files
-
-Reference to an array of file names to read.
-
-=head3 File
-
-Name of file to read. Takes precedence over C<Files>.
-
-=head3 DeleteFiles
-
-If true, the files are deleted after being read.
-
-Actually the files are renamed with a C<deleteme> suffix before being read,
-and then, after reading all the files, they're all deleted together.
-
-The files are locked while being read which, combined with the rename, makes it
-safe to 'consume' files that are still being generated by L<DBI::ProfileDumper>.
-
-=head3 Filter
-
-The C<Filter> parameter can be used to supply a code reference that can
-manipulate the profile data as it is being read. This is most useful for
-editing SQL statements so that slightly different statements in the raw data
-will be merged and aggregated in the loaded data. For example:
-
- Filter => sub {
- my ($path_ref, $data_ref) = @_;
- s/foo = '.*?'/foo = '...'/ for @$path_ref;
- }
-
-Here's an example that performs some normalization on the SQL. It converts all
-numbers to C<N> and all quoted strings to C<S>. It can also convert digits to
-N within names. Finally, it summarizes long "IN (...)" clauses.
-
-It's aggressive and simplistic, but it's often sufficient, and serves as an
-example that you can tailor to suit your own needs:
-
- Filter => sub {
- my ($path_ref, $data_ref) = @_;
- local $_ = $path_ref->[0]; # whichever element contains the SQL Statement
- s/\b\d+\b/N/g; # 42 -> N
- s/\b0x[0-9A-Fa-f]+\b/N/g; # 0xFE -> N
- s/'.*?'/'S'/g; # single quoted strings (doesn't handle escapes)
- s/".*?"/"S"/g; # double quoted strings (doesn't handle escapes)
- # convert names like log_20001231 into log_NNNNNNNN, controlled by $opt{n}
- s/([a-z_]+)(\d{$opt{n},})/$1.('N' x length($2))/ieg if $opt{n};
- # abbreviate massive "in (...)" statements and similar
- s!(([NS],){100,})!sprintf("$2,{repeated %d times}",length($1)/2)!eg;
- }
-
-It's often better to perform this kinds of normalization in the DBI while the
-data is being collected, to avoid too much memory being used by storing profile
-data for many different SQL statement. See L<DBI::Profile>.
-
-=cut
-
-sub new {
- my $pkg = shift;
- my $self = {
- Files => [ "dbi.prof" ],
- Filter => undef,
- DeleteFiles => 0,
- LockFile => $HAS_FLOCK,
- _header => {},
- _nodes => [],
- _node_lookup => {},
- _sort => 'none',
- @_
- };
- bless $self, $pkg;
-
- # File (singular) overrides Files (plural)
- $self->{Files} = [ $self->{File} ] if exists $self->{File};
-
- $self->_read_files();
- return $self;
-}
-
-# read files into _header and _nodes
-sub _read_files {
- my $self = shift;
- my $files = $self->{Files};
- my $read_header = 0;
- my @files_to_delete;
-
- my $fh = gensym;
- foreach (@$files) {
- my $filename = $_;
-
- if ($self->{DeleteFiles}) {
- my $newfilename = $filename . ".deleteme";
- if ($^O eq 'VMS') {
- # VMS default filesystem can only have one period
- $newfilename = $filename . 'deleteme';
- }
- # will clobber an existing $newfilename
- rename($filename, $newfilename)
- or croak "Can't rename($filename, $newfilename): $!";
- # On a versioned filesystem we want old versions to be removed
- 1 while (unlink $filename);
- $filename = $newfilename;
- }
-
- open($fh, "<", $filename)
- or croak("Unable to read profile file '$filename': $!");
-
- # lock the file in case it's still being written to
- # (we'll be forced to wait till the write is complete)
- flock($fh, LOCK_SH) if $self->{LockFile};
-
- if (-s $fh) { # not empty
- $self->_read_header($fh, $filename, $read_header ? 0 : 1);
- $read_header = 1;
- $self->_read_body($fh, $filename);
- }
- close($fh); # and release lock
-
- push @files_to_delete, $filename
- if $self->{DeleteFiles};
- }
- for (@files_to_delete){
- # for versioned file systems
- 1 while (unlink $_);
- if(-e $_){
- warn "Can't delete '$_': $!";
- }
- }
-
- # discard node_lookup now that all files are read
- delete $self->{_node_lookup};
-}
-
-# read the header from the given $fh named $filename. Discards the
-# data unless $keep.
-sub _read_header {
- my ($self, $fh, $filename, $keep) = @_;
-
- # get profiler module id
- my $first = <$fh>;
- chomp $first;
- $self->{_profiler} = $first if $keep;
-
- # collect variables from the header
- local $_;
- while (<$fh>) {
- chomp;
- last unless length $_;
- /^(\S+)\s*=\s*(.*)/
- or croak("Syntax error in header in $filename line $.: $_");
- # XXX should compare new with existing (from previous file)
- # and warn if they differ (different program or path)
- $self->{_header}{$1} = unescape_key($2) if $keep;
- }
-}
-
-
-sub unescape_key { # inverse of escape_key() in DBI::ProfileDumper
- local $_ = shift;
- s/(?<!\\)\\n/\n/g; # expand \n, unless it's a \\n
- s/(?<!\\)\\r/\r/g; # expand \r, unless it's a \\r
- s/\\\\/\\/g; # \\ to \
- return $_;
-}
-
-
-# reads the body of the profile data
-sub _read_body {
- my ($self, $fh, $filename) = @_;
- my $nodes = $self->{_nodes};
- my $lookup = $self->{_node_lookup};
- my $filter = $self->{Filter};
-
- # build up node array
- my @path = ("");
- my (@data, $path_key);
- local $_;
- while (<$fh>) {
- chomp;
- if (/^\+\s+(\d+)\s?(.*)/) {
- # it's a key
- my ($key, $index) = ($2, $1 - 1);
-
- $#path = $index; # truncate path to new length
- $path[$index] = unescape_key($key); # place new key at end
-
- }
- elsif (s/^=\s+//) {
- # it's data - file in the node array with the path in index 0
- # (the optional minus is to make it more robust against systems
- # with unstable high-res clocks - typically due to poor NTP config
- # of kernel SMP behaviour, i.e. min time may be -0.000008))
-
- @data = split / /, $_;
-
- # corrupt data?
- croak("Invalid number of fields in $filename line $.: $_")
- unless @data == 7;
- croak("Invalid leaf node characters $filename line $.: $_")
- unless m/^[-+ 0-9eE\.]+$/;
-
- # hook to enable pre-processing of the data - such as mangling SQL
- # so that slightly different statements get treated as the same
- # and so merged in the results
- $filter->(\@path, \@data) if $filter;
-
- # elements of @path can't have NULLs in them, so this
- # forms a unique string per @path. If there's some way I
- # can get this without arbitrarily stripping out a
- # character I'd be happy to hear it!
- $path_key = join("\0",@path);
-
- # look for previous entry
- if (exists $lookup->{$path_key}) {
- # merge in the new data
- dbi_profile_merge($nodes->[$lookup->{$path_key}], \@data);
- } else {
- # insert a new node - nodes are arrays with data in 0-6
- # and path data after that
- push(@$nodes, [ @data, @path ]);
-
- # record node in %seen
- $lookup->{$path_key} = $#$nodes;
- }
- }
- else {
- croak("Invalid line type syntax error in $filename line $.: $_");
- }
- }
-}
-
-
-
-=head2 $copy = $prof->clone();
-
-Clone a profile data set creating a new object.
-
-=cut
-
-sub clone {
- my $self = shift;
-
- # start with a simple copy
- my $clone = bless { %$self }, ref($self);
-
- # deep copy nodes
- $clone->{_nodes} = [ map { [ @$_ ] } @{$self->{_nodes}} ];
-
- # deep copy header
- $clone->{_header} = { %{$self->{_header}} };
-
- return $clone;
-}
-
-=head2 $header = $prof->header();
-
-Returns a reference to a hash of header values. These are the key
-value pairs included in the header section of the L<DBI::ProfileDumper>
-data format. For example:
-
- $header = {
- Path => [ '!Statement', '!MethodName' ],
- Program => 't/42profile_data.t',
- };
-
-Note that modifying this hash will modify the header data stored
-inside the profile object.
-
-=cut
-
-sub header { shift->{_header} }
-
-
-=head2 $nodes = $prof->nodes()
-
-Returns a reference the sorted nodes array. Each element in the array
-is a single record in the data set. The first seven elements are the
-same as the elements provided by L<DBI::Profile>. After that each key is
-in a separate element. For example:
-
- $nodes = [
- [
- 2, # 0, count
- 0.0312958955764771, # 1, total duration
- 0.000490069389343262, # 2, first duration
- 0.000176072120666504, # 3, shortest duration
- 0.00140702724456787, # 4, longest duration
- 1023115819.83019, # 5, time of first event
- 1023115819.86576, # 6, time of last event
- 'SELECT foo FROM bar' # 7, key1
- 'execute' # 8, key2
- # 6+N, keyN
- ],
- # ...
- ];
-
-Note that modifying this array will modify the node data stored inside
-the profile object.
-
-=cut
-
-sub nodes { shift->{_nodes} }
-
-
-=head2 $count = $prof->count()
-
-Returns the number of items in the profile data set.
-
-=cut
-
-sub count { scalar @{shift->{_nodes}} }
-
-
-=head2 $prof->sort(field => "field")
-
-=head2 $prof->sort(field => "field", reverse => 1)
-
-Sorts data by the given field. Available fields are:
-
- longest
- total
- count
- shortest
-
-The default sort is greatest to smallest, which is the opposite of the
-normal Perl meaning. This, however, matches the expected behavior of
-the dbiprof frontend.
-
-=cut
-
-
-# sorts data by one of the available fields
-{
- my %FIELDS = (
- longest => LONGEST,
- total => TOTAL,
- count => COUNT,
- shortest => SHORTEST,
- key1 => PATH+0,
- key2 => PATH+1,
- key3 => PATH+2,
- );
- sub sort {
- my $self = shift;
- my $nodes = $self->{_nodes};
- my %opt = @_;
-
- croak("Missing required field option.") unless $opt{field};
-
- my $index = $FIELDS{$opt{field}};
-
- croak("Unrecognized sort field '$opt{field}'.")
- unless defined $index;
-
- # sort over index
- if ($opt{reverse}) {
- @$nodes = sort {
- $a->[$index] <=> $b->[$index]
- } @$nodes;
- } else {
- @$nodes = sort {
- $b->[$index] <=> $a->[$index]
- } @$nodes;
- }
-
- # remember how we're sorted
- $self->{_sort} = $opt{field};
-
- return $self;
- }
-}
-
-
-=head2 $count = $prof->exclude(key2 => "disconnect")
-
-=head2 $count = $prof->exclude(key2 => "disconnect", case_sensitive => 1)
-
-=head2 $count = $prof->exclude(key1 => qr/^SELECT/i)
-
-Removes records from the data set that match the given string or
-regular expression. This method modifies the data in a permanent
-fashion - use clone() first to maintain the original data after
-exclude(). Returns the number of nodes left in the profile data set.
-
-=cut
-
-sub exclude {
- my $self = shift;
- my $nodes = $self->{_nodes};
- my %opt = @_;
-
- # find key index number
- my ($index, $val);
- foreach (keys %opt) {
- if (/^key(\d+)$/) {
- $index = PATH + $1 - 1;
- $val = $opt{$_};
- last;
- }
- }
- croak("Missing required keyN option.") unless $index;
-
- if (UNIVERSAL::isa($val,"Regexp")) {
- # regex match
- @$nodes = grep {
- $#$_ < $index or $_->[$index] !~ /$val/
- } @$nodes;
- } else {
- if ($opt{case_sensitive}) {
- @$nodes = grep {
- $#$_ < $index or $_->[$index] ne $val;
- } @$nodes;
- } else {
- $val = lc $val;
- @$nodes = grep {
- $#$_ < $index or lc($_->[$index]) ne $val;
- } @$nodes;
- }
- }
-
- return scalar @$nodes;
-}
-
-
-=head2 $count = $prof->match(key2 => "disconnect")
-
-=head2 $count = $prof->match(key2 => "disconnect", case_sensitive => 1)
-
-=head2 $count = $prof->match(key1 => qr/^SELECT/i)
-
-Removes records from the data set that do not match the given string
-or regular expression. This method modifies the data in a permanent
-fashion - use clone() first to maintain the original data after
-match(). Returns the number of nodes left in the profile data set.
-
-=cut
-
-sub match {
- my $self = shift;
- my $nodes = $self->{_nodes};
- my %opt = @_;
-
- # find key index number
- my ($index, $val);
- foreach (keys %opt) {
- if (/^key(\d+)$/) {
- $index = PATH + $1 - 1;
- $val = $opt{$_};
- last;
- }
- }
- croak("Missing required keyN option.") unless $index;
-
- if (UNIVERSAL::isa($val,"Regexp")) {
- # regex match
- @$nodes = grep {
- $#$_ >= $index and $_->[$index] =~ /$val/
- } @$nodes;
- } else {
- if ($opt{case_sensitive}) {
- @$nodes = grep {
- $#$_ >= $index and $_->[$index] eq $val;
- } @$nodes;
- } else {
- $val = lc $val;
- @$nodes = grep {
- $#$_ >= $index and lc($_->[$index]) eq $val;
- } @$nodes;
- }
- }
-
- return scalar @$nodes;
-}
-
-
-=head2 $Data = $prof->Data()
-
-Returns the same Data hash structure as seen in L<DBI::Profile>. This
-structure is not sorted. The nodes() structure probably makes more
-sense for most analysis.
-
-=cut
-
-sub Data {
- my $self = shift;
- my (%Data, @data, $ptr);
-
- foreach my $node (@{$self->{_nodes}}) {
- # traverse to key location
- $ptr = \%Data;
- foreach my $key (@{$node}[PATH .. $#$node - 1]) {
- $ptr->{$key} = {} unless exists $ptr->{$key};
- $ptr = $ptr->{$key};
- }
-
- # slice out node data
- $ptr->{$node->[-1]} = [ @{$node}[0 .. 6] ];
- }
-
- return \%Data;
-}
-
-
-=head2 $text = $prof->format($nodes->[0])
-
-Formats a single node into a human-readable block of text.
-
-=cut
-
-sub format {
- my ($self, $node) = @_;
- my $format;
-
- # setup keys
- my $keys = "";
- for (my $i = PATH; $i <= $#$node; $i++) {
- my $key = $node->[$i];
-
- # remove leading and trailing space
- $key =~ s/^\s+//;
- $key =~ s/\s+$//;
-
- # if key has newlines or is long take special precautions
- if (length($key) > 72 or $key =~ /\n/) {
- $keys .= " Key " . ($i - PATH + 1) . " :\n\n$key\n\n";
- } else {
- $keys .= " Key " . ($i - PATH + 1) . " : $key\n";
- }
- }
-
- # nodes with multiple runs get the long entry format, nodes with
- # just one run get a single count.
- if ($node->[COUNT] > 1) {
- $format = <<END;
- Count : %d
- Total Time : %3.6f seconds
- Longest Time : %3.6f seconds
- Shortest Time : %3.6f seconds
- Average Time : %3.6f seconds
-END
- return sprintf($format, @{$node}[COUNT,TOTAL,LONGEST,SHORTEST],
- $node->[TOTAL] / $node->[COUNT]) . $keys;
- } else {
- $format = <<END;
- Count : %d
- Time : %3.6f seconds
-END
-
- return sprintf($format, @{$node}[COUNT,TOTAL]) . $keys;
-
- }
-}
-
-
-=head2 $text = $prof->report(number => 10)
-
-Produces a report with the given number of items.
-
-=cut
-
-sub report {
- my $self = shift;
- my $nodes = $self->{_nodes};
- my %opt = @_;
-
- croak("Missing required number option") unless exists $opt{number};
-
- $opt{number} = @$nodes if @$nodes < $opt{number};
-
- my $report = $self->_report_header($opt{number});
- for (0 .. $opt{number} - 1) {
- $report .= sprintf("#" x 5 . "[ %d ]". "#" x 59 . "\n",
- $_ + 1);
- $report .= $self->format($nodes->[$_]);
- $report .= "\n";
- }
- return $report;
-}
-
-# format the header for report()
-sub _report_header {
- my ($self, $number) = @_;
- my $nodes = $self->{_nodes};
- my $node_count = @$nodes;
-
- # find total runtime and method count
- my ($time, $count) = (0,0);
- foreach my $node (@$nodes) {
- $time += $node->[TOTAL];
- $count += $node->[COUNT];
- }
-
- my $header = <<END;
-
-DBI Profile Data ($self->{_profiler})
-
-END
-
- # output header fields
- while (my ($key, $value) = each %{$self->{_header}}) {
- $header .= sprintf(" %-13s : %s\n", $key, $value);
- }
-
- # output summary data fields
- $header .= sprintf(<<END, $node_count, $number, $self->{_sort}, $count, $time);
- Total Records : %d (showing %d, sorted by %s)
- Total Count : %d
- Total Runtime : %3.6f seconds
-
-END
-
- return $header;
-}
-
-
-1;
-
-__END__
-
-=head1 AUTHOR
-
-Sam Tregar <sam@tregar.com>
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright (C) 2002 Sam Tregar
-
-This program is free software; you can redistribute it and/or modify
-it under the same terms as Perl 5 itself.
-
-=cut
+++ /dev/null
-package DBI::ProfileDumper;
-use strict;
-
-=head1 NAME
-
-DBI::ProfileDumper - profile DBI usage and output data to a file
-
-=head1 SYNOPSIS
-
-To profile an existing program using DBI::ProfileDumper, set the
-DBI_PROFILE environment variable and run your program as usual. For
-example, using bash:
-
- DBI_PROFILE=2/DBI::ProfileDumper program.pl
-
-Then analyze the generated file (F<dbi.prof>) with L<dbiprof|dbiprof>:
-
- dbiprof
-
-You can also activate DBI::ProfileDumper from within your code:
-
- use DBI;
-
- # profile with default path (2) and output file (dbi.prof)
- $dbh->{Profile} = "!Statement/DBI::ProfileDumper";
-
- # same thing, spelled out
- $dbh->{Profile} = "!Statement/DBI::ProfileDumper/File:dbi.prof";
-
- # another way to say it
- use DBI::ProfileDumper;
- $dbh->{Profile} = DBI::ProfileDumper->new(
- Path => [ '!Statement' ],
- File => 'dbi.prof' );
-
- # using a custom path
- $dbh->{Profile} = DBI::ProfileDumper->new(
- Path => [ "foo", "bar" ],
- File => 'dbi.prof',
- );
-
-
-=head1 DESCRIPTION
-
-DBI::ProfileDumper is a subclass of L<DBI::Profile|DBI::Profile> which
-dumps profile data to disk instead of printing a summary to your
-screen. You can then use L<dbiprof|dbiprof> to analyze the data in
-a number of interesting ways, or you can roll your own analysis using
-L<DBI::ProfileData|DBI::ProfileData>.
-
-B<NOTE:> For Apache/mod_perl applications, use
-L<DBI::ProfileDumper::Apache|DBI::ProfileDumper::Apache>.
-
-=head1 USAGE
-
-One way to use this module is just to enable it in your C<$dbh>:
-
- $dbh->{Profile} = "1/DBI::ProfileDumper";
-
-This will write out profile data by statement into a file called
-F<dbi.prof>. If you want to modify either of these properties, you
-can construct the DBI::ProfileDumper object yourself:
-
- use DBI::ProfileDumper;
- $dbh->{Profile} = DBI::ProfileDumper->new(
- Path => [ '!Statement' ],
- File => 'dbi.prof'
- );
-
-The C<Path> option takes the same values as in
-L<DBI::Profile>. The C<File> option gives the name of the
-file where results will be collected. If it already exists it will be
-overwritten.
-
-You can also activate this module by setting the DBI_PROFILE
-environment variable:
-
- $ENV{DBI_PROFILE} = "!Statement/DBI::ProfileDumper";
-
-This will cause all DBI handles to share the same profiling object.
-
-=head1 METHODS
-
-The following methods are available to be called using the profile
-object. You can get access to the profile object from the Profile key
-in any DBI handle:
-
- my $profile = $dbh->{Profile};
-
-=head2 flush_to_disk
-
- $profile->flush_to_disk()
-
-Flushes all collected profile data to disk and empties the Data hash. Returns
-the filename written to. If no profile data has been collected then the file is
-not written and flush_to_disk() returns undef.
-
-The file is locked while it's being written. A process 'consuming' the files
-while they're being written to, should rename the file first, then lock it,
-then read it, then close and delete it. The C<DeleteFiles> option to
-L<DBI::ProfileData> does the right thing.
-
-This method may be called multiple times during a program run.
-
-=head2 empty
-
- $profile->empty()
-
-Clears the Data hash without writing to disk.
-
-=head2 filename
-
- $filename = $profile->filename();
-
-Get or set the filename.
-
-The filename can be specified as a CODE reference, in which case the referenced
-code should return the filename to be used. The code will be called with the
-profile object as its first argument.
-
-=head1 DATA FORMAT
-
-The data format written by DBI::ProfileDumper starts with a header
-containing the version number of the module used to generate it. Then
-a block of variable declarations describes the profile. After two
-newlines, the profile data forms the body of the file. For example:
-
- DBI::ProfileDumper 2.003762
- Path = [ '!Statement', '!MethodName' ]
- Program = t/42profile_data.t
-
- + 1 SELECT name FROM users WHERE id = ?
- + 2 prepare
- = 1 0.0312958955764771 0.000490069389343262 0.000176072120666504 0.00140702724456787 1023115819.83019 1023115819.86576
- + 2 execute
- 1 0.0312958955764771 0.000490069389343262 0.000176072120666504 0.00140702724456787 1023115819.83019 1023115819.86576
- + 2 fetchrow_hashref
- = 1 0.0312958955764771 0.000490069389343262 0.000176072120666504 0.00140702724456787 1023115819.83019 1023115819.86576
- + 1 UPDATE users SET name = ? WHERE id = ?
- + 2 prepare
- = 1 0.0312958955764771 0.000490069389343262 0.000176072120666504 0.00140702724456787 1023115819.83019 1023115819.86576
- + 2 execute
- = 1 0.0312958955764771 0.000490069389343262 0.000176072120666504 0.00140702724456787 1023115819.83019 1023115819.86576
-
-The lines beginning with C<+> signs signify keys. The number after
-the C<+> sign shows the nesting level of the key. Lines beginning
-with C<=> are the actual profile data, in the same order as
-in DBI::Profile.
-
-Note that the same path may be present multiple times in the data file
-since C<format()> may be called more than once. When read by
-DBI::ProfileData the data points will be merged to produce a single
-data set for each distinct path.
-
-The key strings are transformed in three ways. First, all backslashes
-are doubled. Then all newlines and carriage-returns are transformed
-into C<\n> and C<\r> respectively. Finally, any NULL bytes (C<\0>)
-are entirely removed. When DBI::ProfileData reads the file the first
-two transformations will be reversed, but NULL bytes will not be
-restored.
-
-=head1 AUTHOR
-
-Sam Tregar <sam@tregar.com>
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright (C) 2002 Sam Tregar
-
-This program is free software; you can redistribute it and/or modify
-it under the same terms as Perl 5 itself.
-
-=cut
-
-# inherit from DBI::Profile
-use DBI::Profile;
-
-our @ISA = ("DBI::Profile");
-
-our $VERSION = "2.015325";
-
-use Carp qw(croak);
-use Fcntl qw(:flock);
-use Symbol;
-
-my $HAS_FLOCK = (defined $ENV{DBI_PROFILE_FLOCK})
- ? $ENV{DBI_PROFILE_FLOCK}
- : do { local $@; eval { flock STDOUT, 0; 1 } };
-
-my $program_header;
-
-
-# validate params and setup default
-sub new {
- my $pkg = shift;
- my $self = $pkg->SUPER::new(
- LockFile => $HAS_FLOCK,
- @_,
- );
-
- # provide a default filename
- $self->filename("dbi.prof") unless $self->filename;
-
- DBI->trace_msg("$self: @{[ %$self ]}\n",0)
- if $self->{Trace} && $self->{Trace} >= 2;
-
- return $self;
-}
-
-
-# get/set filename to use
-sub filename {
- my $self = shift;
- $self->{File} = shift if @_;
- my $filename = $self->{File};
- $filename = $filename->($self) if ref($filename) eq 'CODE';
- return $filename;
-}
-
-
-# flush available data to disk
-sub flush_to_disk {
- my $self = shift;
- my $class = ref $self;
- my $filename = $self->filename;
- my $data = $self->{Data};
-
- if (1) { # make an option
- if (not $data or ref $data eq 'HASH' && !%$data) {
- DBI->trace_msg("flush_to_disk skipped for empty profile\n",0) if $self->{Trace};
- return undef;
- }
- }
-
- my $fh = gensym;
- if (($self->{_wrote_header}||'') eq $filename) {
- # append more data to the file
- # XXX assumes that Path hasn't changed
- open($fh, ">>", $filename)
- or croak("Unable to open '$filename' for $class output: $!");
- } else {
- # create new file (or overwrite existing)
- if (-f $filename) {
- my $bak = $filename.'.prev';
- unlink($bak);
- rename($filename, $bak)
- or warn "Error renaming $filename to $bak: $!\n";
- }
- open($fh, ">", $filename)
- or croak("Unable to open '$filename' for $class output: $!");
- }
- # lock the file (before checking size and writing the header)
- flock($fh, LOCK_EX) if $self->{LockFile};
- # write header if file is empty - typically because we just opened it
- # in '>' mode, or perhaps we used '>>' but the file had been truncated externally.
- if (-s $fh == 0) {
- DBI->trace_msg("flush_to_disk wrote header to $filename\n",0) if $self->{Trace};
- $self->write_header($fh);
- $self->{_wrote_header} = $filename;
- }
-
- my $lines = $self->write_data($fh, $self->{Data}, 1);
- DBI->trace_msg("flush_to_disk wrote $lines lines to $filename\n",0) if $self->{Trace};
-
- close($fh) # unlocks the file
- or croak("Error closing '$filename': $!");
-
- $self->empty();
-
-
- return $filename;
-}
-
-
-# write header to a filehandle
-sub write_header {
- my ($self, $fh) = @_;
-
- # isolate us against globals which effect print
- local($\, $,);
-
- # $self->VERSION can return undef during global destruction
- my $version = $self->VERSION || $VERSION;
-
- # module name and version number
- print $fh ref($self)." $version\n";
-
- # print out Path (may contain CODE refs etc)
- my @path_words = map { escape_key($_) } @{ $self->{Path} || [] };
- print $fh "Path = [ ", join(', ', @path_words), " ]\n";
-
- # print out $0 and @ARGV
- if (!$program_header) {
- # XXX should really quote as well as escape
- $program_header = "Program = "
- . join(" ", map { escape_key($_) } $0, @ARGV)
- . "\n";
- }
- print $fh $program_header;
-
- # all done
- print $fh "\n";
-}
-
-
-# write data in the proscribed format
-sub write_data {
- my ($self, $fh, $data, $level) = @_;
-
- # XXX it's valid for $data to be an ARRAY ref, i.e., Path is empty.
- # produce an empty profile for invalid $data
- return 0 unless $data and UNIVERSAL::isa($data,'HASH');
-
- # isolate us against globals which affect print
- local ($\, $,);
-
- my $lines = 0;
- while (my ($key, $value) = each(%$data)) {
- # output a key
- print $fh "+ $level ". escape_key($key). "\n";
- if (UNIVERSAL::isa($value,'ARRAY')) {
- # output a data set for a leaf node
- print $fh "= ".join(' ', @$value)."\n";
- $lines += 1;
- } else {
- # recurse through keys - this could be rewritten to use a
- # stack for some small performance gain
- $lines += $self->write_data($fh, $value, $level + 1);
- }
- }
- return $lines;
-}
-
-
-# escape a key for output
-sub escape_key {
- my $key = shift;
- $key =~ s!\\!\\\\!g;
- $key =~ s!\n!\\n!g;
- $key =~ s!\r!\\r!g;
- $key =~ s!\0!!g;
- return $key;
-}
-
-
-# flush data to disk when profile object goes out of scope
-sub on_destroy {
- shift->flush_to_disk();
-}
-
-1;
+++ /dev/null
-package DBI::ProfileDumper::Apache;
-
-use strict;
-
-=head1 NAME
-
-DBI::ProfileDumper::Apache - capture DBI profiling data from Apache/mod_perl
-
-=head1 SYNOPSIS
-
-Add this line to your F<httpd.conf>:
-
- PerlSetEnv DBI_PROFILE 2/DBI::ProfileDumper::Apache
-
-(If you're using mod_perl2, see L</When using mod_perl2> for some additional notes.)
-
-Then restart your server. Access the code you wish to test using a
-web browser, then shutdown your server. This will create a set of
-F<dbi.prof.*> files in your Apache log directory.
-
-Get a profiling report with L<dbiprof|dbiprof>:
-
- dbiprof /path/to/your/apache/logs/dbi.prof.*
-
-When you're ready to perform another profiling run, delete the old files and start again.
-
-=head1 DESCRIPTION
-
-This module interfaces DBI::ProfileDumper to Apache/mod_perl. Using
-this module you can collect profiling data from mod_perl applications.
-It works by creating a DBI::ProfileDumper data file for each Apache
-process. These files are created in your Apache log directory. You
-can then use the dbiprof utility to analyze the profile files.
-
-=head1 USAGE
-
-=head2 LOADING THE MODULE
-
-The easiest way to use this module is just to set the DBI_PROFILE
-environment variable in your F<httpd.conf>:
-
- PerlSetEnv DBI_PROFILE 2/DBI::ProfileDumper::Apache
-
-The DBI will look after loading and using the module when the first DBI handle
-is created.
-
-It's also possible to use this module by setting the Profile attribute
-of any DBI handle:
-
- $dbh->{Profile} = "2/DBI::ProfileDumper::Apache";
-
-See L<DBI::ProfileDumper> for more possibilities, and L<DBI::Profile> for full
-details of the DBI's profiling mechanism.
-
-=head2 WRITING PROFILE DATA
-
-The profile data files will be written to your Apache log directory by default.
-
-The user that the httpd processes run as will need write access to the
-directory. So, for example, if you're running the child httpds as user 'nobody'
-and using chronolog to write to the logs directory, then you'll need to change
-the default.
-
-You can change the destination directory either by specifying a C<Dir> value
-when creating the profile (like C<File> in the L<DBI::ProfileDumper> docs),
-or you can use the C<DBI_PROFILE_APACHE_LOG_DIR> env var to change that. For example:
-
- PerlSetEnv DBI_PROFILE_APACHE_LOG_DIR /server_root/logs
-
-=head3 When using mod_perl2
-
-Under mod_perl2 you'll need to either set the C<DBI_PROFILE_APACHE_LOG_DIR> env var,
-or enable the mod_perl2 C<GlobalRequest> option, like this:
-
- PerlOptions +GlobalRequest
-
-to the global config section you're about test with DBI::ProfileDumper::Apache.
-If you don't do one of those then you'll see messages in your error_log similar to:
-
- DBI::ProfileDumper::Apache on_destroy failed: Global $r object is not available. Set:
- PerlOptions +GlobalRequest in httpd.conf at ..../DBI/ProfileDumper/Apache.pm line 144
-
-=head3 Naming the files
-
-The default file name is inherited from L<DBI::ProfileDumper> via the
-filename() method, but DBI::ProfileDumper::Apache appends the parent pid and
-the current pid, separated by dots, to that name.
-
-=head3 Silencing the log
-
-By default a message is written to STDERR (i.e., the apache error_log file)
-when flush_to_disk() is called (either explicitly, or implicitly via DESTROY).
-
-That's usually very useful. If you don't want the log message you can silence
-it by setting the C<Quiet> attribute true.
-
- PerlSetEnv DBI_PROFILE 2/DBI::ProfileDumper::Apache/Quiet:1
-
- $dbh->{Profile} = "!Statement/DBI::ProfileDumper/Quiet:1";
-
- $dbh->{Profile} = DBI::ProfileDumper->new(
- Path => [ '!Statement' ]
- Quiet => 1
- );
-
-
-=head2 GATHERING PROFILE DATA
-
-Once you have the module loaded, use your application as you normally
-would. Stop the webserver when your tests are complete. Profile data
-files will be produced when Apache exits and you'll see something like
-this in your error_log:
-
- DBI::ProfileDumper::Apache writing to /usr/local/apache/logs/dbi.prof.2604.2619
-
-Now you can use dbiprof to examine the data:
-
- dbiprof /usr/local/apache/logs/dbi.prof.2604.*
-
-By passing dbiprof a list of all generated files, dbiprof will
-automatically merge them into one result set. You can also pass
-dbiprof sorting and querying options, see L<dbiprof> for details.
-
-=head2 CLEANING UP
-
-Once you've made some code changes, you're ready to start again.
-First, delete the old profile data files:
-
- rm /usr/local/apache/logs/dbi.prof.*
-
-Then restart your server and get back to work.
-
-=head1 OTHER ISSUES
-
-=head2 Memory usage
-
-DBI::Profile can use a lot of memory for very active applications because it
-collects profiling data in memory for each distinct query run.
-Calling C<flush_to_disk()> will write the current data to disk and free the
-memory it's using. For example:
-
- $dbh->{Profile}->flush_to_disk() if $dbh->{Profile};
-
-or, rather than flush every time, you could flush less often:
-
- $dbh->{Profile}->flush_to_disk()
- if $dbh->{Profile} and ++$i % 100;
-
-=head1 AUTHOR
-
-Sam Tregar <sam@tregar.com>
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright (C) 2002 Sam Tregar
-
-This program is free software; you can redistribute it and/or modify
-it under the same terms as Perl 5 itself.
-
-=cut
-
-our $VERSION = "2.014121";
-
-our @ISA = qw(DBI::ProfileDumper);
-
-use DBI::ProfileDumper;
-use File::Spec;
-
-my $initial_pid = $$;
-
-use constant MP2 => ($ENV{MOD_PERL_API_VERSION} and $ENV{MOD_PERL_API_VERSION} == 2) ? 1 : 0;
-
-my $server_root_dir;
-
-if (MP2) {
- require Apache2::ServerUtil;
- $server_root_dir = Apache2::ServerUtil::server_root();
-}
-else {
- require Apache;
- $server_root_dir = eval { Apache->server_root_relative('') } || "/tmp";
-}
-
-
-sub _dirname {
- my $self = shift;
- return $self->{Dir} ||= $ENV{DBI_PROFILE_APACHE_LOG_DIR}
- || File::Spec->catdir($server_root_dir, "logs");
-}
-
-
-sub filename {
- my $self = shift;
- my $filename = $self->SUPER::filename(@_);
- return $filename if not $filename; # not set yet
-
- # to be able to identify groups of profile files from the same set of
- # apache processes, we include the parent pid in the file name
- # as well as the pid.
- my $group_pid = ($$ eq $initial_pid) ? $$ : getppid();
- $filename .= ".$group_pid.$$";
-
- return $filename if File::Spec->file_name_is_absolute($filename);
- return File::Spec->catfile($self->_dirname, $filename);
-}
-
-
-sub flush_to_disk {
- my $self = shift;
-
- my $filename = $self->SUPER::flush_to_disk(@_);
-
- print STDERR ref($self)." pid$$ written to $filename\n"
- if $filename && not $self->{Quiet};
-
- return $filename;
-}
-
-1;
+++ /dev/null
-package DBI::ProfileSubs;
-
-our $VERSION = "0.009396";
-
-=head1 NAME
-
-DBI::ProfileSubs - Subroutines for dynamic profile Path
-
-=head1 SYNOPSIS
-
- DBI_PROFILE='&norm_std_n3' prog.pl
-
-This is new and still experimental.
-
-=head1 TO DO
-
-Define come kind of naming convention for the subs.
-
-=cut
-
-use strict;
-use warnings;
-
-
-# would be good to refactor these regex into separate subs and find some
-# way to compose them in various combinations into multiple subs.
-# Perhaps via AUTOLOAD where \&auto_X_Y_Z creates a sub that does X, Y, and Z.
-# The final subs always need to be very fast.
-#
-
-sub norm_std_n3 {
- # my ($h, $method_name) = @_;
- local $_ = $_;
-
- s/\b\d+\b/<N>/g; # 42 -> <N>
- s/\b0x[0-9A-Fa-f]+\b/<N>/g; # 0xFE -> <N>
-
- s/'.*?'/'<S>'/g; # single quoted strings (doesn't handle escapes)
- s/".*?"/"<S>"/g; # double quoted strings (doesn't handle escapes)
-
- # convert names like log20001231 into log<N>
- s/([a-z_]+)(\d{3,})\b/${1}<N>/ig;
-
- # abbreviate massive "in (...)" statements and similar
- s!((\s*<[NS]>\s*,\s*){100,})!sprintf("$2,<repeated %d times>",length($1)/2)!eg;
-
- return $_;
-}
-
-1;
+++ /dev/null
-# $Header: /home/timbo/dbi/lib/DBI/RCS/ProxyServer.pm,v 11.9 2003/05/14 11:08:17 timbo Exp $
-# -*- perl -*-
-#
-# DBI::ProxyServer - a proxy server for DBI drivers
-#
-# Copyright (c) 1997 Jochen Wiedmann
-#
-# The DBD::Proxy module is free software; you can redistribute it and/or
-# modify it under the same terms as Perl itself. In particular permission
-# is granted to Tim Bunce for distributing this as a part of the DBI.
-#
-#
-# Author: Jochen Wiedmann
-# Am Eisteich 9
-# 72555 Metzingen
-# Germany
-#
-# Email: joe@ispsoft.de
-# Phone: +49 7123 14881
-#
-#
-##############################################################################
-
-
-require 5.004;
-use strict;
-
-use RPC::PlServer 0.2001;
-require DBI;
-require Config;
-
-
-package DBI::ProxyServer;
-
-
-
-############################################################################
-#
-# Constants
-#
-############################################################################
-
-use vars qw($VERSION @ISA);
-
-$VERSION = "0.3005";
-@ISA = qw(RPC::PlServer DBI);
-
-
-# Most of the options below are set to default values, we note them here
-# just for the sake of documentation.
-my %DEFAULT_SERVER_OPTIONS;
-{
- my $o = \%DEFAULT_SERVER_OPTIONS;
- $o->{'chroot'} = undef, # To be used in the initfile,
- # after loading the required
- # DBI drivers.
- $o->{'clients'} =
- [ { 'mask' => '.*',
- 'accept' => 1,
- 'cipher' => undef
- }
- ];
- $o->{'configfile'} = '/etc/dbiproxy.conf' if -f '/etc/dbiproxy.conf';
- $o->{'debug'} = 0;
- $o->{'facility'} = 'daemon';
- $o->{'group'} = undef;
- $o->{'localaddr'} = undef; # Bind to any local IP number
- $o->{'localport'} = undef; # Must set port number on the
- # command line.
- $o->{'logfile'} = undef; # Use syslog or EventLog.
-
- # XXX don't restrict methods that can be called (trust users once connected)
- $o->{'XXX_methods'} = {
- 'DBI::ProxyServer' => {
- 'Version' => 1,
- 'NewHandle' => 1,
- 'CallMethod' => 1,
- 'DestroyHandle' => 1
- },
- 'DBI::ProxyServer::db' => {
- 'prepare' => 1,
- 'commit' => 1,
- 'rollback' => 1,
- 'STORE' => 1,
- 'FETCH' => 1,
- 'func' => 1,
- 'quote' => 1,
- 'type_info_all' => 1,
- 'table_info' => 1,
- 'disconnect' => 1,
- },
- 'DBI::ProxyServer::st' => {
- 'execute' => 1,
- 'STORE' => 1,
- 'FETCH' => 1,
- 'func' => 1,
- 'fetch' => 1,
- 'finish' => 1
- }
- };
- if ($Config::Config{'usethreads'} eq 'define') {
- $o->{'mode'} = 'threads';
- } elsif ($Config::Config{'d_fork'} eq 'define') {
- $o->{'mode'} = 'fork';
- } else {
- $o->{'mode'} = 'single';
- }
- # No pidfile by default, configuration must provide one if needed
- $o->{'pidfile'} = 'none';
- $o->{'user'} = undef;
-};
-
-
-############################################################################
-#
-# Name: Version
-#
-# Purpose: Return version string
-#
-# Inputs: $class - This class
-#
-# Result: Version string; suitable for printing by "--version"
-#
-############################################################################
-
-sub Version {
- my $version = $DBI::ProxyServer::VERSION;
- "DBI::ProxyServer $version, Copyright (C) 1998, Jochen Wiedmann";
-}
-
-
-############################################################################
-#
-# Name: AcceptApplication
-#
-# Purpose: Verify DBI DSN
-#
-# Inputs: $self - This instance
-# $dsn - DBI dsn
-#
-# Returns: TRUE for a valid DSN, FALSE otherwise
-#
-############################################################################
-
-sub AcceptApplication {
- my $self = shift; my $dsn = shift;
- $dsn =~ /^dbi:\w+:/i;
-}
-
-
-############################################################################
-#
-# Name: AcceptVersion
-#
-# Purpose: Verify requested DBI version
-#
-# Inputs: $self - Instance
-# $version - DBI version being requested
-#
-# Returns: TRUE for ok, FALSE otherwise
-#
-############################################################################
-
-sub AcceptVersion {
- my $self = shift; my $version = shift;
- require DBI;
- DBI::ProxyServer->init_rootclass();
- $DBI::VERSION >= $version;
-}
-
-
-############################################################################
-#
-# Name: AcceptUser
-#
-# Purpose: Verify user and password by connecting to the client and
-# creating a database connection
-#
-# Inputs: $self - Instance
-# $user - User name
-# $password - Password
-#
-############################################################################
-
-sub AcceptUser {
- my $self = shift; my $user = shift; my $password = shift;
- return 0 if (!$self->SUPER::AcceptUser($user, $password));
- my $dsn = $self->{'application'};
- $self->Debug("Connecting to $dsn as $user");
- local $ENV{DBI_AUTOPROXY} = ''; # :-)
- $self->{'dbh'} = eval {
- DBI::ProxyServer->connect($dsn, $user, $password,
- { 'PrintError' => 0,
- 'Warn' => 0,
- 'RaiseError' => 1,
- 'HandleError' => sub {
- my $err = $_[1]->err;
- my $state = $_[1]->state || '';
- $_[0] .= " [err=$err,state=$state]";
- return 0;
- } })
- };
- if ($@) {
- $self->Error("Error while connecting to $dsn as $user: $@");
- return 0;
- }
- [1, $self->StoreHandle($self->{'dbh'}) ];
-}
-
-
-sub CallMethod {
- my $server = shift;
- my $dbh = $server->{'dbh'};
- # We could store the private_server attribute permanently in
- # $dbh. However, we'd have a reference loop in that case and
- # I would be concerned about garbage collection. :-(
- $dbh->{'private_server'} = $server;
- $server->Debug("CallMethod: => " . do { local $^W; join(",", @_)});
- my @result = eval { $server->SUPER::CallMethod(@_) };
- my $msg = $@;
- undef $dbh->{'private_server'};
- if ($msg) {
- $server->Debug("CallMethod died with: $@");
- die $msg;
- } else {
- $server->Debug("CallMethod: <= " . do { local $^W; join(",", @result) });
- }
- @result;
-}
-
-
-sub main {
- my $server = DBI::ProxyServer->new(\%DEFAULT_SERVER_OPTIONS, \@_);
- $server->Bind();
-}
-
-
-############################################################################
-#
-# The DBI part of the proxyserver is implemented as a DBI subclass.
-# Thus we can reuse some of the DBI methods and overwrite only
-# those that need additional handling.
-#
-############################################################################
-
-package DBI::ProxyServer::dr;
-
-@DBI::ProxyServer::dr::ISA = qw(DBI::dr);
-
-
-package DBI::ProxyServer::db;
-
-@DBI::ProxyServer::db::ISA = qw(DBI::db);
-
-sub prepare {
- my($dbh, $statement, $attr, $params, $proto_ver) = @_;
- my $server = $dbh->{'private_server'};
- if (my $client = $server->{'client'}) {
- if ($client->{'sql'}) {
- if ($statement =~ /^\s*(\S+)/) {
- my $st = $1;
- if (!($statement = $client->{'sql'}->{$st})) {
- die "Unknown SQL query: $st";
- }
- } else {
- die "Cannot parse restricted SQL statement: $statement";
- }
- }
- }
- my $sth = $dbh->SUPER::prepare($statement, $attr);
- my $handle = $server->StoreHandle($sth);
-
- if ( $proto_ver and $proto_ver > 1 ) {
- $sth->{private_proxyserver_described} = 0;
- return $handle;
-
- } else {
- # The difference between the usual prepare and ours is that we implement
- # a combined prepare/execute. The DBD::Proxy driver doesn't call us for
- # prepare. Only if an execute happens, then we are called with method
- # "prepare". Further execute's are called as "execute".
- my @result = $sth->execute($params);
- my ($NAME, $TYPE);
- my $NUM_OF_FIELDS = $sth->{NUM_OF_FIELDS};
- if ($NUM_OF_FIELDS) { # is a SELECT
- $NAME = $sth->{NAME};
- $TYPE = $sth->{TYPE};
- }
- ($handle, $NUM_OF_FIELDS, $sth->{'NUM_OF_PARAMS'},
- $NAME, $TYPE, @result);
- }
-}
-
-sub table_info {
- my $dbh = shift;
- my $sth = $dbh->SUPER::table_info();
- my $numFields = $sth->{'NUM_OF_FIELDS'};
- my $names = $sth->{'NAME'};
- my $types = $sth->{'TYPE'};
-
- # We wouldn't need to send all the rows at this point, instead we could
- # make use of $rsth->fetch() on the client as usual.
- # The problem is that some drivers (namely DBD::ExampleP, DBD::mysql and
- # DBD::mSQL) are returning foreign sth's here, thus an instance of
- # DBI::st and not DBI::ProxyServer::st. We could fix this by permitting
- # the client to execute method DBI::st, but I don't like this.
- my @rows;
- while (my ($row) = $sth->fetch()) {
- last unless defined $row;
- push(@rows, [@$row]);
- }
- ($numFields, $names, $types, @rows);
-}
-
-
-package DBI::ProxyServer::st;
-
-@DBI::ProxyServer::st::ISA = qw(DBI::st);
-
-sub execute {
- my $sth = shift; my $params = shift; my $proto_ver = shift;
- my @outParams;
- if ($params) {
- for (my $i = 0; $i < @$params;) {
- my $param = $params->[$i++];
- if (!ref($param)) {
- $sth->bind_param($i, $param);
- }
- else {
- if (!ref(@$param[0])) {#It's not a reference
- $sth->bind_param($i, @$param);
- }
- else {
- $sth->bind_param_inout($i, @$param);
- my $ref = shift @$param;
- push(@outParams, $ref);
- }
- }
- }
- }
- my $rows = $sth->SUPER::execute();
- if ( $proto_ver and $proto_ver > 1 and not $sth->{private_proxyserver_described} ) {
- my ($NAME, $TYPE);
- my $NUM_OF_FIELDS = $sth->{NUM_OF_FIELDS};
- if ($NUM_OF_FIELDS) { # is a SELECT
- $NAME = $sth->{NAME};
- $TYPE = $sth->{TYPE};
- }
- $sth->{private_proxyserver_described} = 1;
- # First execution, we ship back description.
- return ($rows, $NUM_OF_FIELDS, $sth->{'NUM_OF_PARAMS'}, $NAME, $TYPE, @outParams);
- }
- ($rows, @outParams);
-}
-
-sub fetch {
- my $sth = shift; my $numRows = shift || 1;
- my($ref, @rows);
- while ($numRows-- && ($ref = $sth->SUPER::fetch())) {
- push(@rows, [@$ref]);
- }
- @rows;
-}
-
-
-1;
-
-
-__END__
-
-=head1 NAME
-
-DBI::ProxyServer - a server for the DBD::Proxy driver
-
-=head1 SYNOPSIS
-
- use DBI::ProxyServer;
- DBI::ProxyServer::main(@ARGV);
-
-=head1 DESCRIPTION
-
-DBI::Proxy Server is a module for implementing a proxy for the DBI proxy
-driver, DBD::Proxy. It allows access to databases over the network if the
-DBMS does not offer networked operations. But the proxy server might be
-useful for you, even if you have a DBMS with integrated network
-functionality: It can be used as a DBI proxy in a firewalled environment.
-
-DBI::ProxyServer runs as a daemon on the machine with the DBMS or on the
-firewall. The client connects to the agent using the DBI driver DBD::Proxy,
-thus in the exactly same way than using DBD::mysql, DBD::mSQL or any other
-DBI driver.
-
-The agent is implemented as a RPC::PlServer application. Thus you have
-access to all the possibilities of this module, in particular encryption
-and a similar configuration file. DBI::ProxyServer adds the possibility of
-query restrictions: You can define a set of queries that a client may
-execute and restrict access to those. (Requires a DBI driver that supports
-parameter binding.) See L</CONFIGURATION FILE>.
-
-The provided driver script, L<dbiproxy>, may either be used as it is or
-used as the basis for a local version modified to meet your needs.
-
-=head1 OPTIONS
-
-When calling the DBI::ProxyServer::main() function, you supply an
-array of options. These options are parsed by the Getopt::Long module.
-The ProxyServer inherits all of RPC::PlServer's and hence Net::Daemon's
-options and option handling, in particular the ability to read
-options from either the command line or a config file. See
-L<RPC::PlServer>. See L<Net::Daemon>. Available options include
-
-=over 4
-
-=item I<chroot> (B<--chroot=dir>)
-
-(UNIX only) After doing a bind(), change root directory to the given
-directory by doing a chroot(). This is useful for security, but it
-restricts the environment a lot. For example, you need to load DBI
-drivers in the config file or you have to create hard links to Unix
-sockets, if your drivers are using them. For example, with MySQL, a
-config file might contain the following lines:
-
- my $rootdir = '/var/dbiproxy';
- my $unixsockdir = '/tmp';
- my $unixsockfile = 'mysql.sock';
- foreach $dir ($rootdir, "$rootdir$unixsockdir") {
- mkdir 0755, $dir;
- }
- link("$unixsockdir/$unixsockfile",
- "$rootdir$unixsockdir/$unixsockfile");
- require DBD::mysql;
-
- {
- 'chroot' => $rootdir,
- ...
- }
-
-If you don't know chroot(), think of an FTP server where you can see a
-certain directory tree only after logging in. See also the --group and
---user options.
-
-=item I<clients>
-
-An array ref with a list of clients. Clients are hash refs, the attributes
-I<accept> (0 for denying access and 1 for permitting) and I<mask>, a Perl
-regular expression for the clients IP number or its host name.
-
-=item I<configfile> (B<--configfile=file>)
-
-Config files are assumed to return a single hash ref that overrides the
-arguments of the new method. However, command line arguments in turn take
-precedence over the config file. See the L<"CONFIGURATION FILE"> section
-below for details on the config file.
-
-=item I<debug> (B<--debug>)
-
-Turn debugging mode on. Mainly this asserts that logging messages of
-level "debug" are created.
-
-=item I<facility> (B<--facility=mode>)
-
-(UNIX only) Facility to use for L<Sys::Syslog>. The default is
-B<daemon>.
-
-=item I<group> (B<--group=gid>)
-
-After doing a bind(), change the real and effective GID to the given.
-This is useful, if you want your server to bind to a privileged port
-(<1024), but don't want the server to execute as root. See also
-the --user option.
-
-GID's can be passed as group names or numeric values.
-
-=item I<localaddr> (B<--localaddr=ip>)
-
-By default a daemon is listening to any IP number that a machine
-has. This attribute allows one to restrict the server to the given
-IP number.
-
-=item I<localport> (B<--localport=port>)
-
-This attribute sets the port on which the daemon is listening. It
-must be given somehow, as there's no default.
-
-=item I<logfile> (B<--logfile=file>)
-
-Be default logging messages will be written to the syslog (Unix) or
-to the event log (Windows NT). On other operating systems you need to
-specify a log file. The special value "STDERR" forces logging to
-stderr. See L<Net::Daemon::Log> for details.
-
-=item I<mode> (B<--mode=modename>)
-
-The server can run in three different modes, depending on the environment.
-
-If you are running Perl 5.005 and did compile it for threads, then the
-server will create a new thread for each connection. The thread will
-execute the server's Run() method and then terminate. This mode is the
-default, you can force it with "--mode=threads".
-
-If threads are not available, but you have a working fork(), then the
-server will behave similar by creating a new process for each connection.
-This mode will be used automatically in the absence of threads or if
-you use the "--mode=fork" option.
-
-Finally there's a single-connection mode: If the server has accepted a
-connection, he will enter the Run() method. No other connections are
-accepted until the Run() method returns (if the client disconnects).
-This operation mode is useful if you have neither threads nor fork(),
-for example on the Macintosh. For debugging purposes you can force this
-mode with "--mode=single".
-
-=item I<pidfile> (B<--pidfile=file>)
-
-(UNIX only) If this option is present, a PID file will be created at the
-given location. Default is to not create a pidfile.
-
-=item I<user> (B<--user=uid>)
-
-After doing a bind(), change the real and effective UID to the given.
-This is useful, if you want your server to bind to a privileged port
-(<1024), but don't want the server to execute as root. See also
-the --group and the --chroot options.
-
-UID's can be passed as group names or numeric values.
-
-=item I<version> (B<--version>)
-
-Suppresses startup of the server; instead the version string will
-be printed and the program exits immediately.
-
-=back
-
-=head1 SHUTDOWN
-
-DBI::ProxyServer is built on L<RPC::PlServer> which is, in turn, built on L<Net::Daemon>.
-
-You should refer to L<Net::Daemon> for how to shutdown the server, except that
-you can't because it's not currently documented there (as of v0.43).
-The bottom-line is that it seems that there's no support for graceful shutdown.
-
-=head1 CONFIGURATION FILE
-
-The configuration file is just that of I<RPC::PlServer> or I<Net::Daemon>
-with some additional attributes in the client list.
-
-The config file is a Perl script. At the top of the file you may include
-arbitrary Perl source, for example load drivers at the start (useful
-to enhance performance), prepare a chroot environment and so on.
-
-The important thing is that you finally return a hash ref of option
-name/value pairs. The possible options are listed above.
-
-All possibilities of Net::Daemon and RPC::PlServer apply, in particular
-
-=over 4
-
-=item Host and/or User dependent access control
-
-=item Host and/or User dependent encryption
-
-=item Changing UID and/or GID after binding to the port
-
-=item Running in a chroot() environment
-
-=back
-
-Additionally the server offers you query restrictions. Suggest the
-following client list:
-
- 'clients' => [
- { 'mask' => '^admin\.company\.com$',
- 'accept' => 1,
- 'users' => [ 'root', 'wwwrun' ],
- },
- {
- 'mask' => '^admin\.company\.com$',
- 'accept' => 1,
- 'users' => [ 'root', 'wwwrun' ],
- 'sql' => {
- 'select' => 'SELECT * FROM foo',
- 'insert' => 'INSERT INTO foo VALUES (?, ?, ?)'
- }
- }
-
-then only the users root and wwwrun may connect from admin.company.com,
-executing arbitrary queries, but only wwwrun may connect from other
-hosts and is restricted to
-
- $sth->prepare("select");
-
-or
-
- $sth->prepare("insert");
-
-which in fact are "SELECT * FROM foo" or "INSERT INTO foo VALUES (?, ?, ?)".
-
-
-=head1 Proxyserver Configuration file (bigger example)
-
-This section tells you how to restrict a DBI-Proxy: Not every user from
-every workstation shall be able to execute every query.
-
-There is a perl program "dbiproxy" which runs on a machine which is able
-to connect to all the databases we wish to reach. All Perl-DBD-drivers must
-be installed on this machine. You can also reach databases for which drivers
-are not available on the machine where you run the program querying the
-database, e.g. ask MS-Access-database from Linux.
-
-Create a configuration file "proxy_oracle.cfg" at the dbproxy-server:
-
- {
- # This shall run in a shell or a DOS-window
- # facility => 'daemon',
- pidfile => 'your_dbiproxy.pid',
- logfile => 1,
- debug => 0,
- mode => 'single',
- localport => '12400',
-
- # Access control, the first match in this list wins!
- # So the order is important
- clients => [
- # hint to organize:
- # the most specialized rules for single machines/users are 1st
- # then the denying rules
- # then the rules about whole networks
-
- # rule: internal_webserver
- # desc: to get statistical information
- {
- # this IP-address only is meant
- mask => '^10\.95\.81\.243$',
- # accept (not defer) connections like this
- accept => 1,
- # only users from this list
- # are allowed to log on
- users => [ 'informationdesk' ],
- # only this statistical query is allowed
- # to get results for a web-query
- sql => {
- alive => 'select count(*) from dual',
- statistic_area => 'select count(*) from e01admin.e01e203 where geb_bezei like ?',
- }
- },
-
- # rule: internal_bad_guy_1
- {
- mask => '^10\.95\.81\.1$',
- accept => 0,
- },
-
- # rule: employee_workplace
- # desc: get detailed information
- {
- # any IP-address is meant here
- mask => '^10\.95\.81\.(\d+)$',
- # accept (not defer) connections like this
- accept => 1,
- # only users from this list
- # are allowed to log on
- users => [ 'informationdesk', 'lippmann' ],
- # all these queries are allowed:
- sql => {
- search_city => 'select ort_nr, plz, ort from e01admin.e01e200 where plz like ?',
- search_area => 'select gebiettyp, geb_bezei from e01admin.e01e203 where geb_bezei like ? or geb_bezei like ?',
- }
- },
-
- # rule: internal_bad_guy_2
- # This does NOT work, because rule "employee_workplace" hits
- # with its ip-address-mask of the whole network
- {
- # don't accept connection from this ip-address
- mask => '^10\.95\.81\.5$',
- accept => 0,
- }
- ]
- }
-
-Start the proxyserver like this:
-
- rem well-set Oracle_home needed for Oracle
- set ORACLE_HOME=d:\oracle\ora81
- dbiproxy --configfile proxy_oracle.cfg
-
-
-=head2 Testing the connection from a remote machine
-
-Call a program "dbish" from your commandline. I take the machine from rule "internal_webserver"
-
- dbish "dbi:Proxy:hostname=oracle.zdf;port=12400;dsn=dbi:Oracle:e01" informationdesk xxx
-
-There will be a shell-prompt:
-
- informationdesk@dbi...> alive
-
- Current statement buffer (enter '/'...):
- alive
-
- informationdesk@dbi...> /
- COUNT(*)
- '1'
- [1 rows of 1 fields returned]
-
-
-=head2 Testing the connection with a perl-script
-
-Create a perl-script like this:
-
- # file: oratest.pl
- # call me like this: perl oratest.pl user password
-
- use strict;
- use DBI;
-
- my $user = shift || die "Usage: $0 user password";
- my $pass = shift || die "Usage: $0 user password";
- my $config = {
- dsn_at_proxy => "dbi:Oracle:e01",
- proxy => "hostname=oechsle.zdf;port=12400",
- };
- my $dsn = sprintf "dbi:Proxy:%s;dsn=%s",
- $config->{proxy},
- $config->{dsn_at_proxy};
-
- my $dbh = DBI->connect( $dsn, $user, $pass )
- || die "connect did not work: $DBI::errstr";
-
- my $sql = "search_city";
- printf "%s\n%s\n%s\n", "="x40, $sql, "="x40;
- my $cur = $dbh->prepare($sql);
- $cur->bind_param(1,'905%');
- &show_result ($cur);
-
- my $sql = "search_area";
- printf "%s\n%s\n%s\n", "="x40, $sql, "="x40;
- my $cur = $dbh->prepare($sql);
- $cur->bind_param(1,'Pfarr%');
- $cur->bind_param(2,'Bronnamberg%');
- &show_result ($cur);
-
- my $sql = "statistic_area";
- printf "%s\n%s\n%s\n", "="x40, $sql, "="x40;
- my $cur = $dbh->prepare($sql);
- $cur->bind_param(1,'Pfarr%');
- &show_result ($cur);
-
- $dbh->disconnect;
- exit;
-
-
- sub show_result {
- my $cur = shift;
- unless ($cur->execute()) {
- print "Could not execute\n";
- return;
- }
-
- my $rownum = 0;
- while (my @row = $cur->fetchrow_array()) {
- printf "Row is: %s\n", join(", ",@row);
- if ($rownum++ > 5) {
- print "... and so on\n";
- last;
- }
- }
- $cur->finish;
- }
-
-The result
-
- C:\>perl oratest.pl informationdesk xxx
- ========================================
- search_city
- ========================================
- Row is: 3322, 9050, Chemnitz
- Row is: 3678, 9051, Chemnitz
- Row is: 10447, 9051, Chemnitz
- Row is: 12128, 9051, Chemnitz
- Row is: 10954, 90513, Zirndorf
- Row is: 5808, 90513, Zirndorf
- Row is: 5715, 90513, Zirndorf
- ... and so on
- ========================================
- search_area
- ========================================
- Row is: 101, Bronnamberg
- Row is: 400, Pfarramt Zirndorf
- Row is: 400, Pfarramt Rosstal
- Row is: 400, Pfarramt Oberasbach
- Row is: 401, Pfarramt Zirndorf
- Row is: 401, Pfarramt Rosstal
- ========================================
- statistic_area
- ========================================
- DBD::Proxy::st execute failed: Server returned error: Failed to execute method CallMethod: Unknown SQL query: statistic_area at E:/Perl/site/lib/DBI/ProxyServer.pm line 258.
- Could not execute
-
-
-=head2 How the configuration works
-
-The most important section to control access to your dbi-proxy is "client=>"
-in the file "proxy_oracle.cfg":
-
-Controlling which person at which machine is allowed to access
-
-=over 4
-
-=item * "mask" is a perl regular expression against the plain ip-address of the machine which wishes to connect _or_ the reverse-lookup from a nameserver.
-
-=item * "accept" tells the dbiproxy-server whether ip-adresse like in "mask" are allowed to connect or not (0/1)
-
-=item * "users" is a reference to a list of usernames which must be matched, this is NOT a regular expression.
-
-=back
-
-Controlling which SQL-statements are allowed
-
-You can put every SQL-statement you like in simply omitting "sql => ...", but the more important thing is to restrict the connection so that only allowed queries are possible.
-
-If you include an sql-section in your config-file like this:
-
- sql => {
- alive => 'select count(*) from dual',
- statistic_area => 'select count(*) from e01admin.e01e203 where geb_bezei like ?',
- }
-
-The user is allowed to put two queries against the dbi-proxy. The queries are _not_ "select count(*)...", the queries are "alive" and "statistic_area"! These keywords are replaced by the real query. So you can run a query for "alive":
-
- my $sql = "alive";
- my $cur = $dbh->prepare($sql);
- ...
-
-The flexibility is that you can put parameters in the where-part of the query so the query are not static. Simply replace a value in the where-part of the query through a question mark and bind it as a parameter to the query.
-
- my $sql = "statistic_area";
- my $cur = $dbh->prepare($sql);
- $cur->bind_param(1,'905%');
- # A second parameter would be called like this:
- # $cur->bind_param(2,'98%');
-
-The result is this query:
-
- select count(*) from e01admin.e01e203
- where geb_bezei like '905%'
-
-Don't try to put parameters into the sql-query like this:
-
- # Does not work like you think.
- # Only the first word of the query is parsed,
- # so it's changed to "statistic_area", the rest is omitted.
- # You _have_ to work with $cur->bind_param.
- my $sql = "statistic_area 905%";
- my $cur = $dbh->prepare($sql);
- ...
-
-
-=head2 Problems
-
-=over 4
-
-=item * I don't know how to restrict users to special databases.
-
-=item * I don't know how to pass query-parameters via dbish
-
-=back
-
-
-=head1 SECURITY WARNING
-
-L<RPC::PlServer> used underneath is not secure due to serializing and
-deserializing data with L<Storable> module. Use the proxy driver only in
-trusted environment.
-
-
-=head1 AUTHOR
-
- Copyright (c) 1997 Jochen Wiedmann
- Am Eisteich 9
- 72555 Metzingen
- Germany
-
- Email: joe@ispsoft.de
- Phone: +49 7123 14881
-
-The DBI::ProxyServer module is free software; you can redistribute it
-and/or modify it under the same terms as Perl itself. In particular
-permission is granted to Tim Bunce for distributing this as a part of
-the DBI.
-
-
-=head1 SEE ALSO
-
-L<dbiproxy>, L<DBD::Proxy>, L<DBI>, L<RPC::PlServer>,
-L<RPC::PlClient>, L<Net::Daemon>, L<Net::Daemon::Log>,
-L<Sys::Syslog>, L<Win32::EventLog>, L<syslog>
+++ /dev/null
-########################################################################
-package # hide from PAUSE
- DBI;
-# vim: ts=8:sw=4
-########################################################################
-#
-# Copyright (c) 2002,2003 Tim Bunce Ireland.
-#
-# See COPYRIGHT section in DBI.pm for usage and distribution rights.
-#
-########################################################################
-#
-# Please send patches and bug reports to
-#
-# Jeff Zucker <jeff@vpservices.com> with cc to <dbi-dev@perl.org>
-#
-########################################################################
-
-use strict;
-use Carp;
-require Symbol;
-
-require utf8;
-*utf8::is_utf8 = sub { # hack for perl 5.6
- require bytes;
- return unless defined $_[0];
- return !(length($_[0]) == bytes::length($_[0]))
-} unless defined &utf8::is_utf8;
-
-$DBI::PurePerl = $ENV{DBI_PUREPERL} || 1;
-$DBI::PurePerl::VERSION = "2.014286";
-
-$DBI::neat_maxlen ||= 400;
-
-$DBI::tfh = Symbol::gensym();
-open $DBI::tfh, ">&STDERR" or warn "Can't dup STDERR: $!";
-select( (select($DBI::tfh), $| = 1)[0] ); # autoflush
-
-# check for weaken support, used by ChildHandles
-my $HAS_WEAKEN = eval {
- require Scalar::Util;
- # this will croak() if this Scalar::Util doesn't have a working weaken().
- Scalar::Util::weaken( my $test = [] );
- 1;
-};
-
-%DBI::last_method_except = map { $_=>1 } qw(DESTROY _set_fbav set_err);
-
-use constant SQL_ALL_TYPES => 0;
-use constant SQL_ARRAY => 50;
-use constant SQL_ARRAY_LOCATOR => 51;
-use constant SQL_BIGINT => (-5);
-use constant SQL_BINARY => (-2);
-use constant SQL_BIT => (-7);
-use constant SQL_BLOB => 30;
-use constant SQL_BLOB_LOCATOR => 31;
-use constant SQL_BOOLEAN => 16;
-use constant SQL_CHAR => 1;
-use constant SQL_CLOB => 40;
-use constant SQL_CLOB_LOCATOR => 41;
-use constant SQL_DATE => 9;
-use constant SQL_DATETIME => 9;
-use constant SQL_DECIMAL => 3;
-use constant SQL_DOUBLE => 8;
-use constant SQL_FLOAT => 6;
-use constant SQL_GUID => (-11);
-use constant SQL_INTEGER => 4;
-use constant SQL_INTERVAL => 10;
-use constant SQL_INTERVAL_DAY => 103;
-use constant SQL_INTERVAL_DAY_TO_HOUR => 108;
-use constant SQL_INTERVAL_DAY_TO_MINUTE => 109;
-use constant SQL_INTERVAL_DAY_TO_SECOND => 110;
-use constant SQL_INTERVAL_HOUR => 104;
-use constant SQL_INTERVAL_HOUR_TO_MINUTE => 111;
-use constant SQL_INTERVAL_HOUR_TO_SECOND => 112;
-use constant SQL_INTERVAL_MINUTE => 105;
-use constant SQL_INTERVAL_MINUTE_TO_SECOND => 113;
-use constant SQL_INTERVAL_MONTH => 102;
-use constant SQL_INTERVAL_SECOND => 106;
-use constant SQL_INTERVAL_YEAR => 101;
-use constant SQL_INTERVAL_YEAR_TO_MONTH => 107;
-use constant SQL_LONGVARBINARY => (-4);
-use constant SQL_LONGVARCHAR => (-1);
-use constant SQL_MULTISET => 55;
-use constant SQL_MULTISET_LOCATOR => 56;
-use constant SQL_NUMERIC => 2;
-use constant SQL_REAL => 7;
-use constant SQL_REF => 20;
-use constant SQL_ROW => 19;
-use constant SQL_SMALLINT => 5;
-use constant SQL_TIME => 10;
-use constant SQL_TIMESTAMP => 11;
-use constant SQL_TINYINT => (-6);
-use constant SQL_TYPE_DATE => 91;
-use constant SQL_TYPE_TIME => 92;
-use constant SQL_TYPE_TIMESTAMP => 93;
-use constant SQL_TYPE_TIMESTAMP_WITH_TIMEZONE => 95;
-use constant SQL_TYPE_TIME_WITH_TIMEZONE => 94;
-use constant SQL_UDT => 17;
-use constant SQL_UDT_LOCATOR => 18;
-use constant SQL_UNKNOWN_TYPE => 0;
-use constant SQL_VARBINARY => (-3);
-use constant SQL_VARCHAR => 12;
-use constant SQL_WCHAR => (-8);
-use constant SQL_WLONGVARCHAR => (-10);
-use constant SQL_WVARCHAR => (-9);
-
-# for Cursor types
-use constant SQL_CURSOR_FORWARD_ONLY => 0;
-use constant SQL_CURSOR_KEYSET_DRIVEN => 1;
-use constant SQL_CURSOR_DYNAMIC => 2;
-use constant SQL_CURSOR_STATIC => 3;
-use constant SQL_CURSOR_TYPE_DEFAULT => SQL_CURSOR_FORWARD_ONLY;
-
-use constant IMA_HAS_USAGE => 0x0001; #/* check parameter usage */
-use constant IMA_FUNC_REDIRECT => 0x0002; #/* is $h->func(..., "method")*/
-use constant IMA_KEEP_ERR => 0x0004; #/* don't reset err & errstr */
-use constant IMA_KEEP_ERR_SUB => 0x0008; #/* '' if in nested call */
-use constant IMA_NO_TAINT_IN => 0x0010; #/* don't check for tainted args*/
-use constant IMA_NO_TAINT_OUT => 0x0020; #/* don't taint results */
-use constant IMA_COPY_UP_STMT => 0x0040; #/* copy sth Statement to dbh */
-use constant IMA_END_WORK => 0x0080; #/* set on commit & rollback */
-use constant IMA_STUB => 0x0100; #/* do nothing eg $dbh->connected */
-use constant IMA_CLEAR_STMT => 0x0200; #/* clear Statement before call */
-use constant IMA_UNRELATED_TO_STMT=> 0x0400; #/* profile as empty Statement */
-use constant IMA_NOT_FOUND_OKAY => 0x0800; #/* not error if not found */
-use constant IMA_EXECUTE => 0x1000; #/* do/execute: DBIcf_Executed */
-use constant IMA_SHOW_ERR_STMT => 0x2000; #/* dbh meth relates to Statement*/
-use constant IMA_HIDE_ERR_PARAMVALUES => 0x4000; #/* ParamValues are not relevant */
-use constant IMA_IS_FACTORY => 0x8000; #/* new h ie connect & prepare */
-use constant IMA_CLEAR_CACHED_KIDS => 0x10000; #/* clear CachedKids before call */
-
-use constant DBIstcf_STRICT => 0x0001;
-use constant DBIstcf_DISCARD_STRING => 0x0002;
-
-my %is_flag_attribute = map {$_ =>1 } qw(
- Active
- AutoCommit
- ChopBlanks
- CompatMode
- Executed
- Taint
- TaintIn
- TaintOut
- InactiveDestroy
- AutoInactiveDestroy
- LongTruncOk
- MultiThread
- PrintError
- PrintWarn
- RaiseError
- ShowErrorStatement
- Warn
-);
-my %is_valid_attribute = map {$_ =>1 } (keys %is_flag_attribute, qw(
- ActiveKids
- Attribution
- BegunWork
- CachedKids
- Callbacks
- ChildHandles
- CursorName
- Database
- DebugDispatch
- Driver
- Err
- Errstr
- ErrCount
- FetchHashKeyName
- HandleError
- HandleSetErr
- ImplementorClass
- Kids
- LongReadLen
- NAME NAME_uc NAME_lc NAME_uc_hash NAME_lc_hash
- NULLABLE
- NUM_OF_FIELDS
- NUM_OF_PARAMS
- Name
- PRECISION
- ParamValues
- Profile
- Provider
- ReadOnly
- RootClass
- RowCacheSize
- RowsInCache
- SCALE
- State
- Statement
- TYPE
- Type
- TraceLevel
- Username
- Version
-));
-
-sub valid_attribute {
- my $attr = shift;
- return 1 if $is_valid_attribute{$attr};
- return 1 if $attr =~ m/^[a-z]/; # starts with lowercase letter
- return 0
-}
-
-my $initial_setup;
-sub initial_setup {
- $initial_setup = 1;
- print $DBI::tfh __FILE__ . " version " . $DBI::PurePerl::VERSION . "\n"
- if $DBI::dbi_debug & 0xF;
- untie $DBI::err;
- untie $DBI::errstr;
- untie $DBI::state;
- untie $DBI::rows;
- #tie $DBI::lasth, 'DBI::var', '!lasth'; # special case: return boolean
-}
-
-sub _install_method {
- my ( $caller, $method, $from, $param_hash ) = @_;
- initial_setup() unless $initial_setup;
-
- my ($class, $method_name) = $method =~ /^[^:]+::(.+)::(.+)$/;
- my $bitmask = $param_hash->{'O'} || 0;
- my @pre_call_frag;
-
- return if $method_name eq 'can';
-
- push @pre_call_frag, q{
- delete $h->{CachedKids};
- # ignore DESTROY for outer handle (DESTROY for inner likely to follow soon)
- return if $h_inner;
- # handle AutoInactiveDestroy and InactiveDestroy
- $h->{InactiveDestroy} = 1
- if $h->{AutoInactiveDestroy} and $$ != $h->{dbi_pp_pid};
- $h->{Active} = 0
- if $h->{InactiveDestroy};
- # copy err/errstr/state up to driver so $DBI::err etc still work
- if ($h->{err} and my $drh = $h->{Driver}) {
- $drh->{$_} = $h->{$_} for ('err','errstr','state');
- }
- } if $method_name eq 'DESTROY';
-
- push @pre_call_frag, q{
- return $h->{$_[0]} if exists $h->{$_[0]};
- } if $method_name eq 'FETCH' && !exists $ENV{DBI_TRACE}; # XXX ?
-
- push @pre_call_frag, "return;"
- if IMA_STUB & $bitmask;
-
- push @pre_call_frag, q{
- $method_name = pop @_;
- } if IMA_FUNC_REDIRECT & $bitmask;
-
- push @pre_call_frag, q{
- my $parent_dbh = $h->{Database};
- } if (IMA_COPY_UP_STMT|IMA_EXECUTE) & $bitmask;
-
- push @pre_call_frag, q{
- warn "No Database set for $h on $method_name!" unless $parent_dbh; # eg proxy problems
- $parent_dbh->{Statement} = $h->{Statement} if $parent_dbh;
- } if IMA_COPY_UP_STMT & $bitmask;
-
- push @pre_call_frag, q{
- $h->{Executed} = 1;
- $parent_dbh->{Executed} = 1 if $parent_dbh;
- } if IMA_EXECUTE & $bitmask;
-
- push @pre_call_frag, q{
- %{ $h->{CachedKids} } = () if $h->{CachedKids};
- } if IMA_CLEAR_CACHED_KIDS & $bitmask;
-
- if (IMA_KEEP_ERR & $bitmask) {
- push @pre_call_frag, q{
- my $keep_error = DBI::_err_hash($h);
- };
- }
- else {
- my $ke_init = (IMA_KEEP_ERR_SUB & $bitmask)
- ? q{= ($h->{dbi_pp_parent}->{dbi_pp_call_depth} && DBI::_err_hash($h)) }
- : "";
- push @pre_call_frag, qq{
- my \$keep_error $ke_init;
- };
- my $clear_error_code = q{
- #warn "$method_name cleared err";
- $h->{err} = $DBI::err = undef;
- $h->{errstr} = $DBI::errstr = undef;
- $h->{state} = $DBI::state = '';
- };
- $clear_error_code = q{
- printf $DBI::tfh " !! %s: %s CLEARED by call to }.$method_name.q{ method\n".
- $h->{err}, $h->{err}
- if defined $h->{err} && $DBI::dbi_debug & 0xF;
- }. $clear_error_code
- if exists $ENV{DBI_TRACE};
- push @pre_call_frag, ($ke_init)
- ? qq{ unless (\$keep_error) { $clear_error_code }}
- : $clear_error_code
- unless $method_name eq 'set_err';
- }
-
- push @pre_call_frag, q{
- my $ErrCount = $h->{ErrCount};
- };
-
- push @pre_call_frag, q{
- if (($DBI::dbi_debug & 0xF) >= 2) {
- local $^W;
- my $args = join " ", map { DBI::neat($_) } ($h, @_);
- printf $DBI::tfh " > $method_name in $imp ($args) [$@]\n";
- }
- } if exists $ENV{DBI_TRACE}; # note use of 'exists'
-
- push @pre_call_frag, q{
- $h->{'dbi_pp_last_method'} = $method_name;
- } unless exists $DBI::last_method_except{$method_name};
-
- # --- post method call code fragments ---
- my @post_call_frag;
-
- push @post_call_frag, q{
- if (my $trace_level = ($DBI::dbi_debug & 0xF)) {
- if ($h->{err}) {
- printf $DBI::tfh " !! ERROR: %s %s\n", $h->{err}, $h->{errstr};
- }
- my $ret = join " ", map { DBI::neat($_) } @ret;
- my $msg = " < $method_name= $ret";
- $msg = ($trace_level >= 2) ? Carp::shortmess($msg) : "$msg\n";
- print $DBI::tfh $msg;
- }
- } if exists $ENV{DBI_TRACE}; # note use of exists
-
- push @post_call_frag, q{
- $h->{Executed} = 0;
- if ($h->{BegunWork}) {
- $h->{BegunWork} = 0;
- $h->{AutoCommit} = 1;
- }
- } if IMA_END_WORK & $bitmask;
-
- push @post_call_frag, q{
- if ( ref $ret[0] and
- UNIVERSAL::isa($ret[0], 'DBI::_::common') and
- defined( (my $h_new = tied(%{$ret[0]})||$ret[0])->{err} )
- ) {
- # copy up info/warn to drh so PrintWarn on connect is triggered
- $h->set_err($h_new->{err}, $h_new->{errstr}, $h_new->{state})
- }
- } if IMA_IS_FACTORY & $bitmask;
-
- push @post_call_frag, q{
- if ($keep_error) {
- $keep_error = 0
- if $h->{ErrCount} > $ErrCount
- or DBI::_err_hash($h) ne $keep_error;
- }
-
- $DBI::err = $h->{err};
- $DBI::errstr = $h->{errstr};
- $DBI::state = $h->{state};
-
- if ( !$keep_error
- && defined(my $err = $h->{err})
- && ($call_depth <= 1 && !$h->{dbi_pp_parent}{dbi_pp_call_depth})
- ) {
-
- my($pe,$pw,$re,$he) = @{$h}{qw(PrintError PrintWarn RaiseError HandleError)};
- my $msg;
-
- if ($err && ($pe || $re || $he) # error
- or (!$err && length($err) && $pw) # warning
- ) {
- my $last = ($DBI::last_method_except{$method_name})
- ? ($h->{'dbi_pp_last_method'}||$method_name) : $method_name;
- my $errstr = $h->{errstr} || $DBI::errstr || $err || '';
- my $msg = sprintf "%s %s %s: %s", $imp, $last,
- ($err eq "0") ? "warning" : "failed", $errstr;
-
- if ($h->{'ShowErrorStatement'} and my $Statement = $h->{Statement}) {
- $msg .= ' [for Statement "' . $Statement;
- if (my $ParamValues = $h->FETCH('ParamValues')) {
- $msg .= '" with ParamValues: ';
- $msg .= DBI::_concat_hash_sorted($ParamValues, "=", ", ", 1, undef);
- $msg .= "]";
- }
- else {
- $msg .= '"]';
- }
- }
- if ($err eq "0") { # is 'warning' (not info)
- carp $msg if $pw;
- }
- else {
- my $do_croak = 1;
- if (my $subsub = $h->{'HandleError'}) {
- $do_croak = 0 if &$subsub($msg,$h,$ret[0]);
- }
- if ($do_croak) {
- printf $DBI::tfh " $method_name has failed ($h->{PrintError},$h->{RaiseError})\n"
- if ($DBI::dbi_debug & 0xF) >= 4;
- carp $msg if $pe;
- die $msg if $h->{RaiseError};
- }
- }
- }
- }
- };
-
-
- my $method_code = q[
- sub {
- my $h = shift;
- my $h_inner = tied(%$h);
- $h = $h_inner if $h_inner;
-
- my $imp;
- if ($method_name eq 'DESTROY') {
- # during global destruction, $h->{...} can trigger "Can't call FETCH on an undef value"
- # implying that tied() above lied to us, so we need to use eval
- local $@; # protect $@
- $imp = eval { $h->{"ImplementorClass"} } or return; # probably global destruction
- }
- else {
- $imp = $h->{"ImplementorClass"} or do {
- warn "Can't call $method_name method on handle $h after take_imp_data()\n"
- if not exists $h->{Active};
- return; # or, more likely, global destruction
- };
- }
-
- ] . join("\n", '', @pre_call_frag, '') . q[
-
- my $call_depth = $h->{'dbi_pp_call_depth'} + 1;
- local ($h->{'dbi_pp_call_depth'}) = $call_depth;
-
- my @ret;
- my $sub = $imp->can($method_name);
- if (!$sub and IMA_FUNC_REDIRECT & $bitmask and $sub = $imp->can('func')) {
- push @_, $method_name;
- }
- if ($sub) {
- (wantarray) ? (@ret = &$sub($h,@_)) : (@ret = scalar &$sub($h,@_));
- }
- else {
- # XXX could try explicit fallback to $imp->can('AUTOLOAD') etc
- # which would then let Multiplex pass PurePerl tests, but some
- # hook into install_method may be better.
- croak "Can't locate DBI object method \"$method_name\" via package \"$imp\""
- if ] . ((IMA_NOT_FOUND_OKAY & $bitmask) ? 0 : 1) . q[;
- }
-
- ] . join("\n", '', @post_call_frag, '') . q[
-
- return (wantarray) ? @ret : $ret[0];
- }
- ];
- no strict qw(refs);
- my $code_ref = eval qq{#line 1 "DBI::PurePerl $method"\n$method_code};
- warn "$@\n$method_code\n" if $@;
- die "$@\n$method_code\n" if $@;
- *$method = $code_ref;
- if (0 && $method =~ /\b(connect|FETCH)\b/) { # debuging tool
- my $l=0; # show line-numbered code for method
- warn "*$method code:\n".join("\n", map { ++$l.": $_" } split/\n/,$method_code);
- }
-}
-
-
-sub _new_handle {
- my ($class, $parent, $attr, $imp_data, $imp_class) = @_;
-
- DBI->trace_msg(" New $class (for $imp_class, parent=$parent, id=".($imp_data||'').")\n")
- if $DBI::dbi_debug >= 3;
-
- $attr->{ImplementorClass} = $imp_class
- or Carp::croak("_new_handle($class): 'ImplementorClass' attribute not given");
-
- # This is how we create a DBI style Object:
- # %outer gets tied to %$attr (which becomes the 'inner' handle)
- my (%outer, $i, $h);
- $i = tie %outer, $class, $attr; # ref to inner hash (for driver)
- $h = bless \%outer, $class; # ref to outer hash (for application)
- # The above tie and bless may migrate down into _setup_handle()...
- # Now add magic so DBI method dispatch works
- DBI::_setup_handle($h, $imp_class, $parent, $imp_data);
- return $h unless wantarray;
- return ($h, $i);
-}
-
-sub _setup_handle {
- my($h, $imp_class, $parent, $imp_data) = @_;
- my $h_inner = tied(%$h) || $h;
- if (($DBI::dbi_debug & 0xF) >= 4) {
- local $^W;
- print $DBI::tfh " _setup_handle(@_)\n";
- }
- $h_inner->{"imp_data"} = $imp_data;
- $h_inner->{"ImplementorClass"} = $imp_class;
- $h_inner->{"Kids"} = $h_inner->{"ActiveKids"} = 0; # XXX not maintained
- if ($parent) {
- foreach (qw(
- RaiseError PrintError PrintWarn HandleError HandleSetErr
- Warn LongTruncOk ChopBlanks AutoCommit ReadOnly
- ShowErrorStatement FetchHashKeyName LongReadLen CompatMode
- )) {
- $h_inner->{$_} = $parent->{$_}
- if exists $parent->{$_} && !exists $h_inner->{$_};
- }
- if (ref($parent) =~ /::db$/) { # is sth
- $h_inner->{Database} = $parent;
- $parent->{Statement} = $h_inner->{Statement};
- $h_inner->{NUM_OF_PARAMS} = 0;
- $h_inner->{Active} = 0; # driver sets true when there's data to fetch
- }
- elsif (ref($parent) =~ /::dr$/){ # is dbh
- $h_inner->{Driver} = $parent;
- $h_inner->{Active} = 0;
- }
- else {
- warn "panic: ".ref($parent); # should never happen
- }
- $h_inner->{dbi_pp_parent} = $parent;
-
- # add to the parent's ChildHandles
- if ($HAS_WEAKEN) {
- my $handles = $parent->{ChildHandles} ||= [];
- push @$handles, $h;
- Scalar::Util::weaken($handles->[-1]);
- # purge destroyed handles occasionally
- if (@$handles % 120 == 0) {
- @$handles = grep { defined } @$handles;
- Scalar::Util::weaken($_) for @$handles; # re-weaken after grep
- }
- }
- }
- else { # setting up a driver handle
- $h_inner->{Warn} = 1;
- $h_inner->{PrintWarn} = 1;
- $h_inner->{AutoCommit} = 1;
- $h_inner->{TraceLevel} = 0;
- $h_inner->{CompatMode} = (1==0);
- $h_inner->{FetchHashKeyName} ||= 'NAME';
- $h_inner->{LongReadLen} ||= 80;
- $h_inner->{ChildHandles} ||= [] if $HAS_WEAKEN;
- $h_inner->{Type} ||= 'dr';
- $h_inner->{Active} = 1;
- }
- $h_inner->{"dbi_pp_call_depth"} = 0;
- $h_inner->{"dbi_pp_pid"} = $$;
- $h_inner->{ErrCount} = 0;
-}
-
-sub constant {
- warn "constant(@_) called unexpectedly"; return undef;
-}
-
-sub trace {
- my ($h, $level, $file) = @_;
- $level = $h->parse_trace_flags($level)
- if defined $level and !DBI::looks_like_number($level);
- my $old_level = $DBI::dbi_debug;
- _set_trace_file($file) if $level;
- if (defined $level) {
- $DBI::dbi_debug = $level;
- print $DBI::tfh " DBI $DBI::VERSION (PurePerl) "
- . "dispatch trace level set to $DBI::dbi_debug\n"
- if $DBI::dbi_debug & 0xF;
- }
- _set_trace_file($file) if !$level;
- return $old_level;
-}
-
-sub _set_trace_file {
- my ($file) = @_;
- #
- # DAA add support for filehandle inputs
- #
- # DAA required to avoid closing a prior fh trace()
- $DBI::tfh = undef unless $DBI::tfh_needs_close;
-
- if (ref $file eq 'GLOB') {
- $DBI::tfh = $file;
- select((select($DBI::tfh), $| = 1)[0]);
- $DBI::tfh_needs_close = 0;
- return 1;
- }
- if ($file && ref \$file eq 'GLOB') {
- $DBI::tfh = *{$file}{IO};
- select((select($DBI::tfh), $| = 1)[0]);
- $DBI::tfh_needs_close = 0;
- return 1;
- }
- $DBI::tfh_needs_close = 1;
- if (!$file || $file eq 'STDERR') {
- open $DBI::tfh, ">&STDERR" or carp "Can't dup STDERR: $!";
- }
- elsif ($file eq 'STDOUT') {
- open $DBI::tfh, ">&STDOUT" or carp "Can't dup STDOUT: $!";
- }
- else {
- open $DBI::tfh, ">>$file" or carp "Can't open $file: $!";
- }
- select((select($DBI::tfh), $| = 1)[0]);
- return 1;
-}
-sub _get_imp_data { shift->{"imp_data"}; }
-sub _svdump { }
-sub dump_handle {
- my ($h,$msg,$level) = @_;
- $msg||="dump_handle $h";
- print $DBI::tfh "$msg:\n";
- for my $attrib (sort keys %$h) {
- print $DBI::tfh "\t$attrib => ".DBI::neat($h->{$attrib})."\n";
- }
-}
-
-sub _handles {
- my $h = shift;
- my $h_inner = tied %$h;
- if ($h_inner) { # this is okay
- return $h unless wantarray;
- return ($h, $h_inner);
- }
- # XXX this isn't okay... we have an inner handle but
- # currently have no way to get at its outer handle,
- # so we just warn and return the inner one for both...
- Carp::carp("Can't return outer handle from inner handle using DBI::PurePerl");
- return $h unless wantarray;
- return ($h,$h);
-}
-
-sub hash {
- my ($key, $type) = @_;
- my ($hash);
- if (!$type) {
- $hash = 0;
- # XXX The C version uses the "char" type, which could be either
- # signed or unsigned. I use signed because so do the two
- # compilers on my system.
- for my $char (unpack ("c*", $key)) {
- $hash = $hash * 33 + $char;
- }
- $hash &= 0x7FFFFFFF; # limit to 31 bits
- $hash |= 0x40000000; # set bit 31
- return -$hash; # return negative int
- }
- elsif ($type == 1) { # Fowler/Noll/Vo hash
- # see http://www.isthe.com/chongo/tech/comp/fnv/
- require Math::BigInt; # feel free to reimplement w/o BigInt!
- (my $version = $Math::BigInt::VERSION || 0) =~ s/_.*//; # eg "1.70_01"
- if ($version >= 1.56) {
- $hash = Math::BigInt->new(0x811c9dc5);
- for my $uchar (unpack ("C*", $key)) {
- # multiply by the 32 bit FNV magic prime mod 2^64
- $hash = ($hash * 0x01000193) & 0xffffffff;
- # xor the bottom with the current octet
- $hash ^= $uchar;
- }
- # cast to int
- return unpack "i", pack "i", $hash;
- }
- croak("DBI::PurePerl doesn't support hash type 1 without Math::BigInt >= 1.56 (available on CPAN)");
- }
- else {
- croak("bad hash type $type");
- }
-}
-
-sub looks_like_number {
- my @new = ();
- for my $thing(@_) {
- if (!defined $thing or $thing eq '') {
- push @new, undef;
- }
- else {
- push @new, ($thing =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/) ? 1 : 0;
- }
- }
- return (@_ >1) ? @new : $new[0];
-}
-
-sub neat {
- my $v = shift;
- return "undef" unless defined $v;
- my $quote = q{"};
- if (not utf8::is_utf8($v)) {
- return $v if (($v & ~ $v) eq "0"); # is SvNIOK
- $quote = q{'};
- }
- my $maxlen = shift || $DBI::neat_maxlen;
- if ($maxlen && $maxlen < length($v) + 2) {
- $v = substr($v,0,$maxlen-5);
- $v .= '...';
- }
- $v =~ s/[^[:print:]]/./g;
- return "$quote$v$quote";
-}
-
-sub sql_type_cast {
- my (undef, $sql_type, $flags) = @_;
-
- return -1 unless defined $_[0];
-
- my $cast_ok = 1;
-
- my $evalret = eval {
- use warnings FATAL => qw(numeric);
- if ($sql_type == SQL_INTEGER) {
- my $dummy = $_[0] + 0;
- return 1;
- }
- elsif ($sql_type == SQL_DOUBLE) {
- my $dummy = $_[0] + 0.0;
- return 1;
- }
- elsif ($sql_type == SQL_NUMERIC) {
- my $dummy = $_[0] + 0.0;
- return 1;
- }
- else {
- return -2;
- }
- } or $^W && warn $@; # XXX warnings::warnif("numeric", $@) ?
-
- return $evalret if defined($evalret) && ($evalret == -2);
- $cast_ok = 0 unless $evalret;
-
- # DBIstcf_DISCARD_STRING not supported for PurePerl currently
-
- return 2 if $cast_ok;
- return 0 if $flags & DBIstcf_STRICT;
- return 1;
-}
-
-sub dbi_time {
- return time();
-}
-
-sub DBI::st::TIEHASH { bless $_[1] => $_[0] };
-
-sub _concat_hash_sorted {
- my ( $hash_ref, $kv_separator, $pair_separator, $use_neat, $num_sort ) = @_;
- # $num_sort: 0=lexical, 1=numeric, undef=try to guess
-
- return undef unless defined $hash_ref;
- die "hash is not a hash reference" unless ref $hash_ref eq 'HASH';
- my $keys = _get_sorted_hash_keys($hash_ref, $num_sort);
- my $string = '';
- for my $key (@$keys) {
- $string .= $pair_separator if length $string > 0;
- my $value = $hash_ref->{$key};
- if ($use_neat) {
- $value = DBI::neat($value, 0);
- }
- else {
- $value = (defined $value) ? "'$value'" : 'undef';
- }
- $string .= $key . $kv_separator . $value;
- }
- return $string;
-}
-
-sub _get_sorted_hash_keys {
- my ($hash_ref, $num_sort) = @_;
- if (not defined $num_sort) {
- my $sort_guess = 1;
- $sort_guess = (not looks_like_number($_)) ? 0 : $sort_guess
- for keys %$hash_ref;
- $num_sort = $sort_guess;
- }
-
- my @keys = keys %$hash_ref;
- no warnings 'numeric';
- my @sorted = ($num_sort)
- ? sort { $a <=> $b or $a cmp $b } @keys
- : sort @keys;
- return \@sorted;
-}
-
-sub _err_hash {
- return 1 unless defined $_[0]->{err};
- return "$_[0]->{err} $_[0]->{errstr}"
-}
-
-
-package
- DBI::var;
-
-sub FETCH {
- my($key)=shift;
- return $DBI::err if $$key eq '*err';
- return $DBI::errstr if $$key eq '&errstr';
- Carp::confess("FETCH $key not supported when using DBI::PurePerl");
-}
-
-package
- DBD::_::common;
-
-sub swap_inner_handle {
- my ($h1, $h2) = @_;
- # can't make this work till we can get the outer handle from the inner one
- # probably via a WeakRef
- return $h1->set_err($DBI::stderr, "swap_inner_handle not currently supported by DBI::PurePerl");
-}
-
-sub trace { # XXX should set per-handle level, not global
- my ($h, $level, $file) = @_;
- $level = $h->parse_trace_flags($level)
- if defined $level and !DBI::looks_like_number($level);
- my $old_level = $DBI::dbi_debug;
- DBI::_set_trace_file($file) if defined $file;
- if (defined $level) {
- $DBI::dbi_debug = $level;
- if ($DBI::dbi_debug) {
- printf $DBI::tfh
- " %s trace level set to %d in DBI $DBI::VERSION (PurePerl)\n",
- $h, $DBI::dbi_debug;
- print $DBI::tfh " Full trace not available because DBI_TRACE is not in environment\n"
- unless exists $ENV{DBI_TRACE};
- }
- }
- return $old_level;
-}
-*debug = \&trace; *debug = \&trace; # twice to avoid typo warning
-
-sub FETCH {
- my($h,$key)= @_;
- my $v = $h->{$key};
- #warn ((exists $h->{$key}) ? "$key=$v\n" : "$key NONEXISTANT\n");
- return $v if defined $v;
- if ($key =~ /^NAME_.c$/) {
- my $cols = $h->FETCH('NAME');
- return undef unless $cols;
- my @lcols = map { lc $_ } @$cols;
- $h->{NAME_lc} = \@lcols;
- my @ucols = map { uc $_ } @$cols;
- $h->{NAME_uc} = \@ucols;
- return $h->FETCH($key);
- }
- if ($key =~ /^NAME.*_hash$/) {
- my $i=0;
- for my $c(@{$h->FETCH('NAME')||[]}) {
- $h->{'NAME_hash'}->{$c} = $i;
- $h->{'NAME_lc_hash'}->{"\L$c"} = $i;
- $h->{'NAME_uc_hash'}->{"\U$c"} = $i;
- $i++;
- }
- return $h->{$key};
- }
- if (!defined $v && !exists $h->{$key}) {
- return ($h->FETCH('TaintIn') && $h->FETCH('TaintOut')) if $key eq'Taint';
- return (1==0) if $is_flag_attribute{$key}; # return perl-style sv_no, not undef
- return $DBI::dbi_debug if $key eq 'TraceLevel';
- return [] if $key eq 'ChildHandles' && $HAS_WEAKEN;
- if ($key eq 'Type') {
- return "dr" if $h->isa('DBI::dr');
- return "db" if $h->isa('DBI::db');
- return "st" if $h->isa('DBI::st');
- Carp::carp( sprintf "Can't determine Type for %s",$h );
- }
- if (!$is_valid_attribute{$key} and $key =~ m/^[A-Z]/) {
- local $^W; # hide undef warnings
- Carp::carp( sprintf "Can't get %s->{%s}: unrecognised attribute (@{[ %$h ]})",$h,$key )
- }
- }
- return $v;
-}
-sub STORE {
- my ($h,$key,$value) = @_;
- if ($key eq 'AutoCommit') {
- Carp::croak("DBD driver has not implemented the AutoCommit attribute")
- unless $value == -900 || $value == -901;
- $value = ($value == -901);
- }
- elsif ($key =~ /^Taint/ ) {
- Carp::croak(sprintf "Can't set %s->{%s}: Taint mode not supported by DBI::PurePerl",$h,$key)
- if $value;
- }
- elsif ($key eq 'TraceLevel') {
- $h->trace($value);
- return 1;
- }
- elsif ($key eq 'NUM_OF_FIELDS') {
- $h->{$key} = $value;
- if ($value) {
- my $fbav = DBD::_::st::dbih_setup_fbav($h);
- @$fbav = (undef) x $value if @$fbav != $value;
- }
- return 1;
- }
- elsif (!$is_valid_attribute{$key} && $key =~ /^[A-Z]/ && !exists $h->{$key}) {
- Carp::carp(sprintf "Can't set %s->{%s}: unrecognised attribute or invalid value %s",
- $h,$key,$value);
- }
- $h->{$key} = $is_flag_attribute{$key} ? !!$value : $value;
- Scalar::Util::weaken($h->{$key}) if $key eq 'CachedKids';
- return 1;
-}
-sub DELETE {
- my ($h, $key) = @_;
- return $h->FETCH($key) unless $key =~ /^private_/;
- return delete $h->{$key};
-}
-sub err { return shift->{err} }
-sub errstr { return shift->{errstr} }
-sub state { return shift->{state} }
-sub set_err {
- my ($h, $errnum,$msg,$state, $method, $rv) = @_;
- $h = tied(%$h) || $h;
-
- if (my $hss = $h->{HandleSetErr}) {
- return if $hss->($h, $errnum, $msg, $state, $method);
- }
-
- if (!defined $errnum) {
- $h->{err} = $DBI::err = undef;
- $h->{errstr} = $DBI::errstr = undef;
- $h->{state} = $DBI::state = '';
- return;
- }
-
- if ($h->{errstr}) {
- $h->{errstr} .= sprintf " [err was %s now %s]", $h->{err}, $errnum
- if $h->{err} && $errnum && $h->{err} ne $errnum;
- $h->{errstr} .= sprintf " [state was %s now %s]", $h->{state}, $state
- if $h->{state} and $h->{state} ne "S1000" && $state && $h->{state} ne $state;
- $h->{errstr} .= "\n$msg" if $h->{errstr} ne $msg;
- $DBI::errstr = $h->{errstr};
- }
- else {
- $h->{errstr} = $DBI::errstr = $msg;
- }
-
- # assign if higher priority: err > "0" > "" > undef
- my $err_changed;
- if ($errnum # new error: so assign
- or !defined $h->{err} # no existing warn/info: so assign
- # new warn ("0" len 1) > info ("" len 0): so assign
- or defined $errnum && length($errnum) > length($h->{err})
- ) {
- $h->{err} = $DBI::err = $errnum;
- ++$h->{ErrCount} if $errnum;
- ++$err_changed;
- }
-
- if ($err_changed) {
- $state ||= "S1000" if $DBI::err;
- $h->{state} = $DBI::state = ($state eq "00000") ? "" : $state
- if $state;
- }
-
- if (my $p = $h->{Database}) { # just sth->dbh, not dbh->drh (see ::db::DESTROY)
- $p->{err} = $DBI::err;
- $p->{errstr} = $DBI::errstr;
- $p->{state} = $DBI::state;
- }
-
- $h->{'dbi_pp_last_method'} = $method;
- return $rv; # usually undef
-}
-sub trace_msg {
- my ($h, $msg, $minlevel)=@_;
- $minlevel = 1 unless defined $minlevel;
- return unless $minlevel <= ($DBI::dbi_debug & 0xF);
- print $DBI::tfh $msg;
- return 1;
-}
-sub private_data {
- warn "private_data @_";
-}
-sub take_imp_data {
- my $dbh = shift;
- # A reasonable default implementation based on the one in DBI.xs.
- # Typically a pure-perl driver would have their own take_imp_data method
- # that would delete all but the essential items in the hash before ending with:
- # return $dbh->SUPER::take_imp_data();
- # Of course it's useless if the driver doesn't also implement support for
- # the dbi_imp_data attribute to the connect() method.
- require Storable;
- croak("Can't take_imp_data from handle that's not Active")
- unless $dbh->{Active};
- for my $sth (@{ $dbh->{ChildHandles} || [] }) {
- next unless $sth;
- $sth->finish if $sth->{Active};
- bless $sth, 'DBI::zombie';
- }
- delete $dbh->{$_} for (keys %is_valid_attribute);
- delete $dbh->{$_} for grep { m/^dbi_/ } keys %$dbh;
- # warn "@{[ %$dbh ]}";
- local $Storable::forgive_me = 1; # in case there are some CODE refs
- my $imp_data = Storable::freeze($dbh);
- # XXX um, should probably untie here - need to check dispatch behaviour
- return $imp_data;
-}
-sub rows {
- return -1; # always returns -1 here, see DBD::_::st::rows below
-}
-sub DESTROY {
-}
-
-package
- DBD::_::dr;
-
-sub dbixs_revision {
- return 0;
-}
-
-package
- DBD::_::db;
-
-sub connected {
-}
-
-
-package
- DBD::_::st;
-
-sub fetchrow_arrayref {
- my $h = shift;
- # if we're here then driver hasn't implemented fetch/fetchrow_arrayref
- # so we assume they've implemented fetchrow_array and call that instead
- my @row = $h->fetchrow_array or return;
- return $h->_set_fbav(\@row);
-}
-# twice to avoid typo warning
-*fetch = \&fetchrow_arrayref; *fetch = \&fetchrow_arrayref;
-
-sub fetchrow_array {
- my $h = shift;
- # if we're here then driver hasn't implemented fetchrow_array
- # so we assume they've implemented fetch/fetchrow_arrayref
- my $row = $h->fetch or return;
- return @$row;
-}
-*fetchrow = \&fetchrow_array; *fetchrow = \&fetchrow_array;
-
-sub fetchrow_hashref {
- my $h = shift;
- my $row = $h->fetch or return;
- my $FetchCase = shift;
- my $FetchHashKeyName = $FetchCase || $h->{'FetchHashKeyName'} || 'NAME';
- my $FetchHashKeys = $h->FETCH($FetchHashKeyName);
- my %rowhash;
- @rowhash{ @$FetchHashKeys } = @$row;
- return \%rowhash;
-}
-sub dbih_setup_fbav {
- my $h = shift;
- return $h->{'_fbav'} || do {
- $DBI::rows = $h->{'_rows'} = 0;
- my $fields = $h->{'NUM_OF_FIELDS'}
- or DBI::croak("NUM_OF_FIELDS not set");
- my @row = (undef) x $fields;
- \@row;
- };
-}
-sub _get_fbav {
- my $h = shift;
- my $av = $h->{'_fbav'} ||= dbih_setup_fbav($h);
- $DBI::rows = ++$h->{'_rows'};
- return $av;
-}
-sub _set_fbav {
- my $h = shift;
- my $fbav = $h->{'_fbav'};
- if ($fbav) {
- $DBI::rows = ++$h->{'_rows'};
- }
- else {
- $fbav = $h->_get_fbav;
- }
- my $row = shift;
- if (my $bc = $h->{'_bound_cols'}) {
- for my $i (0..@$row-1) {
- my $bound = $bc->[$i];
- $fbav->[$i] = ($bound) ? ($$bound = $row->[$i]) : $row->[$i];
- }
- }
- else {
- @$fbav = @$row;
- }
- return $fbav;
-}
-sub bind_col {
- my ($h, $col, $value_ref,$from_bind_columns) = @_;
- my $fbav = $h->{'_fbav'} ||= dbih_setup_fbav($h); # from _get_fbav()
- my $num_of_fields = @$fbav;
- DBI::croak("bind_col: column $col is not a valid column (1..$num_of_fields)")
- if $col < 1 or $col > $num_of_fields;
- return 1 if not defined $value_ref; # ie caller is just trying to set TYPE
- DBI::croak("bind_col($col,$value_ref) needs a reference to a scalar")
- unless ref $value_ref eq 'SCALAR';
- $h->{'_bound_cols'}->[$col-1] = $value_ref;
- return 1;
-}
-sub finish {
- my $h = shift;
- $h->{'_fbav'} = undef;
- $h->{'Active'} = 0;
- return 1;
-}
-sub rows {
- my $h = shift;
- my $rows = $h->{'_rows'};
- return -1 unless defined $rows;
- return $rows;
-}
-
-1;
-__END__
-
-=pod
-
-=head1 NAME
-
-DBI::PurePerl -- a DBI emulation using pure perl (no C/XS compilation required)
-
-=head1 SYNOPSIS
-
- BEGIN { $ENV{DBI_PUREPERL} = 2 }
- use DBI;
-
-=head1 DESCRIPTION
-
-This is a pure perl emulation of the DBI internals. In almost all
-cases you will be better off using standard DBI since the portions
-of the standard version written in C make it *much* faster.
-
-However, if you are in a situation where it isn't possible to install
-a compiled version of standard DBI, and you're using pure-perl DBD
-drivers, then this module allows you to use most common features
-of DBI without needing any changes in your scripts.
-
-=head1 EXPERIMENTAL STATUS
-
-DBI::PurePerl is new so please treat it as experimental pending
-more extensive testing. So far it has passed all tests with DBD::CSV,
-DBD::AnyData, DBD::XBase, DBD::Sprite, DBD::mysqlPP. Please send
-bug reports to Jeff Zucker at <jeff@vpservices.com> with a cc to
-<dbi-dev@perl.org>.
-
-=head1 USAGE
-
-The usage is the same as for standard DBI with the exception
-that you need to set the environment variable DBI_PUREPERL if
-you want to use the PurePerl version.
-
- DBI_PUREPERL == 0 (the default) Always use compiled DBI, die
- if it isn't properly compiled & installed
-
- DBI_PUREPERL == 1 Use compiled DBI if it is properly compiled
- & installed, otherwise use PurePerl
-
- DBI_PUREPERL == 2 Always use PurePerl
-
-You may set the environment variable in your shell (e.g. with
-set or setenv or export, etc) or else set it in your script like
-this:
-
- BEGIN { $ENV{DBI_PUREPERL}=2 }
-
-before you C<use DBI;>.
-
-=head1 INSTALLATION
-
-In most situations simply install DBI (see the DBI pod for details).
-
-In the situation in which you can not install DBI itself, you
-may manually copy DBI.pm and PurePerl.pm into the appropriate
-directories.
-
-For example:
-
- cp DBI.pm /usr/jdoe/mylibs/.
- cp PurePerl.pm /usr/jdoe/mylibs/DBI/.
-
-Then add this to the top of scripts:
-
- BEGIN {
- $ENV{DBI_PUREPERL} = 1; # or =2
- unshift @INC, '/usr/jdoe/mylibs';
- }
-
-(Or should we perhaps patch Makefile.PL so that if DBI_PUREPERL
-is set to 2 prior to make, the normal compile process is skipped
-and the files are installed automatically?)
-
-=head1 DIFFERENCES BETWEEN DBI AND DBI::PurePerl
-
-=head2 Attributes
-
-Boolean attributes still return boolean values but the actual values
-used may be different, i.e., 0 or undef instead of an empty string.
-
-Some handle attributes are either not supported or have very limited
-functionality:
-
- ActiveKids
- InactiveDestroy
- AutoInactiveDestroy
- Kids
- Taint
- TaintIn
- TaintOut
-
-(and probably others)
-
-=head2 Tracing
-
-Trace functionality is more limited and the code to handle tracing is
-only embedded into DBI:PurePerl if the DBI_TRACE environment variable
-is defined. To enable total tracing you can set the DBI_TRACE
-environment variable as usual. But to enable individual handle
-tracing using the trace() method you also need to set the DBI_TRACE
-environment variable, but set it to 0.
-
-=head2 Parameter Usage Checking
-
-The DBI does some basic parameter count checking on method calls.
-DBI::PurePerl doesn't.
-
-=head2 Speed
-
-DBI::PurePerl is slower. Although, with some drivers in some
-contexts this may not be very significant for you.
-
-By way of example... the test.pl script in the DBI source
-distribution has a simple benchmark that just does:
-
- my $null_dbh = DBI->connect('dbi:NullP:','','');
- my $i = 10_000;
- $null_dbh->prepare('') while $i--;
-
-In other words just prepares a statement, creating and destroying
-a statement handle, over and over again. Using the real DBI this
-runs at ~4550 handles per second whereas DBI::PurePerl manages
-~2800 per second on the same machine (not too bad really).
-
-=head2 May not fully support hash()
-
-If you want to use type 1 hash, i.e., C<hash($string,1)> with
-DBI::PurePerl, you'll need version 1.56 or higher of Math::BigInt
-(available on CPAN).
-
-=head2 Doesn't support preparse()
-
-The DBI->preparse() method isn't supported in DBI::PurePerl.
-
-=head2 Doesn't support DBD::Proxy
-
-There's a subtle problem somewhere I've not been able to identify.
-DBI::ProxyServer seem to work fine with DBI::PurePerl but DBD::Proxy
-does not work 100% (which is sad because that would be far more useful :)
-Try re-enabling t/80proxy.t for DBI::PurePerl to see if the problem
-that remains will affect you're usage.
-
-=head2 Others
-
- can() - doesn't have any special behaviour
-
-Please let us know if you find any other differences between DBI
-and DBI::PurePerl.
-
-=head1 AUTHORS
-
-Tim Bunce and Jeff Zucker.
-
-Tim provided the direction and basis for the code. The original
-idea for the module and most of the brute force porting from C to
-Perl was by Jeff. Tim then reworked some core parts to boost the
-performance and accuracy of the emulation. Thanks also to Randal
-Schwartz and John Tobey for patches.
-
-=head1 COPYRIGHT
-
-Copyright (c) 2002 Tim Bunce Ireland.
-
-See COPYRIGHT section in DBI.pm for usage and distribution rights.
-
-=cut
+++ /dev/null
-#######################################################################
-#
-# DBI::SQL::Nano - a very tiny SQL engine
-#
-# Copyright (c) 2010 by Jens Rehsack < rehsack AT cpan.org >
-# Copyright (c) 2004 by Jeff Zucker < jzucker AT cpan.org >
-#
-# All rights reserved.
-#
-# You may freely distribute and/or modify this module under the terms
-# of either the GNU General Public License (GPL) or the Artistic License,
-# as specified in the Perl README file.
-#
-# See the pod at the bottom of this file for help information
-#
-#######################################################################
-
-#######################
-package DBI::SQL::Nano;
-#######################
-use strict;
-use warnings;
-use vars qw( $VERSION $versions );
-
-use Carp qw(croak);
-
-require DBI; # for looks_like_number()
-
-BEGIN
-{
- $VERSION = "1.015544";
-
- $versions->{nano_version} = $VERSION;
- if ( $ENV{DBI_SQL_NANO} || !eval { require SQL::Statement; $SQL::Statement::VERSION ge '1.400' } )
- {
- @DBI::SQL::Nano::Statement::ISA = qw(DBI::SQL::Nano::Statement_);
- @DBI::SQL::Nano::Table::ISA = qw(DBI::SQL::Nano::Table_);
- }
- else
- {
- @DBI::SQL::Nano::Statement::ISA = qw( SQL::Statement );
- @DBI::SQL::Nano::Table::ISA = qw( SQL::Eval::Table);
- $versions->{statement_version} = $SQL::Statement::VERSION;
- }
-}
-
-###################################
-package DBI::SQL::Nano::Statement_;
-###################################
-
-use Carp qw(croak);
-use Errno;
-
-if ( eval { require Clone; } )
-{
- Clone->import("clone");
-}
-else
-{
- require Storable; # in CORE since 5.7.3
- *clone = \&Storable::dclone;
-}
-
-sub new
-{
- my ( $class, $sql ) = @_;
- my $self = {};
- bless $self, $class;
- return $self->prepare($sql);
-}
-
-#####################################################################
-# PREPARE
-#####################################################################
-sub prepare
-{
- my ( $self, $sql ) = @_;
- $sql =~ s/\s+$//;
- $sql =~ s/\s*;$//;
- for ($sql)
- {
- /^\s*CREATE\s+TABLE\s+(.*?)\s*\((.+)\)\s*$/is
- && do
- {
- $self->{command} = 'CREATE';
- $self->{table_name} = $1;
- defined $2 and $2 ne "" and
- $self->{column_names} = parse_coldef_list($2);
- $self->{column_names} or croak "Can't find columns";
- };
- /^\s*DROP\s+TABLE\s+(IF\s+EXISTS\s+)?(.*?)\s*$/is
- && do
- {
- $self->{command} = 'DROP';
- $self->{table_name} = $2;
- defined $1 and $1 ne "" and
- $self->{ignore_missing_table} = 1;
- };
- /^\s*SELECT\s+(.*?)\s+FROM\s+(\S+)((.*))?/is
- && do
- {
- $self->{command} = 'SELECT';
- defined $1 and $1 ne "" and
- $self->{column_names} = parse_comma_list($1);
- $self->{column_names} or croak "Can't find columns";
- $self->{table_name} = $2;
- if ( my $clauses = $4 )
- {
- if ( $clauses =~ /^(.*)\s+ORDER\s+BY\s+(.*)$/is )
- {
- $clauses = $1;
- $self->{order_clause} = $self->parse_order_clause($2);
- }
- $self->{where_clause} = $self->parse_where_clause($clauses) if ($clauses);
- }
- };
- /^\s*INSERT\s+(?:INTO\s+)?(\S+)\s*(\((.*?)\))?\s*VALUES\s*\((.+)\)/is
- && do
- {
- $self->{command} = 'INSERT';
- $self->{table_name} = $1;
- defined $2 and $2 ne "" and
- $self->{column_names} = parse_comma_list($2);
- defined $4 and $4 ne "" and
- $self->{values} = $self->parse_values_list($4);
- $self->{values} or croak "Can't parse values";
- };
- /^\s*DELETE\s+FROM\s+(\S+)((.*))?/is
- && do
- {
- $self->{command} = 'DELETE';
- $self->{table_name} = $1;
- defined $3 and $3 ne "" and
- $self->{where_clause} = $self->parse_where_clause($3);
- };
- /^\s*UPDATE\s+(\S+)\s+SET\s+(.+)(\s+WHERE\s+.+)/is
- && do
- {
- $self->{command} = 'UPDATE';
- $self->{table_name} = $1;
- defined $2 and $2 ne "" and
- $self->parse_set_clause($2);
- defined $3 and $3 ne "" and
- $self->{where_clause} = $self->parse_where_clause($3);
- };
- }
- croak "Couldn't parse" unless ( $self->{command} and $self->{table_name} );
- return $self;
-}
-
-sub parse_order_clause
-{
- my ( $self, $str ) = @_;
- my @clause = split /\s+/, $str;
- return { $clause[0] => 'ASC' } if ( @clause == 1 );
- croak "Bad ORDER BY clause '$str'" if ( @clause > 2 );
- $clause[1] ||= '';
- return { $clause[0] => uc $clause[1] }
- if $clause[1] =~ /^ASC$/i
- or $clause[1] =~ /^DESC$/i;
- croak "Bad ORDER BY clause '$clause[1]'";
-}
-
-sub parse_coldef_list
-{ # check column definitions
- my @col_defs;
- for ( split ',', shift )
- {
- my $col = clean_parse_str($_);
- if ( $col =~ /^(\S+?)\s+.+/ )
- { # doesn't check what it is
- $col = $1; # just checks if it exists
- }
- else
- {
- croak "No column definition for '$_'";
- }
- push @col_defs, $col;
- }
- return \@col_defs;
-}
-
-sub parse_comma_list
-{
- [ map { clean_parse_str($_) } split( ',', shift ) ];
-}
-sub clean_parse_str { local $_ = shift; s/\(//; s/\)//; s/^\s+//; s/\s+$//; $_; }
-
-sub parse_values_list
-{
- my ( $self, $str ) = @_;
- [ map { $self->parse_value( clean_parse_str($_) ) } split( ',', $str ) ];
-}
-
-sub parse_set_clause
-{
- my $self = shift;
- my @cols = split /,/, shift;
- my $set_clause;
- for my $col (@cols)
- {
- my ( $col_name, $value ) = $col =~ /^\s*(.+?)\s*=\s*(.+?)\s*$/s;
- push @{ $self->{column_names} }, $col_name;
- push @{ $self->{values} }, $self->parse_value($value);
- }
- croak "Can't parse set clause" unless ( $self->{column_names} and $self->{values} );
-}
-
-sub parse_value
-{
- my ( $self, $str ) = @_;
- return unless ( defined $str );
- $str =~ s/\s+$//;
- $str =~ s/^\s+//;
- if ( $str =~ /^\?$/ )
- {
- push @{ $self->{params} }, '?';
- return {
- value => '?',
- type => 'placeholder'
- };
- }
- return {
- value => undef,
- type => 'NULL'
- } if ( $str =~ /^NULL$/i );
- return {
- value => $1,
- type => 'string'
- } if ( $str =~ /^'(.+)'$/s );
- return {
- value => $str,
- type => 'number'
- } if ( DBI::looks_like_number($str) );
- return {
- value => $str,
- type => 'column'
- };
-}
-
-sub parse_where_clause
-{
- my ( $self, $str ) = @_;
- $str =~ s/\s+$//;
- if ( $str =~ /^\s*WHERE\s+(.*)/i )
- {
- $str = $1;
- }
- else
- {
- croak "Couldn't find WHERE clause in '$str'";
- }
- my ($neg) = $str =~ s/^\s*(NOT)\s+//is;
- my $opexp = '=|<>|<=|>=|<|>|LIKE|CLIKE|IS';
- my ( $val1, $op, $val2 ) = $str =~ /^(.+?)\s*($opexp)\s*(.+)\s*$/iso;
- croak "Couldn't parse WHERE expression '$str'" unless ( defined $val1 and defined $op and defined $val2 );
- return {
- arg1 => $self->parse_value($val1),
- arg2 => $self->parse_value($val2),
- op => $op,
- neg => $neg,
- };
-}
-
-#####################################################################
-# EXECUTE
-#####################################################################
-sub execute
-{
- my ( $self, $data, $params ) = @_;
- my $num_placeholders = $self->params;
- my $num_params = scalar @$params || 0;
- croak "Number of params '$num_params' does not match number of placeholders '$num_placeholders'"
- unless ( $num_placeholders == $num_params );
- if ( scalar @$params )
- {
- for my $i ( 0 .. $#{ $self->{values} } )
- {
- if ( $self->{values}->[$i]->{type} eq 'placeholder' )
- {
- $self->{values}->[$i]->{value} = shift @$params;
- }
- }
- if ( $self->{where_clause} )
- {
- if ( $self->{where_clause}->{arg1}->{type} eq 'placeholder' )
- {
- $self->{where_clause}->{arg1}->{value} = shift @$params;
- }
- if ( $self->{where_clause}->{arg2}->{type} eq 'placeholder' )
- {
- $self->{where_clause}->{arg2}->{value} = shift @$params;
- }
- }
- }
- my $command = $self->{command};
- ( $self->{'NUM_OF_ROWS'}, $self->{'NUM_OF_FIELDS'}, $self->{'data'}, ) = $self->$command( $data, $params );
- $self->{NAME} ||= $self->{column_names};
- return $self->{'NUM_OF_ROWS'} || '0E0';
-}
-
-my $enoentstr = "Cannot open .*\(" . Errno::ENOENT . "\)";
-my $enoentrx = qr/$enoentstr/;
-
-sub DROP ($$$)
-{
- my ( $self, $data, $params ) = @_;
-
- my $table;
- my @err;
- eval {
- local $SIG{__WARN__} = sub { push @err, @_ };
- ($table) = $self->open_tables( $data, 0, 1 );
- };
- if ( $self->{ignore_missing_table} and ( $@ or @err ) and grep { $_ =~ $enoentrx } ( @err, $@ ) )
- {
- $@ = '';
- return ( -1, 0 );
- }
-
- croak( $@ || $err[0] ) if ( $@ || @err );
- return ( -1, 0 ) unless $table;
-
- $table->drop($data);
- ( -1, 0 );
-}
-
-sub CREATE ($$$)
-{
- my ( $self, $data, $params ) = @_;
- my $table = $self->open_tables( $data, 1, 1 );
- $table->push_names( $data, $self->{column_names} );
- ( 0, 0 );
-}
-
-sub INSERT ($$$)
-{
- my ( $self, $data, $params ) = @_;
- my $table = $self->open_tables( $data, 0, 1 );
- $self->verify_columns($table);
- my $all_columns = $table->{col_names};
- $table->seek( $data, 0, 2 ) unless ( $table->can('insert_one_row') );
- my ($array) = [];
- my ( $val, $col, $i );
- $self->{column_names} = $table->col_names() unless ( $self->{column_names} );
- my $cNum = scalar( @{ $self->{column_names} } ) if ( $self->{column_names} );
- my $param_num = 0;
-
- $cNum or
- croak "Bad col names in INSERT";
-
- my $maxCol = $#$all_columns;
-
- for ( $i = 0; $i < $cNum; $i++ )
- {
- $col = $self->{column_names}->[$i];
- $array->[ $self->column_nums( $table, $col ) ] = $self->row_values($i);
- }
-
- # Extend row to put values in ALL fields
- $#$array < $maxCol and $array->[$maxCol] = undef;
-
- $table->can('insert_new_row') ? $table->insert_new_row( $data, $array ) : $table->push_row( $data, $array );
-
- return ( 1, 0 );
-}
-
-sub DELETE ($$$)
-{
- my ( $self, $data, $params ) = @_;
- my $table = $self->open_tables( $data, 0, 1 );
- $self->verify_columns($table);
- my ($affected) = 0;
- my ( @rows, $array );
- my $can_dor = $table->can('delete_one_row');
- while ( $array = $table->fetch_row($data) )
- {
- if ( $self->eval_where( $table, $array ) )
- {
- ++$affected;
- if ( $self->{fetched_from_key} )
- {
- $array = $self->{fetched_value};
- $table->delete_one_row( $data, $array );
- return ( $affected, 0 );
- }
- push( @rows, $array ) if ($can_dor);
- }
- else
- {
- push( @rows, $array ) unless ($can_dor);
- }
- }
- if ($can_dor)
- {
- foreach $array (@rows)
- {
- $table->delete_one_row( $data, $array );
- }
- }
- else
- {
- $table->seek( $data, 0, 0 );
- foreach $array (@rows)
- {
- $table->push_row( $data, $array );
- }
- $table->truncate($data);
- }
- return ( $affected, 0 );
-}
-
-sub _anycmp($$;$)
-{
- my ( $a, $b, $case_fold ) = @_;
-
- if ( !defined($a) || !defined($b) )
- {
- return defined($a) - defined($b);
- }
- elsif ( DBI::looks_like_number($a) && DBI::looks_like_number($b) )
- {
- return $a <=> $b;
- }
- else
- {
- return $case_fold ? lc($a) cmp lc($b) || $a cmp $b : $a cmp $b;
- }
-}
-
-sub SELECT ($$$)
-{
- my ( $self, $data, $params ) = @_;
- my $table = $self->open_tables( $data, 0, 0 );
- $self->verify_columns($table);
- my $tname = $self->{table_name};
- my ($affected) = 0;
- my ( @rows, %cols, $array, $val, $col, $i );
- while ( $array = $table->fetch_row($data) )
- {
- if ( $self->eval_where( $table, $array ) )
- {
- $array = $self->{fetched_value} if ( $self->{fetched_from_key} );
- unless ( keys %cols )
- {
- my $col_nums = $self->column_nums($table);
- %cols = reverse %{$col_nums};
- }
-
- my $rowhash;
- for ( sort keys %cols )
- {
- $rowhash->{ $cols{$_} } = $array->[$_];
- }
- my @newarray;
- for ( $i = 0; $i < @{ $self->{column_names} }; $i++ )
- {
- $col = $self->{column_names}->[$i];
- push @newarray, $rowhash->{$col};
- }
- push( @rows, \@newarray );
- return ( scalar(@rows), scalar @{ $self->{column_names} }, \@rows )
- if ( $self->{fetched_from_key} );
- }
- }
- if ( $self->{order_clause} )
- {
- my ( $sort_col, $desc ) = each %{ $self->{order_clause} };
- my @sortCols = ( $self->column_nums( $table, $sort_col, 1 ) );
- $sortCols[1] = uc $desc eq 'DESC' ? 1 : 0;
-
- @rows = sort {
- my ( $result, $colNum, $desc );
- my $i = 0;
- do
- {
- $colNum = $sortCols[ $i++ ];
- $desc = $sortCols[ $i++ ];
- $result = _anycmp( $a->[$colNum], $b->[$colNum] );
- $result = -$result if ($desc);
- } while ( !$result && $i < @sortCols );
- $result;
- } @rows;
- }
- ( scalar(@rows), scalar @{ $self->{column_names} }, \@rows );
-}
-
-sub UPDATE ($$$)
-{
- my ( $self, $data, $params ) = @_;
- my $table = $self->open_tables( $data, 0, 1 );
- $self->verify_columns($table);
- return undef unless $table;
- my $affected = 0;
- my $can_usr = $table->can('update_specific_row');
- my $can_uor = $table->can('update_one_row');
- my $can_rwu = $can_usr || $can_uor;
- my ( @rows, $array, $f_array, $val, $col, $i );
-
- while ( $array = $table->fetch_row($data) )
- {
- if ( $self->eval_where( $table, $array ) )
- {
- $array = $self->{fetched_value} if ( $self->{fetched_from_key} and $can_rwu );
- my $orig_ary = clone($array) if ($can_usr);
- for ( $i = 0; $i < @{ $self->{column_names} }; $i++ )
- {
- $col = $self->{column_names}->[$i];
- $array->[ $self->column_nums( $table, $col ) ] = $self->row_values($i);
- }
- $affected++;
- if ( $self->{fetched_value} )
- {
- if ($can_usr)
- {
- $table->update_specific_row( $data, $array, $orig_ary );
- }
- elsif ($can_uor)
- {
- $table->update_one_row( $data, $array );
- }
- return ( $affected, 0 );
- }
- push( @rows, $can_usr ? [ $array, $orig_ary ] : $array );
- }
- else
- {
- push( @rows, $array ) unless ($can_rwu);
- }
- }
- if ($can_rwu)
- {
- foreach my $array (@rows)
- {
- if ($can_usr)
- {
- $table->update_specific_row( $data, @$array );
- }
- elsif ($can_uor)
- {
- $table->update_one_row( $data, $array );
- }
- }
- }
- else
- {
- $table->seek( $data, 0, 0 );
- foreach my $array (@rows)
- {
- $table->push_row( $data, $array );
- }
- $table->truncate($data);
- }
-
- return ( $affected, 0 );
-}
-
-sub verify_columns
-{
- my ( $self, $table ) = @_;
- my @cols = @{ $self->{column_names} };
- if ( $self->{where_clause} )
- {
- if ( my $col = $self->{where_clause}->{arg1} )
- {
- push @cols, $col->{value} if $col->{type} eq 'column';
- }
- if ( my $col = $self->{where_clause}->{arg2} )
- {
- push @cols, $col->{value} if $col->{type} eq 'column';
- }
- }
- for (@cols)
- {
- $self->column_nums( $table, $_ );
- }
-}
-
-sub column_nums
-{
- my ( $self, $table, $stmt_col_name, $find_in_stmt ) = @_;
- my %dbd_nums = %{ $table->col_nums() };
- my @dbd_cols = @{ $table->col_names() };
- my %stmt_nums;
- if ( $stmt_col_name and !$find_in_stmt )
- {
- while ( my ( $k, $v ) = each %dbd_nums )
- {
- return $v if uc $k eq uc $stmt_col_name;
- }
- croak "No such column '$stmt_col_name'";
- }
- if ( $stmt_col_name and $find_in_stmt )
- {
- for my $i ( 0 .. @{ $self->{column_names} } )
- {
- return $i if uc $stmt_col_name eq uc $self->{column_names}->[$i];
- }
- croak "No such column '$stmt_col_name'";
- }
- for my $i ( 0 .. $#dbd_cols )
- {
- for my $stmt_col ( @{ $self->{column_names} } )
- {
- $stmt_nums{$stmt_col} = $i if uc $dbd_cols[$i] eq uc $stmt_col;
- }
- }
- return \%stmt_nums;
-}
-
-sub eval_where
-{
- my ( $self, $table, $rowary ) = @_;
- my $where = $self->{"where_clause"} || return 1;
- my $col_nums = $table->col_nums();
- my %cols = reverse %{$col_nums};
- my $rowhash;
- for ( sort keys %cols )
- {
- $rowhash->{ uc $cols{$_} } = $rowary->[$_];
- }
- return $self->process_predicate( $where, $table, $rowhash );
-}
-
-sub process_predicate
-{
- my ( $self, $pred, $table, $rowhash ) = @_;
- my $val1 = $pred->{arg1};
- if ( $val1->{type} eq 'column' )
- {
- $val1 = $rowhash->{ uc $val1->{value} };
- }
- else
- {
- $val1 = $val1->{value};
- }
- my $val2 = $pred->{arg2};
- if ( $val2->{type} eq 'column' )
- {
- $val2 = $rowhash->{ uc $val2->{value} };
- }
- else
- {
- $val2 = $val2->{value};
- }
- my $op = $pred->{op};
- my $neg = $pred->{neg};
- if ( $op eq '=' and !$neg and $table->can('fetch_one_row') )
- {
- my $key_col = $table->fetch_one_row( 1, 1 );
- if ( $pred->{arg1}->{value} =~ /^$key_col$/i )
- {
- $self->{fetched_from_key} = 1;
- $self->{fetched_value} = $table->fetch_one_row( 0, $pred->{arg2}->{value} );
- return 1;
- }
- }
- my $match = $self->is_matched( $val1, $op, $val2 ) || 0;
- if ($neg) { $match = $match ? 0 : 1; }
- return $match;
-}
-
-sub is_matched
-{
- my ( $self, $val1, $op, $val2 ) = @_;
- if ( $op eq 'IS' )
- {
- return 1 if ( !defined $val1 or $val1 eq '' );
- return 0;
- }
- $val1 = '' unless ( defined $val1 );
- $val2 = '' unless ( defined $val2 );
- if ( $op =~ /LIKE|CLIKE/i )
- {
- $val2 = quotemeta($val2);
- $val2 =~ s/\\%/.*/g;
- $val2 =~ s/_/./g;
- }
- if ( $op eq 'LIKE' ) { return $val1 =~ /^$val2$/s; }
- if ( $op eq 'CLIKE' ) { return $val1 =~ /^$val2$/si; }
- if ( DBI::looks_like_number($val1) && DBI::looks_like_number($val2) )
- {
- if ( $op eq '<' ) { return $val1 < $val2; }
- if ( $op eq '>' ) { return $val1 > $val2; }
- if ( $op eq '=' ) { return $val1 == $val2; }
- if ( $op eq '<>' ) { return $val1 != $val2; }
- if ( $op eq '<=' ) { return $val1 <= $val2; }
- if ( $op eq '>=' ) { return $val1 >= $val2; }
- }
- else
- {
- if ( $op eq '<' ) { return $val1 lt $val2; }
- if ( $op eq '>' ) { return $val1 gt $val2; }
- if ( $op eq '=' ) { return $val1 eq $val2; }
- if ( $op eq '<>' ) { return $val1 ne $val2; }
- if ( $op eq '<=' ) { return $val1 ge $val2; }
- if ( $op eq '>=' ) { return $val1 le $val2; }
- }
-}
-
-sub params
-{
- my ( $self, $val_num ) = @_;
- if ( !$self->{"params"} ) { return 0; }
- if ( defined $val_num )
- {
- return $self->{"params"}->[$val_num];
- }
-
- return wantarray ? @{ $self->{"params"} } : scalar @{ $self->{"params"} };
-}
-
-sub open_tables
-{
- my ( $self, $data, $createMode, $lockMode ) = @_;
- my $table_name = $self->{table_name};
- my $table;
- eval { $table = $self->open_table( $data, $table_name, $createMode, $lockMode ) };
- if ($@)
- {
- chomp $@;
- croak $@;
- }
- croak "Couldn't open table '$table_name'" unless $table;
- if ( !$self->{column_names} or $self->{column_names}->[0] eq '*' )
- {
- $self->{column_names} = $table->col_names();
- }
- return $table;
-}
-
-sub row_values
-{
- my ( $self, $val_num ) = @_;
- if ( !$self->{"values"} ) { return 0; }
- if ( defined $val_num )
- {
- return $self->{"values"}->[$val_num]->{value};
- }
- if (wantarray)
- {
- return map { $_->{"value"} } @{ $self->{"values"} };
- }
- else
- {
- return scalar @{ $self->{"values"} };
- }
-}
-
-sub column_names
-{
- my ($self) = @_;
- my @col_names;
- if ( $self->{column_names} and $self->{column_names}->[0] ne '*' )
- {
- @col_names = @{ $self->{column_names} };
- }
- return @col_names;
-}
-
-###############################
-package DBI::SQL::Nano::Table_;
-###############################
-
-use Carp qw(croak);
-
-sub new ($$)
-{
- my ( $proto, $attr ) = @_;
- my ($self) = {%$attr};
-
- defined( $self->{col_names} ) and "ARRAY" eq ref( $self->{col_names} )
- or croak("attribute 'col_names' must be defined as an array");
- exists( $self->{col_nums} ) or $self->{col_nums} = _map_colnums( $self->{col_names} );
- defined( $self->{col_nums} ) and "HASH" eq ref( $self->{col_nums} )
- or croak("attribute 'col_nums' must be defined as a hash");
-
- bless( $self, ( ref($proto) || $proto ) );
- return $self;
-}
-
-sub _map_colnums
-{
- my $col_names = $_[0];
- my %col_nums;
- for my $i ( 0 .. $#$col_names )
- {
- next unless $col_names->[$i];
- $col_nums{ $col_names->[$i] } = $i;
- }
- return \%col_nums;
-}
-
-sub row() { return $_[0]->{row}; }
-sub column($) { return $_[0]->{row}->[ $_[0]->column_num( $_[1] ) ]; }
-sub column_num($) { $_[0]->{col_nums}->{ $_[1] }; }
-sub col_nums() { $_[0]->{col_nums} }
-sub col_names() { $_[0]->{col_names}; }
-
-sub drop ($$) { croak "Abstract method " . ref( $_[0] ) . "::drop called" }
-sub fetch_row ($$$) { croak "Abstract method " . ref( $_[0] ) . "::fetch_row called" }
-sub push_row ($$$) { croak "Abstract method " . ref( $_[0] ) . "::push_row called" }
-sub push_names ($$$) { croak "Abstract method " . ref( $_[0] ) . "::push_names called" }
-sub truncate ($$) { croak "Abstract method " . ref( $_[0] ) . "::truncate called" }
-sub seek ($$$$) { croak "Abstract method " . ref( $_[0] ) . "::seek called" }
-
-1;
-__END__
-
-=pod
-
-=head1 NAME
-
-DBI::SQL::Nano - a very tiny SQL engine
-
-=head1 SYNOPSIS
-
- BEGIN { $ENV{DBI_SQL_NANO}=1 } # forces use of Nano rather than SQL::Statement
- use DBI::SQL::Nano;
- use Data::Dumper;
- my $stmt = DBI::SQL::Nano::Statement->new(
- "SELECT bar,baz FROM foo WHERE qux = 1"
- ) or die "Couldn't parse";
- print Dumper $stmt;
-
-=head1 DESCRIPTION
-
-C<< DBI::SQL::Nano >> is meant as a I<very> minimal SQL engine for use in
-situations where SQL::Statement is not available. In most situations you are
-better off installing L<SQL::Statement> although DBI::SQL::Nano may be faster
-for some B<very> simple tasks.
-
-DBI::SQL::Nano, like SQL::Statement is primarily intended to provide a SQL
-engine for use with some pure perl DBDs including L<DBD::DBM>, L<DBD::CSV>,
-L<DBD::AnyData>, and L<DBD::Excel>. It is not of much use in and of itself.
-You can dump out the structure of a parsed SQL statement, but that is about
-it.
-
-=head1 USAGE
-
-=head2 Setting the DBI_SQL_NANO flag
-
-By default, when a C<< DBD >> uses C<< DBI::SQL::Nano >>, the module will
-look to see if C<< SQL::Statement >> is installed. If it is, SQL::Statement
-objects are used. If SQL::Statement is not available, DBI::SQL::Nano
-objects are used.
-
-In some cases, you may wish to use DBI::SQL::Nano objects even if
-SQL::Statement is available. To force usage of DBI::SQL::Nano objects
-regardless of the availability of SQL::Statement, set the environment
-variable DBI_SQL_NANO to 1.
-
-You can set the environment variable in your shell prior to running your
-script (with SET or EXPORT or whatever), or else you can set it in your
-script by putting this at the top of the script:
-
- BEGIN { $ENV{DBI_SQL_NANO} = 1 }
-
-=head2 Supported SQL syntax
-
- Here's a pseudo-BNF. Square brackets [] indicate optional items;
- Angle brackets <> indicate items defined elsewhere in the BNF.
-
- statement ::=
- DROP TABLE [IF EXISTS] <table_name>
- | CREATE TABLE <table_name> <col_def_list>
- | INSERT INTO <table_name> [<insert_col_list>] VALUES <val_list>
- | DELETE FROM <table_name> [<where_clause>]
- | UPDATE <table_name> SET <set_clause> <where_clause>
- | SELECT <select_col_list> FROM <table_name> [<where_clause>]
- [<order_clause>]
-
- the optional IF EXISTS clause ::=
- * similar to MySQL - prevents errors when trying to drop
- a table that doesn't exist
-
- identifiers ::=
- * table and column names should be valid SQL identifiers
- * especially avoid using spaces and commas in identifiers
- * note: there is no error checking for invalid names, some
- will be accepted, others will cause parse failures
-
- table_name ::=
- * only one table (no multiple table operations)
- * see identifier for valid table names
-
- col_def_list ::=
- * a parens delimited, comma-separated list of column names
- * see identifier for valid column names
- * column types and column constraints may be included but are ignored
- e.g. these are all the same:
- (id,phrase)
- (id INT, phrase VARCHAR(40))
- (id INT PRIMARY KEY, phrase VARCHAR(40) NOT NULL)
- * you are *strongly* advised to put in column types even though
- they are ignored ... it increases portability
-
- insert_col_list ::=
- * a parens delimited, comma-separated list of column names
- * as in standard SQL, this is optional
-
- select_col_list ::=
- * a comma-separated list of column names
- * or an asterisk denoting all columns
-
- val_list ::=
- * a parens delimited, comma-separated list of values which can be:
- * placeholders (an unquoted question mark)
- * numbers (unquoted numbers)
- * column names (unquoted strings)
- * nulls (unquoted word NULL)
- * strings (delimited with single quote marks);
- * note: leading and trailing percent mark (%) and underscore (_)
- can be used as wildcards in quoted strings for use with
- the LIKE and CLIKE operators
- * note: escaped single quotation marks within strings are not
- supported, neither are embedded commas, use placeholders instead
-
- set_clause ::=
- * a comma-separated list of column = value pairs
- * see val_list for acceptable value formats
-
- where_clause ::=
- * a single "column/value <op> column/value" predicate, optionally
- preceded by "NOT"
- * note: multiple predicates combined with ORs or ANDs are not supported
- * see val_list for acceptable value formats
- * op may be one of:
- < > >= <= = <> LIKE CLIKE IS
- * CLIKE is a case insensitive LIKE
-
- order_clause ::= column_name [ASC|DESC]
- * a single column optional ORDER BY clause is supported
- * as in standard SQL, if neither ASC (ascending) nor
- DESC (descending) is specified, ASC becomes the default
-
-=head1 TABLES
-
-DBI::SQL::Nano::Statement operates on exactly one table. This table will be
-opened by inherit from DBI::SQL::Nano::Statement and implements the
-C<< open_table >> method.
-
- sub open_table ($$$$$)
- {
- ...
- return Your::Table->new( \%attributes );
- }
-
-DBI::SQL::Nano::Statement_ expects a rudimentary interface is implemented by
-the table object, as well as SQL::Statement expects.
-
- package Your::Table;
-
- use vars qw(@ISA);
- @ISA = qw(DBI::SQL::Nano::Table);
-
- sub drop ($$) { ... }
- sub fetch_row ($$$) { ... }
- sub push_row ($$$) { ... }
- sub push_names ($$$) { ... }
- sub truncate ($$) { ... }
- sub seek ($$$$) { ... }
-
-The base class interfaces are provided by DBI::SQL::Nano::Table_ in case of
-relying on DBI::SQL::Nano or SQL::Eval::Table (see L<SQL::Eval> for details)
-otherwise.
-
-=head1 BUGS AND LIMITATIONS
-
-There are no known bugs in DBI::SQL::Nano::Statement. If you find a one
-and want to report, please see L<DBI> for how to report bugs.
-
-DBI::SQL::Nano::Statement is designed to provide a minimal subset for
-executing SQL statements.
-
-The most important limitation might be the restriction on one table per
-statement. This implies, that no JOINs are supported and there cannot be
-any foreign key relation between tables.
-
-The where clause evaluation of DBI::SQL::Nano::Statement is very slow
-(SQL::Statement uses a precompiled evaluation).
-
-INSERT can handle only one row per statement. To insert multiple rows,
-use placeholders as explained in DBI.
-
-The DBI::SQL::Nano parser is very limited and does not support any
-additional syntax such as brackets, comments, functions, aggregations
-etc.
-
-In contrast to SQL::Statement, temporary tables are not supported.
-
-=head1 ACKNOWLEDGEMENTS
-
-Tim Bunce provided the original idea for this module, helped me out of the
-tangled trap of namespaces, and provided help and advice all along the way.
-Although I wrote it from the ground up, it is based on Jochen Wiedmann's
-original design of SQL::Statement, so much of the credit for the API goes
-to him.
-
-=head1 AUTHOR AND COPYRIGHT
-
-This module is originally written by Jeff Zucker < jzucker AT cpan.org >
-
-This module is currently maintained by Jens Rehsack < jrehsack AT cpan.org >
-
-Copyright (C) 2010 by Jens Rehsack, all rights reserved.
-Copyright (C) 2004 by Jeff Zucker, all rights reserved.
-
-You may freely distribute and/or modify this module under the terms of
-either the GNU General Public License (GPL) or the Artistic License,
-as specified in the Perl README file.
-
-=cut
-
+++ /dev/null
-package DBI::Util::CacheMemory;
-
-# $Id: CacheMemory.pm 10314 2007-11-26 22:25:33Z Tim $
-#
-# Copyright (c) 2007, Tim Bunce, Ireland
-#
-# You may distribute under the terms of either the GNU General Public
-# License or the Artistic License, as specified in the Perl README file.
-
-use strict;
-use warnings;
-
-=head1 NAME
-
-DBI::Util::CacheMemory - a very fast but very minimal subset of Cache::Memory
-
-=head1 DESCRIPTION
-
-Like Cache::Memory (part of the Cache distribution) but doesn't support any fancy features.
-
-This module aims to be a very fast compatible strict sub-set for simple cases,
-such as basic client-side caching for DBD::Gofer.
-
-Like Cache::Memory, and other caches in the Cache and Cache::Cache
-distributions, the data will remain in the cache until cleared, it expires,
-or the process dies. The cache object simply going out of scope will I<not>
-destroy the data.
-
-=head1 METHODS WITH CHANGES
-
-=head2 new
-
-All options except C<namespace> are ignored.
-
-=head2 set
-
-Doesn't support expiry.
-
-=head2 purge
-
-Same as clear() - deletes everything in the namespace.
-
-=head1 METHODS WITHOUT CHANGES
-
-=over
-
-=item clear
-
-=item count
-
-=item exists
-
-=item remove
-
-=back
-
-=head1 UNSUPPORTED METHODS
-
-If it's not listed above, it's not supported.
-
-=cut
-
-our $VERSION = "0.010315";
-
-my %cache;
-
-sub new {
- my ($class, %options ) = @_;
- my $namespace = $options{namespace} ||= 'Default';
- #$options{_cache} = \%cache; # can be handy for debugging/dumping
- my $self = bless \%options => $class;
- $cache{ $namespace } ||= {}; # init - ensure it exists
- return $self;
-}
-
-sub set {
- my ($self, $key, $value) = @_;
- $cache{ $self->{namespace} }->{$key} = $value;
-}
-
-sub get {
- my ($self, $key) = @_;
- return $cache{ $self->{namespace} }->{$key};
-}
-
-sub exists {
- my ($self, $key) = @_;
- return exists $cache{ $self->{namespace} }->{$key};
-}
-
-sub remove {
- my ($self, $key) = @_;
- return delete $cache{ $self->{namespace} }->{$key};
-}
-
-sub purge {
- return shift->clear;
-}
-
-sub clear {
- $cache{ shift->{namespace} } = {};
-}
-
-sub count {
- return scalar keys %{ $cache{ shift->{namespace} } };
-}
-
-sub size {
- my $c = $cache{ shift->{namespace} };
- my $size = 0;
- while ( my ($k,$v) = each %$c ) {
- $size += length($k) + length($v);
- }
- return $size;
-}
-
-1;
+++ /dev/null
-package DBI::Util::_accessor;
-use strict;
-use Carp;
-our $VERSION = "0.009479";
-
-# inspired by Class::Accessor::Fast
-
-sub new {
- my($proto, $fields) = @_;
- my($class) = ref $proto || $proto;
- $fields ||= {};
-
- my @dubious = grep { !m/^_/ && !$proto->can($_) } keys %$fields;
- carp "$class doesn't have accessors for fields: @dubious" if @dubious;
-
- # make a (shallow) copy of $fields.
- bless {%$fields}, $class;
-}
-
-sub mk_accessors {
- my($self, @fields) = @_;
- $self->mk_accessors_using('make_accessor', @fields);
-}
-
-sub mk_accessors_using {
- my($self, $maker, @fields) = @_;
- my $class = ref $self || $self;
-
- # So we don't have to do lots of lookups inside the loop.
- $maker = $self->can($maker) unless ref $maker;
-
- no strict 'refs';
- foreach my $field (@fields) {
- my $accessor = $self->$maker($field);
- *{$class."\:\:$field"} = $accessor
- unless defined &{$class."\:\:$field"};
- }
- #my $hash_ref = \%{$class."\:\:_accessors_hash};
- #$hash_ref->{$_}++ for @fields;
- # XXX also copy down _accessors_hash of base class(es)
- # so one in this class is complete
- return;
-}
-
-sub make_accessor {
- my($class, $field) = @_;
- return sub {
- my $self = shift;
- return $self->{$field} unless @_;
- croak "Too many arguments to $field" if @_ > 1;
- return $self->{$field} = shift;
- };
-}
-
-sub make_accessor_autoviv_hashref {
- my($class, $field) = @_;
- return sub {
- my $self = shift;
- return $self->{$field} ||= {} unless @_;
- croak "Too many arguments to $field" if @_ > 1;
- return $self->{$field} = shift;
- };
-}
-
-1;
+++ /dev/null
-package
- DBI; # hide this non-DBI package from simple indexers
-
-# $Id: W32ODBC.pm 8696 2007-01-24 23:12:38Z Tim $
-#
-# Copyright (c) 1997,1999 Tim Bunce
-# With many thanks to Patrick Hollins for polishing.
-#
-# You may distribute under the terms of either the GNU General Public
-# License or the Artistic License, as specified in the Perl README file.
-
-=head1 NAME
-
-DBI::W32ODBC - An experimental DBI emulation layer for Win32::ODBC
-
-=head1 SYNOPSIS
-
- use DBI::W32ODBC;
-
- # apart from the line above everything is just the same as with
- # the real DBI when using a basic driver with few features.
-
-=head1 DESCRIPTION
-
-This is an experimental pure perl DBI emulation layer for Win32::ODBC
-
-If you can improve this code I'd be interested in hearing about it. If
-you are having trouble using it please respect the fact that it's very
-experimental. Ideally fix it yourself and send me the details.
-
-=head2 Some Things Not Yet Implemented
-
- Most attributes including PrintError & RaiseError.
- type_info and table_info
-
-Volunteers welcome!
-
-=cut
-
-${'DBI::VERSION'} # hide version from PAUSE indexer
- = "0.01";
-
-my $Revision = sprintf("12.%06d", q$Revision: 8696 $ =~ /(\d+)/o);
-
-
-sub DBI::W32ODBC::import { } # must trick here since we're called DBI/W32ODBC.pm
-
-
-use Carp;
-
-use Win32::ODBC;
-
-@ISA = qw(Win32::ODBC);
-
-use strict;
-
-$DBI::dbi_debug = $ENV{PERL_DBI_DEBUG} || 0;
-carp "Loaded (W32ODBC) DBI.pm ${'DBI::VERSION'} (debug $DBI::dbi_debug)"
- if $DBI::dbi_debug;
-
-
-
-sub connect {
- my ($class, $dbname, $dbuser, $dbpasswd, $module, $attr) = @_;
- $dbname .= ";UID=$dbuser" if $dbuser;
- $dbname .= ";PWD=$dbpasswd" if $dbpasswd;
- my $h = new Win32::ODBC $dbname;
- warn "Error connecting to $dbname: ".Win32::ODBC::Error()."\n" unless $h;
- bless $h, $class if $h; # rebless into our class
- $h;
-}
-
-
-sub quote {
- my ($h, $string) = @_;
- return "NULL" if !defined $string;
- $string =~ s/'/''/g; # standard
- # This hack seems to be required for Access but probably breaks for
- # other databases when using \r and \n. It would be better if we could
- # use ODBC options to detect that we're actually using Access.
- $string =~ s/\r/' & chr\$(13) & '/g;
- $string =~ s/\n/' & chr\$(10) & '/g;
- "'$string'";
-}
-
-sub do {
- my($h, $statement, $attribs, @params) = @_;
- Carp::carp "\$h->do() attribs unused" if $attribs;
- my $new_h = $h->prepare($statement) or return undef; ##
- pop @{ $h->{'___sths'} }; ## certain death assured
- $new_h->execute(@params) or return undef; ##
- my $rows = $new_h->rows; ##
- $new_h->finish; ## bang bang
- ($rows == 0) ? "0E0" : $rows;
-}
-
-# ---
-
-sub prepare {
- my ($h, $sql) = @_;
- ## opens a new connection with every prepare to allow
- ## multiple, concurrent queries
- my $new_h = new Win32::ODBC $h->{DSN}; ##
- return undef if not $new_h; ## bail if no connection
- bless $new_h; ## shouldn't be sub-classed...
- $new_h->{'__prepare'} = $sql; ##
- $new_h->{NAME} = []; ##
- $new_h->{NUM_OF_FIELDS} = -1; ##
- push @{ $h->{'___sths'} } ,$new_h; ## save sth in parent for mass destruction
- return $new_h; ##
-}
-
-sub execute {
- my ($h) = @_;
- my $rc = $h->Sql($h->{'__prepare'});
- return undef if $rc;
- my @fields = $h->FieldNames;
- $h->{NAME} = \@fields;
- $h->{NUM_OF_FIELDS} = scalar @fields;
- $h; # return dbh as pseudo sth
-}
-
-
-sub fetchrow_hashref { ## provide DBI compatibility
- my $h = shift;
- my $NAME = shift || "NAME";
- my $row = $h->fetchrow_arrayref or return undef;
- my %hash;
- @hash{ @{ $h->{$NAME} } } = @$row;
- return \%hash;
-}
-
-sub fetchrow {
- my $h = shift;
- return unless $h->FetchRow();
- my $fields_r = $h->{NAME};
- return $h->Data(@$fields_r);
-}
-sub fetch {
- my @row = shift->fetchrow;
- return undef unless @row;
- return \@row;
-}
-*fetchrow_arrayref = \&fetch; ## provide DBI compatibility
-*fetchrow_array = \&fetchrow; ## provide DBI compatibility
-
-sub rows {
- shift->RowCount;
-}
-
-sub finish {
- shift->Close; ## uncommented this line
-}
-
-# ---
-
-sub commit {
- shift->Transact(ODBC::SQL_COMMIT);
-}
-sub rollback {
- shift->Transact(ODBC::SQL_ROLLBACK);
-}
-
-sub disconnect {
- my ($h) = shift; ## this will kill all the statement handles
- foreach (@{$h->{'___sths'}}) { ## created for a specific connection
- $_->Close if $_->{DSN}; ##
- } ##
- $h->Close; ##
-}
-
-sub err {
- (shift->Error)[0];
-}
-sub errstr {
- scalar( shift->Error );
-}
-
-# ---
-
-1;
+++ /dev/null
-package # hide this package from CPAN indexer
- Win32::ODBC;
-
-use strict;
-
-use DBI;
-
-# once we've been loaded we don't want perl to load the real Win32::ODBC
-$INC{'Win32/ODBC.pm'} = $INC{'Win32/DBIODBC.pm'} || 1;
-
-#my $db = new Win32::ODBC("DSN=$self->{'DSN'};UID=$self->{'UID'};PWD=$self->{'PWD'};");
-
-#EMU --- my $db = new Win32::ODBC("DSN=$DSN;UID=$login;PWD=$password;");
-sub new
-{
- shift;
- my $connect_line= shift;
-
-# [R] self-hack to allow empty UID and PWD
- my $temp_connect_line;
- $connect_line=~/DSN=\w+/;
- $temp_connect_line="$&;";
- if ($connect_line=~/UID=\w?/)
- {$temp_connect_line.="$&;";}
- else {$temp_connect_line.="UID=;";};
- if ($connect_line=~/PWD=\w?/)
- {$temp_connect_line.="$&;";}
- else {$temp_connect_line.="PWD=;";};
- $connect_line=$temp_connect_line;
-# -[R]-
-
- my $self= {};
-
-
- $_=$connect_line;
- /^(DSN=)(.*)(;UID=)(.*)(;PWD=)(.*)(;)$/;
-
- #---- DBI CONNECTION VARIABLES
-
- $self->{ODBC_DSN}=$2;
- $self->{ODBC_UID}=$4;
- $self->{ODBC_PWD}=$6;
-
-
- #---- DBI CONNECTION VARIABLES
- $self->{DBI_DBNAME}=$self->{ODBC_DSN};
- $self->{DBI_USER}=$self->{ODBC_UID};
- $self->{DBI_PASSWORD}=$self->{ODBC_PWD};
- $self->{DBI_DBD}='ODBC';
-
- #---- DBI CONNECTION
- $self->{'DBI_DBH'}=DBI->connect($self->{'DBI_DBNAME'},
- $self->{'DBI_USER'},$self->{'DBI_PASSWORD'},$self->{'DBI_DBD'});
-
- warn "Error($DBI::err) : $DBI::errstr\n" if ! $self->{'DBI_DBH'};
-
-
- #---- RETURN
-
- bless $self;
-}
-
-
-#EMU --- $db->Sql('SELECT * FROM DUAL');
-sub Sql
-{
- my $self= shift;
- my $SQL_statment=shift;
-
- # print " SQL : $SQL_statment \n";
-
- $self->{'DBI_SQL_STATMENT'}=$SQL_statment;
-
- my $dbh=$self->{'DBI_DBH'};
-
- # print " DBH : $dbh \n";
-
- my $sth=$dbh->prepare("$SQL_statment");
-
- # print " STH : $sth \n";
-
- $self->{'DBI_STH'}=$sth;
-
- if ($sth)
- {
- $sth->execute();
- }
-
- #--- GET ERROR MESSAGES
- $self->{DBI_ERR}=$DBI::err;
- $self->{DBI_ERRSTR}=$DBI::errstr;
-
- if ($sth)
- {
- #--- GET COLUMNS NAMES
- $self->{'DBI_NAME'} = $sth->{NAME};
- }
-
-# [R] provide compatibility with Win32::ODBC's way of identifying erroneous SQL statements
- return ($self->{'DBI_ERR'})?1:undef;
-# -[R]-
-}
-
-
-#EMU --- $db->FetchRow())
-sub FetchRow
-{
- my $self= shift;
-
- my $sth=$self->{'DBI_STH'};
- if ($sth)
- {
- my @row=$sth->fetchrow_array;
- $self->{'DBI_ROW'}=\@row;
-
- if (scalar(@row)>0)
- {
- #-- the row of result is not nul
- #-- return something nothing will be return else
- return 1;
- }
- }
- return undef;
-}
-
-# [R] provide compatibility with Win32::ODBC's Data() method.
-sub Data
-{
- my $self=shift;
- my @array=@{$self->{'DBI_ROW'}};
- foreach my $element (@array)
- {
- # remove padding of spaces by DBI
- $element=~s/(\s*$)//;
- };
- return (wantarray())?@array:join('', @array);
-};
-# -[R]-
-
-#EMU --- %record = $db->DataHash;
-sub DataHash
-{
- my $self= shift;
-
- my $p_name=$self->{'DBI_NAME'};
- my $p_row=$self->{'DBI_ROW'};
-
- my @name=@$p_name;
- my @row=@$p_row;
-
- my %DataHash;
-#print @name; print "\n"; print @row;
-# [R] new code that seems to work consistent with Win32::ODBC
- while (@name)
- {
- my $name=shift(@name);
- my $value=shift(@row);
-
- # remove padding of spaces by DBI
- $name=~s/(\s*$)//;
- $value=~s/(\s*$)//;
-
- $DataHash{$name}=$value;
- };
-# -[R]-
-
-# [R] old code that didn't appear to work
-# foreach my $name (@name)
-# {
-# $name=~s/(^\s*)|(\s*$)//;
-# my @arr=@$name;
-# foreach (@arr)
-# {
-# print "lot $name name col $_ or ROW= 0 $row[0] 1 $row[1] 2 $row[2] \n ";
-# $DataHash{$name}=shift(@row);
-# }
-# }
-# -[R]-
-
- #--- Return Hash
- return %DataHash;
-}
-
-
-#EMU --- $db->Error()
-sub Error
-{
- my $self= shift;
-
- if ($self->{'DBI_ERR'} ne '')
- {
- #--- Return error message
- $self->{'DBI_ERRSTR'};
- }
-
- #-- else good no error message
-
-}
-
-# [R] provide compatibility with Win32::ODBC's Close() method.
-sub Close
-{
- my $self=shift;
-
- my $dbh=$self->{'DBI_DBH'};
- $dbh->disconnect;
-}
-# -[R]-
-
-1;
-
-__END__
-
-# [R] to -[R]- indicate sections edited by me, Roy Lee
-
-=head1 NAME
-
-Win32::DBIODBC - Win32::ODBC emulation layer for the DBI
-
-=head1 SYNOPSIS
-
- use Win32::DBIODBC; # instead of use Win32::ODBC
-
-=head1 DESCRIPTION
-
-This is a I<very> basic I<very> alpha quality Win32::ODBC emulation
-for the DBI. To use it just replace
-
- use Win32::ODBC;
-
-in your scripts with
-
- use Win32::DBIODBC;
-
-or, while experimenting, you can pre-load this module without changing your
-scripts by doing
-
- perl -MWin32::DBIODBC your_script_name
-
-=head1 TO DO
-
-Error handling is virtually non-existent.
-
-=head1 AUTHOR
-
-Tom Horen <tho@melexis.com>
-
-=cut
+++ /dev/null
-#!perl -w
-
-use strict;
-
-use Test::More tests => 130;
-use File::Spec;
-use Config;
-
-$|=1;
-
-## ----------------------------------------------------------------------------
-## 01basic.t - test of some basic DBI functions
-## ----------------------------------------------------------------------------
-# Mostly this script takes care of testing the items exported by the 3
-# tags below (in this order):
-# - :sql_types
-# - :squl_cursor_types
-# - :util
-# It also then handles some other class methods and functions of DBI, such
-# as the following:
-# - $DBI::dbi_debug & its relation to DBI->trace
-# - DBI->internal
-# and then tests on that return value:
-# - $i->debug
-# - $i->{DebugDispatch}
-# - $i->{Warn}
-# - $i->{Attribution}
-# - $i->{Version}
-# - $i->{private_test1}
-# - $i->{cachedKids}
-# - $i->{Kids}
-# - $i->{ActiveKids}
-# - $i->{Active}
-# - and finally that it will not autovivify
-# - DBI->available_drivers
-# - DBI->installed_versions (only for developers)
-## ----------------------------------------------------------------------------
-
-## load DBI and export some symbols
-BEGIN {
- diag "--- Perl $] on $Config{archname}";
-
- use_ok('DBI', qw(
- :sql_types
- :sql_cursor_types
- :utils
- ));
-}
-
-
-## ----------------------------------------------------------------------------
-## testing the :sql_types exports
-
-cmp_ok(SQL_GUID , '==', -11, '... testing sql_type');
-cmp_ok(SQL_WLONGVARCHAR , '==', -10, '... testing sql_type');
-cmp_ok(SQL_WVARCHAR , '==', -9, '... testing sql_type');
-cmp_ok(SQL_WCHAR , '==', -8, '... testing sql_type');
-cmp_ok(SQL_BIT , '==', -7, '... testing sql_type');
-cmp_ok(SQL_TINYINT , '==', -6, '... testing sql_type');
-cmp_ok(SQL_BIGINT , '==', -5, '... testing sql_type');
-cmp_ok(SQL_LONGVARBINARY , '==', -4, '... testing sql_type');
-cmp_ok(SQL_VARBINARY , '==', -3, '... testing sql_type');
-cmp_ok(SQL_BINARY , '==', -2, '... testing sql_type');
-cmp_ok(SQL_LONGVARCHAR , '==', -1, '... testing sql_type');
-cmp_ok(SQL_UNKNOWN_TYPE , '==', 0, '... testing sql_type');
-cmp_ok(SQL_ALL_TYPES , '==', 0, '... testing sql_type');
-cmp_ok(SQL_CHAR , '==', 1, '... testing sql_type');
-cmp_ok(SQL_NUMERIC , '==', 2, '... testing sql_type');
-cmp_ok(SQL_DECIMAL , '==', 3, '... testing sql_type');
-cmp_ok(SQL_INTEGER , '==', 4, '... testing sql_type');
-cmp_ok(SQL_SMALLINT , '==', 5, '... testing sql_type');
-cmp_ok(SQL_FLOAT , '==', 6, '... testing sql_type');
-cmp_ok(SQL_REAL , '==', 7, '... testing sql_type');
-cmp_ok(SQL_DOUBLE , '==', 8, '... testing sql_type');
-cmp_ok(SQL_DATETIME , '==', 9, '... testing sql_type');
-cmp_ok(SQL_DATE , '==', 9, '... testing sql_type');
-cmp_ok(SQL_INTERVAL , '==', 10, '... testing sql_type');
-cmp_ok(SQL_TIME , '==', 10, '... testing sql_type');
-cmp_ok(SQL_TIMESTAMP , '==', 11, '... testing sql_type');
-cmp_ok(SQL_VARCHAR , '==', 12, '... testing sql_type');
-cmp_ok(SQL_BOOLEAN , '==', 16, '... testing sql_type');
-cmp_ok(SQL_UDT , '==', 17, '... testing sql_type');
-cmp_ok(SQL_UDT_LOCATOR , '==', 18, '... testing sql_type');
-cmp_ok(SQL_ROW , '==', 19, '... testing sql_type');
-cmp_ok(SQL_REF , '==', 20, '... testing sql_type');
-cmp_ok(SQL_BLOB , '==', 30, '... testing sql_type');
-cmp_ok(SQL_BLOB_LOCATOR , '==', 31, '... testing sql_type');
-cmp_ok(SQL_CLOB , '==', 40, '... testing sql_type');
-cmp_ok(SQL_CLOB_LOCATOR , '==', 41, '... testing sql_type');
-cmp_ok(SQL_ARRAY , '==', 50, '... testing sql_type');
-cmp_ok(SQL_ARRAY_LOCATOR , '==', 51, '... testing sql_type');
-cmp_ok(SQL_MULTISET , '==', 55, '... testing sql_type');
-cmp_ok(SQL_MULTISET_LOCATOR , '==', 56, '... testing sql_type');
-cmp_ok(SQL_TYPE_DATE , '==', 91, '... testing sql_type');
-cmp_ok(SQL_TYPE_TIME , '==', 92, '... testing sql_type');
-cmp_ok(SQL_TYPE_TIMESTAMP , '==', 93, '... testing sql_type');
-cmp_ok(SQL_TYPE_TIME_WITH_TIMEZONE , '==', 94, '... testing sql_type');
-cmp_ok(SQL_TYPE_TIMESTAMP_WITH_TIMEZONE , '==', 95, '... testing sql_type');
-cmp_ok(SQL_INTERVAL_YEAR , '==', 101, '... testing sql_type');
-cmp_ok(SQL_INTERVAL_MONTH , '==', 102, '... testing sql_type');
-cmp_ok(SQL_INTERVAL_DAY , '==', 103, '... testing sql_type');
-cmp_ok(SQL_INTERVAL_HOUR , '==', 104, '... testing sql_type');
-cmp_ok(SQL_INTERVAL_MINUTE , '==', 105, '... testing sql_type');
-cmp_ok(SQL_INTERVAL_SECOND , '==', 106, '... testing sql_type');
-cmp_ok(SQL_INTERVAL_YEAR_TO_MONTH , '==', 107, '... testing sql_type');
-cmp_ok(SQL_INTERVAL_DAY_TO_HOUR , '==', 108, '... testing sql_type');
-cmp_ok(SQL_INTERVAL_DAY_TO_MINUTE , '==', 109, '... testing sql_type');
-cmp_ok(SQL_INTERVAL_DAY_TO_SECOND , '==', 110, '... testing sql_type');
-cmp_ok(SQL_INTERVAL_HOUR_TO_MINUTE , '==', 111, '... testing sql_type');
-cmp_ok(SQL_INTERVAL_HOUR_TO_SECOND , '==', 112, '... testing sql_type');
-cmp_ok(SQL_INTERVAL_MINUTE_TO_SECOND , '==', 113, '... testing sql_type');
-
-## ----------------------------------------------------------------------------
-## testing the :sql_cursor_types exports
-
-cmp_ok(SQL_CURSOR_FORWARD_ONLY, '==', 0, '... testing sql_cursor_types');
-cmp_ok(SQL_CURSOR_KEYSET_DRIVEN, '==', 1, '... testing sql_cursor_types');
-cmp_ok(SQL_CURSOR_DYNAMIC, '==', 2, '... testing sql_cursor_types');
-cmp_ok(SQL_CURSOR_STATIC, '==', 3, '... testing sql_cursor_types');
-cmp_ok(SQL_CURSOR_TYPE_DEFAULT, '==', 0, '... testing sql_cursor_types');
-
-## ----------------------------------------------------------------------------
-## test the :util exports
-
-## testing looks_like_number
-
-my @is_num = looks_like_number(undef, "", "foo", 1, ".", 2, "2");
-
-ok(!defined $is_num[0], '... looks_like_number : undef -> undef');
-ok(!defined $is_num[1], '... looks_like_number : "" -> undef (eg "don\'t know")');
-ok( defined $is_num[2], '... looks_like_number : "foo" -> defined false');
-ok( !$is_num[2], '... looks_like_number : "foo" -> defined false');
-ok( $is_num[3], '... looks_like_number : 1 -> true');
-ok( !$is_num[4], '... looks_like_number : "." -> false');
-ok( $is_num[5], '... looks_like_number : 1 -> true');
-ok( $is_num[6], '... looks_like_number : 1 -> true');
-
-## testing neat
-
-cmp_ok($DBI::neat_maxlen, '==', 1000, "... $DBI::neat_maxlen initial state is 400");
-
-is(neat(1 + 1), "2", '... neat : 1 + 1 -> "2"');
-is(neat("2"), "'2'", '... neat : 2 -> "\'2\'"');
-is(neat(undef), "undef", '... neat : undef -> "undef"');
-
-## testing neat_list
-
-is(neat_list([ 1 + 1, "2", undef, "foobarbaz"], 8, "|"), "2|'2'|undef|'foo...'", '... test array argument w/separator and maxlen');
-is(neat_list([ 1 + 1, "2", undef, "foobarbaz"]), "2, '2', undef, 'foobarbaz'", '... test array argument w/out separator or maxlen');
-
-
-## ----------------------------------------------------------------------------
-## testing DBI functions
-
-## test DBI->internal
-
-my $switch = DBI->internal;
-
-isa_ok($switch, 'DBI::dr');
-
-## checking attributes of $switch
-
-# NOTE:
-# check too see if this covers all the attributes or not
-
-# TO DO:
-# these three can be improved
-$switch->debug(0);
-pass('... test debug');
-$switch->{DebugDispatch} = 0; # handled by Switch
-pass('... test DebugDispatch');
-$switch->{Warn} = 1; # handled by DBI core
-pass('... test Warn');
-
-like($switch->{'Attribution'}, qr/DBI.*? by Tim Bunce/, '... this should say Tim Bunce');
-
-# is this being presumptious?
-is($switch->{'Version'}, $DBI::VERSION, '... the version should match DBI version');
-
-cmp_ok(($switch->{private_test1} = 1), '==', 1, '... this should work and return 1');
-cmp_ok($switch->{private_test1}, '==', 1, '... this should equal 1');
-
-is($switch->{CachedKids}, undef, '... CachedKids should be undef initially');
-my $cache = {};
-$switch->{CachedKids} = $cache;
-is($switch->{CachedKids}, $cache, '... CachedKids should be our ref');
-
-cmp_ok($switch->{Kids}, '==', 0, '... this should be zero');
-cmp_ok($switch->{ActiveKids}, '==', 0, '... this should be zero');
-
-ok($switch->{Active}, '... Active flag is true');
-
-# test attribute warnings
-{
- my $warn = "";
- local $SIG{__WARN__} = sub { $warn .= "@_" };
- $switch->{FooBarUnknown} = 1;
- like($warn, qr/Can't set.*FooBarUnknown/, '... we should get a warning here');
-
- $warn = "";
- $_ = $switch->{BarFooUnknown};
- like($warn, qr/Can't get.*BarFooUnknown/, '... we should get a warning here');
-
- $warn = "";
- my $dummy = $switch->{$_} for qw(private_foo dbd_foo dbi_foo); # special cases
- cmp_ok($warn, 'eq', "", '... we should get no warnings here');
-}
-
-# is this here for a reason? Are we testing anything?
-
-$switch->trace_msg("Test \$h->trace_msg text.\n", 1);
-DBI->trace_msg("Test DBI->trace_msg text.\n", 1);
-
-## testing DBI->available_drivers
-
-my @drivers = DBI->available_drivers();
-cmp_ok(scalar(@drivers), '>', 0, '... we at least have one driver installed');
-
-# NOTE:
-# we lowercase the interpolated @drivers array
-# so that our reg-exp will match on VMS & Win32
-
-like(lc("@drivers"), qr/examplep/, '... we should at least have ExampleP installed');
-
-# call available_drivers in scalar context
-
-my $num_drivers = DBI->available_drivers;
-cmp_ok($num_drivers, '>', 0, '... we should at least have one driver');
-
-## testing DBI::hash
-
-cmp_ok(DBI::hash("foo1" ), '==', -1077531989, '... should be -1077531989');
-cmp_ok(DBI::hash("foo1",0), '==', -1077531989, '... should be -1077531989');
-cmp_ok(DBI::hash("foo2",0), '==', -1077531990, '... should be -1077531990');
-SKIP: {
- skip("Math::BigInt < 1.56",2)
- if $DBI::PurePerl && !eval { require Math::BigInt; require_version Math::BigInt 1.56 };
- skip("Math::BigInt $Math::BigInt::VERSION broken",2)
- if $DBI::PurePerl && $Math::BigInt::VERSION =~ /^1\.8[45]/;
- my $bigint_vers = $Math::BigInt::VERSION || "";
- if (!$DBI::PurePerl) {
- cmp_ok(DBI::hash("foo1",1), '==', -1263462440);
- cmp_ok(DBI::hash("foo2",1), '==', -1263462437);
- }
- else {
- # for PurePerl we use Math::BigInt but that's often caused test failures that
- # aren't DBI's fault. So we just warn (via a skip) if it's not working right.
- skip("Seems like your Math::BigInt $Math::BigInt::VERSION has a bug",2)
- unless (DBI::hash("foo1X",1) == -1263462440) && (DBI::hash("foo2",1) == -1263462437);
- ok(1, "Math::BigInt $Math::BigInt::VERSION worked okay");
- ok(1);
- }
-}
-
-is(data_string_desc(""), "UTF8 off, ASCII, 0 characters 0 bytes");
-is(data_string_desc(42), "UTF8 off, ASCII, 2 characters 2 bytes");
-is(data_string_desc("foo"), "UTF8 off, ASCII, 3 characters 3 bytes");
-is(data_string_desc(undef), "UTF8 off, undef");
-is(data_string_desc("bar\x{263a}"), "UTF8 on, non-ASCII, 4 characters 6 bytes");
-is(data_string_desc("\xEA"), "UTF8 off, non-ASCII, 1 characters 1 bytes");
-
-is(data_string_diff( "", ""), "");
-is(data_string_diff( "",undef), "String b is undef, string a has 0 characters");
-is(data_string_diff(undef,undef), "");
-is(data_string_diff("aaa","aaa"), "");
-
-is(data_string_diff("aaa","aba"), "Strings differ at index 1: a[1]=a, b[1]=b");
-is(data_string_diff("aba","aaa"), "Strings differ at index 1: a[1]=b, b[1]=a");
-is(data_string_diff("aa" ,"aaa"), "String a truncated after 2 characters");
-is(data_string_diff("aaa","aa" ), "String b truncated after 2 characters");
-
-is(data_diff( "", ""), "");
-is(data_diff(undef,undef), "");
-is(data_diff("aaa","aaa"), "");
-
-is(data_diff( "",undef),
- join "","a: UTF8 off, ASCII, 0 characters 0 bytes\n",
- "b: UTF8 off, undef\n",
- "String b is undef, string a has 0 characters\n");
-is(data_diff("aaa","aba"),
- join "","a: UTF8 off, ASCII, 3 characters 3 bytes\n",
- "b: UTF8 off, ASCII, 3 characters 3 bytes\n",
- "Strings differ at index 1: a[1]=a, b[1]=b\n");
-is(data_diff(pack("C",0xEA), pack("U",0xEA)),
- join "", "a: UTF8 off, non-ASCII, 1 characters 1 bytes\n",
- "b: UTF8 on, non-ASCII, 1 characters 2 bytes\n",
- "Strings contain the same sequence of characters\n");
-is(data_diff(pack("C",0xEA), pack("U",0xEA), 1), ""); # no logical difference
-
-
-## ----------------------------------------------------------------------------
-# restrict this test to just developers
-
-SKIP: {
- skip 'developer tests', 4 unless -d ".svn" || -d ".git";
-
- if ($^O eq "MSWin32" && eval { require Win32API::File }) {
- Win32API::File::SetErrorMode(Win32API::File::SEM_FAILCRITICALERRORS());
- }
-
- print "Test DBI->installed_versions (for @drivers)\n";
- print "(If one of those drivers, or the configuration for it, is bad\n";
- print "then these tests can kill or freeze the process here. That's not the DBI's fault.)\n";
- $SIG{ALRM} = sub {
- die "Test aborted because a driver (one of: @drivers) hung while loading"
- ." (almost certainly NOT a DBI problem)";
- };
- alarm(20);
-
- ## ----------------------------------------------------------------------------
- ## test installed_versions
-
- # scalar context
- my $installed_versions = DBI->installed_versions;
-
- is(ref($installed_versions), 'HASH', '... we got a hash of installed versions');
- cmp_ok(scalar(keys(%{$installed_versions})), '>=', 1, '... make sure we have at least one');
-
- # list context
- my @installed_drivers = DBI->installed_versions;
-
- cmp_ok(scalar(@installed_drivers), '>=', 1, '... make sure we got at least one');
- like("@installed_drivers", qr/Sponge/, '... make sure at least one of them is DBD::Sponge');
-}
-
-## testing dbi_debug
-
-cmp_ok($DBI::dbi_debug, '==', 0, "... DBI::dbi_debug's initial state is 0");
-
-SKIP: {
- my $null = File::Spec->devnull();
- skip "cannot find : $null", 2 unless ($^O eq "MSWin32" || -e $null);
-
- DBI->trace(15,$null);
- cmp_ok($DBI::dbi_debug, '==', 15, "... DBI::dbi_debug is 15");
- DBI->trace(0, undef);
- cmp_ok($DBI::dbi_debug, '==', 0, "... DBI::dbi_debug is 0");
-}
-
-1;
+++ /dev/null
-#!perl -w
-# vim:sw=4:ts=8:et
-$|=1;
-
-use strict;
-
-use Test::More tests => 53;
-
-## ----------------------------------------------------------------------------
-## 02dbidrv.t - ...
-## ----------------------------------------------------------------------------
-# This test creates a Test Driver (DBD::Test) and then exercises it.
-# NOTE:
-# There are a number of tests as well that are embedded within the actual
-# driver code as well
-## ----------------------------------------------------------------------------
-
-## load DBI
-
-BEGIN {
- use_ok('DBI');
-}
-
-## ----------------------------------------------------------------------------
-## create a Test Driver (DBD::Test)
-
-## main Test Driver Package
-{
- package DBD::Test;
-
- use strict;
- use warnings;
-
- my $drh = undef;
-
- sub driver {
- return $drh if $drh;
-
- Test::More::pass('... DBD::Test->driver called to getnew Driver handle');
-
- my($class, $attr) = @_;
- $class = "${class}::dr";
- ($drh) = DBI::_new_drh($class, {
- Name => 'Test',
- Version => '$Revision: 11.11 $',
- },
- 77 # 'implementors data'
- );
-
- Test::More::ok($drh, "... new Driver handle ($drh) created successfully");
- Test::More::isa_ok($drh, 'DBI::dr');
-
- return $drh;
- }
-}
-
-## Test Driver
-{
- package DBD::Test::dr;
-
- use strict;
- use warnings;
-
- $DBD::Test::dr::imp_data_size = 0;
-
- Test::More::cmp_ok($DBD::Test::dr::imp_data_size, '==', 0, '... check DBD::Test::dr::imp_data_size to avoid typo');
-
- sub DESTROY { undef }
-
- sub data_sources {
- my ($h) = @_;
-
- Test::More::ok($h, '... Driver object passed to data_sources');
- Test::More::isa_ok($h, 'DBI::dr');
- Test::More::ok(!tied $h, '... Driver object is not tied');
-
- return ("dbi:Test:foo", "dbi:Test:bar");
- }
-}
-
-## Test db package
-{
- package DBD::Test::db;
-
- use strict;
-
- $DBD::Test::db::imp_data_size = 0;
-
- Test::More::cmp_ok($DBD::Test::db::imp_data_size, '==', 0, '... check DBD::Test::db::imp_data_size to avoid typo');
-
- sub do {
- my $h = shift;
-
- Test::More::ok($h, '... Database object passed to do');
- Test::More::isa_ok($h, 'DBI::db');
- Test::More::ok(!tied $h, '... Database object is not tied');
-
- my $drh_i = $h->{Driver};
-
- Test::More::ok($drh_i, '... got Driver object from Database object with Driver attribute');
- Test::More::isa_ok($drh_i, "DBI::dr");
- Test::More::ok(!tied %{$drh_i}, '... Driver object is not tied');
-
- my $drh_o = $h->FETCH('Driver');
-
- Test::More::ok($drh_o, '... got Driver object from Database object by FETCH-ing Driver attribute');
- Test::More::isa_ok($drh_o, "DBI::dr");
- SKIP: {
- Test::More::skip "running DBI::PurePerl", 1 if $DBI::PurePerl;
- Test::More::ok(tied %{$drh_o}, '... Driver object is not tied');
- }
-
- # return this to make our test pass
- return 1;
- }
-
- sub data_sources {
- my ($dbh, $attr) = @_;
- my @ds = $dbh->SUPER::data_sources($attr);
-
- Test::More::is_deeply((
- \@ds,
- [ 'dbi:Test:foo', 'dbi:Test:bar' ]
- ),
- '... checking fetched datasources from Driver'
- );
-
- push @ds, "dbi:Test:baz";
- return @ds;
- }
-
- sub disconnect {
- shift->STORE(Active => 0);
- }
-}
-
-## ----------------------------------------------------------------------------
-## test the Driver (DBD::Test)
-
-$INC{'DBD/Test.pm'} = 'dummy'; # required to fool DBI->install_driver()
-
-# Note that install_driver should *not* normally be called directly.
-# This test does so only because it's a test of install_driver!
-
-my $drh = DBI->install_driver('Test');
-
-ok($drh, '... got a Test Driver object back from DBI->install_driver');
-isa_ok($drh, 'DBI::dr');
-
-cmp_ok(DBI::_get_imp_data($drh), '==', 77, '... checking the DBI::_get_imp_data function');
-
-my @ds1 = DBI->data_sources("Test");
-is_deeply((
- [ @ds1 ],
- [ 'dbi:Test:foo', 'dbi:Test:bar' ]
- ), '... got correct datasources from DBI->data_sources("Test")'
-);
-
-SKIP: {
- skip "Kids attribute not supported under DBI::PurePerl", 1 if $DBI::PurePerl;
-
- cmp_ok($drh->{Kids}, '==', 0, '... this Driver does not yet have any Kids');
-}
-
-# create scope to test $dbh DESTROY behaviour
-do {
-
- my $dbh = $drh->connect;
-
- ok($dbh, '... got a database handle from calling $drh->connect');
- isa_ok($dbh, 'DBI::db');
-
- SKIP: {
- skip "Kids attribute not supported under DBI::PurePerl", 1 if $DBI::PurePerl;
-
- cmp_ok($drh->{Kids}, '==', 1, '... this Driver does not yet have any Kids');
- }
-
- my @ds2 = $dbh->data_sources();
- is_deeply((
- [ @ds2 ],
- [ 'dbi:Test:foo', 'dbi:Test:bar', 'dbi:Test:baz' ]
- ), '... got correct datasources from $dbh->data_sources()'
- );
-
- ok($dbh->do('dummy'), '... this will trigger more driver internal tests above in DBD::Test::db');
-
- $dbh->disconnect;
-
- $drh->set_err("41", "foo 41 drh");
- cmp_ok($drh->err, '==', 41, '... checking Driver handle err set with set_err method');
- $dbh->set_err("42", "foo 42 dbh");
- cmp_ok($dbh->err, '==', 42, '... checking Database handle err set with set_err method');
- cmp_ok($drh->err, '==', 41, '... checking Database handle err set with Driver handle set_err method');
-
-};
-
-SKIP: {
- skip "Kids attribute not supported under DBI::PurePerl", 1 if $DBI::PurePerl;
-
- cmp_ok($drh->{Kids}, '==', 0, '... this Driver does not yet have any Kids')
- or $drh->dump_handle("bad Kids",3);
-}
-
-# copied up to drh from dbh when dbh was DESTROYd
-cmp_ok($drh->err, '==', 42, '... $dbh->DESTROY should set $drh->err to 42');
-
-$drh->set_err("99", "foo");
-cmp_ok($DBI::err, '==', 99, '... checking $DBI::err set with Driver handle set_err method');
-is($DBI::errstr, "foo 42 dbh [err was 42 now 99]\nfoo", '... checking $DBI::errstr');
-
-$drh->default_user("",""); # just to reset err etc
-$drh->set_err(1, "errmsg", "00000");
-is($DBI::state, "", '... checking $DBI::state');
-
-$drh->set_err(1, "test error 1");
-is($DBI::state, 'S1000', '... checking $DBI::state');
-
-$drh->set_err(2, "test error 2", "IM999");
-is($DBI::state, 'IM999', '... checking $DBI::state');
-
-SKIP: {
- skip "using DBI::PurePerl", 1 if $DBI::PurePerl;
- eval {
- $DBI::rows = 1
- };
- like($@, qr/Can't modify/, '... trying to assign to $DBI::rows should throw an excpetion'); #'
-}
-
-is($drh->{FetchHashKeyName}, 'NAME', '... FetchHashKeyName is NAME');
-$drh->{FetchHashKeyName} = 'NAME_lc';
-is($drh->{FetchHashKeyName}, 'NAME_lc', '... FetchHashKeyName is now changed to NAME_lc');
-
-ok(!$drh->disconnect_all, '... calling $drh->disconnect_all (not implemented but will fail silently)');
-
-ok defined $drh->dbixs_revision, 'has dbixs_revision';
-ok($drh->dbixs_revision =~ m/^\d+$/, 'has integer dbixs_revision');
-
-SKIP: {
- skip "using DBI::PurePerl", 5 if $DBI::PurePerl;
- my $can = $drh->can('FETCH');
-
- ok($can, '... $drh can FETCH');
- is(ref($can), "CODE", '... and it returned a proper CODE ref');
-
- my $name = $can->($drh, "Name");
-
- ok($name, '... used FETCH returned from can to fetch the Name attribute');
- is($name, "Test", '... the Name attribute is equal to Test');
-
- ok(!$drh->can('disconnect_all'), '... ');
-}
-
-1;
+++ /dev/null
-#!perl -w
-$|=1;
-
-use strict;
-
-use Test::More tests => 137;
-
-## ----------------------------------------------------------------------------
-## 03handle.t - tests handles
-## ----------------------------------------------------------------------------
-# This set of tests exercises the different handles; Driver, Database and
-# Statement in various ways, in particular in their interactions with one
-# another
-## ----------------------------------------------------------------------------
-
-BEGIN {
- use_ok( 'DBI' );
-}
-
-# installed drivers should start empty
-my %drivers = DBI->installed_drivers();
-is(scalar keys %drivers, 0);
-
-## ----------------------------------------------------------------------------
-# get the Driver handle
-
-my $driver = "ExampleP";
-
-my $drh = DBI->install_driver($driver);
-isa_ok( $drh, 'DBI::dr' );
-
-SKIP: {
- skip "Kids attribute not supported under DBI::PurePerl", 1 if $DBI::PurePerl;
-
- cmp_ok($drh->{Kids}, '==', 0, '... this Driver does not yet have any Kids');
-}
-
-# now the driver should be registered
-%drivers = DBI->installed_drivers();
-is(scalar keys %drivers, 1);
-ok(exists $drivers{ExampleP});
-ok($drivers{ExampleP}->isa('DBI::dr'));
-
-my $using_dbd_gofer = ($ENV{DBI_AUTOPROXY}||'') =~ /^dbi:Gofer.*transport=/i;
-
-## ----------------------------------------------------------------------------
-# do database handle tests inside do BLOCK to capture scope
-
-do {
- my $dbh = DBI->connect("dbi:$driver:", '', '');
- isa_ok($dbh, 'DBI::db');
-
- my $drh = $dbh->{Driver}; # (re)get drh here so tests can work using_dbd_gofer
-
- SKIP: {
- skip "Kids and ActiveKids attributes not supported under DBI::PurePerl", 2 if $DBI::PurePerl;
-
- cmp_ok($drh->{Kids}, '==', 1, '... our Driver has one Kid');
- cmp_ok($drh->{ActiveKids}, '==', 1, '... our Driver has one ActiveKid');
- }
-
- my $sql = "select name from ?";
-
- my $sth1 = $dbh->prepare_cached($sql);
- isa_ok($sth1, 'DBI::st');
- ok($sth1->execute("."), '... execute ran successfully');
-
- my $ck = $dbh->{CachedKids};
- is(ref($ck), "HASH", '... we got the CachedKids hash');
-
- cmp_ok(scalar(keys(%{$ck})), '==', 1, '... there is one CachedKid');
- ok(eq_set(
- [ values %{$ck} ],
- [ $sth1 ]
- ),
- '... our statement handle should be in the CachedKids');
-
- ok($sth1->{Active}, '... our first statement is Active');
-
- {
- my $warn = 0; # use this to check that we are warned
- local $SIG{__WARN__} = sub { ++$warn if $_[0] =~ /still active/i };
-
- my $sth2 = $dbh->prepare_cached($sql);
- isa_ok($sth2, 'DBI::st');
-
- is($sth1, $sth2, '... prepare_cached returned the same statement handle');
- cmp_ok($warn,'==', 1, '... we got warned about our first statement handle being still active');
-
- ok(!$sth1->{Active}, '... our first statement is no longer Active since we re-prepared it');
-
- my $sth3 = $dbh->prepare_cached($sql, { foo => 1 });
- isa_ok($sth3, 'DBI::st');
-
- isnt($sth1, $sth3, '... prepare_cached returned a different statement handle now');
- cmp_ok(scalar(keys(%{$ck})), '==', 2, '... there are two CachedKids');
- ok(eq_set(
- [ values %{$ck} ],
- [ $sth1, $sth3 ]
- ),
- '... both statement handles should be in the CachedKids');
-
- ok($sth1->execute("."), '... executing first statement handle again');
- ok($sth1->{Active}, '... first statement handle is now active again');
-
- my $sth4 = $dbh->prepare_cached($sql, undef, 3);
- isa_ok($sth4, 'DBI::st');
-
- isnt($sth1, $sth4, '... our fourth statement handle is not the same as our first');
- ok($sth1->{Active}, '... first statement handle is still active');
-
- cmp_ok(scalar(keys(%{$ck})), '==', 2, '... there are two CachedKids');
- ok(eq_set(
- [ values %{$ck} ],
- [ $sth2, $sth4 ]
- ),
- '... second and fourth statement handles should be in the CachedKids');
-
- $sth1->finish;
- ok(!$sth1->{Active}, '... first statement handle is no longer active');
-
- ok($sth4->execute("."), '... fourth statement handle executed properly');
- ok($sth4->{Active}, '... fourth statement handle is Active');
-
- my $sth5 = $dbh->prepare_cached($sql, undef, 1);
- isa_ok($sth5, 'DBI::st');
-
- cmp_ok($warn, '==', 1, '... we still only got one warning');
-
- is($sth4, $sth5, '... fourth statement handle and fifth one match');
- ok(!$sth4->{Active}, '... fourth statement handle is not Active');
- ok(!$sth5->{Active}, '... fifth statement handle is not Active (shouldnt be its the same as fifth)');
-
- cmp_ok(scalar(keys(%{$ck})), '==', 2, '... there are two CachedKids');
- ok(eq_set(
- [ values %{$ck} ],
- [ $sth2, $sth5 ]
- ),
- '... second and fourth/fifth statement handles should be in the CachedKids');
- }
-
- SKIP: {
- skip "swap_inner_handle() not supported under DBI::PurePerl", 23 if $DBI::PurePerl;
-
- my $sth6 = $dbh->prepare($sql);
- $sth6->execute(".");
- my $sth1_driver_name = $sth1->{Database}{Driver}{Name};
-
- ok( $sth6->{Active}, '... sixth statement handle is active');
- ok(!$sth1->{Active}, '... first statement handle is not active');
-
- ok($sth1->swap_inner_handle($sth6), '... first statement handle becomes the sixth');
- ok(!$sth6->{Active}, '... sixth statement handle is now not active');
- ok( $sth1->{Active}, '... first statement handle is now active again');
-
- ok($sth1->swap_inner_handle($sth6), '... first statement handle becomes the sixth');
- ok( $sth6->{Active}, '... sixth statement handle is active');
- ok(!$sth1->{Active}, '... first statement handle is not active');
-
- ok($sth1->swap_inner_handle($sth6), '... first statement handle becomes the sixth');
- ok(!$sth6->{Active}, '... sixth statement handle is now not active');
- ok( $sth1->{Active}, '... first statement handle is now active again');
-
- $sth1->{PrintError} = 0;
- ok(!$sth1->swap_inner_handle($dbh), '... can not swap a sth with a dbh');
- cmp_ok( $sth1->errstr, 'eq', "Can't swap_inner_handle between sth and dbh");
-
- ok($sth1->swap_inner_handle($sth6), '... first statement handle becomes the sixth');
- ok( $sth6->{Active}, '... sixth statement handle is active');
- ok(!$sth1->{Active}, '... first statement handle is not active');
-
- $sth6->finish;
-
- ok(my $dbh_nullp = DBI->connect("dbi:NullP:", undef, undef, { go_bypass => 1 }));
- ok(my $sth7 = $dbh_nullp->prepare(""));
-
- $sth1->{PrintError} = 0;
- ok(!$sth1->swap_inner_handle($sth7), "... can't swap_inner_handle with handle from different parent");
- cmp_ok( $sth1->errstr, 'eq', "Can't swap_inner_handle with handle from different parent");
-
- cmp_ok( $sth1->{Database}{Driver}{Name}, 'eq', $sth1_driver_name );
- ok( $sth1->swap_inner_handle($sth7,1), "... can swap to different parent if forced");
- cmp_ok( $sth1->{Database}{Driver}{Name}, 'eq', "NullP" );
-
- $dbh_nullp->disconnect;
- }
-
- ok( $dbh->ping, 'ping should be true before disconnect');
- $dbh->disconnect;
- $dbh->{PrintError} = 0; # silence 'not connected' warning
- ok( !$dbh->ping, 'ping should be false after disconnect');
-
- SKIP: {
- skip "Kids and ActiveKids attributes not supported under DBI::PurePerl", 2 if $DBI::PurePerl;
-
- cmp_ok($drh->{Kids}, '==', 1, '... our Driver has one Kid after disconnect');
- cmp_ok($drh->{ActiveKids}, '==', 0, '... our Driver has no ActiveKids after disconnect');
- }
-
-};
-
-if ($using_dbd_gofer) {
- $drh->{CachedKids} = {};
-}
-
-# make sure our driver has no more kids after this test
-# NOTE:
-# this also assures us that the next test has an empty slate as well
-SKIP: {
- skip "Kids attribute not supported under DBI::PurePerl", 1 if $DBI::PurePerl;
-
- cmp_ok($drh->{Kids}, '==', 0, "... our $drh->{Name} driver should have 0 Kids after dbh was destoryed");
-}
-
-## ----------------------------------------------------------------------------
-# handle reference leak tests
-
-# NOTE:
-# this test checks for reference leaks by testing the Kids attribute
-# which is not supported by DBI::PurePerl, so we just do not run this
-# for DBI::PurePerl all together. Even though some of the tests would
-# pass, it does not make sense because in the end, what is actually
-# being tested for will give a false positive
-
-sub work {
- my (%args) = @_;
- my $dbh = DBI->connect("dbi:$driver:", '', '');
- isa_ok( $dbh, 'DBI::db' );
-
- cmp_ok($drh->{Kids}, '==', 1, '... the Driver should have 1 Kid(s) now');
-
- if ( $args{Driver} ) {
- isa_ok( $dbh->{Driver}, 'DBI::dr' );
- } else {
- pass( "not testing Driver here" );
- }
-
- my $sth = $dbh->prepare_cached("select name from ?");
- isa_ok( $sth, 'DBI::st' );
-
- if ( $args{Database} ) {
- isa_ok( $sth->{Database}, 'DBI::db' );
- } else {
- pass( "not testing Database here" );
- }
-
- $dbh->disconnect;
- # both handles should be freed here
-}
-
-SKIP: {
- skip "Kids attribute not supported under DBI::PurePerl", 25 if $DBI::PurePerl;
- skip "drh Kids not testable under DBD::Gofer", 25 if $using_dbd_gofer;
-
- foreach my $args (
- {},
- { Driver => 1 },
- { Database => 1 },
- { Driver => 1, Database => 1 },
- ) {
- work( %{$args} );
- cmp_ok($drh->{Kids}, '==', 0, '... the Driver should have no Kids');
- }
-
- # make sure we have no kids when we end this
- cmp_ok($drh->{Kids}, '==', 0, '... the Driver should have no Kids at the end of this test');
-}
-
-## ----------------------------------------------------------------------------
-# handle take_imp_data test
-
-SKIP: {
- skip "take_imp_data test not supported under DBD::Gofer", 19 if $using_dbd_gofer;
-
- my $dbh = DBI->connect("dbi:$driver:", '', '');
- isa_ok($dbh, "DBI::db");
- my $drh = $dbh->{Driver}; # (re)get drh here so tests can work using_dbd_gofer
-
- cmp_ok($drh->{Kids}, '==', 1, '... our Driver should have 1 Kid(s) here')
- unless $DBI::PurePerl && pass();
-
- $dbh->prepare("select name from ?"); # destroyed at once
- my $sth2 = $dbh->prepare("select name from ?"); # inactive
- my $sth3 = $dbh->prepare("select name from ?"); # active:
- $sth3->execute(".");
- is $sth3->{Active}, 1;
- is $dbh->{ActiveKids}, 1
- unless $DBI::PurePerl && pass();
-
- my $ChildHandles = $dbh->{ChildHandles};
-
- skip "take_imp_data test needs weakrefs", 15 if not $ChildHandles;
-
- ok $ChildHandles, 'we need weakrefs for take_imp_data to work safely with child handles';
- is @$ChildHandles, 3, 'should have 3 entries (implementation detail)';
- is grep({ defined } @$ChildHandles), 2, 'should have 2 defined handles';
-
- my $imp_data = $dbh->take_imp_data;
- ok($imp_data, '... we got some imp_data to test');
- # generally length($imp_data) = 112 for 32bit, 116 for 64 bit
- # (as of DBI 1.37) but it can differ on some platforms
- # depending on structure packing by the compiler
- # so we just test that it's something reasonable:
- cmp_ok(length($imp_data), '>=', 80, '... test that our imp_data is greater than or equal to 80, this is reasonable');
-
- cmp_ok($drh->{Kids}, '==', 0, '... our Driver should have 0 Kid(s) after calling take_imp_data');
-
- is ref $sth3, 'DBI::zombie', 'sth should be reblessed';
- eval { $sth3->finish };
- like $@, qr/Can't locate object method/;
-
- {
- my @warn;
- local $SIG{__WARN__} = sub { push @warn, $_[0] if $_[0] =~ /after take_imp_data/; print "warn: @_\n"; };
-
- my $drh = $dbh->{Driver};
- ok(!defined $drh, '... our Driver should be undefined');
-
- my $trace_level = $dbh->{TraceLevel};
- ok(!defined $trace_level, '... our TraceLevel should be undefined');
-
- ok(!defined $dbh->disconnect, '... disconnect should return undef');
-
- ok(!defined $dbh->quote(42), '... quote should return undefined');
-
- cmp_ok(scalar @warn, '==', 4, '... we should have gotten 4 warnings');
- }
-
- my $dbh2 = DBI->connect("dbi:$driver:", '', '', { dbi_imp_data => $imp_data });
- isa_ok($dbh2, "DBI::db");
- # need a way to test dbi_imp_data has been used
-
- cmp_ok($drh->{Kids}, '==', 1, '... our Driver should have 1 Kid(s) again')
- unless $DBI::PurePerl && pass();
-
-}
-
-# we need this SKIP block on its own since we are testing the
-# destruction of objects within the scope of the above SKIP
-# block
-SKIP: {
- skip "Kids attribute not supported under DBI::PurePerl", 1 if $DBI::PurePerl;
-
- cmp_ok($drh->{Kids}, '==', 0, '... our Driver has no Kids after this test');
-}
-
-## ----------------------------------------------------------------------------
-# NullP statement handle attributes without execute
-
-my $driver2 = "NullP";
-
-my $drh2 = DBI->install_driver($driver);
-isa_ok( $drh2, 'DBI::dr' );
-
-SKIP: {
- skip "Kids attribute not supported under DBI::PurePerl", 1 if $DBI::PurePerl;
-
- cmp_ok($drh2->{Kids}, '==', 0, '... our Driver (2) has no Kids before this test');
-}
-
-do {
- my $dbh = DBI->connect("dbi:$driver2:", '', '');
- isa_ok($dbh, "DBI::db");
-
- my $sth = $dbh->prepare("foo bar");
- isa_ok($sth, "DBI::st");
-
- cmp_ok($sth->{NUM_OF_PARAMS}, '==', 0, '... NUM_OF_PARAMS is 0');
- is($sth->{NUM_OF_FIELDS}, undef, '... NUM_OF_FIELDS should be undef');
- is($sth->{Statement}, "foo bar", '... Statement is "foo bar"');
-
- ok(!defined $sth->{NAME}, '... NAME is undefined');
- ok(!defined $sth->{TYPE}, '... TYPE is undefined');
- ok(!defined $sth->{SCALE}, '... SCALE is undefined');
- ok(!defined $sth->{PRECISION}, '... PRECISION is undefined');
- ok(!defined $sth->{NULLABLE}, '... NULLABLE is undefined');
- ok(!defined $sth->{RowsInCache}, '... RowsInCache is undefined');
- ok(!defined $sth->{ParamValues}, '... ParamValues is undefined');
- # derived NAME attributes
- ok(!defined $sth->{NAME_uc}, '... NAME_uc is undefined');
- ok(!defined $sth->{NAME_lc}, '... NAME_lc is undefined');
- ok(!defined $sth->{NAME_hash}, '... NAME_hash is undefined');
- ok(!defined $sth->{NAME_uc_hash}, '... NAME_uc_hash is undefined');
- ok(!defined $sth->{NAME_lc_hash}, '... NAME_lc_hash is undefined');
-
- my $dbh_ref = ref($dbh);
- my $sth_ref = ref($sth);
-
- ok($dbh_ref->can("prepare"), '... $dbh can call "prepare"');
- ok(!$dbh_ref->can("nonesuch"), '... $dbh cannot call "nonesuch"');
- ok($sth_ref->can("execute"), '... $sth can call "execute"');
-
- # what is this test for??
-
- # I don't know why this warning has the "(perhaps ...)" suffix, it shouldn't:
- # Can't locate object method "nonesuch" via package "DBI::db" (perhaps you forgot to load "DBI::db"?)
- eval { ref($dbh)->nonesuch; };
-
- $dbh->disconnect;
-};
-
-SKIP: {
- skip "Kids attribute not supported under DBI::PurePerl", 1 if $DBI::PurePerl;
-
- cmp_ok($drh2->{Kids}, '==', 0, '... our Driver (2) has no Kids after this test');
-}
-
-## ----------------------------------------------------------------------------
-
-1;
+++ /dev/null
-#!perl -w
-$|=1;
-
-use strict;
-
-use Test::More tests => 12;
-
-## ----------------------------------------------------------------------------
-## 04mods.t - ...
-## ----------------------------------------------------------------------------
-# Note:
-# the modules tested here are all marked as new and not guaranteed, so this if
-# they change, these will fail.
-## ----------------------------------------------------------------------------
-
-BEGIN {
- use_ok( 'DBI' );
-
- # load these first, since the other two load them
- # and we want to catch the error first
- use_ok( 'DBI::Const::GetInfo::ANSI' );
- use_ok( 'DBI::Const::GetInfo::ODBC' );
-
- use_ok( 'DBI::Const::GetInfoType', qw(%GetInfoType) );
- use_ok( 'DBI::Const::GetInfoReturn', qw(%GetInfoReturnTypes %GetInfoReturnValues) );
-}
-
-## test GetInfoType
-
-cmp_ok(scalar(keys(%GetInfoType)), '>', 1, '... we have at least one key in the GetInfoType hash');
-
-is_deeply(
- \%GetInfoType,
- { %DBI::Const::GetInfo::ANSI::InfoTypes, %DBI::Const::GetInfo::ODBC::InfoTypes },
- '... the GetInfoType hash is constructed from the ANSI and ODBC hashes'
- );
-
-## test GetInfoReturnTypes
-
-cmp_ok(scalar(keys(%GetInfoReturnTypes)), '>', 1, '... we have at least one key in the GetInfoReturnType hash');
-
-is_deeply(
- \%GetInfoReturnTypes,
- { %DBI::Const::GetInfo::ANSI::ReturnTypes, %DBI::Const::GetInfo::ODBC::ReturnTypes },
- '... the GetInfoReturnType hash is constructed from the ANSI and ODBC hashes'
- );
-
-## test GetInfoReturnValues
-
-cmp_ok(scalar(keys(%GetInfoReturnValues)), '>', 1, '... we have at least one key in the GetInfoReturnValues hash');
-
-# ... testing GetInfoReturnValues any further would be difficult
-
-## test the two methods found in DBI::Const::GetInfoReturn
-
-can_ok('DBI::Const::GetInfoReturn', 'Format');
-can_ok('DBI::Const::GetInfoReturn', 'Explain');
-
-1;
+++ /dev/null
-# Before `make install' is performed this script should be runnable with
-# `make test'. After `make install' it should work as `perl CatHash.t'
-
-#########################
-
-# change 'tests => 1' to 'tests => last_test_to_print';
-
-use strict;
-use Benchmark qw(:all);
-use Scalar::Util qw(looks_like_number);
-no warnings 'uninitialized';
-
-use Test::More tests => 41;
-
-BEGIN { use_ok('DBI') };
-
-# null and undefs -- segfaults?;
-is (DBI::_concat_hash_sorted(undef, "=", ":", 0, undef), undef);
-is (DBI::_concat_hash_sorted({ }, "=", ":", 0, undef), "");
-eval { DBI::_concat_hash_sorted([], "=", ":", 0, undef) };
-like ($@ || "", qr/is not a hash reference/);
-is (DBI::_concat_hash_sorted({ }, undef, ":", 0, undef), "");
-is (DBI::_concat_hash_sorted({ }, "=", undef, 0, undef), "");
-is (DBI::_concat_hash_sorted({ }, "=", ":", undef, undef),"");
-
-# simple cases
-is (DBI::_concat_hash_sorted({ 1=>"a", 2=>"b" }, "=", ", ", undef, undef), "1='a', 2='b'");
-# nul byte in key sep and pair sep
-# (nul byte in hash not supported)
-is DBI::_concat_hash_sorted({ 1=>"a", 2=>"b" }, "=\000=", ":\000:", undef, undef),
- "1=\000='a':\000:2=\000='b'", 'should work with nul bytes in kv_sep and pair_sep';
-is DBI::_concat_hash_sorted({ 1=>"a\000a", 2=>"b" }, "=", ":", 1, undef),
- "1='a.a':2='b'", 'should work with nul bytes in hash value (neat)';
-is DBI::_concat_hash_sorted({ 1=>"a\000a", 2=>"b" }, "=", ":", 0, undef),
- "1='a\000a':2='b'", 'should work with nul bytes in hash value (not neat)';
-
-# Simple stress tests
-# limit stress when performing automated testing
-# eg http://www.nntp.perl.org/group/perl.cpan.testers/2009/06/msg4374116.html
-my $stress = $ENV{AUTOMATED_TESTING} ? 1_000 : 10_000;
-ok(DBI::_concat_hash_sorted({bob=>'two', fred=>'one' }, "="x$stress, ":", 1, undef));
-ok(DBI::_concat_hash_sorted({bob=>'two', fred=>'one' }, "=", ":"x$stress, 1, undef));
-ok(DBI::_concat_hash_sorted({map {$_=>undef} (1..1000)}, "="x$stress, ":", 1, undef));
-ok(DBI::_concat_hash_sorted({map {$_=>undef} (1..1000)}, "=", ":"x$stress, 1, undef), 'test');
-ok(DBI::_concat_hash_sorted({map {$_=>undef} (1..100)}, "="x$stress, ":"x$stress, 1, undef), 'test');
-
-my $simple_hash = {
- bob=>"there",
- jack=>12,
- fred=>"there",
- norman=>"there",
- # sam =>undef
-};
-
-my $simple_numeric = {
- 1=>"there",
- 2=>"there",
- 16 => 'yo',
- 07 => "buddy",
- 49 => undef,
-};
-
-my $simple_mixed = {
- bob=>"there",
- jack=>12,
- fred=>"there",
- sam =>undef,
- 1=>"there",
- 32=>"there",
- 16 => 'yo',
- 07 => "buddy",
- 49 => undef,
-};
-
-my $simple_float = {
- 1.12 =>"there",
- 3.1415926 =>"there",
- 32=>"there",
- 1.6 => 'yo',
- 0.78 => "buddy",
- 49 => undef,
-};
-
-#eval {
-# DBI::_concat_hash_sorted($simple_hash, "=",,":",1,12);
-#};
-ok(1," Unknown sort order");
-#like ($@, qr/Unknown sort order/, "Unknown sort order");
-
-
-
-## Loopify and Add Neat
-
-
-my %neats = (
- "Neat"=>0,
- "Not Neat"=> 1
-);
-my %sort_types = (
- guess=>undef,
- numeric => 1,
- lexical=> 0
-);
-my %hashes = (
- Numeric=>$simple_numeric,
- "Simple Hash" => $simple_hash,
- "Mixed Hash" => $simple_mixed,
- "Float Hash" => $simple_float
-);
-
-for my $sort_type (keys %sort_types){
- for my $neat (keys %neats) {
- for my $hash (keys %hashes) {
- test_concat_hash($hash, $neat, $sort_type);
- }
- }
-}
-
-sub test_concat_hash {
- my ($hash, $neat, $sort_type) = @_;
- my @args = ($hashes{$hash}, "=", ":",$neats{$neat}, $sort_types{$sort_type});
- is (
- DBI::_concat_hash_sorted(@args),
- _concat_hash_sorted(@args),
- "$hash - $neat $sort_type"
- );
-}
-
-if (0) {
- eval {
- cmpthese(200_000, {
- Perl => sub {_concat_hash_sorted($simple_hash, "=", ":",0,undef); },
- C=> sub {DBI::_concat_hash_sorted($simple_hash, "=", ":",0,1);}
- });
-
- print "\n";
- cmpthese(200_000, {
- NotNeat => sub {DBI::_concat_hash_sorted(
- $simple_hash, "=", ":",1,undef);
- },
- Neat => sub {DBI::_concat_hash_sorted(
- $simple_hash, "=", ":",0,undef);
- }
- });
- };
-}
-#CatHash::_concat_hash_values({ }, ":-",,"::",1,1);
-
-
-sub _concat_hash_sorted {
- my ( $hash_ref, $kv_separator, $pair_separator, $use_neat, $num_sort ) = @_;
- # $num_sort: 0=lexical, 1=numeric, undef=try to guess
-
- return undef unless defined $hash_ref;
- die "hash is not a hash reference" unless ref $hash_ref eq 'HASH';
- my $keys = _get_sorted_hash_keys($hash_ref, $num_sort);
- my $string = '';
- for my $key (@$keys) {
- $string .= $pair_separator if length $string > 0;
- my $value = $hash_ref->{$key};
- if ($use_neat) {
- $value = DBI::neat($value, 0);
- }
- else {
- $value = (defined $value) ? "'$value'" : 'undef';
- }
- $string .= $key . $kv_separator . $value;
- }
- return $string;
-}
-
-sub _get_sorted_hash_keys {
- my ($hash_ref, $sort_type) = @_;
- if (not defined $sort_type) {
- my $sort_guess = 1;
- $sort_guess = (not looks_like_number($_)) ? 0 : $sort_guess
- for keys %$hash_ref;
- $sort_type = $sort_guess;
- }
-
- my @keys = keys %$hash_ref;
- no warnings 'numeric';
- my @sorted = ($sort_type)
- ? sort { $a <=> $b or $a cmp $b } @keys
- : sort @keys;
- #warn "$sort_type = @sorted\n";
- return \@sorted;
-}
-
-1;
+++ /dev/null
-#!perl -w
-
-use strict;
-use Storable qw(dclone);
-
-use Test::More;
-
-## ----------------------------------------------------------------------------
-## 06attrs.t - ...
-## ----------------------------------------------------------------------------
-# This test checks the parameters and the values associated with them for
-# the three different handles (Driver, Database, Statement)
-## ----------------------------------------------------------------------------
-
-BEGIN {
- use_ok( 'DBI' )
-}
-
-$|=1;
-
-my $using_autoproxy = ($ENV{DBI_AUTOPROXY});
-my $dsn = 'dbi:ExampleP:dummy';
-
-# Connect to the example driver.
-my $dbh = DBI->connect($dsn, '', '', {
- PrintError => 0, RaiseError => 1,
-});
-
-isa_ok( $dbh, 'DBI::db' );
-
-# Clean up when we're done.
-END { $dbh->disconnect if $dbh };
-
-## ----------------------------------------------------------------------------
-# Check the database handle attributes.
-
-# bit flag attr
-ok( $dbh->{Warn}, '... checking Warn attribute for dbh');
-ok( $dbh->{Active}, '... checking Active attribute for dbh');
-ok( $dbh->{AutoCommit}, '... checking AutoCommit attribute for dbh');
-ok(!$dbh->{CompatMode}, '... checking CompatMode attribute for dbh');
-ok(!$dbh->{InactiveDestroy}, '... checking InactiveDestroy attribute for dbh');
-ok(!$dbh->{AutoInactiveDestroy}, '... checking AutoInactiveDestroy attribute for dbh');
-ok(!$dbh->{PrintError}, '... checking PrintError attribute for dbh');
-ok( $dbh->{PrintWarn}, '... checking PrintWarn attribute for dbh'); # true because of perl -w above
-ok( $dbh->{RaiseError}, '... checking RaiseError attribute for dbh');
-ok(!$dbh->{ShowErrorStatement}, '... checking ShowErrorStatement attribute for dbh');
-ok(!$dbh->{ChopBlanks}, '... checking ChopBlanks attribute for dbh');
-ok(!$dbh->{LongTruncOk}, '... checking LongTrunkOk attribute for dbh');
-ok(!$dbh->{TaintIn}, '... checking TaintIn attribute for dbh');
-ok(!$dbh->{TaintOut}, '... checking TaintOut attribute for dbh');
-ok(!$dbh->{Taint}, '... checking Taint attribute for dbh');
-ok(!$dbh->{Executed}, '... checking Executed attribute for dbh');
-
-# other attr
-cmp_ok($dbh->{ErrCount}, '==', 0, '... checking ErrCount attribute for dbh');
-
-SKIP: {
- skip "Kids and ActiveKids attribute not supported under DBI::PurePerl", 2 if $DBI::PurePerl;
-
- cmp_ok($dbh->{Kids}, '==', 0, '... checking Kids attribute for dbh');;
- cmp_ok($dbh->{ActiveKids}, '==', 0, '... checking ActiveKids attribute for dbh');;
-}
-
-is($dbh->{CachedKids}, undef, '... checking CachedKids attribute for dbh');
-ok(!defined $dbh->{HandleError}, '... checking HandleError attribute for dbh');
-ok(!defined $dbh->{Profile}, '... checking Profile attribute for dbh');
-ok(!defined $dbh->{Statement}, '... checking Statement attribute for dbh');
-ok(!defined $dbh->{RowCacheSize}, '... checking RowCacheSize attribute for dbh');
-ok(!defined $dbh->{ReadOnly}, '... checking ReadOnly attribute for dbh');
-
-is($dbh->{FetchHashKeyName}, 'NAME', '... checking FetchHashKeyName attribute for dbh');
-is($dbh->{Name}, 'dummy', '... checking Name attribute for dbh') # fails for Multiplex
- unless $using_autoproxy && ok(1);
-
-cmp_ok($dbh->{TraceLevel}, '==', $DBI::dbi_debug & 0xF, '... checking TraceLevel attribute for dbh');
-cmp_ok($dbh->{LongReadLen}, '==', 80, '... checking LongReadLen attribute for dbh');
-
-is_deeply [ $dbh->FETCH_many(qw(HandleError FetchHashKeyName LongReadLen ErrCount)) ],
- [ undef, qw(NAME 80 0) ], 'should be able to FETCH_many';
-
-is $dbh->{examplep_private_dbh_attrib}, 42, 'should see driver-private dbh attribute value';
-is delete $dbh->{examplep_private_dbh_attrib}, 42, 'delete on non-private attribute acts like fetch';
-is $dbh->{examplep_private_dbh_attrib}, 42, 'value unchanged after delete';
-
-$dbh->{private_foo} = 42;
-is $dbh->{private_foo}, 42, 'should see private_foo dbh attribute value';
-is delete $dbh->{private_foo}, 42, 'delete should return private_foo dbh attribute value';
-is $dbh->{private_foo}, undef, 'value of private_foo after delete should be undef';
-
-# Raise an error.
-eval {
- $dbh->do('select foo from foo')
-};
-like($@, qr/^DBD::\w+::db do failed: Unknown field names: foo/ , '... catching exception');
-
-ok(defined $dbh->err, '... $dbh->err is undefined');
-like($dbh->errstr, qr/^Unknown field names: foo\b/, '... checking $dbh->errstr');
-
-is($dbh->state, 'S1000', '... checking $dbh->state');
-
-ok($dbh->{Executed}, '... checking Executed attribute for dbh'); # even though it failed
-$dbh->{Executed} = 0; # reset(able)
-cmp_ok($dbh->{Executed}, '==', 0, '... checking Executed attribute for dbh (after reset)');
-
-cmp_ok($dbh->{ErrCount}, '==', 1, '... checking ErrCount attribute for dbh (after error was generated)');
-
-## ----------------------------------------------------------------------------
-# Test the driver handle attributes.
-
-my $drh = $dbh->{Driver};
-isa_ok( $drh, 'DBI::dr' );
-
-ok($dbh->err, '... checking $dbh->err');
-
-cmp_ok($drh->{ErrCount}, '==', 0, '... checking ErrCount attribute for drh');
-
-ok( $drh->{Warn}, '... checking Warn attribute for drh');
-ok( $drh->{Active}, '... checking Active attribute for drh');
-ok( $drh->{AutoCommit}, '... checking AutoCommit attribute for drh');
-ok(!$drh->{CompatMode}, '... checking CompatMode attribute for drh');
-ok(!$drh->{InactiveDestroy}, '... checking InactiveDestroy attribute for drh');
-ok(!$drh->{AutoInactiveDestroy}, '... checking AutoInactiveDestroy attribute for drh');
-ok(!$drh->{PrintError}, '... checking PrintError attribute for drh');
-ok( $drh->{PrintWarn}, '... checking PrintWarn attribute for drh'); # true because of perl -w above
-ok(!$drh->{RaiseError}, '... checking RaiseError attribute for drh');
-ok(!$drh->{ShowErrorStatement}, '... checking ShowErrorStatement attribute for drh');
-ok(!$drh->{ChopBlanks}, '... checking ChopBlanks attribute for drh');
-ok(!$drh->{LongTruncOk}, '... checking LongTrunkOk attribute for drh');
-ok(!$drh->{TaintIn}, '... checking TaintIn attribute for drh');
-ok(!$drh->{TaintOut}, '... checking TaintOut attribute for drh');
-ok(!$drh->{Taint}, '... checking Taint attribute for drh');
-
-SKIP: {
- skip "Executed attribute not supported under DBI::PurePerl", 1 if $DBI::PurePerl;
-
- ok($drh->{Executed}, '... checking Executed attribute for drh') # due to the do() above
-}
-
-SKIP: {
- skip "Kids and ActiveKids attribute not supported under DBI::PurePerl", 2 if ($DBI::PurePerl or $dbh->{mx_handle_list});
- cmp_ok($drh->{Kids}, '==', 1, '... checking Kids attribute for drh');
- cmp_ok($drh->{ActiveKids}, '==', 1, '... checking ActiveKids attribute for drh');
-}
-
-is($drh->{CachedKids}, undef, '... checking CachedKids attribute for drh');
-ok(!defined $drh->{HandleError}, '... checking HandleError attribute for drh');
-ok(!defined $drh->{Profile}, '... checking Profile attribute for drh');
-ok(!defined $drh->{ReadOnly}, '... checking ReadOnly attribute for drh');
-
-cmp_ok($drh->{TraceLevel}, '==', $DBI::dbi_debug & 0xF, '... checking TraceLevel attribute for drh');
-cmp_ok($drh->{LongReadLen}, '==', 80, '... checking LongReadLen attribute for drh');
-
-is($drh->{FetchHashKeyName}, 'NAME', '... checking FetchHashKeyName attribute for drh');
-is($drh->{Name}, 'ExampleP', '... checking Name attribute for drh')
- unless $using_autoproxy && ok(1);
-
-## ----------------------------------------------------------------------------
-# Test the statement handle attributes.
-
-# Create a statement handle.
-my $sth = $dbh->prepare("select ctime, name from ?");
-isa_ok($sth, "DBI::st");
-
-ok(!$sth->{Executed}, '... checking Executed attribute for sth');
-ok(!$dbh->{Executed}, '... checking Executed attribute for dbh');
-cmp_ok($sth->{ErrCount}, '==', 0, '... checking ErrCount attribute for sth');
-
-# Trigger an exception.
-eval {
- $sth->execute("foo")
-};
-# we don't check actual opendir error msg because of locale differences
-like($@, qr/^DBD::\w+::st execute failed: .*opendir\(foo\): /msi, '... checking exception');
-
-# Test all of the statement handle attributes.
-like($sth->errstr, qr/opendir\(foo\): /, '... checking $sth->errstr');
-is($sth->state, 'S1000', '... checking $sth->state');
-ok($sth->{Executed}, '... checking Executed attribute for sth'); # even though it failed
-ok($dbh->{Executed}, '... checking Exceuted attribute for dbh'); # due to $sth->prepare, even though it failed
-
-cmp_ok($sth->{ErrCount}, '==', 1, '... checking ErrCount attribute for sth');
-
-$sth->{ErrCount} = 0;
-cmp_ok($sth->{ErrCount}, '==', 0, '... checking ErrCount attribute for sth (after reset)');
-
-# booleans
-ok( $sth->{Warn}, '... checking Warn attribute for sth');
-ok(!$sth->{Active}, '... checking Active attribute for sth');
-ok(!$sth->{CompatMode}, '... checking CompatMode attribute for sth');
-ok(!$sth->{InactiveDestroy}, '... checking InactiveDestroy attribute for sth');
-ok(!$sth->{AutoInactiveDestroy}, '... checking AutoInactiveDestroy attribute for sth');
-ok(!$sth->{PrintError}, '... checking PrintError attribute for sth');
-ok( $sth->{PrintWarn}, '... checking PrintWarn attribute for sth');
-ok( $sth->{RaiseError}, '... checking RaiseError attribute for sth');
-ok(!$sth->{ShowErrorStatement}, '... checking ShowErrorStatement attribute for sth');
-ok(!$sth->{ChopBlanks}, '... checking ChopBlanks attribute for sth');
-ok(!$sth->{LongTruncOk}, '... checking LongTrunkOk attribute for sth');
-ok(!$sth->{TaintIn}, '... checking TaintIn attribute for sth');
-ok(!$sth->{TaintOut}, '... checking TaintOut attribute for sth');
-ok(!$sth->{Taint}, '... checking Taint attribute for sth');
-
-# common attr
-SKIP: {
- skip "Kids and ActiveKids attribute not supported under DBI::PurePerl", 2 if $DBI::PurePerl;
- cmp_ok($sth->{Kids}, '==', 0, '... checking Kids attribute for sth');
- cmp_ok($sth->{ActiveKids}, '==', 0, '... checking ActiveKids attribute for sth');
-}
-
-ok(!defined $sth->{CachedKids}, '... checking CachedKids attribute for sth');
-ok(!defined $sth->{HandleError}, '... checking HandleError attribute for sth');
-ok(!defined $sth->{Profile}, '... checking Profile attribute for sth');
-ok(!defined $sth->{ReadOnly}, '... checking ReadOnly attribute for sth');
-
-cmp_ok($sth->{TraceLevel}, '==', $DBI::dbi_debug & 0xF, '... checking TraceLevel attribute for sth');
-cmp_ok($sth->{LongReadLen}, '==', 80, '... checking LongReadLen attribute for sth');
-
-is($sth->{FetchHashKeyName}, 'NAME', '... checking FetchHashKeyName attribute for sth');
-
-# sth specific attr
-ok(!defined $sth->{CursorName}, '... checking CursorName attribute for sth');
-
-cmp_ok($sth->{NUM_OF_FIELDS}, '==', 2, '... checking NUM_OF_FIELDS attribute for sth');
-cmp_ok($sth->{NUM_OF_PARAMS}, '==', 1, '... checking NUM_OF_PARAMS attribute for sth');
-
-my $name = $sth->{NAME};
-is(ref($name), 'ARRAY', '... checking type of NAME attribute for sth');
-cmp_ok(scalar(@{$name}), '==', 2, '... checking number of elements returned');
-is_deeply($name, ['ctime', 'name' ], '... checking values returned');
-
-my $name_lc = $sth->{NAME_lc};
-is(ref($name_lc), 'ARRAY', '... checking type of NAME_lc attribute for sth');
-cmp_ok(scalar(@{$name_lc}), '==', 2, '... checking number of elements returned');
-is_deeply($name_lc, ['ctime', 'name' ], '... checking values returned');
-
-my $name_uc = $sth->{NAME_uc};
-is(ref($name_uc), 'ARRAY', '... checking type of NAME_uc attribute for sth');
-cmp_ok(scalar(@{$name_uc}), '==', 2, '... checking number of elements returned');
-is_deeply($name_uc, ['CTIME', 'NAME' ], '... checking values returned');
-
-my $nhash = $sth->{NAME_hash};
-is(ref($nhash), 'HASH', '... checking type of NAME_hash attribute for sth');
-cmp_ok(scalar(keys(%{$nhash})), '==', 2, '... checking number of keys returned');
-cmp_ok($nhash->{ctime}, '==', 0, '... checking values returned');
-cmp_ok($nhash->{name}, '==', 1, '... checking values returned');
-
-my $nhash_lc = $sth->{NAME_lc_hash};
-is(ref($nhash_lc), 'HASH', '... checking type of NAME_lc_hash attribute for sth');
-cmp_ok(scalar(keys(%{$nhash_lc})), '==', 2, '... checking number of keys returned');
-cmp_ok($nhash_lc->{ctime}, '==', 0, '... checking values returned');
-cmp_ok($nhash_lc->{name}, '==', 1, '... checking values returned');
-
-my $nhash_uc = $sth->{NAME_uc_hash};
-is(ref($nhash_uc), 'HASH', '... checking type of NAME_uc_hash attribute for sth');
-cmp_ok(scalar(keys(%{$nhash_uc})), '==', 2, '... checking number of keys returned');
-cmp_ok($nhash_uc->{CTIME}, '==', 0, '... checking values returned');
-cmp_ok($nhash_uc->{NAME}, '==', 1, '... checking values returned');
-
-if (
- ! $using_autoproxy
- and
- # Older Storable does not work properly with tied handles
- # Instead of hard-depending on newer Storable, just skip this
- # particular test outright
- eval { Storable->VERSION("2.16") }
-) {
- # set ability to set sth attributes that are usually set internally
- for $a (qw(NAME NAME_lc NAME_uc NAME_hash NAME_lc_hash NAME_uc_hash)) {
- my $v = $sth->{$a};
- ok(eval { $sth->{$a} = dclone($sth->{$a}) }, "Can set sth $a");
- is_deeply($sth->{$a}, $v, "Can get set sth $a");
- }
-}
-
-my $type = $sth->{TYPE};
-is(ref($type), 'ARRAY', '... checking type of TYPE attribute for sth');
-cmp_ok(scalar(@{$type}), '==', 2, '... checking number of elements returned');
-is_deeply($type, [ 4, 12 ], '... checking values returned');
-
-my $null = $sth->{NULLABLE};
-is(ref($null), 'ARRAY', '... checking type of NULLABLE attribute for sth');
-cmp_ok(scalar(@{$null}), '==', 2, '... checking number of elements returned');
-is_deeply($null, [ 0, 0 ], '... checking values returned');
-
-# Should these work? They don't.
-my $prec = $sth->{PRECISION};
-is(ref($prec), 'ARRAY', '... checking type of PRECISION attribute for sth');
-cmp_ok(scalar(@{$prec}), '==', 2, '... checking number of elements returned');
-is_deeply($prec, [ 10, 1024 ], '... checking values returned');
-
-my $scale = $sth->{SCALE};
-is(ref($scale), 'ARRAY', '... checking type of SCALE attribute for sth');
-cmp_ok(scalar(@{$scale}), '==', 2, '... checking number of elements returned');
-is_deeply($scale, [ 0, 0 ], '... checking values returned');
-
-my $params = $sth->{ParamValues};
-is(ref($params), 'HASH', '... checking type of ParamValues attribute for sth');
-is($params->{1}, 'foo', '... checking values returned');
-
-is($sth->{Statement}, "select ctime, name from ?", '... checking Statement attribute for sth');
-ok(!defined $sth->{RowsInCache}, '... checking type of RowsInCache attribute for sth');
-
-is $sth->{examplep_private_sth_attrib}, 24, 'should see driver-private sth attribute value';
-
-# $h->{TraceLevel} tests are in t/09trace.t
-
-note "Checking inheritance\n";
-
-SKIP: {
- skip "drh->dbh->sth inheritance test skipped with DBI_AUTOPROXY", 2 if $ENV{DBI_AUTOPROXY};
-
-sub check_inherited {
- my ($drh, $attr, $value, $skip_sth) = @_;
- local $drh->{$attr} = $value;
- local $drh->{PrintError} = 1;
- my $dbh = $drh->connect("dummy");
- is $dbh->{$attr}, $drh->{$attr}, "dbh $attr value should be inherited from drh";
- unless ($skip_sth) {
- my $sth = $dbh->prepare("select name from .");
- is $sth->{$attr}, $dbh->{$attr}, "sth $attr value should be inherited from dbh";
- }
-}
-
-check_inherited($drh, "ReadOnly", 1, 0);
-
-}
-
-done_testing();
-
-1;
-# end
+++ /dev/null
-#!perl -w
-$|=1;
-
-use strict;
-
-use Test::More;
-
-use DBI 1.50; # also tests Exporter::require_version
-
-BEGIN {
- plan skip_all => '$h->{Kids} attribute not supported for DBI::PurePerl'
- if $DBI::PurePerl && $DBI::PurePerl; # doubled to avoid typo warning
- plan tests => 20;
-}
-
-## ----------------------------------------------------------------------------
-## 07kids.t
-## ----------------------------------------------------------------------------
-# This test check the Kids and the ActiveKids attributes and how they act
-# in various situations.
-#
-# Check the database handle's kids:
-# - upon creation of handle
-# - upon creation of statement handle
-# - after execute of statement handle
-# - after finish of statement handle
-# - after destruction of statement handle
-# Check the driver handle's kids:
-# - after creation of database handle
-# - after disconnection of database handle
-# - after destruction of database handle
-## ----------------------------------------------------------------------------
-
-
-# Connect to the example driver and create a database handle
-my $dbh = DBI->connect('dbi:ExampleP:dummy', '', '',
- {
- PrintError => 1,
- RaiseError => 0
- });
-
-# check our database handle to make sure its good
-isa_ok($dbh, 'DBI::db');
-
-# check that it has no Kids or ActiveKids yet
-cmp_ok($dbh->{Kids}, '==', 0, '... database handle has 0 Kid(s) at start');
-cmp_ok($dbh->{ActiveKids}, '==', 0, '... database handle has 0 ActiveKid(s) at start');
-
-# create a scope for our $sth to live and die in
-do {
-
- # create a statement handle
- my $sth = $dbh->prepare('select uid from ./');
-
- # verify that it is a correct statement handle
- isa_ok($sth, "DBI::st");
-
- # check our Kids and ActiveKids after prepare
- cmp_ok($dbh->{Kids}, '==', 1, '... database handle has 1 Kid(s) after $dbh->prepare');
- cmp_ok($dbh->{ActiveKids}, '==', 0, '... database handle has 0 ActiveKid(s) after $dbh->prepare');
-
- $sth->execute();
-
- # check our Kids and ActiveKids after execute
- cmp_ok($dbh->{Kids}, '==', 1, '... database handle has 1 Kid(s) after $sth->execute');
- cmp_ok($dbh->{ActiveKids}, '==', 1, '... database handle has 1 ActiveKid(s) after $sth->execute');
-
- $sth->finish();
-
- # check our Kids and Activekids after finish
- cmp_ok($dbh->{Kids}, '==', 1, '... database handle has 1 Kid(s) after $sth->finish');
- cmp_ok($dbh->{ActiveKids}, '==', 0, '... database handle has 0 ActiveKid(s) after $sth->finish');
-
-};
-
-# now check it after the statement handle has been destroyed
-cmp_ok($dbh->{Kids}, '==', 0, '... database handle has 0 Kid(s) after $sth is destroyed');
-cmp_ok($dbh->{ActiveKids}, '==', 0, '... database handle has 0 ActiveKid(s) after $sth is destroyed');
-
-# get the database handles driver Driver
-my $drh = $dbh->{Driver};
-
-# check that is it a correct driver handle
-isa_ok($drh, "DBI::dr");
-
-# check the driver's Kids and ActiveKids
-cmp_ok( $drh->{Kids}, '==', 1, '... driver handle has 1 Kid(s)');
-cmp_ok( $drh->{ActiveKids}, '==', 1, '... driver handle has 1 ActiveKid(s)');
-
-$dbh->disconnect;
-
-# check the driver's Kids and ActiveKids after $dbh->disconnect
-cmp_ok( $drh->{Kids}, '==', 1, '... driver handle has 1 Kid(s) after $dbh->disconnect');
-cmp_ok( $drh->{ActiveKids}, '==', 0, '... driver handle has 0 ActiveKid(s) after $dbh->disconnect');
-
-undef $dbh;
-ok(!defined($dbh), '... lets be sure that $dbh is not undefined');
-
-# check the driver's Kids and ActiveKids after undef $dbh
-cmp_ok( $drh->{Kids}, '==', 0, '... driver handle has 0 Kid(s) after undef $dbh');
-cmp_ok( $drh->{ActiveKids}, '==', 0, '... driver handle has 0 ActiveKid(s) after undef $dbh');
-
+++ /dev/null
-#!perl -w
-
-use strict;
-
-use Test::More;
-
-## ----------------------------------------------------------------------------
-## 08keeperr.t
-## ----------------------------------------------------------------------------
-#
-## ----------------------------------------------------------------------------
-
-BEGIN {
- use_ok('DBI');
-}
-
-$|=1;
-$^W=1;
-
-## ----------------------------------------------------------------------------
-# subclass DBI
-
-# DBI subclass
-package My::DBI;
-use base 'DBI';
-
-# Database handle subclass
-package My::DBI::db;
-use base 'DBI::db';
-
-# Statement handle subclass
-package My::DBI::st;
-use base 'DBI::st';
-
-sub execute {
- my $sth = shift;
- # we localize an attribute here to check that the corresponding STORE
- # at scope exit doesn't clear any recorded error
- local $sth->{Warn} = 0;
- my $rv = $sth->SUPER::execute(@_);
- return $rv;
-}
-
-
-## ----------------------------------------------------------------------------
-# subclass the subclass of DBI
-
-package Test;
-
-use strict;
-use base 'My::DBI';
-
-use DBI;
-
-my @con_info = ('dbi:ExampleP:.', undef, undef, { PrintError => 0, RaiseError => 1 });
-
-sub test_select {
- my $dbh = shift;
- eval { $dbh->selectrow_arrayref('select * from foo') };
- $dbh->disconnect;
- return $@;
-}
-
-my $err1 = test_select( My::DBI->connect(@con_info) );
-Test::More::like($err1, qr/^DBD::(ExampleP|Multiplex|Gofer)::db selectrow_arrayref failed: opendir/, '... checking error');
-
-my $err2 = test_select( DBI->connect(@con_info) );
-Test::More::like($err2, qr/^DBD::(ExampleP|Multiplex|Gofer)::db selectrow_arrayref failed: opendir/, '... checking error');
-
-package main;
-
-my $using_dbd_gofer = ( $ENV{DBI_AUTOPROXY} || '' ) =~ /^dbi:Gofer.*transport=/i;
-
-
-# test ping does not destroy the errstr
-sub ping_keeps_err {
- my $dbh = DBI->connect('DBI:ExampleP:', undef, undef, { PrintError => 0 });
-
- $dbh->set_err(42, "ERROR 42");
- is $dbh->err, 42;
- is $dbh->errstr, "ERROR 42";
- ok $dbh->ping, "ping returns true";
- is $dbh->err, 42, "err unchanged after ping";
- is $dbh->errstr, "ERROR 42", "errstr unchanged after ping";
-
- $dbh->disconnect;
-
- $dbh->set_err(42, "ERROR 42");
- is $dbh->err, 42, "err unchanged after ping";
- is $dbh->errstr, "ERROR 42", "errstr unchanged after ping";
- ok !$dbh->ping, "ping returns false";
- # it's reasonable for ping() to set err/errstr if it fails
- # so here we just test that there is an error
- ok $dbh->err, "err true after failed ping";
- ok $dbh->errstr, "errstr true after failed ping";
-
-
- # for a driver which doesn't have its own ping
- $dbh = DBI->connect('DBI:Sponge:', undef, undef, { PrintError => 0 });
- $dbh->STORE(Active => 1);
-
- $dbh->set_err(42, "ERROR 42");
- is $dbh->err, 42;
- is $dbh->errstr, "ERROR 42";
- ok $dbh->ping, "ping returns true: ".$dbh->ping;
- is $dbh->err, 42, "err unchanged after ping";
- is $dbh->errstr, "ERROR 42", "errstr unchanged after ping";
-
- $dbh->disconnect;
- $dbh->STORE(Active => 0);
-
- $dbh->set_err(42, "ERROR 42");
- is $dbh->err, 42, "err unchanged after ping";
- is $dbh->errstr, "ERROR 42", "errstr unchanged after ping";
- ok !$dbh->ping, "ping returns false";
- # it's reasonable for ping() to set err/errstr if it fails
- # so here we just test that there is an error
- ok $dbh->err, "err true after failed ping";
- ok $dbh->errstr, "errstr true after failed ping";
-
-}
-
-## ----------------------------------------------------------------------------
-print "Test HandleSetErr\n";
-
-my $dbh = DBI->connect(@con_info);
-isa_ok($dbh, "DBI::db");
-
-$dbh->{RaiseError} = 1;
-$dbh->{PrintError} = 1;
-$dbh->{PrintWarn} = 1;
-
-# warning handler
-my %warn;
-my @handlewarn;
-
-sub reset_warn_counts {
- %warn = ( failed => 0, warning => 0 );
- @handlewarn = (0,0,0);
-}
-reset_warn_counts();
-
-$SIG{__WARN__} = sub {
- my $msg = shift;
- if ($msg =~ /^DBD::\w+::\S+\s+(\S+)\s+(\w+)/) {
- ++$warn{$2};
- $msg =~ s/\n/\\n/g;
- print "warn: '$msg'\n";
- return;
- }
- warn $msg;
-};
-
-# HandleSetErr handler
-$dbh->{HandleSetErr} = sub {
- my ($h, $err, $errstr, $state) = @_;
- return 0
- unless defined $err;
- ++$handlewarn[ $err ? 2 : length($err) ]; # count [info, warn, err] calls
- return 1
- if $state && $state eq "return"; # for tests
- ($_[1], $_[2], $_[3]) = (99, "errstr99", "OV123")
- if $state && $state eq "override"; # for tests
- return 0
- if $err; # be transparent for errors
- local $^W;
- print "HandleSetErr called: h=$h, err=$err, errstr=$errstr, state=$state\n";
- return 0;
-};
-
-# start our tests
-
-ok(!defined $DBI::err, '... $DBI::err is not defined');
-
-# ----
-
-$dbh->set_err("", "(got info)");
-
-ok(defined $DBI::err, '... $DBI::err is defined'); # true
-is($DBI::err, "", '... $DBI::err is an empty string');
-is($DBI::errstr, "(got info)", '... $DBI::errstr is as we expected');
-is($dbh->errstr, "(got info)", '... $dbh->errstr matches $DBI::errstr');
-cmp_ok($warn{failed}, '==', 0, '... $warn{failed} is 0');
-cmp_ok($warn{warning}, '==', 0, '... $warn{warning} is 0');
-is_deeply(\@handlewarn, [ 1, 0, 0 ], '... the @handlewarn array is (1, 0, 0)');
-
-# ----
-
-$dbh->set_err(0, "(got warn)", "AA001"); # triggers PrintWarn
-
-ok(defined $DBI::err, '... $DBI::err is defined');
-is($DBI::err, "0", '... $DBI::err is "0"');
-is($DBI::errstr, "(got info)\n(got warn)",
- '... $DBI::errstr is as we expected');
-is($dbh->errstr, "(got info)\n(got warn)",
- '... $dbh->errstr matches $DBI::errstr');
-is($DBI::state, "AA001", '... $DBI::state is AA001');
-cmp_ok($warn{warning}, '==', 1, '... $warn{warning} is 1');
-is_deeply(\@handlewarn, [ 1, 1, 0 ], '... the @handlewarn array is (1, 1, 0)');
-
-
-# ----
-
-$dbh->set_err("", "(got more info)"); # triggers PrintWarn
-
-ok(defined $DBI::err, '... $DBI::err is defined');
-is($DBI::err, "0", '... $DBI::err is "0"'); # not "", ie it's still a warn
-is($dbh->err, "0", '... $dbh->err is "0"');
-is($DBI::state, "AA001", '... $DBI::state is AA001');
-is($DBI::errstr, "(got info)\n(got warn)\n(got more info)",
- '... $DBI::errstr is as we expected');
-is($dbh->errstr, "(got info)\n(got warn)\n(got more info)",
- '... $dbh->errstr matches $DBI::errstr');
-cmp_ok($warn{warning}, '==', 2, '... $warn{warning} is 2');
-is_deeply(\@handlewarn, [ 2, 1, 0 ], '... the @handlewarn array is (2, 1, 0)');
-
-# ----
-
-$dbh->{RaiseError} = 0;
-$dbh->{PrintError} = 1;
-
-# ----
-
-$dbh->set_err("42", "(got error)", "AA002");
-
-ok(defined $DBI::err, '... $DBI::err is defined');
-cmp_ok($DBI::err, '==', 42, '... $DBI::err is 42');
-cmp_ok($warn{warning}, '==', 2, '... $warn{warning} is 2');
-is($dbh->errstr, "(got info)\n(got warn)\n(got more info) [state was AA001 now AA002]\n(got error)",
- '... $dbh->errstr is as we expected');
-is($DBI::state, "AA002", '... $DBI::state is AA002');
-is_deeply(\@handlewarn, [ 2, 1, 1 ], '... the @handlewarn array is (2, 1, 1)');
-
-# ----
-
-$dbh->set_err("", "(got info)");
-
-ok(defined $DBI::err, '... $DBI::err is defined');
-cmp_ok($DBI::err, '==', 42, '... $DBI::err is 42');
-cmp_ok($warn{warning}, '==', 2, '... $warn{warning} is 2');
-is($dbh->errstr, "(got info)\n(got warn)\n(got more info) [state was AA001 now AA002]\n(got error)\n(got info)",
- '... $dbh->errstr is as we expected');
-is_deeply(\@handlewarn, [ 3, 1, 1 ], '... the @handlewarn array is (3, 1, 1)');
-
-# ----
-
-$dbh->set_err("0", "(got warn)"); # no PrintWarn because it's already an err
-
-ok(defined $DBI::err, '... $DBI::err is defined');
-cmp_ok($DBI::err, '==', 42, '... $DBI::err is 42');
-cmp_ok($warn{warning}, '==', 2, '... $warn{warning} is 2');
-is($dbh->errstr, "(got info)\n(got warn)\n(got more info) [state was AA001 now AA002]\n(got error)\n(got info)\n(got warn)",
- '... $dbh->errstr is as we expected');
-is_deeply(\@handlewarn, [ 3, 2, 1 ], '... the @handlewarn array is (3, 2, 1)');
-
-# ----
-
-$dbh->set_err("4200", "(got new error)", "AA003");
-
-ok(defined $DBI::err, '... $DBI::err is defined');
-cmp_ok($DBI::err, '==', 4200, '... $DBI::err is 4200');
-cmp_ok($warn{warning}, '==', 2, '... $warn{warning} is 2');
-is($dbh->errstr, "(got info)\n(got warn)\n(got more info) [state was AA001 now AA002]\n(got error)\n(got info)\n(got warn) [err was 42 now 4200] [state was AA002 now AA003]\n(got new error)",
- '... $dbh->errstr is as we expected');
-is_deeply(\@handlewarn, [ 3, 2, 2 ], '... the @handlewarn array is (3, 2, 2)');
-
-# ----
-
-$dbh->set_err(undef, "foo", "bar"); # clear error
-
-ok(!defined $dbh->errstr, '... $dbh->errstr is defined');
-ok(!defined $dbh->err, '... $dbh->err is defined');
-is($dbh->state, "", '... $dbh->state is an empty string');
-
-# ----
-
-reset_warn_counts();
-
-# ----
-
-my @ret;
-@ret = $dbh->set_err(1, "foo"); # PrintError
-
-cmp_ok(scalar(@ret), '==', 1, '... only returned one value');
-ok(!defined $ret[0], '... the first value is undefined');
-ok(!defined $dbh->set_err(2, "bar"), '... $dbh->set_err returned undefiend'); # PrintError
-ok(!defined $dbh->set_err(3, "baz"), '... $dbh->set_err returned undefiend'); # PrintError
-ok(!defined $dbh->set_err(0, "warn"), '... $dbh->set_err returned undefiend'); # PrintError
-is($dbh->errstr, "foo [err was 1 now 2]\nbar [err was 2 now 3]\nbaz\nwarn",
- '... $dbh->errstr is as we expected');
-is($warn{failed}, 4, '... $warn{failed} is 4');
-is_deeply(\@handlewarn, [ 0, 1, 3 ], '... the @handlewarn array is (0, 1, 3)');
-
-# ----
-
-$dbh->set_err(undef, undef, undef); # clear error
-
-@ret = $dbh->set_err(1, "foo", "AA123", "method");
-cmp_ok(scalar @ret, '==', 1, '... only returned one value');
-ok(!defined $ret[0], '... the first value is undefined');
-
-@ret = $dbh->set_err(1, "foo", "AA123", "method", "42");
-cmp_ok(scalar @ret, '==', 1, '... only returned one value');
-is($ret[0], "42", '... the first value is "42"');
-
-@ret = $dbh->set_err(1, "foo", "return");
-cmp_ok(scalar @ret, '==', 0, '... returned no values');
-
-# ----
-
-$dbh->set_err(undef, undef, undef); # clear error
-
-@ret = $dbh->set_err("", "info", "override");
-cmp_ok(scalar @ret, '==', 1, '... only returned one value');
-ok(!defined $ret[0], '... the first value is undefined');
-cmp_ok($dbh->err, '==', 99, '... $dbh->err is 99');
-is($dbh->errstr, "errstr99", '... $dbh->errstr is as we expected');
-is($dbh->state, "OV123", '... $dbh->state is as we expected');
-$dbh->disconnect;
-
-# ---
-
-ping_keeps_err();
-
-# ---
-
-reset_warn_counts();
-
-SKIP: {
- # we could test this with gofer is we used a different keep_err method other than STORE
- # to trigger the set_err calls
- skip 'set_err keep_error skipped for Gofer', 2
- if $using_dbd_gofer;
-
- $dbh->{examplep_set_err} = ""; # set information state
- cmp_ok($warn{warning}, '==', 0, 'no extra warning generated for set_err("") in STORE');
-
- $dbh->{examplep_set_err} = "0"; # set warning state
- cmp_ok($warn{warning}, '==', 1, 'warning generated for set_err("0") in STORE');
-}
-
-# ---
-
-# ----
-done_testing();
-
-1;
-# end
+++ /dev/null
-#!perl -w
-# vim:sw=4:ts=8
-
-use strict;
-
-use Test::More tests => 99;
-
-## ----------------------------------------------------------------------------
-## 09trace.t
-## ----------------------------------------------------------------------------
-#
-## ----------------------------------------------------------------------------
-
-BEGIN {
- $ENV{DBI_TRACE} = 0; # for PurePerl - ensure DBI_TRACE is in the env
- use_ok( 'DBI' );
-}
-
-$|=1;
-
-
-my $trace_file = "dbitrace$$.log";
-
-1 while unlink $trace_file;
-warn "Can't unlink existing $trace_file: $!" if -e $trace_file;
-
-my $orig_trace_level = DBI->trace;
-DBI->trace(3, $trace_file); # enable trace before first driver load
-
-my $dbh = DBI->connect('dbi:ExampleP(AutoCommit=>1):', undef, undef);
-die "Unable to connect to ExampleP driver: $DBI::errstr" unless $dbh;
-
-isa_ok($dbh, 'DBI::db');
-
-$dbh->dump_handle("dump_handle test, write to log file", 2);
-
-DBI->trace(0, undef); # turn off and restore to STDERR
-
-SKIP: {
- skip "cygwin has buffer flushing bug", 1 if ($^O =~ /cygwin/i);
- ok( -s $trace_file, "trace file size = " . -s $trace_file);
-}
-
-DBI->trace($orig_trace_level); # no way to restore previous outfile XXX
-
-
-# Clean up when we're done.
-END { $dbh->disconnect if $dbh;
- 1 while unlink $trace_file; };
-
-## ----------------------------------------------------------------------------
-# Check the database handle attributes.
-
-cmp_ok($dbh->{TraceLevel}, '==', $DBI::dbi_debug & 0xF, '... checking TraceLevel attribute');
-
-1 while unlink $trace_file;
-
-$dbh->trace(0, $trace_file);
-ok( -f $trace_file, '... trace file successfully created');
-
-my @names = qw(
- SQL
- CON
- ENC
- DBD
- TXN
- foo bar baz boo bop
-);
-my %flag;
-my $all_flags = 0;
-
-foreach my $name (@names) {
- print "parse_trace_flag $name\n";
- ok( my $flag1 = $dbh->parse_trace_flag($name) );
- ok( my $flag2 = $dbh->parse_trace_flags($name) );
- is( $flag1, $flag2 );
-
- $dbh->{TraceLevel} = $flag1;
- is( $dbh->{TraceLevel}, $flag1 );
-
- $dbh->{TraceLevel} = 0;
- is( $dbh->{TraceLevel}, 0 );
-
- $dbh->trace($flag1);
- is $dbh->trace, $flag1;
- is $dbh->{TraceLevel}, $flag1;
-
- $dbh->{TraceLevel} = $name; # set by name
- $dbh->{TraceLevel} = undef; # check no change on undef
- is( $dbh->{TraceLevel}, $flag1 );
-
- $flag{$name} = $flag1;
- $all_flags |= $flag1
- if defined $flag1; # reduce noise if there's a bug
-}
-
-print "parse_trace_flag @names\n";
-ok(eq_set([ keys %flag ], [ @names ]), '...');
-$dbh->{TraceLevel} = 0;
-$dbh->{TraceLevel} = join "|", @names;
-is($dbh->{TraceLevel}, $all_flags, '...');
-
-{
- print "inherit\n";
- my $sth = $dbh->prepare("select ctime, name from foo");
- isa_ok( $sth, 'DBI::st' );
- is( $sth->{TraceLevel}, $all_flags );
-}
-
-$dbh->{TraceLevel} = 0;
-ok !$dbh->{TraceLevel};
-$dbh->{TraceLevel} = 'ALL';
-ok $dbh->{TraceLevel};
-
-{
- print "test unknown parse_trace_flag\n";
- my $warn = 0;
- local $SIG{__WARN__} = sub {
- if ($_[0] =~ /unknown/i) { ++$warn; print "caught warn: ",@_ }else{ warn @_ }
- };
- is $dbh->parse_trace_flag("nonesuch"), undef;
- is $warn, 0;
- is $dbh->parse_trace_flags("nonesuch"), 0;
- is $warn, 1;
- is $dbh->parse_trace_flags("nonesuch|SQL|nonesuch2"), $dbh->parse_trace_flag("SQL");
- is $warn, 2;
-}
-
-$dbh->dump_handle("dump_handle test, write to log file", 2);
-
-$dbh->trace(0);
-ok !$dbh->{TraceLevel};
-$dbh->trace(undef, "STDERR"); # close $trace_file
-ok( -s $trace_file );
-
-1;
-# end
+++ /dev/null
-#!perl -w
-
-use lib qw(blib/arch blib/lib); # needed since -T ignores PERL5LIB
-use DBI qw(:sql_types);
-use Config;
-use Cwd;
-use strict;
-use Data::Dumper;
-
-$^W = 1;
-$| = 1;
-
-require File::Basename;
-require File::Spec;
-require VMS::Filespec if $^O eq 'VMS';
-
-use Test::More tests => 242;
-
-do {
- # provide some protection against growth in size of '.' during the test
- # which was probable cause of this failure
- # http://www.nntp.perl.org/group/perl.cpan.testers/2009/09/msg5297317.html
- my $tmpfile = "deleteme_$$";
- open my $fh, ">$tmpfile";
- close $fh;
- unlink $tmpfile;
-};
-
-# "globals"
-my ($r, $dbh);
-
-ok !eval {
- $dbh = DBI->connect("dbi:NoneSuch:foobar", 1, 1, { RaiseError => 1, AutoCommit => 1 });
-}, 'connect should fail';
-like($@, qr/install_driver\(NoneSuch\) failed/, '... we should have an exception here');
-ok(!$dbh, '... $dbh2 should not be defined');
-
-{
- my ($error, $tdbh);
- eval {
- $tdbh = DBI->connect('dbi:ExampleP:', '', []);
- } or do {
- $error= $@ || "Zombie Error";
- };
- like($error,qr/Usage:/,"connect with unblessed ref password should fail");
- ok(!defined($tdbh), '... $dbh should not be defined');
-}
-{
- package Test::Secret;
- use overload '""' => sub { return "" };
-}
-{
- my ($error,$tdbh);
- eval {
- $tdbh = DBI->connect('dbi:ExampleP:', '', bless [], "Test::Secret");
- } or do {
- $error= $@ || "Zombie Error";
- };
- ok(!$error,"connect with blessed ref password should not fail");
- ok(defined($tdbh), '... $dbh should be defined');
-}
-
-$dbh = DBI->connect('dbi:ExampleP:', '', '');
-
-sub check_connect_cached {
- # connect_cached
- # ------------------------------------------
- # This test checks that connect_cached works
- # and how it then relates to the CachedKids
- # attribute for the driver.
-
- ok my $dbh_cached_1 = DBI->connect_cached('dbi:ExampleP:', '', '', { TraceLevel=>0, Executed => 0 });
-
- ok my $dbh_cached_2 = DBI->connect_cached('dbi:ExampleP:', '', '', { TraceLevel=>0, Executed => 0 });
-
- is($dbh_cached_1, $dbh_cached_2, '... these 2 handles are cached, so they are the same');
-
- ok my $dbh_cached_3 = DBI->connect_cached('dbi:ExampleP:', '', '', { examplep_foo => 1 });
-
- isnt($dbh_cached_3, $dbh_cached_2, '... this handle was created with different parameters, so it is not the same');
-
- # check that cached_connect applies attributes to handles returned from the cache
- # (The specific case of Executed is relevant to DBD::Gofer retry-on-error logic)
- ok $dbh_cached_1->do("select * from ."); # set Executed flag
- ok $dbh_cached_1->{Executed}, 'Executed should be true';
- ok my $dbh_cached_4 = DBI->connect_cached('dbi:ExampleP:', '', '', { TraceLevel=>0, Executed => 0 });
- is $dbh_cached_4, $dbh_cached_1, 'should return same handle';
- ok !$dbh_cached_4->{Executed}, 'Executed should be false because reset by connect attributes';
-
- my $drh = $dbh->{Driver};
- isa_ok($drh, "DBI::dr");
-
- my @cached_kids = values %{$drh->{CachedKids}};
- ok(eq_set(\@cached_kids, [ $dbh_cached_1, $dbh_cached_3 ]), '... these are our cached kids');
-
- $drh->{CachedKids} = {};
- cmp_ok(scalar(keys %{$drh->{CachedKids}}), '==', 0, '... we have emptied out cache');
-}
-
-check_connect_cached();
-
-$dbh->{AutoCommit} = 1;
-$dbh->{PrintError} = 0;
-
-ok($dbh->{AutoCommit} == 1);
-cmp_ok($dbh->{PrintError}, '==', 0, '... PrintError should be 0');
-
-is($dbh->{FetchHashKeyName}, 'NAME', '... FetchHashKey is NAME');
-
-# test access to driver-private attributes
-like($dbh->{example_driver_path}, qr/DBD\/ExampleP\.pm$/, '... checking the example driver_path');
-
-print "others\n";
-eval { $dbh->commit('dummy') };
-ok($@ =~ m/DBI commit: invalid number of arguments:/, $@)
- unless $DBI::PurePerl && ok(1);
-
-ok($dbh->ping, "ping should return true");
-
-# --- errors
-my $cursor_e = $dbh->prepare("select unknown_field_name from ?");
-is($cursor_e, undef, "prepare should fail");
-ok($dbh->err, "sth->err should be true");
-ok($DBI::err, "DBI::err should be true");
-cmp_ok($DBI::err, 'eq', $dbh->err , "\$DBI::err should match \$dbh->err");
-like($DBI::errstr, qr/Unknown field names: unknown_field_name/, "\$DBI::errstr should contain error string");
-cmp_ok($DBI::errstr, 'eq', $dbh->errstr, "\$DBI::errstr should match \$dbh->errstr");
-
-# --- func
-ok($dbh->errstr eq $dbh->func('errstr'));
-
-my $std_sql = "select mode,size,name from ?";
-my $csr_a = $dbh->prepare($std_sql);
-ok(ref $csr_a);
-ok($csr_a->{NUM_OF_FIELDS} == 3);
-
-SKIP: {
- skip "inner/outer handles not fully supported for DBI::PurePerl", 3 if $DBI::PurePerl;
- ok(tied %{ $csr_a->{Database} }); # ie is 'outer' handle
- ok($csr_a->{Database} eq $dbh, "$csr_a->{Database} ne $dbh")
- unless $dbh->{mx_handle_list} && ok(1); # skip for Multiplex tests
- ok(tied %{ $csr_a->{Database}->{Driver} }); # ie is 'outer' handle
-}
-
-my $driver_name = $csr_a->{Database}->{Driver}->{Name};
-ok($driver_name eq 'ExampleP')
- unless $ENV{DBI_AUTOPROXY} && ok(1);
-
-# --- FetchHashKeyName
-$dbh->{FetchHashKeyName} = 'NAME_uc';
-my $csr_b = $dbh->prepare($std_sql);
-$csr_b->execute('.');
-ok(ref $csr_b);
-
-ok($csr_a != $csr_b);
-
-ok("@{$csr_b->{NAME_lc}}" eq "mode size name"); # before NAME
-ok("@{$csr_b->{NAME_uc}}" eq "MODE SIZE NAME");
-ok("@{$csr_b->{NAME}}" eq "mode size name");
-ok("@{$csr_b->{ $csr_b->{FetchHashKeyName} }}" eq "MODE SIZE NAME");
-
-ok("@{[sort keys %{$csr_b->{NAME_lc_hash}}]}" eq "mode name size");
-ok("@{[sort values %{$csr_b->{NAME_lc_hash}}]}" eq "0 1 2");
-ok("@{[sort keys %{$csr_b->{NAME_uc_hash}}]}" eq "MODE NAME SIZE");
-ok("@{[sort values %{$csr_b->{NAME_uc_hash}}]}" eq "0 1 2");
-
-do "./t/lib.pl";
-
-# get a dir always readable on all platforms
-#my $dir = getcwd() || cwd();
-#$dir = VMS::Filespec::unixify($dir) if $^O eq 'VMS';
-# untaint $dir
-#$dir =~ m/(.*)/; $dir = $1 || die;
-my $dir = test_dir ();
-
-# ---
-
-my($col0, $col1, $col2, $col3, $rows);
-my(@row_a, @row_b);
-
-ok($csr_a->bind_columns(undef, \($col0, $col1, $col2)) );
-ok($csr_a->execute( $dir ), $DBI::errstr);
-
-@row_a = $csr_a->fetchrow_array;
-ok(@row_a);
-
-# check bind_columns
-is($row_a[0], $col0);
-is($row_a[1], $col1);
-is($row_a[2], $col2);
-
-ok( ! $csr_a->bind_columns(undef, \($col0, $col1)) );
-like $csr_a->errstr, '/bind_columns called with 2 values but 3 are needed/', 'errstr should contain error message';
-ok( ! $csr_a->bind_columns(undef, \($col0, $col1, $col2, $col3)) );
-like $csr_a->errstr, '/bind_columns called with 4 values but 3 are needed/', 'errstr should contain error message';
-
-ok( $csr_a->bind_col(2, undef, { foo => 42 }) );
-ok ! eval { $csr_a->bind_col(0, undef) };
-like $@, '/bind_col: column 0 is not a valid column \(1..3\)/', 'errstr should contain error message';
-ok ! eval { $csr_a->bind_col(4, undef) };
-like $@, '/bind_col: column 4 is not a valid column \(1..3\)/', 'errstr should contain error message';
-
-ok($csr_b->bind_param(1, $dir));
-ok($csr_b->execute());
-@row_b = @{ $csr_b->fetchrow_arrayref };
-ok(@row_b);
-
-ok("@row_a" eq "@row_b");
-@row_b = $csr_b->fetchrow_array;
-ok("@row_a" ne "@row_b");
-
-ok($csr_a->finish);
-ok($csr_b->finish);
-
-$csr_a = undef; # force destruction of this cursor now
-ok(1);
-
-print "fetchrow_hashref('NAME_uc')\n";
-ok($csr_b->execute());
-my $row_b = $csr_b->fetchrow_hashref('NAME_uc');
-ok($row_b);
-ok($row_b->{MODE} == $row_a[0]);
-ok($row_b->{SIZE} == $row_a[1]);
-ok($row_b->{NAME} eq $row_a[2]);
-
-print "fetchrow_hashref('ParamValues')\n";
-ok($csr_b->execute());
-ok(!defined eval { $csr_b->fetchrow_hashref('ParamValues') } ); # PurePerl croaks
-
-print "FetchHashKeyName\n";
-ok($csr_b->execute());
-$row_b = $csr_b->fetchrow_hashref();
-ok($row_b);
-ok(keys(%$row_b) == 3);
-ok($row_b->{MODE} == $row_a[0]);
-ok($row_b->{SIZE} == $row_a[1]);
-ok($row_b->{NAME} eq $row_a[2]);
-
-print "fetchall_arrayref\n";
-ok($csr_b->execute());
-$r = $csr_b->fetchall_arrayref;
-ok($r);
-ok(@$r);
-ok($r->[0]->[0] == $row_a[0]);
-ok($r->[0]->[1] == $row_a[1]);
-ok($r->[0]->[2] eq $row_a[2]);
-
-print "fetchall_arrayref array slice\n";
-ok($csr_b->execute());
-$r = $csr_b->fetchall_arrayref([2,1]);
-ok($r && @$r);
-ok($r->[0]->[1] == $row_a[1]);
-ok($r->[0]->[0] eq $row_a[2]);
-
-print "fetchall_arrayref hash slice\n";
-ok($csr_b->execute());
-$r = $csr_b->fetchall_arrayref({ SizE=>1, nAMe=>1});
-ok($r && @$r);
-ok($r->[0]->{SizE} == $row_a[1]);
-ok($r->[0]->{nAMe} eq $row_a[2]);
-
-ok ! $csr_b->fetchall_arrayref({ NoneSuch=>1 });
-like $DBI::errstr, qr/Invalid column name/;
-
-print "fetchall_arrayref renaming hash slice\n";
-ok($csr_b->execute());
-$r = $csr_b->fetchall_arrayref(\{ 1 => "Koko", 2 => "Nimi"});
-ok($r && @$r);
-ok($r->[0]->{Koko} == $row_a[1]);
-ok($r->[0]->{Nimi} eq $row_a[2]);
-
-ok ! eval { $csr_b->fetchall_arrayref(\{ 9999 => "Koko" }) };
-like $@, qr/\Qis not a valid column/;
-
-print "fetchall_arrayref empty renaming hash slice\n";
-ok($csr_b->execute());
-$r = $csr_b->fetchall_arrayref(\{});
-ok($r && @$r);
-ok(keys %{$r->[0]} == 0);
-
-ok($csr_b->execute());
-ok(!$csr_b->fetchall_arrayref(\[]));
-like $DBI::errstr, qr/\Qfetchall_arrayref(REF) invalid/;
-
-print "fetchall_arrayref hash\n";
-ok($csr_b->execute());
-$r = $csr_b->fetchall_arrayref({});
-ok($r);
-ok(keys %{$r->[0]} == 3);
-ok("@{$r->[0]}{qw(MODE SIZE NAME)}" eq "@row_a", "'@{$r->[0]}{qw(MODE SIZE NAME)}' ne '@row_a'");
-
-print "rows()\n"; # assumes previous fetch fetched all rows
-$rows = $csr_b->rows;
-ok($rows > 0, "row count $rows");
-ok($rows == @$r, "$rows vs ".@$r);
-ok($rows == $DBI::rows, "$rows vs $DBI::rows");
-
-print "fetchall_arrayref array slice and max rows\n";
-ok($csr_b->execute());
-$r = $csr_b->fetchall_arrayref([0], 1);
-ok($r);
-is_deeply($r, [[$row_a[0]]]);
-
-$r = $csr_b->fetchall_arrayref([], 1);
-is @$r, 1, 'should fetch one row';
-
-$r = $csr_b->fetchall_arrayref([], 99999);
-ok @$r, 'should fetch all the remaining rows';
-
-$r = $csr_b->fetchall_arrayref([], 99999);
-is $r, undef, 'should return undef as there are no more rows';
-
-# ---
-
-print "selectrow_array\n";
-@row_b = $dbh->selectrow_array($std_sql, undef, $dir);
-ok(@row_b == 3);
-ok("@row_b" eq "@row_a");
-
-print "selectrow_hashref\n";
-$r = $dbh->selectrow_hashref($std_sql, undef, $dir);
-ok(keys %$r == 3);
-ok($r->{MODE} eq $row_a[0]);
-ok($r->{SIZE} eq $row_a[1]);
-ok($r->{NAME} eq $row_a[2]);
-
-print "selectall_arrayref\n";
-$r = $dbh->selectall_arrayref($std_sql, undef, $dir);
-ok($r);
-ok(@{$r->[0]} == 3);
-ok("@{$r->[0]}" eq "@row_a");
-ok(@$r == $rows);
-
-print "selectall_arrayref Slice array slice\n";
-$r = $dbh->selectall_arrayref($std_sql, { Slice => [ 2, 0 ] }, $dir);
-ok($r);
-ok(@{$r->[0]} == 2);
-ok("@{$r->[0]}" eq "$row_a[2] $row_a[0]", qq{"@{$r->[0]}" eq "$row_a[2] $row_a[0]"});
-ok(@$r == $rows);
-
-print "selectall_arrayref Columns array slice\n";
-$r = $dbh->selectall_arrayref($std_sql, { Columns => [ 3, 1 ] }, $dir);
-ok($r);
-ok(@{$r->[0]} == 2);
-ok("@{$r->[0]}" eq "$row_a[2] $row_a[0]", qq{"@{$r->[0]}" eq "$row_a[2] $row_a[0]"});
-ok(@$r == $rows);
-
-print "selectall_arrayref hash slice\n";
-$r = $dbh->selectall_arrayref($std_sql, { Columns => { MoDe=>1, NamE=>1 } }, $dir);
-ok($r);
-ok(keys %{$r->[0]} == 2);
-ok(exists $r->[0]{MoDe});
-ok(exists $r->[0]{NamE});
-ok($r->[0]{MoDe} eq $row_a[0]);
-ok($r->[0]{NamE} eq $row_a[2]);
-ok(@$r == $rows);
-
-print "selectall_array\n";
-$r = [ $dbh->selectall_array($std_sql, undef, $dir) ];
-ok($r);
-ok(@{$r->[0]} == 3);
-ok("@{$r->[0]}" eq "@row_a");
-ok(@$r == $rows);
-
-print "selectall_hashref\n";
-$r = $dbh->selectall_hashref($std_sql, 'NAME', undef, $dir);
-ok($r, "selectall_hashref result");
-is(ref $r, 'HASH', "selectall_hashref HASH: ".ref $r);
-is(scalar keys %$r, $rows);
-is($r->{ $row_a[2] }{SIZE}, $row_a[1], qq{$r->{ $row_a[2] }{SIZE} eq $row_a[1]});
-
-print "selectall_hashref by column number\n";
-$r = $dbh->selectall_hashref($std_sql, 3, undef, $dir);
-ok($r);
-ok($r->{ $row_a[2] }{SIZE} eq $row_a[1], qq{$r->{ $row_a[2] }{SIZE} eq $row_a[1]});
-
-print "selectcol_arrayref\n";
-$r = $dbh->selectcol_arrayref($std_sql, undef, $dir);
-ok($r);
-ok(@$r == $rows);
-ok($r->[0] eq $row_b[0]);
-
-print "selectcol_arrayref column slice\n";
-$r = $dbh->selectcol_arrayref($std_sql, { Columns => [3,2] }, $dir);
-ok($r);
-# warn Dumper([\@row_b, $r]);
-ok(@$r == $rows * 2);
-ok($r->[0] eq $row_b[2]);
-ok($r->[1] eq $row_b[1]);
-
-# ---
-
-print "others...\n";
-my $csr_c;
-$csr_c = $dbh->prepare("select unknown_field_name1 from ?");
-ok(!defined $csr_c);
-ok($DBI::errstr =~ m/Unknown field names: unknown_field_name1/);
-
-print "RaiseError & PrintError & ShowErrorStatement\n";
-$dbh->{RaiseError} = 1;
-ok($dbh->{RaiseError});
-$dbh->{ShowErrorStatement} = 1;
-ok($dbh->{ShowErrorStatement});
-
-my $error_sql = "select unknown_field_name2 from ?";
-
-ok(! eval { $csr_c = $dbh->prepare($error_sql); 1; });
-#print "$@\n";
-like $@, qr/\Q$error_sql/; # ShowErrorStatement
-like $@, qr/Unknown field names: unknown_field_name2/;
-
-# check attributes are inherited
-my $se_sth1 = $dbh->prepare("select mode from ?");
-ok($se_sth1->{RaiseError});
-ok($se_sth1->{ShowErrorStatement});
-
-# check ShowErrorStatement ParamValues are included and sorted
-$se_sth1->bind_param($_, "val$_") for (1..11);
-ok( !eval { $se_sth1->execute } );
-like $@, qr/\[for Statement "select mode from \?" with ParamValues: 1='val1', 2='val2', 3='val3', 4='val4', 5='val5', 6='val6', 7='val7', 8='val8', 9='val9', 10='val10', 11='val11'\]/;
-
-# this test relies on the fact that ShowErrorStatement is set above
-TODO: {
- local $TODO = "rt66127 not fixed yet";
- eval {
- local $se_sth1->{PrintError} = 0;
- $se_sth1->execute(1,2);
- };
- unlike($@, qr/ParamValues:/, 'error string does not contain ParamValues');
- is($se_sth1->{ParamValues}, undef, 'ParamValues is empty')
- or diag(Dumper($se_sth1->{ParamValues}));
-};
-# check that $dbh->{Statement} tracks last _executed_ sth
-$se_sth1 = $dbh->prepare("select mode from ?");
-ok($se_sth1->{Statement} eq "select mode from ?");
-ok($dbh->{Statement} eq "select mode from ?") or print "got: $dbh->{Statement}\n";
-my $se_sth2 = $dbh->prepare("select name from ?");
-ok($se_sth2->{Statement} eq "select name from ?");
-ok($dbh->{Statement} eq "select name from ?");
-$se_sth1->execute('.');
-ok($dbh->{Statement} eq "select mode from ?");
-
-# show error param values
-ok(! eval { $se_sth1->execute('first','second') }); # too many params
-ok($@ =~ /\b1='first'/, $@);
-ok($@ =~ /\b2='second'/, $@);
-
-$se_sth1->finish;
-$se_sth2->finish;
-
-$dbh->{RaiseError} = 0;
-ok(!$dbh->{RaiseError});
-$dbh->{ShowErrorStatement} = 0;
-ok(!$dbh->{ShowErrorStatement});
-
-{
- my @warn;
- local($SIG{__WARN__}) = sub { push @warn, @_ };
- $dbh->{PrintError} = 1;
- ok($dbh->{PrintError});
- ok(! $dbh->selectall_arrayref("select unknown_field_name3 from ?"));
- ok("@warn" =~ m/Unknown field names: unknown_field_name3/);
- $dbh->{PrintError} = 0;
- ok(!$dbh->{PrintError});
-}
-
-
-print "HandleError\n";
-my $HandleErrorReturn;
-my $HandleError = sub {
- my $msg = sprintf "HandleError: %s [h=%s, rv=%s, #=%d]",
- $_[0],$_[1],(defined($_[2])?$_[2]:'undef'),scalar(@_);
- die $msg if $HandleErrorReturn < 0;
- print "$msg\n";
- $_[2] = 42 if $HandleErrorReturn == 2;
- return $HandleErrorReturn;
-};
-
-$dbh->{HandleError} = $HandleError;
-ok($dbh->{HandleError});
-ok($dbh->{HandleError} == $HandleError);
-
-$dbh->{RaiseError} = 1;
-$dbh->{PrintError} = 0;
-$error_sql = "select unknown_field_name2 from ?";
-
-print "HandleError -> die\n";
-$HandleErrorReturn = -1;
-ok(! eval { $csr_c = $dbh->prepare($error_sql); 1; });
-ok($@ =~ m/^HandleError:/, $@);
-
-print "HandleError -> 0 -> RaiseError\n";
-$HandleErrorReturn = 0;
-ok(! eval { $csr_c = $dbh->prepare($error_sql); 1; });
-ok($@ =~ m/^DBD::(ExampleP|Multiplex|Gofer)::db prepare failed:/, $@);
-
-print "HandleError -> 1 -> return (original)undef\n";
-$HandleErrorReturn = 1;
-$r = eval { $csr_c = $dbh->prepare($error_sql); };
-ok(!$@, $@);
-ok(!defined($r), $r);
-
-print "HandleError -> 2 -> return (modified)42\n";
-$HandleErrorReturn = 2;
-$r = eval { $csr_c = $dbh->prepare($error_sql); };
-ok(!$@, $@);
-ok($r==42) unless $dbh->{mx_handle_list} && ok(1); # skip for Multiplex
-
-$dbh->{HandleError} = undef;
-ok(!$dbh->{HandleError});
-
-{
- # dump_results;
- my $sth = $dbh->prepare($std_sql);
-
- isa_ok($sth, "DBI::st");
-
- if (length(File::Spec->updir)) {
- ok($sth->execute(File::Spec->updir));
- } else {
- ok($sth->execute('../'));
- }
-
- my $dump_file = "dumpcsr.tst.$$";
- SKIP: {
- skip "# dump_results test skipped: unable to open $dump_file: $!\n", 4
- unless open(DUMP_RESULTS, ">$dump_file");
- ok($sth->dump_results("10", "\n", ",\t", \*DUMP_RESULTS));
- close(DUMP_RESULTS) or warn "close $dump_file: $!";
- ok(-s $dump_file > 0);
- is( unlink( $dump_file ), 1, "Remove $dump_file" );
- ok( !-e $dump_file, "Actually gone" );
- }
-
-}
-
-note "table_info\n";
-# First generate a list of all subdirectories
-$dir = File::Basename::dirname( $INC{"DBI.pm"} );
-my $dh;
-ok(opendir($dh, $dir));
-my(%dirs, %unexpected, %missing);
-while (defined(my $file = readdir($dh))) {
- $dirs{$file} = 1 if -d File::Spec->catdir($dir,$file);
-}
-note( "Local $dir subdirs: @{[ keys %dirs ]}" );
-closedir($dh);
-my $sth = $dbh->table_info($dir, undef, "%", "TABLE");
-ok($sth);
-%unexpected = %dirs;
-%missing = ();
-while (my $ref = $sth->fetchrow_hashref()) {
- if (exists($unexpected{$ref->{'TABLE_NAME'}})) {
- delete $unexpected{$ref->{'TABLE_NAME'}};
- } else {
- $missing{$ref->{'TABLE_NAME'}} = 1;
- }
-}
-ok(keys %unexpected == 0)
- or diag "Unexpected directories: ", join(",", keys %unexpected), "\n";
-ok(keys %missing == 0)
- or diag "Missing directories: ", join(",", keys %missing), "\n";
-
-note "tables\n";
-my @tables_expected = (
- q{"schema"."table"},
- q{"sch-ema"."table"},
- q{"schema"."ta-ble"},
- q{"sch ema"."table"},
- q{"schema"."ta ble"},
-);
-my @tables = $dbh->tables(undef, undef, "%", "VIEW");
-ok(@tables == @tables_expected, "Table count mismatch".@tables_expected." vs ".@tables);
-ok($tables[$_] eq $tables_expected[$_], "$tables[$_] ne $tables_expected[$_]")
- foreach (0..$#tables_expected);
-
-for (my $i = 0; $i < 300; $i += 100) {
- note "Testing the fake directories ($i).\n";
- ok($csr_a = $dbh->prepare("SELECT name, mode FROM long_list_$i"));
- ok($csr_a->execute(), $DBI::errstr);
- my $ary = $csr_a->fetchall_arrayref;
- ok(@$ary == $i, @$ary." rows instead of $i");
- if ($i) {
- my @n1 = map { $_->[0] } @$ary;
- my @n2 = reverse map { "file$_" } 1..$i;
- ok("@n1" eq "@n2", "'@n1' ne '@n2'");
- }
- else {
- ok(1);
- }
-}
-
-
-SKIP: {
- skip "test not tested with Multiplex", 1
- if $dbh->{mx_handle_list};
- note "Testing \$dbh->func().\n";
- my %tables;
- %tables = map { $_ =~ /lib/ ? ($_, 1) : () } $dbh->tables();
- my @func_tables = $dbh->func('lib', 'examplep_tables');
- foreach my $t (@func_tables) {
- defined(delete $tables{$t}) or print "Unexpected table: $t\n";
- }
- is(keys(%tables), 0);
-}
-
-{
- # some tests on special cases for the older tables call
- # uses DBD::NullP and relies on 2 facts about DBD::NullP:
- # 1) it has a get_info for for 29 - the quote chr
- # 2) it has a table_info which returns some types and catalogs
- my $dbhnp = DBI->connect('dbi:NullP:test');
-
- # this special case should just return a list of table types
- my @types = $dbhnp->tables('','','','%');
- ok(scalar(@types), 'we got some table types');
- my $defined = grep {defined($_)} @types;
- is($defined, scalar(@types), 'all table types are defined');
- SKIP: {
- skip "some table types were not defined", 1 if ($defined != scalar(@types));
- my $found_sep = grep {$_ =~ '\.'} @types;
- is($found_sep, 0, 'no name separators in table types') or diag(Dumper(\@types));
- };
-
- # this special case should just return a list of catalogs
- my @catalogs = $dbhnp->tables('%', '', '');
- ok(scalar(@catalogs), 'we got some catalogs');
- SKIP: {
- skip "no catalogs found", 1 if !scalar(@catalogs);
- my $found_sep = grep {$_ =~ '\.'} @catalogs;
- is($found_sep, 0, 'no name separators in catalogs') or diag(Dumper(\@catalogs));
- };
- $dbhnp->disconnect;
-}
-
-$dbh->disconnect;
-ok(!$dbh->{Active});
-ok(!$dbh->ping, "ping should return false after disconnect");
-
-1;
+++ /dev/null
-#!perl -w
-# vim:ts=8:sw=4
-$|=1;
-
-use strict;
-
-use Test::More;
-use DBI;
-use Storable qw(dclone);
-use Data::Dumper;
-
-$Data::Dumper::Indent = 1;
-$Data::Dumper::Sortkeys = 1;
-$Data::Dumper::Quotekeys = 0;
-
-plan tests => 24;
-
-my $dbh = DBI->connect("dbi:Sponge:foo","","", {
- PrintError => 0,
- RaiseError => 1,
-});
-
-my $source_rows = [ # data for DBD::Sponge to return via fetch
- [ 41, "AAA", 9 ],
- [ 41, "BBB", 9 ],
- [ 42, "BBB", undef ],
- [ 43, "ccc", 7 ],
- [ 44, "DDD", 6 ],
-];
-
-sub go {
- my $source = shift || $source_rows;
- my $sth = $dbh->prepare("foo", {
- rows => dclone($source),
- NAME => [ qw(C1 C2 C3) ],
- });
- ok($sth->execute(), $DBI::errstr);
- return $sth;
-}
-
-my($sth, $col0, $col1, $col2, $rows);
-
-# --- fetchrow_arrayref
-# --- fetchrow_array
-# etc etc
-
-# --- fetchall_hashref
-my @fetchall_hashref_results = ( # single keys
- C1 => {
- 41 => { C1 => 41, C2 => 'BBB', C3 => 9 },
- 42 => { C1 => 42, C2 => 'BBB', C3 => undef },
- 43 => { C1 => 43, C2 => 'ccc', C3 => 7 },
- 44 => { C1 => 44, C2 => 'DDD', C3 => 6 }
- },
- C2 => {
- AAA => { C1 => 41, C2 => 'AAA', C3 => 9 },
- BBB => { C1 => 42, C2 => 'BBB', C3 => undef },
- DDD => { C1 => 44, C2 => 'DDD', C3 => 6 },
- ccc => { C1 => 43, C2 => 'ccc', C3 => 7 }
- },
- [ 'C2' ] => { # single key within arrayref
- AAA => { C1 => 41, C2 => 'AAA', C3 => 9 },
- BBB => { C1 => 42, C2 => 'BBB', C3 => undef },
- DDD => { C1 => 44, C2 => 'DDD', C3 => 6 },
- ccc => { C1 => 43, C2 => 'ccc', C3 => 7 }
- },
-);
-push @fetchall_hashref_results, ( # multiple keys
- [ 'C1', 'C2' ] => {
- '41' => {
- AAA => { C1 => '41', C2 => 'AAA', C3 => 9 },
- BBB => { C1 => '41', C2 => 'BBB', C3 => 9 }
- },
- '42' => {
- BBB => { C1 => '42', C2 => 'BBB', C3 => undef }
- },
- '43' => {
- ccc => { C1 => '43', C2 => 'ccc', C3 => 7 }
- },
- '44' => {
- DDD => { C1 => '44', C2 => 'DDD', C3 => 6 }
- }
- },
-);
-
-my %dump;
-
-while (my $keyfield = shift @fetchall_hashref_results) {
- my $expected = shift @fetchall_hashref_results;
- my $k = (ref $keyfield) ? "[@$keyfield]" : $keyfield;
- print "# fetchall_hashref($k)\n";
- ok($sth = go());
- my $result = $sth->fetchall_hashref($keyfield);
- ok($result);
- is_deeply($result, $expected);
- # $dump{$k} = dclone $result; # just for adding tests
-}
-
-warn Dumper \%dump if %dump;
-
-# test assignment to NUM_OF_FIELDS automatically alters the row buffer
-$sth = go();
-my $row = $sth->fetchrow_arrayref;
-is scalar @$row, 3;
-is $sth->{NUM_OF_FIELDS}, 3;
-is scalar @{ $sth->_get_fbav }, 3;
-$sth->{NUM_OF_FIELDS} = 4;
-is $sth->{NUM_OF_FIELDS}, 4;
-is scalar @{ $sth->_get_fbav }, 4;
-$sth->{NUM_OF_FIELDS} = 2;
-is $sth->{NUM_OF_FIELDS}, 2;
-is scalar @{ $sth->_get_fbav }, 2;
-
-$sth->finish;
-
-
-if (0) {
- my @perf = map { [ int($_/100), $_, $_ ] } 0..10000;
- require Benchmark;
- Benchmark::timethis(10, sub { go(\@perf)->fetchall_hashref([ 'C1','C2','C3' ]) });
-}
-
-
-1; # end
+++ /dev/null
-#!perl -w
-
-use lib qw(blib/arch blib/lib); # needed since -T ignores PERL5LIB
-use strict;
-
-use Test::More tests => 10;
-
-use DBI qw(:sql_types);
-use Config;
-use Cwd;
-
-$^W = 1;
-$| = 1;
-
-my $dbh = DBI->connect('dbi:ExampleP:', '', '');
-
-sub check_quote {
- # checking quote
- is($dbh->quote("quote's"), "'quote''s'", '... quoting strings with embedded single quotes');
- is($dbh->quote("42", SQL_VARCHAR), "'42'", '... quoting number as SQL_VARCHAR');
- is($dbh->quote("42", SQL_INTEGER), "42", '... quoting number as SQL_INTEGER');
- is($dbh->quote(undef), "NULL", '... quoting undef as NULL');
-}
-
-check_quote();
-
-sub check_quote_identifier {
-
- is($dbh->quote_identifier('foo'), '"foo"', '... properly quotes foo as "foo"');
- is($dbh->quote_identifier('f"o'), '"f""o"', '... properly quotes f"o as "f""o"');
- is($dbh->quote_identifier('foo','bar'), '"foo"."bar"', '... properly quotes foo, bar as "foo"."bar"');
- is($dbh->quote_identifier(undef,undef,'bar'), '"bar"', '... properly quotes undef, undef, bar as "bar"');
-
- is($dbh->quote_identifier('foo',undef,'bar'), '"foo"."bar"', '... properly quotes foo, undef, bar as "foo"."bar"');
-
- SKIP: {
- skip "Can't test alternate quote_identifier logic with DBI_AUTOPROXY", 1
- if $ENV{DBI_AUTOPROXY};
- my $qi = $dbh->{dbi_quote_identifier_cache} || die "test out of date with dbi internals?";
- $qi->[1] = '@'; # SQL_CATALOG_NAME_SEPARATOR
- $qi->[2] = 2; # SQL_CATALOG_LOCATION
- is($dbh->quote_identifier('foo',undef,'bar'), '"bar"@"foo"', '... now quotes it as "bar"@"foo" after flushing cache');
- }
-}
-
-check_quote_identifier();
-
-1;
+++ /dev/null
-#!perl -wT
-
-use lib qw(blib/arch blib/lib); # needed since -T ignores PERL5LIB
-use DBI qw(:sql_types);
-use Config;
-use Cwd;
-use strict;
-
-
-$^W = 1;
-$| = 1;
-
-require VMS::Filespec if $^O eq 'VMS';
-
-use Test::More;
-
-# Check Taint attribute works. This requires this test to be run
-# manually with the -T flag: "perl -T -Mblib t/examp.t"
-sub is_tainted {
- my $foo;
- return ! eval { ($foo=join('',@_)), kill 0; 1; };
-}
-sub mk_tainted {
- my $string = shift;
- return substr($string.$^X, 0, length($string));
-}
-
-plan skip_all => "Taint attributes not supported with DBI::PurePerl" if $DBI::PurePerl;
-plan skip_all => "Taint attribute tests require taint mode (perl -T)" unless is_tainted($^X);
-plan skip_all => "Taint attribute tests not functional with DBI_AUTOPROXY" if $ENV{DBI_AUTOPROXY};
-
-plan tests => 36;
-
-# get a dir always readable on all platforms
-my $dir = getcwd() || cwd();
-$dir = VMS::Filespec::unixify($dir) if $^O eq 'VMS';
-$dir =~ m/(.*)/; $dir = $1 || die; # untaint $dir
-
-my ($r, $dbh);
-
-$dbh = DBI->connect('dbi:ExampleP:', '', '', { PrintError=>0, RaiseError=>1, Taint => 1 });
-
-my $std_sql = "select mode,size,name from ?";
-my $csr_a = $dbh->prepare($std_sql);
-ok(ref $csr_a);
-
-ok($dbh->{'Taint'});
-ok($dbh->{'TaintIn'} == 1);
-ok($dbh->{'TaintOut'} == 1);
-
-$dbh->{'TaintOut'} = 0;
-ok($dbh->{'Taint'} == 0);
-ok($dbh->{'TaintIn'} == 1);
-ok($dbh->{'TaintOut'} == 0);
-
-$dbh->{'Taint'} = 0;
-ok($dbh->{'Taint'} == 0);
-ok($dbh->{'TaintIn'} == 0);
-ok($dbh->{'TaintOut'} == 0);
-
-$dbh->{'TaintIn'} = 1;
-ok($dbh->{'Taint'} == 0);
-ok($dbh->{'TaintIn'} == 1);
-ok($dbh->{'TaintOut'} == 0);
-
-$dbh->{'TaintOut'} = 1;
-ok($dbh->{'Taint'} == 1);
-ok($dbh->{'TaintIn'} == 1);
-ok($dbh->{'TaintOut'} == 1);
-
-$dbh->{'Taint'} = 0;
-my $st;
-eval { $st = $dbh->prepare($std_sql); };
-ok(ref $st);
-
-ok($st->{'Taint'} == 0);
-
-ok($st->execute( $dir ), 'should execute ok');
-
-my @row = $st->fetchrow_array;
-ok(@row);
-
-ok(!is_tainted($row[0]));
-ok(!is_tainted($row[1]));
-ok(!is_tainted($row[2]));
-
-print "TaintIn\n";
-$st->{'TaintIn'} = 1;
-
-@row = $st->fetchrow_array;
-ok(@row);
-
-ok(!is_tainted($row[0]));
-ok(!is_tainted($row[1]));
-ok(!is_tainted($row[2]));
-
-print "TaintOut\n";
-$st->{'TaintOut'} = 1;
-
-@row = $st->fetchrow_array;
-ok(@row);
-
-ok(is_tainted($row[0]));
-ok(is_tainted($row[1]));
-ok(is_tainted($row[2]));
-
-$st->finish;
-
-my $tainted_sql = mk_tainted($std_sql);
-my $tainted_dot = mk_tainted('.');
-
-$dbh->{'Taint'} = $csr_a->{'Taint'} = 1;
-eval { $dbh->prepare($tainted_sql); 1; };
-ok($@ =~ /Insecure dependency/, $@);
-eval { $csr_a->execute($tainted_dot); 1; };
-ok($@ =~ /Insecure dependency/, $@);
-undef $@;
-
-$dbh->{'TaintIn'} = $csr_a->{'TaintIn'} = 0;
-
-eval { $dbh->prepare($tainted_sql); 1; };
-ok(!$@, $@);
-eval { $csr_a->execute($tainted_dot); 1; };
-ok(!$@, $@);
-
-$csr_a->{Taint} = 0;
-ok($csr_a->{Taint} == 0);
-
-$csr_a->finish;
-
-$dbh->disconnect;
-
-1;
+++ /dev/null
-#!perl -w
-# vim:ts=8:sw=4
-$|=1;
-
-use Test::More;
-use DBI;
-
-plan skip_all => "Requires perl 5.8"
- unless $] >= 5.008;
-
-eval {
- require Storable;
- import Storable qw(dclone);
- require Encode;
- import Encode qw(_utf8_on _utf8_off is_utf8);
-};
-
-plan skip_all => "Unable to load required module ($@)"
- unless defined &_utf8_on;
-
-plan tests => 16;
-
-$dbh = DBI->connect("dbi:Sponge:foo","","", {
- PrintError => 0,
- RaiseError => 1,
-});
-
-my $source_rows = [ # data for DBD::Sponge to return via fetch
- [ 41, "AAA", 9 ],
- [ 42, "BB", undef ],
- [ 43, undef, 7 ],
- [ 44, "DDD", 6 ],
-];
-
-my($sth, $col0, $col1, $col2, $rows);
-
-# set utf8 on one of the columns so we can check it carries through into the
-# keys of fetchrow_hashref
-my @col_names = qw(Col1 Col2 Col3);
-_utf8_on($col_names[1]);
-ok is_utf8($col_names[1]);
-ok !is_utf8($col_names[0]);
-
-$sth = $dbh->prepare("foo", {
- rows => dclone($source_rows),
- NAME => \@col_names,
-});
-
-ok($sth->bind_columns(\($col0, $col1, $col2)) );
-ok($sth->execute(), $DBI::errstr);
-
-ok $sth->fetch;
-cmp_ok $col1, 'eq', "AAA";
-ok !is_utf8($col1);
-
-# force utf8 flag on
-_utf8_on($col1);
-ok is_utf8($col1);
-
-ok $sth->fetch;
-cmp_ok $col1, 'eq', "BB";
-# XXX sadly this test doesn't detect the problem when using DBD::Sponge
-# because DBD::Sponge uses $sth->_set_fbav (correctly) and that uses
-# sv_setsv which doesn't have the utf8 persistence that sv_setpv does.
-ok !is_utf8($col1); # utf8 flag should have been reset
-
-ok $sth->fetch;
-ok !defined $col1; # null
-ok !is_utf8($col1); # utf8 flag should have been reset
-
-ok my $hash = $sth->fetchrow_hashref;
-ok 1 == grep { is_utf8($_) } keys %$hash;
-
-$sth->finish;
-
-# end
+++ /dev/null
-#!perl -w
-$|=1;
-
-use strict;
-
-use Test::More tests => 55;
-
-## ----------------------------------------------------------------------------
-## 15array.t
-## ----------------------------------------------------------------------------
-#
-## ----------------------------------------------------------------------------
-
-BEGIN {
- use_ok('DBI');
-}
-
-# create a database handle
-my $dbh = DBI->connect("dbi:Sponge:dummy", '', '', {
- RaiseError => 1,
- ShowErrorStatement => 1,
- AutoCommit => 1
-});
-
-# check that our db handle is good
-isa_ok($dbh, "DBI::db");
-
-my $rv;
-my $rows = [];
-my $tuple_status = [];
-my $dumped;
-
-my $sth = $dbh->prepare("insert", {
- rows => $rows, # where to 'insert' (push) the rows
- NUM_OF_PARAMS => 4,
- execute_hook => sub { # DBD::Sponge hook to make certain data trigger an error for that row
- local $^W;
- return $_[0]->set_err(1,"errmsg") if grep { $_ and $_ eq "B" } @_;
- return 1;
- }
- });
-
-isa_ok($sth, "DBI::st");
-
-cmp_ok(scalar @{$rows}, '==', 0, '... we should have 0 rows');
-
-# -----------------------------------------------
-
-ok(! eval {
- local $sth->{PrintError} = 0;
- $sth->execute_array(
- {
- ArrayTupleStatus => $tuple_status
- },
- [ 1, 2, 3 ], # array of integers
- 42, # scalar 42 treated as array of 42's
- undef, # scalar undef treated as array of undef's
- [ qw(A B C) ], # array of strings
- ) },
- '... execute_array should return false'
-);
-ok $@, 'execute_array failure with RaiseError should have died';
-like $sth->errstr, '/executing 3 generated 1 errors/';
-
-cmp_ok(scalar @{$rows}, '==', 2, '... we should have 2 rows');
-cmp_ok(scalar @{$tuple_status}, '==', 3, '... we should have 3 tuple_status');
-
-ok(eq_array(
- $rows,
- [ [1, 42, undef, 'A'], [3, 42, undef, 'C'] ]
- ),
- '... our rows are as expected');
-
-ok(eq_array(
- $tuple_status,
- [1, [1, 'errmsg', 'S1000'], 1]
- ),
- '... our tuple_status is as expected');
-
-# -----------------------------------------------
-# --- change one param and re-execute
-
-@$rows = ();
-ok( $sth->bind_param_array(4, [ qw(a b c) ]), '... bind_param_array should return true');
-ok( $sth->execute_array({ ArrayTupleStatus => $tuple_status }), '... execute_array should return true');
-
-cmp_ok(scalar @{$rows}, '==', 3, '... we should have 3 rows');
-cmp_ok(scalar @{$tuple_status}, '==', 3, '... we should have 3 tuple_status');
-
-ok(eq_array(
- $rows,
- [ [1, 42, undef, 'a'], [2, 42, undef, 'b'], [3, 42, undef, 'c'] ]
- ),
- '... our rows are as expected');
-
-ok(eq_array(
- $tuple_status,
- [1, 1, 1]
- ),
- '... our tuple_status is as expected');
-
-# -----------------------------------------------
-# --- call execute_array in array context to get executed AND affected
-@$rows = ();
-my ($executed, $affected) = $sth->execute_array({ ArrayTupleStatus => $tuple_status });
-ok($executed, '... execute_array should return true');
-cmp_ok($executed, '==', 3, '... we should have executed 3 rows');
-cmp_ok($affected, '==', 3, '... we should have affected 3 rows');
-
-# -----------------------------------------------
-# --- with no values for bind params, should execute zero times
-
-@$rows = ();
-$rv = $sth->execute_array( { ArrayTupleStatus => $tuple_status }, [], [], [], []);
-ok($rv, '... execute_array should return true');
-ok(!($rv+0), '... execute_array should return 0 (but true)');
-
-cmp_ok(scalar @{$rows}, '==', 0, '... we should have 0 rows');
-cmp_ok(scalar @{$tuple_status}, '==', 0,'... we should have 0 tuple_status');
-
-# -----------------------------------------------
-# --- with only scalar values for bind params, should execute just once
-
-@$rows = ();
-$rv = $sth->execute_array( { ArrayTupleStatus => $tuple_status }, 5, 6, 7, 8);
-cmp_ok($rv, '==', 1, '... execute_array should return 1');
-
-cmp_ok(scalar @{$rows}, '==', 1, '... we should have 1 rows');
-ok(eq_array( $rows, [ [5,6,7,8] ]), '... our rows are as expected');
-cmp_ok(scalar @{$tuple_status}, '==', 1,'... we should have 1 tuple_status');
-ok(eq_array( $tuple_status, [1]), '... our tuple_status is as expected');
-
-# -----------------------------------------------
-# --- with mix of scalar values and arrays only arrays control tuples
-
-@$rows = ();
-$rv = $sth->execute_array( { ArrayTupleStatus => $tuple_status }, 5, [], 7, 8);
-cmp_ok($rv, '==', 0, '... execute_array should return 0');
-
-cmp_ok(scalar @{$rows}, '==', 0, '... we should have 0 rows');
-cmp_ok(scalar @{$tuple_status}, '==', 0,'... we should have 0 tuple_status');
-
-# -----------------------------------------------
-# --- catch 'undefined value' bug with zero bind values
-
-@$rows = ();
-my $sth_other = $dbh->prepare("insert", {
- rows => $rows, # where to 'insert' (push) the rows
- NUM_OF_PARAMS => 1,
-});
-
-isa_ok($sth_other, "DBI::st");
-
-$rv = $sth_other->execute_array( {}, [] );
-ok($rv, '... execute_array should return true');
-ok(!($rv+0), '... execute_array should return 0 (but true)');
-# no ArrayTupleStatus
-
-cmp_ok(scalar @{$rows}, '==', 0, '... we should have 0 rows');
-
-# -----------------------------------------------
-# --- ArrayTupleFetch code-ref tests ---
-
-my $index = 0;
-
-my $fetchrow = sub { # generate 5 rows of two integer values
- return if $index >= 2;
- $index +=1;
- # There doesn't seem any reliable way to force $index to be
- # treated as a string (and so dumped as such). We just have to
- # make the test case allow either 1 or '1'.
- return [ $index, 'a','b','c' ];
-};
-
-@$rows = ();
-ok( $sth->execute_array({
- ArrayTupleFetch => $fetchrow,
- ArrayTupleStatus => $tuple_status
- }), '... execute_array should return true');
-
-cmp_ok(scalar @{$rows}, '==', 2, '... we should have 2 rows');
-cmp_ok(scalar @{$tuple_status}, '==', 2, '... we should have 2 tuple_status');
-
-ok(eq_array(
- $rows,
- [ [1, 'a', 'b', 'c'], [2, 'a', 'b', 'c'] ]
- ),
- '... rows should match'
-);
-
-ok(eq_array(
- $tuple_status,
- [1, 1]
- ),
- '... tuple_status should match'
-);
-
-# -----------------------------------------------
-# --- ArrayTupleFetch sth tests ---
-
-my $fetch_sth = $dbh->prepare("foo", {
- rows => [ map { [ $_,'x','y','z' ] } 7..9 ],
- NUM_OF_FIELDS => 4
- });
-
-isa_ok($fetch_sth, "DBI::st");
-
-$fetch_sth->execute();
-
-@$rows = ();
-
-ok( $sth->execute_array({
- ArrayTupleFetch => $fetch_sth,
- ArrayTupleStatus => $tuple_status,
- }), '... execute_array should return true');
-
-cmp_ok(scalar @{$rows}, '==', 3, '... we should have 3 rows');
-cmp_ok(scalar @{$tuple_status}, '==', 3, '... we should have 3 tuple_status');
-
-ok(eq_array(
- $rows,
- [ [7, 'x', 'y', 'z'], [8, 'x', 'y', 'z'], [9, 'x', 'y', 'z'] ]
- ),
- '... rows should match'
-);
-
-ok(eq_array(
- $tuple_status,
- [1, 1, 1]
- ),
- '... tuple status should match'
-);
-
-# -----------------------------------------------
-# --- error detection tests ---
-
-$sth->{RaiseError} = 0;
-$sth->{PrintError} = 0;
-
-ok(!defined $sth->execute_array( { ArrayTupleStatus => $tuple_status }, [1],[2]), '... execute_array should return undef');
-is($sth->errstr, '2 bind values supplied but 4 expected', '... errstr is as expected');
-
-ok(!defined $sth->execute_array( { ArrayTupleStatus => { } }, [ 1, 2, 3 ]), '... execute_array should return undef');
-is( $sth->errstr, 'ArrayTupleStatus attribute must be an arrayref', '... errstr is as expected');
-
-ok(!defined $sth->execute_array( { ArrayTupleStatus => $tuple_status }, 1,{},3,4), '... execute_array should return undef');
-is( $sth->errstr, 'Value for parameter 2 must be a scalar or an arrayref, not a HASH', '... errstr is as expected');
-
-ok(!defined $sth->bind_param_array(":foo", [ qw(a b c) ]), '... bind_param_array should return undef');
-is( $sth->errstr, "Can't use named placeholder ':foo' for non-driver supported bind_param_array", '... errstr is as expected');
-
-$dbh->disconnect;
-
-1;
+++ /dev/null
-#!perl -w
-
-use strict;
-
-use Test::More tests => 20; # use explicit plan to avoid race hazard
-
-BEGIN{ use_ok( 'DBI' ) }
-
-my $expect_active;
-
-## main Test Driver Package
-{
- package DBD::Test;
-
- use strict;
- use warnings;
-
- my $drh = undef;
-
- sub driver {
- return $drh if $drh;
- my ($class, $attr) = @_;
- $class = "${class}::dr";
- ($drh) = DBI::_new_drh($class, {
- Name => 'Test',
- Version => '1.0',
- }, 77 );
- return $drh;
- }
-
- sub CLONE { undef $drh }
-}
-
-## Test Driver
-{
- package DBD::Test::dr;
-
- use warnings;
- use Test::More;
-
- sub connect { # normally overridden, but a handy default
- my($drh, $dbname, $user, $auth, $attrs)= @_;
- my ($outer, $dbh) = DBI::_new_dbh($drh);
- $dbh->STORE(Active => 1);
- $dbh->STORE(AutoCommit => 1);
- $dbh->STORE( $_ => $attrs->{$_}) for keys %$attrs;
- return $outer;
- }
-
- $DBD::Test::dr::imp_data_size = 0;
- cmp_ok($DBD::Test::dr::imp_data_size, '==', 0, '... check DBD::Test::dr::imp_data_size to avoid typo');
-}
-
-## Test db package
-{
- package DBD::Test::db;
-
- use strict;
- use warnings;
- use Test::More;
-
- $DBD::Test::db::imp_data_size = 0;
- cmp_ok($DBD::Test::db::imp_data_size, '==', 0, '... check DBD::Test::db::imp_data_size to avoid typo');
-
- sub STORE {
- my ($dbh, $attrib, $value) = @_;
- # would normally validate and only store known attributes
- # else pass up to DBI to handle
- if ($attrib eq 'AutoCommit') {
- # convert AutoCommit values to magic ones to let DBI
- # know that the driver has 'handled' the AutoCommit attribute
- $value = ($value) ? -901 : -900;
- }
- return $dbh->{$attrib} = $value if $attrib =~ /^examplep_/;
- return $dbh->SUPER::STORE($attrib, $value);
- }
-
- sub DESTROY {
- if ($expect_active < 0) { # inside child
- my $self = shift;
- exit ($self->FETCH('Active') || 0) unless $^O eq 'MSWin32';
-
- # On Win32, the forked child is actually a thread. So don't exit,
- # and report failure directly.
- fail 'Child should be inactive on DESTROY' if $self->FETCH('Active');
- } else {
- return $expect_active
- ? ok( shift->FETCH('Active'), 'Should be active in DESTROY')
- : ok( !shift->FETCH('Active'), 'Should not be active in DESTROY');
- }
- }
-}
-
-my $dsn = 'dbi:ExampleP:dummy';
-
-$INC{'DBD/Test.pm'} = 'dummy'; # required to fool DBI->install_driver()
-ok my $drh = DBI->install_driver('Test'), 'Install test driver';
-
-NOSETTING: {
- # Try defaults.
- ok my $dbh = $drh->connect, 'Connect to test driver';
- ok $dbh->{Active}, 'Should start active';
- $expect_active = 1;
-}
-
-IAD: {
- # Try InactiveDestroy.
- ok my $dbh = $drh->connect($dsn, '', '', { InactiveDestroy => 1 }),
- 'Create with ActiveDestroy';
- ok $dbh->{InactiveDestroy}, 'InactiveDestroy should be set';
- ok $dbh->{Active}, 'Should start active';
- $expect_active = 0;
-}
-
-AIAD: {
- # Try AutoInactiveDestroy.
- ok my $dbh = $drh->connect($dsn, '', '', { AutoInactiveDestroy => 1 }),
- 'Create with AutoInactiveDestroy';
- ok $dbh->{AutoInactiveDestroy}, 'InactiveDestroy should be set';
- ok $dbh->{Active}, 'Should start active';
- $expect_active = 1;
-}
-
-FORK: {
- # Try AutoInactiveDestroy and fork.
- ok my $dbh = $drh->connect($dsn, '', '', { AutoInactiveDestroy => 1 }),
- 'Create with AutoInactiveDestroy again';
- ok $dbh->{AutoInactiveDestroy}, 'InactiveDestroy should be set';
- ok $dbh->{Active}, 'Should start active';
-
- my $pid = eval { fork() };
- if (not defined $pid) {
- chomp $@;
- my $msg = "AutoInactiveDestroy destroy test skipped";
- diag "$msg because $@\n";
- pass $msg; # in lieu of the child status test
- }
- elsif ($pid) {
- # parent.
- $expect_active = 1;
- wait;
- ok $? == 0, 'Child should be inactive on DESTROY';
- } else {
- # child.
- $expect_active = -1;
- }
-}
-
+++ /dev/null
-#!perl -w
-# vim:sw=4:ts=8
-
-use strict;
-
-use Test::More tests => 27;
-
-## ----------------------------------------------------------------------------
-## 09trace.t
-## ----------------------------------------------------------------------------
-#
-## ----------------------------------------------------------------------------
-
-BEGIN {
- use_ok( 'DBI' );
-}
-
-$|=1;
-
-our $fancylogfn = "fancylog$$.log";
-our $trace_file = "dbitrace$$.log";
-
-# Clean up when we're done.
-END { 1 while unlink $fancylogfn;
- 1 while unlink $trace_file; };
-
-package PerlIO::via::TraceDBI;
-
-our $logline;
-
-sub OPEN {
- return 1;
-}
-
-sub PUSHED
-{
- my ($class,$mode,$fh) = @_;
- # When writing we buffer the data
- my $buf = '';
- return bless \$buf,$class;
-}
-
-sub FILL
-{
- my ($obj,$fh) = @_;
- return $logline;
-}
-
-sub READLINE
-{
- my ($obj,$fh) = @_;
- return $logline;
-}
-
-sub WRITE
-{
- my ($obj,$buf,$fh) = @_;
-# print "\n*** WRITING $buf\n";
- $logline = $buf;
- return length($buf);
-}
-
-sub FLUSH
-{
- my ($obj,$fh) = @_;
- return 0;
-}
-
-sub CLOSE {
-# print "\n*** CLOSING!!!\n";
- $logline = "**** CERRADO! ***";
- return -1;
-}
-
-1;
-
-package PerlIO::via::MyFancyLogLayer;
-
-sub OPEN {
- my ($obj, $path, $mode, $fh) = @_;
- $$obj = $path;
- return 1;
-}
-
-sub PUSHED
-{
- my ($class,$mode,$fh) = @_;
- # When writing we buffer the data
- my $logger;
- return bless \$logger,$class;
-}
-
-sub WRITE
-{
- my ($obj,$buf,$fh) = @_;
- $$obj->log($buf);
- return length($buf);
-}
-
-sub FLUSH
-{
- my ($obj,$fh) = @_;
- return 0;
-}
-
-sub CLOSE {
- my $self = shift;
- $$self->close();
- return 0;
-}
-
-1;
-
-package MyFancyLogger;
-
-use Symbol qw(gensym);
-
-sub new
-{
- my $self = {};
- my $fh = gensym();
- open $fh, '>', $fancylogfn;
- $self->{_fh} = $fh;
- $self->{_buf} = '';
- return bless $self, shift;
-}
-
-sub log
-{
- my $self = shift;
- my $fh = $self->{_fh};
- $self->{_buf} .= shift;
- print $fh "At ", scalar localtime(), ':', $self->{_buf}, "\n" and
- $self->{_buf} = ''
- if $self->{_buf}=~tr/\n//;
-}
-
-sub close {
- my $self = shift;
- return unless exists $self->{_fh};
- my $fh = $self->{_fh};
- print $fh "At ", scalar localtime(), ':', $self->{_buf}, "\n" and
- $self->{_buf} = ''
- if $self->{_buf};
- close $fh;
- delete $self->{_fh};
-}
-
-1;
-
-package main;
-
-## ----------------------------------------------------------------------------
-# Connect to the example driver.
-
-my $dbh = DBI->connect('dbi:ExampleP:dummy', '', '',
- { PrintError => 0,
- RaiseError => 1,
- PrintWarn => 1,
- });
-isa_ok( $dbh, 'DBI::db' );
-
-# Clean up when we're done.
-END { $dbh->disconnect if $dbh };
-
-## ----------------------------------------------------------------------------
-# Check the database handle attributes.
-
-cmp_ok($dbh->{TraceLevel}, '==', $DBI::dbi_debug & 0xF, '... checking TraceLevel attribute');
-
-1 while unlink $trace_file;
-
-my $tracefd;
-## ----------------------------------------------------------------------------
-# First use regular filehandle
-open $tracefd, '>>', $trace_file;
-
-my $oldfd = select($tracefd);
-$| = 1;
-select $oldfd;
-
-ok(-f $trace_file, '... regular fh: trace file successfully created');
-
-$dbh->trace(2, $tracefd);
-ok( 1, '... regular fh: filehandle successfully set');
-
-#
-# read current size of file
-#
-my $filesz = (stat $tracefd)[7];
-$dbh->trace_msg("First logline\n", 1);
-#
-# read new file size and verify its different
-#
-my $newfsz = (stat $tracefd)[7];
-SKIP: {
- skip 'on VMS autoflush using select does not work', 1 if $^O eq 'VMS';
- ok(($filesz != $newfsz), '... regular fh: trace_msg');
-}
-
-$dbh->trace(undef, "STDOUT"); # close $trace_file
-ok(-f $trace_file, '... regular fh: file successfully changed');
-
-$filesz = (stat $tracefd)[7];
-$dbh->trace_msg("Next logline\n");
-#
-# read new file size and verify its same
-#
-$newfsz = (stat $tracefd)[7];
-ok(($filesz == $newfsz), '... regular fh: trace_msg after changing trace output');
-
-#1 while unlink $trace_file;
-
-$dbh->trace(0); # disable trace
-
-{ # Open trace to glob. started failing in perl-5.10
- my $tf = "foo.log.$$";
- 1 while unlink $tf;
- 1 while unlink "*main::FOO";
- 1 while unlink "*main::STDERR";
- is (-f $tf, undef, "Tracefile removed");
- ok (open (FOO, ">", $tf), "Tracefile FOO opened");
- ok (-f $tf, "Tracefile created");
- DBI->trace (1, *FOO);
- is (-f "*main::FOO", undef, "Regression test");
- DBI->trace_msg ("foo\n", 1);
- DBI->trace (0, *STDERR);
- close FOO;
- open my $fh, "<", $tf;
- is ((<$fh>)[-1], "foo\n", "Traced message");
- close $fh;
- is (-f "*main::STDERR", undef, "Regression test");
- 1 while unlink $tf;
- }
-
-SKIP: {
- eval { require 5.008; };
- skip "Layered I/O not available in Perl $^V", 13
- if $@;
-## ----------------------------------------------------------------------------
-# Then use layered filehandle
-#
-open TRACEFD, '+>:via(TraceDBI)', 'layeredtrace.out';
-print TRACEFD "*** Test our layer\n";
-my $result = <TRACEFD>;
-is $result, "*** Test our layer\n", "... layered fh: file is layered: $result\n";
-
-$dbh->trace(1, \*TRACEFD);
-ok( 1, '... layered fh: filehandle successfully set');
-
-$dbh->trace_msg("Layered logline\n", 1);
-
-$result = <TRACEFD>;
-is $result, "Layered logline\n", "... layered fh: trace_msg: $result\n";
-
-$dbh->trace(1, "STDOUT"); # close $trace_file
-$result = <TRACEFD>;
-is $result, "Layered logline\n", "... layered fh: close doesn't close: $result\n";
-
-$dbh->trace_msg("Next logline\n", 1);
-$result = <TRACEFD>;
-is $result, "Layered logline\n", "... layered fh: trace_msg after change trace output: $result\n";
-
-## ----------------------------------------------------------------------------
-# Then use scalar filehandle
-#
-my $tracestr;
-open TRACEFD, '+>:scalar', \$tracestr;
-print TRACEFD "*** Test our layer\n";
-ok 1, "... scalar trace: file is layered: $tracestr\n";
-
-$dbh->trace(1, \*TRACEFD);
-ok 1, '... scalar trace: filehandle successfully set';
-
-$dbh->trace_msg("Layered logline\n", 1);
-ok 1, "... scalar trace: $tracestr\n";
-
-$dbh->trace(1, "STDOUT"); # close $trace_file
-ok 1, "... scalar trace: close doesn't close: $tracestr\n";
-
-$dbh->trace_msg("Next logline\n", 1);
-ok 1, "... scalar trace: after change trace output: $tracestr\n";
-
-## ----------------------------------------------------------------------------
-# Then use fancy logger
-#
-open my $fh, '>:via(MyFancyLogLayer)', MyFancyLogger->new();
-
-$dbh->trace('SQL', $fh);
-
-$dbh->trace_msg("Layered logline\n", 1);
-ok 1, "... logger: trace_msg\n";
-
-$dbh->trace(1, "STDOUT"); # close $trace_file
-ok 1, "... logger: close doesn't close\n";
-
-$dbh->trace_msg("Next logline\n", 1);
-ok 1, "... logger: trace_msg after change trace output\n";
-
-close $fh;
-
-}
-
-1;
-
-# end
+++ /dev/null
-#!perl -w
-
-use strict;
-use Test::More tests => 8;
-
-$|=1;
-$^W=1;
-
-BEGIN { use_ok( 'DBI', ':sql_types' ) }
-BEGIN { use_ok( 'DBI::DBD::Metadata' ) } # just to check for syntax errors etc
-
-my $dbh = DBI->connect("dbi:ExampleP:.","","", { FetchHashKeyName => 'NAME_lc' })
- or die "Unable to connect to ExampleP driver: $DBI::errstr";
-
-isa_ok($dbh, 'DBI::db');
-#$dbh->trace(3);
-
-#use Data::Dumper;
-#print Dumper($dbh->type_info_all);
-#print Dumper($dbh->type_info);
-#print Dumper($dbh->type_info(DBI::SQL_INTEGER));
-
-my @ti = $dbh->type_info;
-ok(@ti>0);
-
-is($dbh->type_info(SQL_INTEGER)->{DATA_TYPE}, SQL_INTEGER);
-is($dbh->type_info(SQL_INTEGER)->{TYPE_NAME}, 'INTEGER');
-
-is($dbh->type_info(SQL_VARCHAR)->{DATA_TYPE}, SQL_VARCHAR);
-is($dbh->type_info(SQL_VARCHAR)->{TYPE_NAME}, 'VARCHAR');
-
-1;
+++ /dev/null
-#!perl -w
-
-use strict;
-
-$|=1;
-$^W=1;
-
-my $calls = 0;
-my %my_methods;
-
-
-# =================================================
-# Example code for sub classing the DBI.
-#
-# Note that the extra ::db and ::st classes must be set up
-# as sub classes of the corresponding DBI classes.
-#
-# This whole mechanism is new and experimental - it may change!
-
-package MyDBI;
-@MyDBI::ISA = qw(DBI);
-
-# the MyDBI::dr::connect method is NOT called!
-# you can either override MyDBI::connect()
-# or use MyDBI::db::connected()
-
-package MyDBI::db;
-@MyDBI::db::ISA = qw(DBI::db);
-
-sub prepare {
- my($dbh, @args) = @_;
- ++$my_methods{prepare};
- ++$calls;
- my $sth = $dbh->SUPER::prepare(@args);
- return $sth;
-}
-
-
-package MyDBI::st;
-@MyDBI::st::ISA = qw(DBI::st);
-
-sub fetch {
- my($sth, @args) = @_;
- ++$my_methods{fetch};
- ++$calls;
- # this is just to trigger (re)STORE on exit to test that the STORE
- # doesn't clear any erro condition
- local $sth->{Taint} = 0;
- my $row = $sth->SUPER::fetch(@args);
- if ($row) {
- # modify fetched data as an example
- $row->[1] = lc($row->[1]);
-
- # also demonstrate calling set_err()
- return $sth->set_err(1,"Don't be so negative",undef,"fetch")
- if $row->[0] < 0;
- # ... and providing alternate results
- # (although typically would trap and hide and error from SUPER::fetch)
- return $sth->set_err(2,"Don't exaggerate",undef, undef, [ 42,"zz",0 ])
- if $row->[0] > 42;
- }
- return $row;
-}
-
-
-# =================================================
-package main;
-
-use Test::More tests => 43;
-
-BEGIN {
- use_ok( 'DBI' );
-}
-
-my $tmp;
-
-#DBI->trace(2);
-my $dbh = MyDBI->connect("dbi:Sponge:foo","","", {
- PrintError => 0,
- RaiseError => 1,
- CompatMode => 1, # just for clone test
-});
-isa_ok($dbh, 'MyDBI::db');
-is($dbh->{CompatMode}, 1);
-undef $dbh;
-
-$dbh = DBI->connect("dbi:Sponge:foo","","", {
- PrintError => 0,
- RaiseError => 1,
- RootClass => "MyDBI",
- CompatMode => 1, # just for clone test
- dbi_foo => 1, # just to help debugging clone etc
-});
-isa_ok( $dbh, 'MyDBI::db');
-is($dbh->{CompatMode}, 1);
-
-#$dbh->trace(5);
-my $sth = $dbh->prepare("foo",
- # data for DBD::Sponge to return via fetch
- { rows => [
- [ 40, "AAA", 9 ],
- [ 41, "BB", 8 ],
- [ -1, "C", 7 ],
- [ 49, "DD", 6 ]
- ],
- }
-);
-
-is($calls, 1);
-isa_ok($sth, 'MyDBI::st');
-
-my $row = $sth->fetch;
-is($calls, 2);
-is($row->[1], "aaa");
-
-$row = $sth->fetch;
-is($calls, 3);
-is($row->[1], "bb");
-
-is($DBI::err, undef);
-$row = eval { $sth->fetch };
-my $eval_err = $@;
-is(!defined $row, 1);
-is(substr($eval_err,0,50), "DBD::Sponge::st fetch failed: Don't be so negative");
-
-#$sth->trace(5);
-#$sth->{PrintError} = 1;
-$sth->{RaiseError} = 0;
-$row = eval { $sth->fetch };
-isa_ok($row, 'ARRAY');
-is($row->[0], 42);
-is($DBI::err, 2);
-like($DBI::errstr, qr/Don't exaggerate/);
-is($@ =~ /Don't be so negative/, $@);
-
-
-my $dbh2 = $dbh->clone;
-isa_ok( $dbh2, 'MyDBI::db', "Clone A" );
-is($dbh2 != $dbh, 1);
-is($dbh2->{CompatMode}, 1);
-
-my $dbh3 = $dbh->clone({});
-isa_ok( $dbh3, 'MyDBI::db', 'Clone B' );
-is($dbh3 != $dbh, 1);
-is($dbh3 != $dbh2, 1);
-isa_ok( $dbh3, 'MyDBI::db');
-is($dbh3->{CompatMode}, 1);
-
-my $dbh2c = $dbh2->clone;
-isa_ok( $dbh2c, 'MyDBI::db', "Clone of clone A" );
-is($dbh2c != $dbh2, 1);
-is($dbh2c->{CompatMode}, 1);
-
-my $dbh3c = $dbh3->clone({ CompatMode => 0 });
-isa_ok( $dbh3c, 'MyDBI::db', 'Clone of clone B' );
-is((grep { $dbh3c == $_ } $dbh, $dbh2, $dbh3), 0);
-isa_ok( $dbh3c, 'MyDBI::db');
-ok(!$dbh3c->{CompatMode});
-
-$tmp = $dbh->sponge_test_installed_method('foo','bar');
-isa_ok( $tmp, "ARRAY", "installed method" );
-is_deeply( $tmp, [qw( foo bar )] );
-$tmp = eval { $dbh->sponge_test_installed_method() };
-is(!$tmp, 1);
-is($dbh->err, 42);
-is($dbh->errstr, "not enough parameters");
-
-
-$dbh = eval { DBI->connect("dbi:Sponge:foo","","", {
- RootClass => 'nonesuch1', PrintError => 0, RaiseError => 0, });
-};
-ok( !defined($dbh), "Failed connect #1" );
-is(substr($@,0,25), "Can't locate nonesuch1.pm");
-
-$dbh = eval { nonesuch2->connect("dbi:Sponge:foo","","", {
- PrintError => 0, RaiseError => 0, });
-};
-ok( !defined($dbh), "Failed connect #2" );
-is(substr($@,0,36), q{Can't locate object method "connect"});
-
-print "@{[ %my_methods ]}\n";
-1;
+++ /dev/null
-#!perl -w
-#
-# check that the inner-method lookup cache works
-# (or rather, check that it doesn't cache things when it shouldn't)
-
-BEGIN { eval "use threads;" } # Must be first
-my $use_threads_err = $@;
-use Config qw(%Config);
-# With this test code and threads, 5.8.1 has issues with freeing freed
-# scalars, while 5.8.9 doesn't; I don't know about in-between - DAPM
-my $has_threads = $Config{useithreads};
-die $use_threads_err if $has_threads && $use_threads_err;
-
-
-use strict;
-
-$|=1;
-$^W=1;
-
-
-
-use Test::More tests => 49;
-
-BEGIN {
- use_ok( 'DBI' );
-}
-
-sub new_handle {
- my $dbh = DBI->connect("dbi:Sponge:foo","","", {
- PrintError => 0,
- RaiseError => 1,
- });
-
- my $sth = $dbh->prepare("foo",
- # data for DBD::Sponge to return via fetch
- { rows =>
- [
- [ "row0" ],
- [ "row1" ],
- [ "row2" ],
- [ "row3" ],
- [ "row4" ],
- [ "row5" ],
- [ "row6" ],
- ],
- }
- );
-
- return ($dbh, $sth);
-}
-
-
-sub Foo::local1 { [ "local1" ] };
-sub Foo::local2 { [ "local2" ] };
-
-
-my $fetch_hook;
-{
- package Bar;
- @Bar::ISA = qw(DBD::_::st);
- sub fetch { &$fetch_hook };
-}
-
-sub run_tests {
- my ($desc, $dbh, $sth) = @_;
- my $row = $sth->fetch;
- is($row->[0], "row0", "$desc row0");
-
- {
- # replace CV slot
- no warnings 'redefine';
- local *DBD::Sponge::st::fetch = sub { [ "local0" ] };
- $row = $sth->fetch;
- is($row->[0], "local0", "$desc local0");
- }
- $row = $sth->fetch;
- is($row->[0], "row1", "$desc row1");
-
- {
- # replace GP
- local *DBD::Sponge::st::fetch = *Foo::local1;
- $row = $sth->fetch;
- is($row->[0], "local1", "$desc local1");
- }
- $row = $sth->fetch;
- is($row->[0], "row2", "$desc row2");
-
- {
- # replace GV
- local $DBD::Sponge::st::{fetch} = *Foo::local2;
- $row = $sth->fetch;
- is($row->[0], "local2", "$desc local2");
- }
- $row = $sth->fetch;
- is($row->[0], "row3", "$desc row3");
-
- {
- # @ISA = NoSuchPackage
- local $DBD::Sponge::st::{fetch};
- local @DBD::Sponge::st::ISA = qw(NoSuchPackage);
- eval { local $SIG{__WARN__} = sub {}; $row = $sth->fetch };
- like($@, qr/Can't locate DBI object method/, "$desc locate DBI object");
- }
- $row = $sth->fetch;
- is($row->[0], "row4", "$desc row4");
-
- {
- # @ISA = Bar
- $fetch_hook = \&DBD::Sponge::st::fetch;
- local $DBD::Sponge::st::{fetch};
- local @DBD::Sponge::st::ISA = qw(Bar);
- $row = $sth->fetch;
- is($row->[0], "row5", "$desc row5");
- $fetch_hook = sub { [ "local3" ] };
- $row = $sth->fetch;
- is($row->[0], "local3", "$desc local3");
- }
- $row = $sth->fetch;
- is($row->[0], "row6", "$desc row6");
-}
-
-run_tests("plain", new_handle());
-
-
-SKIP: {
- skip "no threads / perl < 5.8.9", 12 unless $has_threads;
- # only enable this when handles are allowed to be shared across threads
- #{
- # my @h = new_handle();
- # threads->new(sub { run_tests("threads", @h) })->join;
- #}
- threads->new(sub { run_tests("threads-h", new_handle()) })->join;
-};
-
-# using weaken attaches magic to the CV; see whether this interferes
-# with the cache magic
-
-use Scalar::Util qw(weaken);
-my $fetch_ref = \&DBI::st::fetch;
-weaken $fetch_ref;
-run_tests("magic", new_handle());
-
-SKIP: {
- skip "no threads / perl < 5.8.9", 12 unless $has_threads;
-
- skip "weaken itself is buggy on 5.8.1 (magic killbackrefs panic "
- ."triggered by threads, fixed in 5.8.2)"
- , 12 unless $] > 5.008001;
- # only enable this when handles are allowed to be shared across threads
- #{
- # my @h = new_handle();
- # threads->new(sub { run_tests("threads", @h) })->join;
- #}
- threads->new(sub { run_tests("magic threads-h", new_handle()) })->join;
-};
-
-1;
+++ /dev/null
-#!perl -w
-$|=1;
-
-# --- Test DBI support for threads created after the DBI was loaded
-
-BEGIN { eval "use threads;" } # Must be first
-my $use_threads_err = $@;
-
-use strict;
-use Config qw(%Config);
-use Test::More;
-
-BEGIN {
- if (!$Config{useithreads} || $] < 5.008001) {
- plan skip_all => "this $^O perl $] not supported for DBI iThreads";
- }
- die $use_threads_err if $use_threads_err; # need threads
-}
-
-my $threads = 4;
-plan tests => 4 + 4 * $threads;
-
-{
- package threads_sub;
- use base qw(threads);
-}
-
-use_ok('DBI');
-
-$DBI::PurePerl = $DBI::PurePerl; # just to silence used only once warning
-$DBI::neat_maxlen = 12345;
-cmp_ok($DBI::neat_maxlen, '==', 12345, '... assignment of neat_maxlen was successful');
-
-my @connect_args = ("dbi:ExampleP:", '', '');
-
-my $dbh_parent = DBI->connect_cached(@connect_args);
-isa_ok( $dbh_parent, 'DBI::db' );
-
-# this our function for the threads to run
-
-sub testing {
- cmp_ok($DBI::neat_maxlen, '==', 12345, '... DBI::neat_maxlen still holding its value');
-
- my $dbh = DBI->connect_cached(@connect_args);
- isa_ok( $dbh, 'DBI::db' );
- isnt($dbh, $dbh_parent, '... new $dbh is not the same instance as $dbh_parent');
-
- SKIP: {
- # skip seems broken with threads (5.8.3)
- # skip "Kids attribute not supported under DBI::PurePerl", 1 if $DBI::PurePerl;
-
- cmp_ok($dbh->{Driver}->{Kids}, '==', 1, '... the Driver has one Kid')
- unless $DBI::PurePerl && ok(1);
- }
-
- # RT #77137: a thread created from a thread was crashing the
- # interpreter
- my $subthread = threads->new(sub {});
-
- # provide a little insurance against thread scheduling issues (hopefully)
- # http://www.nntp.perl.org/group/perl.cpan.testers/2009/06/msg4369660.html
- eval { select undef, undef, undef, 0.2 };
-
- $subthread->join();
-}
-
-# load up the threads
-
-my @thr;
-push @thr, threads_sub->create( \&testing )
- or die "thread->create failed ($!)"
- foreach (1..$threads);
-
-# join all the threads
-
-foreach my $thread (@thr) {
- # provide a little insurance against thread scheduling issues (hopefully)
- # http://www.nntp.perl.org/group/perl.cpan.testers/2009/06/msg4369660.html
- eval { select undef, undef, undef, 0.2 };
-
- $thread->join;
-}
-
-pass('... all tests have passed');
-
-1;
+++ /dev/null
-#!perl -w
-$|=1;
-
-#
-# test script for DBI::Profile
-#
-
-use strict;
-
-use Config;
-use DBI::Profile;
-use DBI qw(dbi_time);
-use Data::Dumper;
-use File::Spec;
-use Storable qw(dclone);
-
-use Test::More;
-
-BEGIN {
- plan skip_all => "profiling not supported for DBI::PurePerl"
- if $DBI::PurePerl;
-
- # tie methods (STORE/FETCH etc) get called different number of times
- plan skip_all => "test results assume perl >= 5.8.2"
- if $] <= 5.008001;
-
- # clock instability on xen systems is a reasonably common cause of failure
- # http://www.nntp.perl.org/group/perl.cpan.testers/2009/05/msg3828158.html
- # so we'll skip automated testing on those systems
- plan skip_all => "skipping profile tests on xen (due to clock instability)"
- if $Config{osvers} =~ /xen/ # eg 2.6.18-4-xen-amd64
- and $ENV{AUTOMATED_TESTING};
-
- plan tests => 60;
-}
-
-$Data::Dumper::Indent = 1;
-$Data::Dumper::Terse = 1;
-
-# log file to store profile results
-my $LOG_FILE = "test_output_profile$$.log";
-my $orig_dbi_debug = $DBI::dbi_debug;
-DBI->trace($DBI::dbi_debug, $LOG_FILE);
-END {
- return if $orig_dbi_debug;
- 1 while unlink $LOG_FILE;
-}
-
-
-print "Test enabling the profile\n";
-
-# make sure profiling starts disabled
-my $dbh = DBI->connect("dbi:ExampleP:", '', '', { RaiseError=>1 });
-ok($dbh, 'connect');
-ok(!$dbh->{Profile} && !$ENV{DBI_PROFILE}, 'Profile and DBI_PROFILE not set');
-
-
-# can turn it on after the fact using a path number
-$dbh = DBI->connect("dbi:ExampleP:", '', '', { RaiseError=>1 });
-$dbh->{Profile} = "4";
-is_deeply sanitize_tree($dbh->{Profile}), bless {
- 'Path' => [ '!MethodName' ],
-} => 'DBI::Profile';
-
-# using a package name
-$dbh = DBI->connect("dbi:ExampleP:", '', '', { RaiseError=>1 });
-$dbh->{Profile} = "/DBI::Profile";
-is_deeply sanitize_tree($dbh->{Profile}), bless {
- 'Path' => [ ],
-} => 'DBI::Profile';
-
-# using a combined path and name
-$dbh = DBI->connect("dbi:ExampleP:", '', '', { RaiseError=>1 });
-$dbh->{Profile} = "20/DBI::Profile";
-is_deeply sanitize_tree($dbh->{Profile}), bless {
- 'Path' => [ '!MethodName', '!Caller2' ],
-} => 'DBI::Profile';
-
-my $t_file = __FILE__;
-$dbh->do("set foo=1"); my $line = __LINE__;
-my $expected_caller = "40profile.t line $line";
-$expected_caller .= " via ${1}40profile.t line 4"
- if $0 =~ /(zv\w+_)/;
-print Dumper($dbh->{Profile});
-is_deeply sanitize_tree($dbh->{Profile}), bless {
- 'Path' => [ '!MethodName', '!Caller2' ],
- 'Data' => { 'do' => {
- $expected_caller => [ 1, 0, 0, 0, 0, 0, 0 ]
- } }
-} => 'DBI::Profile'
- or warn Dumper $dbh->{Profile};
-
-
-# can turn it on at connect
-$dbh = DBI->connect("dbi:ExampleP:", '', '', { RaiseError=>1, Profile=>6 });
-is_deeply $dbh->{Profile}{Path}, [ '!Statement', '!MethodName' ];
-cmp_ok(keys %{ $dbh->{Profile}{Data} }, '==', 1, 'on at connect, 1 key');
-cmp_ok(keys %{ $dbh->{Profile}{Data}{""} }, '>=', 1, 'on at connect, 1 key'); # at least STORE
-ok(ref $dbh->{Profile}{Data}{""}{STORE}, 'STORE is ref');
-
-print "dbi_profile\n";
-# Try to avoid rounding problem on double precision systems
-# $got->[5] = '1150962858.01596498'
-# $expected->[5] = '1150962858.015965'
-# by treating as a string (because is_deeply stringifies)
-my $t1 = DBI::dbi_time() . "";
-my $dummy_statement = "Hi mom";
-my $dummy_methname = "my_method_name";
-my $leaf = dbi_profile($dbh, $dummy_statement, $dummy_methname, $t1, $t1 + 1);
-print Dumper($dbh->{Profile});
-cmp_ok(keys %{ $dbh->{Profile}{Data} }, '==', 2, 'avoid rounding, 1 key');
-cmp_ok(keys %{ $dbh->{Profile}{Data}{$dummy_statement} }, '==', 1,
- 'avoid rounding, 1 dummy statement');
-is(ref($dbh->{Profile}{Data}{$dummy_statement}{$dummy_methname}), 'ARRAY',
- 'dummy method name is array');
-
-ok $leaf, "should return ref to leaf node";
-is ref $leaf, 'ARRAY', "should return ref to leaf node";
-
-my $mine = $dbh->{Profile}{Data}{$dummy_statement}{$dummy_methname};
-
-is $leaf, $mine, "should return ref to correct leaf node";
-
-print "@$mine\n";
-is_deeply $mine, [ 1, 1, 1, 1, 1, $t1, $t1 ];
-
-my $t2 = DBI::dbi_time() . "";
-dbi_profile($dbh, $dummy_statement, $dummy_methname, $t2, $t2 + 2);
-print "@$mine\n";
-is_deeply $mine, [ 2, 3, 1, 1, 2, $t1, $t2 ];
-
-
-print "Test collected profile data\n";
-
-$dbh = DBI->connect("dbi:ExampleP:", '', '', { RaiseError=>1, Profile=>2 });
-# do a (hopefully) measurable amount of work
-my $sql = "select mode,size,name from ?";
-my $sth = $dbh->prepare($sql);
-for my $loop (1..50) { # enough work for low-res timers or v.fast cpus
- $sth->execute(".");
- while ( my $hash = $sth->fetchrow_hashref ) {}
-}
-$dbh->do("set foo=1");
-
-print Dumper($dbh->{Profile});
-
-# check that the proper key was set in Data
-my $data = $dbh->{Profile}{Data}{$sql};
-ok($data, 'profile data');
-is(ref $data, 'ARRAY', 'ARRAY ref');
-ok(@$data == 7, '7 elements');
-ok((grep { defined($_) } @$data) == 7, 'all 7 defined');
-ok((grep { DBI::looks_like_number($_) } @$data) == 7, 'all 7 numeric');
-my ($count, $total, $first, $shortest, $longest, $time1, $time2) = @$data;
-ok($count > 3, 'count is 3');
-ok($total > $first, ' total > first');
-ok($total > $longest, 'total > longest') or
- warn "total $total > longest $longest: failed\n";
-ok($longest > 0, 'longest > 0') or
- warn "longest $longest > 0: failed\n"; # XXX theoretically not reliable
-ok($longest > $shortest, 'longest > shortest');
-ok($time1 >= $^T, 'time1 later than start time');
-ok($time2 >= $^T, 'time2 later than start time');
-ok($time1 <= $time2, 'time1 <= time2');
-my $next = int(dbi_time()) + 1;
-ok($next > $time1, 'next > time1') or
- warn "next $next > first $time1: failed\n";
-ok($next > $time2, 'next > time2') or
- warn "next $next > last $time2: failed\n";
-if ($shortest < 0) {
- my $sys = "$Config{archname} $Config{osvers}"; # ie sparc-linux 2.4.20-2.3sparcsmp
- warn <<EOT;
-Time went backwards at some point during the test on this $sys system!
-Perhaps you have time sync software (like NTP) that adjusted the clock
-by more than $shortest seconds during the test.
-Also some multiprocessor systems, and some virtualization systems can exhibit
-this kind of clock behaviour. Please retry.
-EOT
- # don't treat small negative values as failure
- $shortest = 0 if $shortest > -0.008;
-}
-
-
-my $tmp = sanitize_tree($dbh->{Profile});
-$tmp->{Data}{$sql}[0] = -1; # make test insensitive to local file count
-is_deeply $tmp, (bless {
- 'Path' => [ '!Statement' ],
- 'Data' => {
- '' => [ 6, 0, 0, 0, 0, 0, 0 ],
- $sql => [ -1, 0, 0, 0, 0, 0, 0 ],
- 'set foo=1' => [ 1, 0, 0, 0, 0, 0, 0 ],
- }
-} => 'DBI::Profile'), 'profile';
-
-print "Test profile format\n";
-my $output = $dbh->{Profile}->format();
-print "Profile Output\n$output";
-
-# check that output was produced in the expected format
-ok(length $output, 'non zero length');
-ok($output =~ /^DBI::Profile:/, 'DBI::Profile');
-ok($output =~ /\((\d+) calls\)/, 'some calls');
-ok($1 >= $count, 'calls >= count');
-
-# -----------------------------------------------------------------------------------
-
-# try statement and method name and reference-to-scalar path
-my $by_reference = 'foo';
-$dbh = DBI->connect("dbi:ExampleP:", 'usrnam', '', {
- RaiseError => 1,
- Profile => { Path => [ '{Username}', '!Statement', \$by_reference, '!MethodName' ] }
-});
-$sql = "select name from .";
-$sth = $dbh->prepare($sql);
-$sth->execute();
-$sth->fetchrow_hashref;
-$by_reference = 'bar';
-$sth->finish;
-undef $sth; # DESTROY
-
-$tmp = sanitize_tree($dbh->{Profile});
-ok $tmp->{Data}{usrnam}{""}{foo}{STORE}, 'username stored';
-$tmp->{Data}{usrnam}{""}{foo} = {};
-# make test insentitive to number of local files
-#warn Dumper($tmp);
-is_deeply $tmp, bless {
- 'Path' => [ '{Username}', '!Statement', \$by_reference, '!MethodName' ],
- 'Data' => {
- '' => { # because Profile was enabled by DBI just before Username was set
- '' => {
- 'foo' => {
- 'STORE' => [ 3, 0, 0, 0, 0, 0, 0 ],
- }
- }
- },
- 'usrnam' => {
- '' => {
- 'foo' => { },
- },
- 'select name from .' => {
- 'foo' => {
- 'execute' => [ 1, 0, 0, 0, 0, 0, 0 ],
- 'fetchrow_hashref' => [ 1, 0, 0, 0, 0, 0, 0 ],
- 'prepare' => [ 1, 0, 0, 0, 0, 0, 0 ],
- },
- 'bar' => {
- 'DESTROY' => [ 1, 0, 0, 0, 0, 0, 0 ],
- 'finish' => [ 1, 0, 0, 0, 0, 0, 0 ],
- },
- },
- },
- },
-} => 'DBI::Profile';
-
-$tmp = [ $dbh->{Profile}->as_node_path_list() ];
-is @$tmp, 8, 'should have 8 nodes';
-sanitize_profile_data_nodes($_->[0]) for @$tmp;
-#warn Dumper($dbh->{Profile}->{Data});
-is_deeply $tmp, [
- [ [ 3, 0, 0, 0, 0, 0, 0 ], '', '', 'foo', 'STORE' ],
- [ [ 2, 0, 0, 0, 0, 0, 0 ], 'usrnam', '', 'foo', 'STORE' ],
- [ [ 1, 0, 0, 0, 0, 0, 0 ], 'usrnam', '', 'foo', 'connected' ],
- [ [ 1, 0, 0, 0, 0, 0, 0 ], 'usrnam', 'select name from .', 'bar', 'DESTROY' ],
- [ [ 1, 0, 0, 0, 0, 0, 0 ], 'usrnam', 'select name from .', 'bar', 'finish' ],
- [ [ 1, 0, 0, 0, 0, 0, 0 ], 'usrnam', 'select name from .', 'foo', 'execute' ],
- [ [ 1, 0, 0, 0, 0, 0, 0 ], 'usrnam', 'select name from .', 'foo', 'fetchrow_hashref' ],
- [ [ 1, 0, 0, 0, 0, 0, 0 ], 'usrnam', 'select name from .', 'foo', 'prepare' ]
-];
-
-
-print "testing '!File', '!Caller' and their variants in Path\n";
-
-$dbh->{Profile}->{Path} = [ '!File', '!File2', '!Caller', '!Caller2' ];
-$dbh->{Profile}->{Data} = undef;
-
-my $file = (File::Spec->splitpath(__FILE__))[2]; # '40profile.t'
-my ($line1, $line2);
-sub a_sub {
- $sth = $dbh->prepare("select name from ."); $line2 = __LINE__;
-}
-a_sub(); $line1 = __LINE__;
-
-$tmp = sanitize_profile_data_nodes($dbh->{Profile}{Data});
-#warn Dumper($tmp);
-is_deeply $tmp, {
- "$file" => {
- "$file via $file" => {
- "$file line $line2" => {
- "$file line $line2 via $file line $line1" => [ 1, 0, 0, 0, 0, 0, 0 ]
- }
- }
- }
-};
-
-
-print "testing '!Time' and variants in Path\n";
-
-undef $sth;
-my $factor = 1_000_000;
-$dbh->{Profile}->{Path} = [ '!Time', "!Time~$factor", '!MethodName' ];
-$dbh->{Profile}->{Data} = undef;
-
-# give up a timeslice in the hope that the following few lines
-# run in well under a second even of slow/overloaded systems
-$t1 = int(dbi_time())+1; 1 while int(dbi_time()-0.01) < $t1; # spin till just after second starts
-$t2 = int($t1/$factor)*$factor;
-
-$sth = $dbh->prepare("select name from .");
-$tmp = sanitize_profile_data_nodes($dbh->{Profile}{Data});
-
-# if actual "!Time" recorded is 'close enough' then we'll pass
-# the test - it's not worth failing just because a system is slow
-$t1 = (keys %$tmp)[0] if (abs($t1 - (keys %$tmp)[0]) <= 5);
-
-is_deeply $tmp, {
- $t1 => { $t2 => { prepare => [ 1, 0, 0, 0, 0, 0, 0 ] }}
-}, "!Time and !Time~$factor should work"
- or warn Dumper([$t1, $t2, $tmp]);
-
-
-print "testing &norm_std_n3 in Path\n";
-
-$dbh->{Profile} = '&norm_std_n3'; # assign as string to get magic
-is_deeply $dbh->{Profile}{Path}, [
- \&DBI::ProfileSubs::norm_std_n3
-];
-$dbh->{Profile}->{Data} = undef;
-$sql = qq{insert into foo20060726 (a,b) values (42,"foo")};
-dbi_profile( { foo => $dbh, bar => undef }, $sql, 'mymethod', 100000000, 100000002);
-$tmp = $dbh->{Profile}{Data};
-#warn Dumper($tmp);
-is_deeply $tmp, {
- 'insert into foo<N> (a,b) values (<N>,"<S>")' => [ 1, '2', '2', '2', '2', '100000000', '100000000' ]
-}, '&norm_std_n3 should normalize statement';
-
-
-# -----------------------------------------------------------------------------------
-
-print "testing code ref in Path\n";
-
-sub run_test1 {
- my ($profile) = @_;
- $dbh = DBI->connect("dbi:ExampleP:", 'usrnam', '', {
- RaiseError => 1,
- Profile => $profile,
- });
- $sql = "select name from .";
- $sth = $dbh->prepare($sql);
- $sth->execute();
- $sth->fetchrow_hashref;
- $sth->finish;
- undef $sth; # DESTROY
- my $data = sanitize_profile_data_nodes($dbh->{Profile}{Data}, 1);
- return ($data, $dbh) if wantarray;
- return $data;
-}
-
-$tmp = run_test1( { Path => [ 'foo', sub { 'bar' }, 'baz' ] });
-is_deeply $tmp, { 'foo' => { 'bar' => { 'baz' => [ 11, 0,0,0,0,0,0 ] } } };
-
-$tmp = run_test1( { Path => [ 'foo', sub { 'ping','pong' } ] });
-is_deeply $tmp, { 'foo' => { 'ping' => { 'pong' => [ 11, 0,0,0,0,0,0 ] } } };
-
-$tmp = run_test1( { Path => [ 'foo', sub { \undef } ] });
-is_deeply $tmp, { 'foo' => undef }, 'should be vetoed';
-
-# check what code ref sees in $_
-$tmp = run_test1( { Path => [ sub { $_ } ] });
-is_deeply $tmp, {
- '' => [ 6, 0, 0, 0, 0, 0, 0 ],
- 'select name from .' => [ 5, 0, 0, 0, 0, 0, 0 ]
-}, '$_ should contain statement';
-
-# check what code ref sees in @_
-$tmp = run_test1( { Path => [ sub { my ($h,$method) = @_; return \undef if $method =~ /^[A-Z]+$/; return (ref $h, $method) } ] });
-is_deeply $tmp, {
- 'DBI::db' => {
- 'connected' => [ 1, 0, 0, 0, 0, 0, 0 ],
- 'prepare' => [ 1, 0, 0, 0, 0, 0, 0 ],
- },
- 'DBI::st' => {
- 'fetchrow_hashref' => [ 1, 0, 0, 0, 0, 0, 0 ],
- 'execute' => [ 1, 0, 0, 0, 0, 0, 0 ],
- 'finish' => [ 1, 0, 0, 0, 0, 0, 0 ],
- },
-}, 'should have @_ as keys';
-
-# check we can filter by method
-$tmp = run_test1( { Path => [ sub { return \undef unless $_[1] =~ /^fetch/; return $_[1] } ] });
-#warn Dumper($tmp);
-is_deeply $tmp, {
- 'fetchrow_hashref' => [ 1, 0, 0, 0, 0, 0, 0 ],
-}, 'should be able to filter by method';
-
-DBI->trace(0, "STDOUT"); # close current log to flush it
-ok(-s $LOG_FILE, 'output should go to log file');
-
-# -----------------------------------------------------------------------------------
-
-print "testing as_text\n";
-
-# check %N$ indices
-$dbh->{Profile}->{Data} = { P1 => { P2 => [ 100, 400, 42, 43, 44, 45, 46, 47 ] } };
-my $as_text = $dbh->{Profile}->as_text({
- path => [ 'top' ],
- separator => ':',
- format => '%1$s %2$d [ %10$d %11$d %12$d %13$d %14$d %15$d %16$d %17$d ]',
-});
-is($as_text, "top:P1:P2 4 [ 100 400 42 43 44 45 46 47 ]", 'as_text');
-
-# test sortsub
-$dbh->{Profile}->{Data} = {
- A => { Z => [ 101, 1, 2, 3, 4, 5, 6, 7 ] },
- B => { Y => [ 102, 1, 2, 3, 4, 5, 6, 7 ] },
-};
-$as_text = $dbh->{Profile}->as_text({
- separator => ':',
- format => '%1$s %10$d ',
- sortsub => sub { my $ary=shift; @$ary = sort { $a->[2] cmp $b->[2] } @$ary }
-});
-is($as_text, "B:Y 102 A:Z 101 ", 'as_text sortsub');
-
-# general test, including defaults
-($tmp, $dbh) = run_test1( { Path => [ 'foo', '!MethodName', 'baz' ] });
-$as_text = $dbh->{Profile}->as_text();
-$as_text =~ s/\.00+/.0/g;
-#warn "[$as_text]";
-is $as_text, q{foo > DESTROY > baz: 0.0s / 1 = 0.0s avg (first 0.0s, min 0.0s, max 0.0s)
-foo > STORE > baz: 0.0s / 5 = 0.0s avg (first 0.0s, min 0.0s, max 0.0s)
-foo > connected > baz: 0.0s / 1 = 0.0s avg (first 0.0s, min 0.0s, max 0.0s)
-foo > execute > baz: 0.0s / 1 = 0.0s avg (first 0.0s, min 0.0s, max 0.0s)
-foo > fetchrow_hashref > baz: 0.0s / 1 = 0.0s avg (first 0.0s, min 0.0s, max 0.0s)
-foo > finish > baz: 0.0s / 1 = 0.0s avg (first 0.0s, min 0.0s, max 0.0s)
-foo > prepare > baz: 0.0s / 1 = 0.0s avg (first 0.0s, min 0.0s, max 0.0s)
-}, 'as_text general';
-
-# -----------------------------------------------------------------------------------
-
-print "dbi_profile_merge_nodes\n";
-my $total_time = dbi_profile_merge_nodes(
- my $totals=[],
- [ 10, 0.51, 0.11, 0.01, 0.22, 1023110000, 1023110010 ],
- [ 15, 0.42, 0.12, 0.02, 0.23, 1023110005, 1023110009 ],
-);
-$_ = sprintf "%.2f", $_ for @$totals; # avoid precision issues
-is("@$totals", "25.00 0.93 0.11 0.01 0.23 1023110000.00 1023110010.00",
- 'merged nodes');
-is($total_time, 0.93, 'merged time');
-
-$total_time = dbi_profile_merge_nodes(
- $totals=[], {
- foo => [ 10, 1.51, 0.11, 0.01, 0.22, 1023110000, 1023110010 ],
- bar => [ 17, 1.42, 0.12, 0.02, 0.23, 1023110005, 1023110009 ],
- }
-);
-$_ = sprintf "%.2f", $_ for @$totals; # avoid precision issues
-is("@$totals", "27.00 2.93 0.11 0.01 0.23 1023110000.00 1023110010.00",
- 'merged time foo/bar');
-is($total_time, 2.93, 'merged nodes foo/bar time');
-
-exit 0;
-
-
-sub sanitize_tree {
- my $data = shift;
- my $skip_clone = shift;
- return $data unless ref $data;
- $data = dclone($data) unless $skip_clone;
- sanitize_profile_data_nodes($data->{Data}) if $data->{Data};
- return $data;
-}
-
-sub sanitize_profile_data_nodes {
- my $node = shift;
- if (ref $node eq 'HASH') {
- sanitize_profile_data_nodes($_) for values %$node;
- }
- elsif (ref $node eq 'ARRAY') {
- if (@$node == 7 and DBI::looks_like_number($node->[0])) {
- # sanitize the profile data node to simplify tests
- $_ = 0 for @{$node}[1..@$node-1]; # not 0
- }
- }
- return $node;
-}
+++ /dev/null
-#!perl -wl
-# Using -l to ensure ProfileDumper is isolated from changes to $/ and $\ and such
-
-$|=1;
-
-use strict;
-
-#
-# test script for DBI::ProfileDumper
-#
-
-use DBI;
-use Config;
-use Test::More;
-
-BEGIN {
- plan skip_all => 'profiling not supported for DBI::PurePerl'
- if $DBI::PurePerl;
-
- # clock instability on xen systems is a reasonably common cause of failure
- # http://www.nntp.perl.org/group/perl.cpan.testers/2009/05/msg3828158.html
- # so we'll skip automated testing on those systems
- plan skip_all => "skipping profile tests on xen (due to clock instability)"
- if $Config{osvers} =~ /xen/ # eg 2.6.18-4-xen-amd64
- and $ENV{AUTOMATED_TESTING};
-
- plan tests => 15;
-}
-
-BEGIN {
- use_ok( 'DBI' );
- use_ok( 'DBI::ProfileDumper' );
-}
-
-my $prof_file = "dbi$$.prof";
-my $prof_backup = $prof_file . ".prev";
-END { 1 while unlink $prof_file;
- 1 while unlink $prof_backup; }
-
-my $dbh = DBI->connect("dbi:ExampleP:", '', '',
- { RaiseError=>1, Profile=>"2/DBI::ProfileDumper/File:$prof_file" });
-isa_ok( $dbh, 'DBI::db' );
-isa_ok( $dbh->{Profile}, "DBI::ProfileDumper" );
-isa_ok( $dbh->{Profile}{Data}, 'HASH' );
-isa_ok( $dbh->{Profile}{Path}, 'ARRAY' );
-
-# do a little work
-my $sql = "select mode,size,name from ?";
-my $sth = $dbh->prepare($sql);
-isa_ok( $sth, 'DBI::st' );
-$sth->execute(".");
-
-# check that flush_to_disk doesn't change Path if Path is undef (it
-# did before 1.49)
-{
- local $dbh->{Profile}->{Path} = undef;
- $sth->{Profile}->flush_to_disk();
- is($dbh->{Profile}->{Path}, undef);
-}
-
-$sth->{Profile}->flush_to_disk();
-while ( my $hash = $sth->fetchrow_hashref ) {}
-
-# force output
-undef $sth;
-$dbh->disconnect;
-undef $dbh;
-
-# wrote the profile to disk?
-ok( -s $prof_file, 'Profile is on disk and nonzero size' );
-
-# XXX We're breaking encapsulation here
-open(PROF, $prof_file) or die $!;
-my @prof = <PROF>;
-close PROF;
-
-print @prof;
-
-# has a header?
-like( $prof[0], '/^DBI::ProfileDumper\s+([\d.]+)/', 'Found a version number' );
-
-# version matches VERSION? (DBI::ProfileDumper uses $self->VERSION so
-# it's a stringified version object that looks like N.N.N)
-$prof[0] =~ /^DBI::ProfileDumper\s+([\d.]+)/;
-is( $1, DBI::ProfileDumper->VERSION, "Version numbers match in $prof[0]" );
-
-like( $prof[1], qr{^Path\s+=\s+\[\s+\]}, 'Found the Path');
-ok( $prof[2] =~ m{^Program\s+=\s+(\S+)}, 'Found the Program');
-
-# check that expected key is there
-like(join('', @prof), qr/\+\s+1\s+\Q$sql\E/m);
-
-# unlink($prof_file); # now done by 'make clean'
-
-# should be able to load DBI::ProfileDumper::Apache outside apache
-# this also naturally checks for syntax errors etc.
-SKIP: {
- skip "developer-only test", 1
- unless (-d ".svn" || -d ".git") && -f "MANIFEST.SKIP";
- skip "Apache module not installed", 1
- unless eval { require Apache };
- require_ok('DBI::ProfileDumper::Apache')
-}
-
-1;
+++ /dev/null
-#!perl -w
-$|=1;
-
-use strict;
-
-use DBI;
-use Config;
-use Test::More;
-use Data::Dumper;
-
-BEGIN {
- plan skip_all => 'profiling not supported for DBI::PurePerl'
- if $DBI::PurePerl;
-
- # clock instability on xen systems is a reasonably common cause of failure
- # http://www.nntp.perl.org/group/perl.cpan.testers/2009/05/msg3828158.html
- # so we'll skip automated testing on those systems
- plan skip_all => "skipping profile tests on xen (due to clock instability)"
- if $Config{osvers} =~ /xen/ # eg 2.6.18-4-xen-amd64
- and $ENV{AUTOMATED_TESTING};
-
- plan tests => 31;
-}
-
-BEGIN {
- use_ok( 'DBI::ProfileDumper' );
- use_ok( 'DBI::ProfileData' );
-}
-
-my $sql = "select mode,size,name from ?";
-
-my $prof_file = "dbi$$.prof";
-my $prof_backup = $prof_file . ".prev";
-END { 1 while unlink $prof_file;
- 1 while unlink $prof_backup; }
-
-my $dbh = DBI->connect("dbi:ExampleP:", '', '',
- { RaiseError=>1, Profile=>"6/DBI::ProfileDumper/File:$prof_file" });
-isa_ok( $dbh, 'DBI::db', 'Created connection' );
-
-require DBI::Profile;
-DBI::Profile->import(qw(dbi_time));
-
-# do enough work to avoid 0's on systems that are very fast or have low res timers
-my $t1 = dbi_time();
-foreach (1..20) {
- $dbh->do("set dummy=$_");
- my $sth = $dbh->prepare($sql);
- for my $loop (1..90) {
- $sth->execute(".");
- $sth->fetchrow_hashref;
- $sth->finish;
- }
- $sth->{Profile}->flush_to_disk();
-}
-$dbh->disconnect;
-undef $dbh;
-my $t2 = dbi_time();
-note sprintf "DBI work done in %fs (%f - %f)", $t2-$t1, $t2, $t1;
-
-
-# wrote the profile to disk?
-ok(-s $prof_file, "Profile written to disk, non-zero size" );
-
-# load up
-my $prof = DBI::ProfileData->new(
- File => $prof_file,
- Filter => sub {
- my ($path_ref, $data_ref) = @_;
- $path_ref->[0] =~ s/set dummy=\d/set dummy=N/;
- },
-);
-isa_ok( $prof, 'DBI::ProfileData' );
-cmp_ok( $prof->count, '>=', 3, 'At least 3 profile data items' );
-
-# try a few sorts
-my $nodes = $prof->nodes;
-$prof->sort(field => "longest");
-my $longest = $nodes->[0][4];
-ok($longest);
-$prof->sort(field => "longest", reverse => 1);
-cmp_ok( $nodes->[0][4], '<', $longest );
-
-$prof->sort(field => "count");
-my $most = $nodes->[0];
-ok($most);
-$prof->sort(field => "count", reverse => 1);
-cmp_ok( $nodes->[0][0], '<', $most->[0] );
-
-# remove the top count and make sure it's gone
-my $clone = $prof->clone();
-isa_ok( $clone, 'DBI::ProfileData' );
-$clone->sort(field => "count");
-ok($clone->exclude(key1 => $most->[7]));
-
-# compare keys of the new first element and the old one to make sure
-# exclude works
-ok($clone->nodes()->[0][7] ne $most->[7] &&
- $clone->nodes()->[0][8] ne $most->[8]);
-
-# there can only be one
-$clone = $prof->clone();
-isa_ok( $clone, 'DBI::ProfileData' );
-ok($clone->match(key1 => $clone->nodes->[0][7]));
-ok($clone->match(key2 => $clone->nodes->[0][8]));
-ok($clone->count == 1);
-
-# take a look through Data
-my $Data = $prof->Data;
-print "SQL: $_\n" for keys %$Data;
-ok(exists($Data->{$sql}), "Data for '$sql' should exist")
- or print Dumper($Data);
-ok(exists($Data->{$sql}{execute}), "Data for '$sql'->{execute} should exist");
-
-# did the Filter convert set dummy=1 (etc) into set dummy=N?
-ok(exists($Data->{"set dummy=N"}));
-
-# test escaping of \n and \r in keys
-$dbh = DBI->connect("dbi:ExampleP:", '', '',
- { RaiseError=>1, Profile=>"6/DBI::ProfileDumper/File:$prof_file" });
-isa_ok( $dbh, 'DBI::db', 'Created connection' );
-
-my $sql2 = 'select size from . where name = "LITERAL: \r\n"';
-my $sql3 = "select size from . where name = \"EXPANDED: \r\n\"";
-
-# do a little work
-foreach (1,2,3) {
- my $sth2 = $dbh->prepare($sql2);
- isa_ok( $sth2, 'DBI::st' );
- $sth2->execute();
- $sth2->fetchrow_hashref;
- $sth2->finish;
- my $sth3 = $dbh->prepare($sql3);
- isa_ok( $sth3, 'DBI::st' );
- $sth3->execute();
- $sth3->fetchrow_hashref;
- $sth3->finish;
-}
-$dbh->disconnect;
-undef $dbh;
-
-# load dbi.prof
-$prof = DBI::ProfileData->new( File => $prof_file, DeleteFiles => 1 );
-isa_ok( $prof, 'DBI::ProfileData' );
-
-ok(not(-e $prof_file), "file should be deleted when DeleteFiles set" );
-
-
-# make sure the keys didn't get garbled
-$Data = $prof->Data;
-ok(exists $Data->{$sql2}, "Data for '$sql2' should exist")
- or print Dumper($Data);
-ok(exists $Data->{$sql3}, "Data for '$sql3' should exist")
- or print Dumper($Data);
-
-1;
+++ /dev/null
-#!perl -w
-$|=1;
-
-use strict;
-
-#
-# test script for using DBI_PROFILE env var to enable DBI::Profile
-# and testing non-ref assignments to $h->{Profile}
-#
-
-BEGIN { $ENV{DBI_PROFILE} = 6 } # prior to use DBI
-
-use DBI;
-use DBI::Profile;
-use Config;
-use Data::Dumper;
-
-BEGIN {
- if ($DBI::PurePerl) {
- print "1..0 # Skipped: profiling not supported for DBI::PurePerl\n";
- exit 0;
- }
-}
-
-use Test::More tests => 11;
-
-DBI->trace(0, "STDOUT");
-
-my $dbh1 = DBI->connect("dbi:ExampleP:", '', '', { RaiseError=>1 });
-is(ref $dbh1->{Profile}, "DBI::Profile");
-is(ref $dbh1->{Profile}{Data}, 'HASH');
-is(ref $dbh1->{Profile}{Path}, 'ARRAY');
-
-my $dbh2 = DBI->connect("dbi:ExampleP:", '', '', { RaiseError=>1 });
-is(ref $dbh2->{Profile}, "DBI::Profile");
-is(ref $dbh2->{Profile}{Data}, 'HASH');
-is(ref $dbh2->{Profile}{Path}, 'ARRAY');
-
-is $dbh1->{Profile}, $dbh2->{Profile}, '$h->{Profile} should be shared';
-
-$dbh1->do("set dummy=1");
-$dbh1->do("set dummy=2");
-
-my $profile = $dbh1->{Profile};
-
-my $p_data = $profile->{Data};
-is keys %$p_data, 3; # '', $sql1, $sql2
-ok $p_data->{''};
-ok $p_data->{"set dummy=1"};
-ok $p_data->{"set dummy=2"};
-
-__END__
+++ /dev/null
-#!perl -w
-$|=1;
-
-use strict;
-
-use Cwd;
-use File::Path;
-use File::Spec;
-use Test::More;
-
-my $using_dbd_gofer = ($ENV{DBI_AUTOPROXY}||"") =~ /^dbi:Gofer.*transport=/i;
-
-my $tbl;
-BEGIN { $tbl = "db_". $$ . "_" };
-#END { $tbl and unlink glob "${tbl}*" }
-
-use_ok ("DBI");
-use_ok ("DBI::DBD::SqlEngine");
-use_ok ("DBD::File");
-
-my $sql_statement = DBI::DBD::SqlEngine::Statement->isa('SQL::Statement');
-my $dbh = DBI->connect( "DBI:File:", undef, undef, { PrintError => 0, RaiseError => 0, } ); # Can't use DBI::DBD::SqlEngine direct
-
-for my $sql ( split "\n", <<"" )
- CREATE TABLE foo (id INT, foo TEXT)
- CREATE TABLE bar (id INT, baz TEXT)
- INSERT INTO foo VALUES (1, 'Hello world')
- INSERT INTO bar VALUES (1, 'Bugfixes welcome')
- INSERT bar VALUES (2, 'Bug reports, too')
- SELECT foo FROM foo where ID=1
- UPDATE bar SET id=5 WHERE baz='Bugfixes welcome'
- DELETE FROM foo
- DELETE FROM bar WHERE baz='Bugfixes welcome'
-
-{
- my $sth;
- $sql =~ s/^\s+//;
- eval { $sth = $dbh->prepare( $sql ); };
- ok( $sth, "prepare '$sql'" );
-}
-
-for my $line ( split "\n", <<"" )
- Junk -- Junk
- CREATE foo (id INT, foo TEXT) -- missing table
- INSERT INTO bar (1, 'Bugfixes welcome') -- missing "VALUES"
- UPDATE bar id=5 WHERE baz="Bugfixes welcome" -- missing "SET"
- DELETE * FROM foo -- waste between "DELETE" and "FROM"
-
-{
- my $sth;
- $line =~ s/^\s+//;
- my ($sql, $test) = ( $line =~ m/^([^-]+)\s+--\s+(.*)$/ );
- eval { $sth = $dbh->prepare( $sql ); };
- ok( !$sth, "$test: prepare '$sql'" );
-}
-
-SKIP: {
- # some SQL::Statement / SQL::Parser related tests
- skip( "Not running with SQL::Statement", 3 ) unless ($sql_statement);
- for my $line ( split "\n", <<"" )
- Junk -- Junk
- CREATE TABLE bar (id INT, baz CHARACTER VARYING(255)) -- invalid column type
-
- {
- my $sth;
- $line =~ s/^\s+//;
- my ($sql, $test) = ( $line =~ m/^([^-]+)\s+--\s+(.*)$/ );
- eval { $sth = $dbh->prepare( $sql ); };
- ok( !$sth, "$test: prepare '$sql'" );
- }
-
- my $dbh2 = DBI->connect( "DBI:File:", undef, undef, { sql_dialect => "ANSI" } );
- my $sth;
- eval { $sth = $dbh2->prepare( "CREATE TABLE foo (id INTEGER PRIMARY KEY, phrase CHARACTER VARYING(40) UNIQUE)" ); };
- ok( $sth, "prepared statement using ANSI dialect" );
- skip( "Gofer proxy prevents fetching embedded SQL::Parser object", 1 );
- my $sql_parser = $dbh2->FETCH("sql_parser_object");
- cmp_ok( $sql_parser->dialect(), "eq", "ANSI", "SQL::Parser has 'ANSI' as dialect" );
-}
-
-SKIP: {
- skip( 'not running with DBIx::ContextualFetch', 2 )
- unless eval { require DBIx::ContextualFetch; 1; };
-
- my $dbh;
-
- ok ($dbh = DBI->connect('dbi:File:','','', {RootClass => 'DBIx::ContextualFetch'}));
- is ref $dbh, 'DBIx::ContextualFetch::db', 'root class is DBIx::ContextualFetch';
-}
-
-done_testing ();
+++ /dev/null
-#!perl -w
-$|=1;
-
-use strict;
-
-use Cwd;
-use File::Path;
-use File::Spec;
-use Test::More;
-
-my $using_dbd_gofer = ($ENV{DBI_AUTOPROXY}||"") =~ /^dbi:Gofer.*transport=/i;
-
-my $tbl;
-BEGIN { $tbl = "db_". $$ . "_" };
-#END { $tbl and unlink glob "${tbl}*" }
-
-use_ok ("DBI");
-use_ok ("DBD::File");
-
-do "./t/lib.pl";
-
-my $dir = test_dir ();
-
-my $rowidx = 0;
-my @rows = ( [ "Hello World" ], [ "Hello DBI Developers" ], );
-
-my $dbh;
-
-# Check if we can connect at all
-ok ($dbh = DBI->connect ("dbi:File:"), "Connect clean");
-is (ref $dbh, "DBI::db", "Can connect to DBD::File driver");
-
-my $f_versions = $dbh->func ("f_versions");
-note $f_versions;
-ok ($f_versions, "f_versions");
-
-# Check if all the basic DBI attributes are accepted
-ok ($dbh = DBI->connect ("dbi:File:", undef, undef, {
- RaiseError => 1,
- PrintError => 1,
- AutoCommit => 1,
- ChopBlanks => 1,
- ShowErrorStatement => 1,
- FetchHashKeyName => "NAME_lc",
- }), "Connect with DBI attributes");
-
-# Check if all the f_ attributes are accepted, in two ways
-ok ($dbh = DBI->connect ("dbi:File:f_ext=.txt;f_dir=.;f_encoding=cp1252;f_schema=test"), "Connect with driver attributes in DSN");
-
-my $encoding = "iso-8859-1";
-
-# now use dir to prove file existence
-ok ($dbh = DBI->connect ("dbi:File:", undef, undef, {
- f_ext => ".txt",
- f_dir => $dir,
- f_schema => undef,
- f_encoding => $encoding,
- f_lock => 0,
-
- RaiseError => 0,
- PrintError => 0,
- }), "Connect with driver attributes in hash");
-
-my $sth;
-ok ($sth = $dbh->prepare ("select * from t_sbdgf_53442Gz"), "Prepare select from non-existing file");
-
-{ my @msg;
- eval {
- local $SIG{__DIE__} = sub { push @msg, @_ };
- $sth->execute;
- };
- like ("@msg", qr{Cannot open .*t_sbdgf_}, "Cannot open non-existing file");
- eval {
- note $dbh->f_get_meta ("t_sbdgf_53442Gz", "f_fqfn");
- };
- }
-
-SKIP: {
- my $fh;
- my $tbl2 = $tbl . "2";
-
- my $tbl2_file1 = File::Spec->catfile ($dir, "$tbl2.txt");
- open $fh, ">", $tbl2_file1 or skip;
- print $fh "You cannot read this anyway ...";
- close $fh;
-
- my $tbl2_file2 = File::Spec->catfile ($dir, "$tbl2");
- open $fh, ">", $tbl2_file2 or skip;
- print $fh "Neither that";
- close $fh;
-
- ok ($dbh->do ("drop table if exists $tbl2"), "drop manually created table $tbl2 (first file)");
- ok (! -f $tbl2_file1, "$tbl2_file1 removed");
- ok ( -f $tbl2_file2, "$tbl2_file2 exists");
- ok ($dbh->do ("drop table if exists $tbl2"), "drop manually created table $tbl2 (second file)");
- ok (! -f $tbl2_file2, "$tbl2_file2 removed");
- }
-
-my @tfhl;
-
-# Now test some basic SQL statements
-my $tbl_file = File::Spec->catfile (Cwd::abs_path ($dir), "$tbl.txt");
-ok ($dbh->do ("create table $tbl (txt varchar (20))"), "Create table $tbl") or diag $dbh->errstr;
-ok (-f $tbl_file, "Test table exists");
-
-is ($dbh->f_get_meta ($tbl, "f_fqfn"), $tbl_file, "get single table meta data");
-is_deeply ($dbh->f_get_meta ([$tbl, "t_sbdgf_53442Gz"], [qw(f_dir f_ext)]),
- {
- $tbl => {
- f_dir => $dir,
- f_ext => ".txt",
- },
- t_sbdgf_53442Gz => {
- f_dir => $dir,
- f_ext => ".txt",
- },
- },
- "get multiple meta data");
-
-# Expected: ("unix", "perlio", "encoding(iso-8859-1)")
-# use Data::Peek; DDumper [ @tfh ];
-my @layer = grep { $_ eq "encoding($encoding)" } @tfhl;
-is (scalar @layer, 1, "encoding shows in layer");
-
-my @tables = sort $dbh->func ("list_tables");
-is_deeply (\@tables, [sort "000_just_testing", $tbl], "Listing tables gives test table");
-
-ok ($sth = $dbh->table_info (), "table_info");
-@tables = sort { $a->[2] cmp $b->[2] } @{$sth->fetchall_arrayref};
-is_deeply (\@tables, [ map { [ undef, undef, $_, 'TABLE', 'FILE' ] } sort "000_just_testing", $tbl ], "table_info gives test table");
-
-SKIP: {
- $using_dbd_gofer and skip "modifying meta data doesn't work with Gofer-AutoProxy", 6;
- ok ($dbh->f_set_meta ($tbl, "f_dir", $dir), "set single meta datum");
- is ($tbl_file, $dbh->f_get_meta ($tbl, "f_fqfn"), "verify set single meta datum");
- ok ($dbh->f_set_meta ($tbl, { f_dir => $dir }), "set multiple meta data");
- is ($tbl_file, $dbh->f_get_meta ($tbl, "f_fqfn"), "verify set multiple meta attributes");
-
- ok($dbh->f_new_meta("t_bsgdf_3544G2z", {
- f_ext => undef,
- f_dir => $dir,
- }), "initialize new table (meta) with settings");
-
- my $t_bsgdf_file = File::Spec->catfile (Cwd::abs_path ($dir), "t_bsgdf_3544G2z");
- is($t_bsgdf_file, $dbh->f_get_meta ("t_bsgdf_3544G2z", "f_fqfn"), "verify create meta from scratch");
- }
-
-ok ($sth = $dbh->prepare ("select * from $tbl"), "Prepare select * from $tbl");
-$rowidx = 0;
-SKIP: {
- $using_dbd_gofer and skip "method intrusion didn't work with proxying", 1;
- ok ($sth->execute, "execute on $tbl");
- $dbh->errstr and diag $dbh->errstr;
- }
-
-my $uctbl = uc ($tbl);
-ok ($sth = $dbh->prepare ("select * from $uctbl"), "Prepare select * from $uctbl");
-$rowidx = 0;
-SKIP: {
- $using_dbd_gofer and skip "method intrusion didn't work with proxying", 1;
- ok ($sth->execute, "execute on $uctbl");
- $dbh->errstr and diag $dbh->errstr;
- }
-
-# ==================== ReadOnly tests =============================
-ok ($dbh = DBI->connect ("dbi:File:", undef, undef, {
- f_ext => ".txt",
- f_dir => $dir,
- f_schema => undef,
- f_encoding => $encoding,
- f_lock => 0,
-
- sql_meta => {
- $tbl => {
- col_names => [qw(txt)],
- }
- },
-
- RaiseError => 0,
- PrintError => 0,
- ReadOnly => 1,
- }), "ReadOnly connect with driver attributes in hash");
-
-ok ($sth = $dbh->prepare ("select * from $tbl"), "Prepare select * from $tbl");
-$rowidx = 0;
-SKIP: {
- $using_dbd_gofer and skip "method intrusion didn't work with proxying", 3;
- ok ($sth->execute, "execute on $tbl");
- like ($_, qr{^[0-9]+$}, "TYPE is numeric") for @{$sth->{TYPE}};
- like ($_, qr{^[A-Z]\w+$}, "TYPE_NAME is set") for @{$sth->{TYPE_NAME}};
- $dbh->errstr and diag $dbh->errstr;
- }
-
-ok ($sth = $dbh->prepare ("insert into $tbl (txt) values (?)"), "prepare 'insert into $tbl'");
-is ($sth->execute ("Perl rules"), undef, "insert failed intensionally");
-
-ok ($sth = $dbh->prepare ("delete from $tbl"), "prepare 'delete from $tbl'");
-is ($sth->execute (), undef, "delete failed intensionally");
-
-is ($dbh->do ("drop table $tbl"), undef, "table drop failed intensionally");
-is (-f $tbl_file, 1, "Test table not removed");
-
-# ==================== ReadWrite again tests ======================
-ok ($dbh = DBI->connect ("dbi:File:", undef, undef, {
- f_ext => ".txt",
- f_dir => $dir,
- f_schema => undef,
- f_encoding => $encoding,
- f_lock => 0,
-
- RaiseError => 0,
- PrintError => 0,
- }), "ReadWrite for drop connect with driver attributes in hash");
-
-# XXX add a truncate test
-
-ok ($dbh->do ("drop table $tbl"), "table drop");
-is (-s $tbl_file, undef, "Test table removed"); # -s => size test
-
-# ==================== Nonexisting top-dir ========================
-my %drh = DBI->installed_drivers;
-my $qer = qr{\bNo such directory};
-foreach my $tld ("./non-existing", "nonexisting_folder", "/Fr-dle/hurd0k/ok$$") {
- is (DBI->connect ("dbi:File:", undef, undef, {
- f_dir => $tld,
-
- RaiseError => 0,
- PrintError => 0,
- }), undef, "Should not be able to open a DB to $tld");
- like ($DBI::errstr, $qer, "Error message");
- $drh{File}->set_err (undef, "");
- is ($DBI::errstr, undef, "Cleared error");
- my $dbh;
- eval { $dbh = DBI->connect ("dbi:File:", undef, undef, {
- f_dir => $tld,
-
- RaiseError => 1,
- PrintError => 0,
- })};
- is ($dbh, undef, "connect () should die on $tld with RaiseError");
- like ($@, $qer, "croak message");
- like ($DBI::errstr, $qer, "Error message");
- }
-
-done_testing ();
-
-sub DBD::File::Table::fetch_row ($$)
-{
- my ($self, $data) = @_;
- my $meta = $self->{meta};
- if ($rowidx >= scalar @rows) {
- $self->{row} = undef;
- }
- else {
- $self->{row} = $rows[$rowidx++];
- }
- return $self->{row};
- } # fetch_row
-
-sub DBD::File::Table::push_names ($$$)
-{
- my ($self, $data, $row_aryref) = @_;
- my $meta = $self->{meta};
- @tfhl = PerlIO::get_layers ($meta->{fh});
- @{$meta->{col_names}} = @{$row_aryref};
- } # push_names
+++ /dev/null
-#!perl -w
-$|=1;
-
-use strict;
-use warnings;
-
-require DBD::DBM;
-
-use File::Path;
-use File::Spec;
-use Test::More;
-use Cwd;
-use Config qw(%Config);
-use Storable qw(dclone);
-
-my $using_dbd_gofer = ($ENV{DBI_AUTOPROXY}||'') =~ /^dbi:Gofer.*transport=/i;
-
-use DBI;
-use vars qw( @mldbm_types @dbm_types );
-
-BEGIN {
-
- # 0=SQL::Statement if avail, 1=DBI::SQL::Nano
- # next line forces use of Nano rather than default behaviour
- # $ENV{DBI_SQL_NANO}=1;
- # This is done in zv*n*_50dbm_simple.t
-
- push @mldbm_types, '';
- if (eval { require 'MLDBM.pm'; }) {
- push @mldbm_types, qw(Data::Dumper Storable); # both in CORE
- push @mldbm_types, 'FreezeThaw' if eval { require 'FreezeThaw.pm' };
- push @mldbm_types, 'YAML' if eval { require MLDBM::Serializer::YAML; };
- push @mldbm_types, 'JSON' if eval { require MLDBM::Serializer::JSON; };
- }
-
- # Potential DBM modules in preference order (SDBM_File first)
- # skip NDBM and ODBM as they don't support EXISTS
- my @dbms = qw(SDBM_File GDBM_File DB_File BerkeleyDB NDBM_File ODBM_File);
- my @use_dbms = @ARGV;
- if( !@use_dbms && $ENV{DBD_DBM_TEST_BACKENDS} ) {
- @use_dbms = split ' ', $ENV{DBD_DBM_TEST_BACKENDS};
- }
-
- if (lc "@use_dbms" eq "all") {
- # test with as many of the major DBM types as are available
- @dbm_types = grep { eval { local $^W; require "$_.pm" } } @dbms;
- }
- elsif (@use_dbms) {
- @dbm_types = @use_dbms;
- }
- else {
- # we only test SDBM_File by default to avoid tripping up
- # on any broken DBM's that may be installed in odd places.
- # It's only DBD::DBM we're trying to test here.
- # (However, if SDBM_File is not available, then use another.)
- for my $dbm (@dbms) {
- if (eval { local $^W; require "$dbm.pm" }) {
- @dbm_types = ($dbm);
- last;
- }
- }
- }
-
- if( eval { require List::MoreUtils; } )
- {
- List::MoreUtils->import("part");
- }
- else
- {
- # XXX from PP part of List::MoreUtils
- eval <<'EOP';
-sub part(&@) {
- my ($code, @list) = @_;
- my @parts;
- push @{ $parts[$code->($_)] }, $_ for @list;
- return @parts;
-}
-EOP
- }
-}
-
-my $dbi_sql_nano = not DBD::DBM::Statement->isa('SQL::Statement');
-
-do "./t/lib.pl";
-
-my $dir = test_dir ();
-
-my %tests_statement_results = (
- 2 => [
- "DROP TABLE IF EXISTS fruit", -1,
- "CREATE TABLE fruit (dKey INT, dVal VARCHAR(10))", '0E0',
- "INSERT INTO fruit VALUES (1,'oranges' )", 1,
- "INSERT INTO fruit VALUES (2,'to_change' )", 1,
- "INSERT INTO fruit VALUES (3, NULL )", 1,
- "INSERT INTO fruit VALUES (4,'to delete' )", 1,
- "INSERT INTO fruit VALUES (?,?); #5,via placeholders", 1,
- "INSERT INTO fruit VALUES (6,'to delete' )", 1,
- "INSERT INTO fruit VALUES (7,'to_delete' )", 1,
- "DELETE FROM fruit WHERE dVal='to delete'", 2,
- "UPDATE fruit SET dVal='apples' WHERE dKey=2", 1,
- "DELETE FROM fruit WHERE dKey=7", 1,
- "SELECT * FROM fruit ORDER BY dKey DESC", [
- [ 5, 'via placeholders' ],
- [ 3, '' ],
- [ 2, 'apples' ],
- [ 1, 'oranges' ],
- ],
- "DELETE FROM fruit", 4,
- $dbi_sql_nano ? () : ( "SELECT COUNT(*) FROM fruit", [ [ 0 ] ] ),
- "DROP TABLE fruit", -1,
- ],
- 3 => [
- "DROP TABLE IF EXISTS multi_fruit", -1,
- "CREATE TABLE multi_fruit (dKey INT, dVal VARCHAR(10), qux INT)", '0E0',
- "INSERT INTO multi_fruit VALUES (1,'oranges' , 11 )", 1,
- "INSERT INTO multi_fruit VALUES (2,'to_change', 0 )", 1,
- "INSERT INTO multi_fruit VALUES (3, NULL , 13 )", 1,
- "INSERT INTO multi_fruit VALUES (4,'to_delete', 14 )", 1,
- "INSERT INTO multi_fruit VALUES (?,?,?); #5,via placeholders,15", 1,
- "INSERT INTO multi_fruit VALUES (6,'to_delete', 16 )", 1,
- "INSERT INTO multi_fruit VALUES (7,'to delete', 17 )", 1,
- "INSERT INTO multi_fruit VALUES (8,'to remove', 18 )", 1,
- "UPDATE multi_fruit SET dVal='apples', qux='12' WHERE dKey=2", 1,
- "DELETE FROM multi_fruit WHERE dVal='to_delete'", 2,
- "DELETE FROM multi_fruit WHERE qux=17", 1,
- "DELETE FROM multi_fruit WHERE dKey=8", 1,
- "SELECT * FROM multi_fruit ORDER BY dKey DESC", [
- [ 5, 'via placeholders', 15 ],
- [ 3, undef, 13 ],
- [ 2, 'apples', 12 ],
- [ 1, 'oranges', 11 ],
- ],
- "DELETE FROM multi_fruit", 4,
- $dbi_sql_nano ? () : ( "SELECT COUNT(*) FROM multi_fruit", [ [ 0 ] ] ),
- "DROP TABLE multi_fruit", -1,
- ],
-);
-
-print "Using DBM modules: @dbm_types\n";
-print "Using MLDBM serializers: @mldbm_types\n" if @mldbm_types;
-
-my %test_statements;
-my %expected_results;
-
-for my $columns ( 2 .. 3 )
-{
- my $i = 0;
- my @tests = part { $i++ % 2 } @{ $tests_statement_results{$columns} };
- @{ $test_statements{$columns} } = @{$tests[0]};
- @{ $expected_results{$columns} } = @{$tests[1]};
-}
-
-unless (@dbm_types) {
- plan skip_all => "No DBM modules available";
-}
-
-for my $mldbm ( @mldbm_types ) {
- my $columns = ($mldbm) ? 3 : 2;
- for my $dbm_type ( @dbm_types ) {
- print "\n--- Using $dbm_type ($mldbm) ---\n";
- eval { do_test( $dbm_type, $mldbm, $columns) }
- or warn $@;
- }
-}
-
-done_testing();
-
-sub do_test {
- my ($dtype, $mldbm, $columns) = @_;
-
- #diag ("Starting test: " . $starting_test_no);
-
- # The DBI can't test locking here, sadly, because of the risk it'll hang
- # on systems with broken NFS locking daemons.
- # (This test script doesn't test that locking actually works anyway.)
-
- # use f_lockfile in next release - use it here as test case only
- my $dsn ="dbi:DBM(RaiseError=0,PrintError=1):dbm_type=$dtype;dbm_mldbm=$mldbm;f_lockfile=.lck";
-
- if ($using_dbd_gofer) {
- $dsn .= ";f_dir=$dir";
- }
-
- my $dbh = DBI->connect( $dsn );
-
- my $dbm_versions;
- if ($DBI::VERSION >= 1.37 # needed for install_method
- && !$ENV{DBI_AUTOPROXY} # can't transparently proxy driver-private methods
- ) {
- $dbm_versions = $dbh->dbm_versions;
- }
- else {
- $dbm_versions = $dbh->func('dbm_versions');
- }
- note $dbm_versions;
- ok($dbm_versions, 'dbm_versions');
- isa_ok($dbh, 'DBI::db');
-
- # test if it correctly accepts valid $dbh attributes
- SKIP: {
- skip "Can't set attributes after connect using DBD::Gofer", 2
- if $using_dbd_gofer;
- eval {$dbh->{f_dir}=$dir};
- ok(!$@);
- eval {$dbh->{dbm_mldbm}=$mldbm};
- ok(!$@);
- }
-
- # test if it correctly rejects invalid $dbh attributes
- #
- eval {
- local $SIG{__WARN__} = sub { } if $using_dbd_gofer;
- local $dbh->{RaiseError} = 1;
- local $dbh->{PrintError} = 0;
- $dbh->{dbm_bad_name}=1;
- };
- ok($@);
-
- my @queries = @{$test_statements{$columns}};
- my @results = @{$expected_results{$columns}};
-
- SKIP:
- for my $idx ( 0 .. $#queries ) {
- my $sql = $queries[$idx];
- $sql =~ s/\S*fruit/${dtype}_fruit/; # include dbm type in table name
- $sql =~ s/;$//;
- #diag($sql);
-
- # XXX FIX INSERT with NULL VALUE WHEN COLUMN NOT NULLABLE
- $dtype eq 'BerkeleyDB' and !$mldbm and 0 == index($sql, 'INSERT') and $sql =~ s/NULL/''/;
-
- $sql =~ s/\s*;\s*(?:#(.*))//;
- my $comment = $1;
-
- my $sth = $dbh->prepare($sql);
- ok($sth, "prepare $sql") or diag($dbh->errstr || 'unknown error');
-
- my @bind;
- if($sth->{NUM_OF_PARAMS})
- {
- @bind = split /,/, $comment;
- }
- # if execute errors we will handle it, not PrintError:
- $sth->{PrintError} = 0;
- my $n = $sth->execute(@bind);
- ok($n, 'execute') or diag($sth->errstr || 'unknown error');
- next if (!defined($n));
-
- is( $n, $results[$idx], $sql ) unless( 'ARRAY' eq ref $results[$idx] );
- TODO: {
- local $TODO = "AUTOPROXY drivers might throw away sth->rows()" if($ENV{DBI_AUTOPROXY});
- is( $n, $sth->rows, '$sth->execute(' . $sql . ') == $sth->rows' ) if( $sql =~ m/^(?:UPDATE|DELETE)/ );
- }
- next unless $sql =~ /SELECT/;
- my $results='';
- my $allrows = $sth->fetchall_arrayref();
- my $expected_rows = $results[$idx];
- is( $sth->rows, scalar( @{$expected_rows} ), $sql );
- is_deeply( $allrows, $expected_rows, 'SELECT results' );
- }
-
- my $sth = $dbh->table_info();
- ok ($sth, "prepare table_info (without tables)");
- my @tables = $sth->fetchall_arrayref;
- is_deeply( \@tables, [ [] ], "No tables delivered by table_info" );
-
- $dbh->disconnect;
- return 1;
-}
-1;
+++ /dev/null
-#!perl -w
-$| = 1;
-
-use strict;
-use warnings;
-
-use File::Copy ();
-use File::Path;
-use File::Spec ();
-use Test::More;
-
-my $using_dbd_gofer = ( $ENV{DBI_AUTOPROXY} || '' ) =~ /^dbi:Gofer.*transport=/i;
-
-use DBI;
-
-do "./t/lib.pl";
-
-my $dir = test_dir();
-
-my $dbh = DBI->connect( 'dbi:DBM:', undef, undef, {
- f_dir => $dir,
- sql_identifier_case => 1, # SQL_IC_UPPER
- }
-);
-
-ok( $dbh->do(q/drop table if exists FRED/), 'drop table' );
-
-my $dirfext = $^O eq 'VMS' ? '.sdbm_dir' : '.dir';
-
-$dbh->do(q/create table fred (a integer, b integer)/);
-ok( -f File::Spec->catfile( $dir, "FRED$dirfext" ), "FRED$dirfext exists" );
-
-rmtree $dir;
-mkpath $dir;
-
-if ($using_dbd_gofer)
-{
- # can't modify attributes when connect through a Gofer instance
- $dbh->disconnect();
- $dbh = DBI->connect( 'dbi:DBM:', undef, undef, {
- f_dir => $dir,
- sql_identifier_case => 2, # SQL_IC_LOWER
- }
- );
-}
-else
-{
- $dbh->dbm_clear_meta('fred'); # otherwise the col_names are still known!
- $dbh->{sql_identifier_case} = 2; # SQL_IC_LOWER
-}
-
-$dbh->do(q/create table FRED (a integer, b integer)/);
-ok( -f File::Spec->catfile( $dir, "fred$dirfext" ), "fred$dirfext exists" );
-
-my $tblfext;
-unless( $using_dbd_gofer )
-{
- $tblfext = $dbh->{dbm_tables}->{fred}->{f_ext} || '';
- $tblfext =~ s{/r$}{};
- ok( -f File::Spec->catfile( $dir, "fred$tblfext" ), "fred$tblfext exists" );
-}
-
-ok( $dbh->do(q/insert into fRED (a,b) values(1,2)/), 'insert into mixed case table' );
-
-# but change fRED to FRED and it works.
-
-ok( $dbh->do(q/insert into FRED (a,b) values(2,1)/), 'insert into uppercase table' );
-
-unless ($using_dbd_gofer)
-{
- my $fn_tbl2 = $dbh->{dbm_tables}->{fred}->{f_fqfn};
- $fn_tbl2 =~ s/fred(\.[^.]*)?$/freddy$1/;
- my @dbfiles = grep { -f $_ } (
- $dbh->{dbm_tables}->{fred}->{f_fqfn},
- $dbh->{dbm_tables}->{fred}->{f_fqln},
- $dbh->{dbm_tables}->{fred}->{f_fqbn} . ".dir"
- );
- foreach my $fn (@dbfiles)
- {
- my $tgt_fn = $fn;
- $tgt_fn =~ s/fred(\.[^.]*)?$/freddy$1/;
- File::Copy::copy( $fn, $tgt_fn );
- }
- $dbh->{dbm_tables}->{krueger}->{file} = $fn_tbl2;
-
- my $r = $dbh->selectall_arrayref(q/select * from Krueger/);
- ok( @$r == 2, 'rows found via cloned mixed case table' );
-
- ok( $dbh->do(q/drop table if exists KRUeGEr/), 'drop table' );
-}
-
-my $r = $dbh->selectall_arrayref(q/select * from Fred/);
-ok( @$r == 2, 'rows found via mixed case table' );
-
-SKIP:
-{
- DBD::DBM::Statement->isa("SQL::Statement") or skip("quoted identifiers aren't supported by DBI::SQL::Nano",1);
- my $abs_tbl = File::Spec->catfile( $dir, 'fred' );
- # work around SQL::Statement bug
- DBD::DBM::Statement->isa("SQL::Statement") and SQL::Statement->VERSION() lt "1.32" and $abs_tbl =~ s|\\|/|g;
- $r = $dbh->selectall_arrayref( sprintf( q|select * from "%s"|, $abs_tbl ) );
- ok( @$r == 2, 'rows found via select via fully qualified path' );
-}
-
-if( $using_dbd_gofer )
-{
- ok( $dbh->do(q/drop table if exists FRED/), 'drop table' );
- ok( !-f File::Spec->catfile( $dir, "fred$dirfext" ), "fred$dirfext removed" );
-}
-else
-{
- my $tbl_info = { file => "fred$tblfext" };
-
- ok( $dbh->disconnect(), "disconnect" );
- $dbh = DBI->connect( 'dbi:DBM:', undef, undef, {
- f_dir => $dir,
- sql_identifier_case => 2, # SQL_IC_LOWER
- dbm_tables => { fred => $tbl_info },
- }
- );
-
- my @tbl;
- @tbl = $dbh->tables (undef, undef, undef, undef);
- is( scalar @tbl, 1, "Found 1 tables");
-
- $r = $dbh->selectall_arrayref(q/select * from Fred/);
- ok( @$r == 2, 'rows found after reconnect using "dbm_tables"' );
-
- my $deep_dir = File::Spec->catdir( $dir, 'deep' );
- mkpath $deep_dir;
-
- $dbh = DBI->connect( 'dbi:DBM:', undef, undef, {
- f_dir => $deep_dir,
- sql_identifier_case => 2, # SQL_IC_LOWER
- }
- );
- ok( $dbh->do( q{create table wilma (a integer, b char (10))} ), "Create wilma" );
- ok( $dbh->do( q{insert into wilma values (1, 'Barney')} ), "insert Barney" );
- ok( $dbh->disconnect(), "disconnect" );
-
- $dbh = DBI->connect( 'dbi:DBM:', undef, undef, {
- f_dir => $dir,
- sql_identifier_case => 2, # SQL_IC_LOWER
- }
- );
-
- # Make sure wilma is not found without f_dir_search
- @tbl = $dbh->tables (undef, undef, undef, undef);
- is( scalar @tbl, 1, "Found 1 table");
- ok( $dbh->disconnect(), "disconnect" );
-
- $dbh = DBI->connect( 'dbi:DBM:', undef, undef, {
- f_dir => $dir,
- f_dir_search => [ $deep_dir ],
- sql_identifier_case => 2, # SQL_IC_LOWER
- }
- );
-
- @tbl = $dbh->tables (undef, undef, undef, undef);
- is( scalar @tbl, 2, "Found 2 tables");
- # f_dir should always appear before f_dir_search
- like( $tbl[0], qr{(?:^|\.)fred$}i, "Fred first" );
- like( $tbl[1], qr{(?:^|\.)wilma$}i, "Fred second" );
-
- my( $n, $sth );
- ok( $sth = $dbh->prepare( 'select * from fred' ), "select from fred" );
- ok( $sth->execute, "execute fred" );
- $n = 0;
- $n++ while $sth->fetch;
- is( $n, 2, "2 entry in fred" );
- ok( $sth = $dbh->prepare( 'select * from wilma' ), "select from wilma" );
- ok( $sth->execute, "execute wilma" );
- $n = 0;
- $n++ while $sth->fetch;
- is( $n, 1, "1 entry in wilma" );
-
- ok( $dbh->do(q/drop table if exists FRED/), 'drop table fred' );
- ok( !-f File::Spec->catfile( $dir, "fred$dirfext" ), "fred$dirfext removed" );
- ok( !-f File::Spec->catfile( $dir, "fred$tblfext" ), "fred$tblfext removed" );
-
- ok( $dbh->do(q/drop table if exists wilma/), 'drop table wilma' );
- ok( !-f File::Spec->catfile( $deep_dir, "wilma$dirfext" ), "wilma$dirfext removed" );
- ok( !-f File::Spec->catfile( $deep_dir, "wilma$tblfext" ), "wilma$tblfext removed" );
-}
-
-done_testing();
+++ /dev/null
-#!perl -w
-$| = 1;
-
-use strict;
-use warnings;
-
-require DBD::DBM;
-
-use File::Path;
-use File::Spec;
-use Test::More;
-use Cwd;
-use Config qw(%Config);
-use Storable qw(dclone);
-
-my $using_dbd_gofer = ( $ENV{DBI_AUTOPROXY} || '' ) =~ /^dbi:Gofer.*transport=/i;
-
-use DBI;
-use vars qw( @mldbm_types @dbm_types );
-
-BEGIN
-{
-
- # 0=SQL::Statement if avail, 1=DBI::SQL::Nano
- # next line forces use of Nano rather than default behaviour
- # $ENV{DBI_SQL_NANO}=1;
- # This is done in zv*n*_50dbm_simple.t
-
- if ( eval { require 'MLDBM.pm'; } )
- {
- push @mldbm_types, qw(Data::Dumper Storable); # both in CORE
- push @mldbm_types, 'FreezeThaw' if eval { require 'FreezeThaw.pm' };
- push @mldbm_types, 'YAML' if eval { require MLDBM::Serializer::YAML; };
- push @mldbm_types, 'JSON' if eval { require MLDBM::Serializer::JSON; };
- }
-
- # Potential DBM modules in preference order (SDBM_File first)
- # skip NDBM and ODBM as they don't support EXISTS
- my @dbms = qw(SDBM_File GDBM_File DB_File BerkeleyDB NDBM_File ODBM_File);
- my @use_dbms = @ARGV;
- if ( !@use_dbms && $ENV{DBD_DBM_TEST_BACKENDS} )
- {
- @use_dbms = split ' ', $ENV{DBD_DBM_TEST_BACKENDS};
- }
-
- if ( lc "@use_dbms" eq "all" )
- {
- # test with as many of the major DBM types as are available
- @dbm_types = grep {
- eval { local $^W; require "$_.pm" }
- } @dbms;
- }
- elsif (@use_dbms)
- {
- @dbm_types = @use_dbms;
- }
- else
- {
- # we only test SDBM_File by default to avoid tripping up
- # on any broken DBM's that may be installed in odd places.
- # It's only DBD::DBM we're trying to test here.
- # (However, if SDBM_File is not available, then use another.)
- for my $dbm (@dbms)
- {
- if ( eval { local $^W; require "$dbm.pm" } )
- {
- @dbm_types = ($dbm);
- last;
- }
- }
- }
-
- if ( eval { require List::MoreUtils; } )
- {
- List::MoreUtils->import("part");
- }
- else
- {
- # XXX from PP part of List::MoreUtils
- eval <<'EOP';
-sub part(&@) {
- my ($code, @list) = @_;
- my @parts;
- push @{ $parts[$code->($_)] }, $_ for @list;
- return @parts;
-}
-EOP
- }
-}
-
-my $haveSS = DBD::DBM::Statement->isa('SQL::Statement');
-
-plan skip_all => "DBI::SQL::Nano is being used" unless ( $haveSS );
-plan skip_all => "Not running with MLDBM" unless ( @mldbm_types );
-
-do "./t/lib.pl";
-
-my $dir = test_dir ();
-
-my $dbh = DBI->connect( 'dbi:DBM:', undef, undef, { f_dir => $dir, } );
-
-my $suffix;
-my $tbl_meta;
-
-sub break_at_warn
-{
- note "break here";
-}
-$SIG{__WARN__} = \&break_at_warn;
-$SIG{__DIE__} = \&break_at_warn;
-
-sub load_tables
-{
- my ( $dbmtype, $dbmmldbm ) = @_;
- my $last_suffix;
-
- if ($using_dbd_gofer)
- {
- $dbh->disconnect();
- $dbh = DBI->connect( "dbi:DBM:", undef, undef, { f_dir => $dir, dbm_type => $dbmtype, dbm_mldbm => $dbmmldbm } );
- }
- else
- {
- $last_suffix = $suffix;
- $dbh->{dbm_type} = $dbmtype;
- $dbh->{dbm_mldbm} = $dbmmldbm;
- }
-
- (my $serializer = $dbmmldbm ) =~ s/::/_/g;
- $suffix = join( "_", $$, $dbmtype, $serializer );
-
- if ($last_suffix)
- {
- for my $table (qw(APPL_%s PREC_%s NODE_%s LANDSCAPE_%s CONTACT_%s NM_LANDSCAPE_%s APPL_CONTACT_%s))
- {
- my $readsql = sprintf "SELECT * FROM $table", $last_suffix;
- my $impsql = sprintf "CREATE TABLE $table AS IMPORT (?)", $suffix;
- my ($readsth);
- ok( $readsth = $dbh->prepare($readsql), "prepare: $readsql" );
- ok( $readsth->execute(), "execute: $readsql" );
- ok( $dbh->do( $impsql, {}, $readsth ), $impsql ) or warn $dbh->errstr();
- }
- }
- else
- {
- for my $sql ( split( "\n", join( '', <<'EOD' ) ) )
-CREATE TABLE APPL_%s (id INT, applname CHAR, appluniq CHAR, version CHAR, appl_type CHAR)
-CREATE TABLE PREC_%s (id INT, appl_id INT, node_id INT, precedence INT)
-CREATE TABLE NODE_%s (id INT, nodename CHAR, os CHAR, version CHAR)
-CREATE TABLE LANDSCAPE_%s (id INT, landscapename CHAR)
-CREATE TABLE CONTACT_%s (id INT, surname CHAR, familyname CHAR, phone CHAR, userid CHAR, mailaddr CHAR)
-CREATE TABLE NM_LANDSCAPE_%s (id INT, ls_id INT, obj_id INT, obj_type INT)
-CREATE TABLE APPL_CONTACT_%s (id INT, contact_id INT, appl_id INT, contact_type CHAR)
-
-INSERT INTO APPL_%s VALUES ( 1, 'ZQF', 'ZFQLIN', '10.2.0.4', 'Oracle DB')
-INSERT INTO APPL_%s VALUES ( 2, 'YRA', 'YRA-UX', '10.2.0.2', 'Oracle DB')
-INSERT INTO APPL_%s VALUES ( 3, 'PRN1', 'PRN1-4.B2', '1.1.22', 'CUPS' )
-INSERT INTO APPL_%s VALUES ( 4, 'PRN2', 'PRN2-4.B2', '1.1.22', 'CUPS' )
-INSERT INTO APPL_%s VALUES ( 5, 'PRN1', 'PRN1-4.B1', '1.1.22', 'CUPS' )
-INSERT INTO APPL_%s VALUES ( 7, 'PRN2', 'PRN2-4.B1', '1.1.22', 'CUPS' )
-INSERT INTO APPL_%s VALUES ( 8, 'sql-stmt', 'SQL::Statement', '1.21', 'Project Web-Site')
-INSERT INTO APPL_%s VALUES ( 9, 'cpan.org', 'http://www.cpan.org/', '1.0', 'Web-Site')
-INSERT INTO APPL_%s VALUES (10, 'httpd', 'cpan-apache', '2.2.13', 'Web-Server')
-INSERT INTO APPL_%s VALUES (11, 'cpan-mods', 'cpan-mods', '8.4.1', 'PostgreSQL DB')
-INSERT INTO APPL_%s VALUES (12, 'cpan-authors', 'cpan-authors', '8.4.1', 'PostgreSQL DB')
-
-INSERT INTO NODE_%s VALUES ( 1, 'ernie', 'RHEL', '5.2')
-INSERT INTO NODE_%s VALUES ( 2, 'bert', 'RHEL', '5.2')
-INSERT INTO NODE_%s VALUES ( 3, 'statler', 'FreeBSD', '7.2')
-INSERT INTO NODE_%s VALUES ( 4, 'waldorf', 'FreeBSD', '7.2')
-INSERT INTO NODE_%s VALUES ( 5, 'piggy', 'NetBSD', '5.0.2')
-INSERT INTO NODE_%s VALUES ( 6, 'kermit', 'NetBSD', '5.0.2')
-INSERT INTO NODE_%s VALUES ( 7, 'samson', 'NetBSD', '5.0.2')
-INSERT INTO NODE_%s VALUES ( 8, 'tiffy', 'NetBSD', '5.0.2')
-INSERT INTO NODE_%s VALUES ( 9, 'rowlf', 'Debian Lenny', '5.0')
-INSERT INTO NODE_%s VALUES (10, 'fozzy', 'Debian Lenny', '5.0')
-
-INSERT INTO PREC_%s VALUES ( 1, 1, 1, 1)
-INSERT INTO PREC_%s VALUES ( 2, 1, 2, 2)
-INSERT INTO PREC_%s VALUES ( 3, 2, 2, 1)
-INSERT INTO PREC_%s VALUES ( 4, 2, 1, 2)
-INSERT INTO PREC_%s VALUES ( 5, 3, 5, 1)
-INSERT INTO PREC_%s VALUES ( 6, 3, 7, 2)
-INSERT INTO PREC_%s VALUES ( 7, 4, 6, 1)
-INSERT INTO PREC_%s VALUES ( 8, 4, 8, 2)
-INSERT INTO PREC_%s VALUES ( 9, 5, 7, 1)
-INSERT INTO PREC_%s VALUES (10, 5, 5, 2)
-INSERT INTO PREC_%s VALUES (11, 6, 8, 1)
-INSERT INTO PREC_%s VALUES (12, 7, 6, 2)
-INSERT INTO PREC_%s VALUES (13, 10, 9, 1)
-INSERT INTO PREC_%s VALUES (14, 10, 10, 1)
-INSERT INTO PREC_%s VALUES (15, 8, 9, 1)
-INSERT INTO PREC_%s VALUES (16, 8, 10, 1)
-INSERT INTO PREC_%s VALUES (17, 9, 9, 1)
-INSERT INTO PREC_%s VALUES (18, 9, 10, 1)
-INSERT INTO PREC_%s VALUES (19, 11, 3, 1)
-INSERT INTO PREC_%s VALUES (20, 11, 4, 2)
-INSERT INTO PREC_%s VALUES (21, 12, 4, 1)
-INSERT INTO PREC_%s VALUES (22, 12, 3, 2)
-
-INSERT INTO LANDSCAPE_%s VALUES (1, 'Logistic')
-INSERT INTO LANDSCAPE_%s VALUES (2, 'Infrastructure')
-INSERT INTO LANDSCAPE_%s VALUES (3, 'CPAN')
-
-INSERT INTO CONTACT_%s VALUES ( 1, 'Hans Peter', 'Mueller', '12345', 'HPMUE', 'hp-mueller@here.com')
-INSERT INTO CONTACT_%s VALUES ( 2, 'Knut', 'Inge', '54321', 'KINGE', 'k-inge@here.com')
-INSERT INTO CONTACT_%s VALUES ( 3, 'Lola', 'Nguyen', '+1-123-45678-90', 'LNYUG', 'lola.ngyuen@customer.com')
-INSERT INTO CONTACT_%s VALUES ( 4, 'Helge', 'Brunft', '+41-123-45678-09', 'HBRUN', 'helge.brunft@external-dc.at')
-
--- TYPE: 1: APPL 2: NODE 3: CONTACT
-INSERT INTO NM_LANDSCAPE_%s VALUES ( 1, 1, 1, 2)
-INSERT INTO NM_LANDSCAPE_%s VALUES ( 2, 1, 2, 2)
-INSERT INTO NM_LANDSCAPE_%s VALUES ( 3, 3, 3, 2)
-INSERT INTO NM_LANDSCAPE_%s VALUES ( 4, 3, 4, 2)
-INSERT INTO NM_LANDSCAPE_%s VALUES ( 5, 2, 5, 2)
-INSERT INTO NM_LANDSCAPE_%s VALUES ( 6, 2, 6, 2)
-INSERT INTO NM_LANDSCAPE_%s VALUES ( 7, 2, 7, 2)
-INSERT INTO NM_LANDSCAPE_%s VALUES ( 8, 2, 8, 2)
-INSERT INTO NM_LANDSCAPE_%s VALUES ( 9, 3, 9, 2)
-INSERT INTO NM_LANDSCAPE_%s VALUES (10, 3,10, 2)
-INSERT INTO NM_LANDSCAPE_%s VALUES (11, 1, 1, 1)
-INSERT INTO NM_LANDSCAPE_%s VALUES (12, 2, 2, 1)
-INSERT INTO NM_LANDSCAPE_%s VALUES (13, 2, 2, 3)
-INSERT INTO NM_LANDSCAPE_%s VALUES (14, 3, 1, 3)
-
-INSERT INTO APPL_CONTACT_%s VALUES (1, 3, 1, 'OWNER')
-INSERT INTO APPL_CONTACT_%s VALUES (2, 3, 2, 'OWNER')
-INSERT INTO APPL_CONTACT_%s VALUES (3, 4, 3, 'ADMIN')
-INSERT INTO APPL_CONTACT_%s VALUES (4, 4, 4, 'ADMIN')
-INSERT INTO APPL_CONTACT_%s VALUES (5, 4, 5, 'ADMIN')
-INSERT INTO APPL_CONTACT_%s VALUES (6, 4, 6, 'ADMIN')
-EOD
- {
- chomp $sql;
- $sql =~ s/^\s+//;
- $sql =~ s/--.*$//;
- $sql =~ s/\s+$//;
- next if ( '' eq $sql );
- $sql = sprintf $sql, $suffix;
- ok( $dbh->do($sql), $sql );
- }
- }
-
- for my $table (qw(APPL_%s PREC_%s NODE_%s LANDSCAPE_%s CONTACT_%s NM_LANDSCAPE_%s APPL_CONTACT_%s))
- {
- my $tbl_name = lc sprintf($table, $suffix);
- $tbl_meta->{$tbl_name} = { dbm_type => $dbmtype, dbm_mldbm => $dbmmldbm };
- }
-
- unless ($using_dbd_gofer)
- {
- my $tbl_known_meta = $dbh->dbm_get_meta( "+", [ qw(dbm_type dbm_mldbm) ] );
- is_deeply( $tbl_known_meta, $tbl_meta, "Know meta" );
- }
-}
-
-sub do_tests
-{
- my ( $dbmtype, $serializer ) = @_;
-
- note "Running do_tests for $dbmtype + $serializer";
-
- load_tables( $dbmtype, $serializer );
-
- my %joins;
- my $sql;
-
- $sql = join( " ",
- q{SELECT applname, appluniq, version, nodename },
- sprintf( q{FROM APPL_%s, PREC_%s, NODE_%s }, ($suffix) x 3 ),
- sprintf( q{WHERE appl_type LIKE '%%DB' AND APPL_%s.id=PREC_%s.appl_id AND}, ($suffix) x 2 ),
- sprintf( q{PREC_%s.node_id=NODE_%s.id}, ($suffix) x 2 ),
- );
-
- $joins{$sql} = [
- 'ZQF~ZFQLIN~10.2.0.4~ernie', 'ZQF~ZFQLIN~10.2.0.4~bert',
- 'YRA~YRA-UX~10.2.0.2~bert', 'YRA~YRA-UX~10.2.0.2~ernie',
- 'cpan-mods~cpan-mods~8.4.1~statler', 'cpan-mods~cpan-mods~8.4.1~waldorf',
- 'cpan-authors~cpan-authors~8.4.1~waldorf', 'cpan-authors~cpan-authors~8.4.1~statler',
- ];
-
- $sql = join( " ",
- q{SELECT applname, appluniq, version, landscapename, nodename},
- sprintf( q{FROM APPL_%s, PREC_%s, NODE_%s, LANDSCAPE_%s, NM_LANDSCAPE_%s}, ($suffix) x 5 ),
- sprintf( q{WHERE appl_type LIKE '%%DB' AND APPL_%s.id=PREC_%s.appl_id AND}, ($suffix) x 2 ),
- sprintf( q{PREC_%s.node_id=NODE_%s.id AND NM_LANDSCAPE_%s.obj_id=APPL_%s.id AND}, ($suffix) x 4 ),
- sprintf( q{NM_LANDSCAPE_%s.obj_type=1 AND NM_LANDSCAPE_%s.ls_id=LANDSCAPE_%s.id}, ($suffix) x 3 ),
- );
- $joins{$sql} = [
- 'ZQF~ZFQLIN~10.2.0.4~Logistic~ernie', 'ZQF~ZFQLIN~10.2.0.4~Logistic~bert',
- 'YRA~YRA-UX~10.2.0.2~Infrastructure~bert', 'YRA~YRA-UX~10.2.0.2~Infrastructure~ernie',
- ];
- $sql = join( " ",
- q{SELECT applname, appluniq, version, surname, familyname, phone, nodename},
- sprintf( q{FROM APPL_%s, PREC_%s, NODE_%s, CONTACT_%s, APPL_CONTACT_%s}, ($suffix) x 5 ),
- sprintf( q{WHERE appl_type='CUPS' AND APPL_%s.id=PREC_%s.appl_id AND}, ($suffix) x 2 ),
- sprintf( q{PREC_%s.node_id=NODE_%s.id AND APPL_CONTACT_%s.appl_id=APPL_%s.id AND}, ($suffix) x 4 ),
- sprintf( q{APPL_CONTACT_%s.contact_id=CONTACT_%s.id AND PREC_%s.PRECEDENCE=1}, ($suffix) x 3 ),
- );
- $joins{$sql} = [
- 'PRN1~PRN1-4.B2~1.1.22~Helge~Brunft~+41-123-45678-09~piggy',
- 'PRN2~PRN2-4.B2~1.1.22~Helge~Brunft~+41-123-45678-09~kermit',
- 'PRN1~PRN1-4.B1~1.1.22~Helge~Brunft~+41-123-45678-09~samson',
- ];
- $sql = join( " ",
- q{SELECT DISTINCT applname, appluniq, version, surname, familyname, phone, nodename},
- sprintf( q{FROM APPL_%s, PREC_%s, NODE_%s, CONTACT_%s, APPL_CONTACT_%s}, ($suffix) x 5 ),
- sprintf( q{WHERE appl_type='CUPS' AND APPL_%s.id=PREC_%s.appl_id AND}, ($suffix) x 2 ),
- sprintf( q{PREC_%s.node_id=NODE_%s.id AND APPL_CONTACT_%s.appl_id=APPL_%s.id}, ($suffix) x 4 ),
- sprintf( q{AND APPL_CONTACT_%s.contact_id=CONTACT_%s.id}, ($suffix) x 2 ),
- );
- $joins{$sql} = [
- 'PRN1~PRN1-4.B1~1.1.22~Helge~Brunft~+41-123-45678-09~piggy',
- 'PRN1~PRN1-4.B2~1.1.22~Helge~Brunft~+41-123-45678-09~piggy',
- 'PRN1~PRN1-4.B1~1.1.22~Helge~Brunft~+41-123-45678-09~samson',
- 'PRN1~PRN1-4.B2~1.1.22~Helge~Brunft~+41-123-45678-09~samson',
- 'PRN2~PRN2-4.B2~1.1.22~Helge~Brunft~+41-123-45678-09~kermit',
- 'PRN2~PRN2-4.B2~1.1.22~Helge~Brunft~+41-123-45678-09~tiffy',
- ];
- $sql = join( " ",
- q{SELECT CONCAT('[% NOW %]') AS "timestamp", applname, appluniq, version, nodename},
- sprintf( q{FROM APPL_%s, PREC_%s, NODE_%s}, ($suffix) x 3 ),
- sprintf( q{WHERE appl_type LIKE '%%DB' AND APPL_%s.id=PREC_%s.appl_id AND}, ($suffix) x 2 ),
- sprintf( q{PREC_%s.node_id=NODE_%s.id}, ($suffix) x 2 ),
- );
- $joins{$sql} = [
- '[% NOW %]~ZQF~ZFQLIN~10.2.0.4~ernie',
- '[% NOW %]~ZQF~ZFQLIN~10.2.0.4~bert',
- '[% NOW %]~YRA~YRA-UX~10.2.0.2~bert',
- '[% NOW %]~YRA~YRA-UX~10.2.0.2~ernie',
- '[% NOW %]~cpan-mods~cpan-mods~8.4.1~statler',
- '[% NOW %]~cpan-mods~cpan-mods~8.4.1~waldorf',
- '[% NOW %]~cpan-authors~cpan-authors~8.4.1~waldorf',
- '[% NOW %]~cpan-authors~cpan-authors~8.4.1~statler',
- ];
-
- while ( my ( $sql, $result ) = each(%joins) )
- {
- my $sth = $dbh->prepare($sql);
- eval { $sth->execute() };
- warn $@ if $@;
- my @res;
- while ( my $row = $sth->fetchrow_arrayref() )
- {
- push( @res, join( '~', @{$row} ) );
- }
- is( join( '^', sort @res ), join( '^', sort @{$result} ), $sql );
- }
-}
-
-foreach my $dbmtype (@dbm_types)
-{
- foreach my $serializer (@mldbm_types)
- {
- do_tests( $dbmtype, $serializer );
- }
-}
-
-done_testing();
+++ /dev/null
-#!perl -w
-$| = 1;
-
-use strict;
-use warnings;
-
-require DBD::DBM;
-
-use File::Path;
-use File::Spec;
-use Test::More;
-use Cwd;
-use Config qw(%Config);
-use Storable qw(dclone);
-
-my $using_dbd_gofer = ( $ENV{DBI_AUTOPROXY} || '' ) =~ /^dbi:Gofer.*transport=/i;
-plan skip_all => "Modifying driver state won't compute running behind Gofer" if($using_dbd_gofer);
-
-use DBI;
-
-# <[Sno]> what I could do is create a new test case where inserting into a DBD::DBM and after that clone the meta into a DBD::File $dbh
-# <[Sno]> would that help to get a better picture?
-
-do "./t/lib.pl";
-my $dir = test_dir();
-
-my $dbm_dbh = DBI->connect( 'dbi:DBM:', undef, undef, {
- f_dir => $dir,
- sql_identifier_case => 2, # SQL_IC_LOWER
- }
-);
-
-$dbm_dbh->do(q/create table FRED (a integer, b integer)/);
-$dbm_dbh->do(q/insert into fRED (a,b) values(1,2)/);
-$dbm_dbh->do(q/insert into FRED (a,b) values(2,1)/);
-
-my $f_dbh = DBI->connect( 'dbi:File:', undef, undef, {
- f_dir => $dir,
- sql_identifier_case => 2, # SQL_IC_LOWER
- }
-);
-
-my $dbm_fred_meta = $dbm_dbh->f_get_meta("fred", [qw(dbm_type)]);
-$f_dbh->f_new_meta( "fred", {sql_table_class => "DBD::DBM::Table"} );
-
-my $r = $f_dbh->selectall_arrayref(q/select * from Fred/);
-ok( @$r == 2, 'rows found via mixed case table' );
-
-done_testing();
+++ /dev/null
-#!perl -w
-$|=1;
-
-use strict;
-
-use Cwd;
-use File::Path;
-use File::Spec;
-use Test::More;
-
-my $using_dbd_gofer = ($ENV{DBI_AUTOPROXY}||"") =~ /^dbi:Gofer.*transport=/i;
-$using_dbd_gofer and plan skip_all => "modifying meta data doesn't work with Gofer-AutoProxy";
-
-my $tbl;
-BEGIN { $tbl = "db_". $$ . "_" };
-#END { $tbl and unlink glob "${tbl}*" }
-
-use_ok ("DBI");
-use_ok ("DBD::Mem");
-
-my $dbh = DBI->connect( "DBI:Mem:", undef, undef, { PrintError => 0, RaiseError => 0, } ); # Can't use DBI::DBD::SqlEngine direct
-
-for my $sql ( split "\n", <<"" )
- CREATE TABLE foo (id INT, foo TEXT)
- CREATE TABLE bar (id INT, baz TEXT)
- INSERT INTO foo VALUES (1, 'Hello world')
- INSERT INTO bar VALUES (1, 'Bugfixes welcome')
- INSERT bar VALUES (2, 'Bug reports, too')
- SELECT foo FROM foo where ID=1
- UPDATE bar SET id=5 WHERE baz='Bugfixes welcome'
- DELETE FROM foo
- DELETE FROM bar WHERE baz='Bugfixes welcome'
-
-{
- my $done;
- $sql =~ s/^\s+//;
- eval { $done = $dbh->do( $sql ); };
- ok( $done, "executed '$sql'" ) or diag $dbh->errstr;
-}
-
-done_testing ();
+++ /dev/null
-#!perl -w
-
-use DBI qw(:preparse_flags);
-
-$|=1;
-
-use Test::More;
-
-BEGIN {
- if ($DBI::PurePerl) {
- plan skip_all => 'preparse not supported for DBI::PurePerl';
- }
- else {
- plan tests => 39;
- }
-}
-
-my $dbh = DBI->connect("dbi:ExampleP:", "", "", {
- PrintError => 0,
-});
-isa_ok( $dbh, 'DBI::db' );
-
-sub pp {
- my $dbh = shift;
- my $rv = $dbh->preparse(@_);
- return $rv;
-}
-
-# --------------------------------------------------------------------- #
-# DBIpp_cm_cs /* C style */
-# DBIpp_cm_hs /* # */
-# DBIpp_cm_dd /* -- */
-# DBIpp_cm_br /* {} */
-# DBIpp_cm_dw /* '-- ' dash dash whitespace */
-# DBIpp_cm_XX /* any of the above */
-
-# DBIpp_ph_qm /* ? */
-# DBIpp_ph_cn /* :1 */
-# DBIpp_ph_cs /* :name */
-# DBIpp_ph_sp /* %s (as return only, not accept) */
-# DBIpp_ph_XX /* any of the above */
-
-# DBIpp_st_qq /* '' char escape */
-# DBIpp_st_bs /* \ char escape */
-# DBIpp_st_XX /* any of the above */
-
-# ===================================================================== #
-# pp (h input return accept expected) #
-# ===================================================================== #
-
-## Comments:
-
-is( pp($dbh, "a#b\nc", DBIpp_cm_cs, DBIpp_cm_hs), "a/*b*/\nc" );
-is( pp($dbh, "a#b\nc", DBIpp_cm_dw, DBIpp_cm_hs), "a-- b\nc" );
-is( pp($dbh, "a/*b*/c", DBIpp_cm_hs, DBIpp_cm_cs), "a#b\nc" );
-is( pp($dbh, "a{b}c", DBIpp_cm_cs, DBIpp_cm_br), "a/*b*/c" );
-is( pp($dbh, "a--b\nc", DBIpp_cm_br, DBIpp_cm_dd), "a{b}\nc" );
-
-is( pp($dbh, "a-- b\n/*c*/d", DBIpp_cm_br, DBIpp_cm_cs|DBIpp_cm_dw), "a{ b}\n{c}d" );
-is( pp($dbh, "a/*b*/c#d\ne--f\nh-- i\nj{k}", 0, DBIpp_cm_XX), "a c\ne\nh\nj " );
-
-## Placeholders:
-
-is( pp($dbh, "a = :1", DBIpp_ph_qm, DBIpp_ph_cn), "a = ?" );
-is( pp($dbh, "a = :1", DBIpp_ph_sp, DBIpp_ph_cn), "a = %s" );
-is( pp($dbh, "a = ?" , DBIpp_ph_cn, DBIpp_ph_qm), "a = :p1" );
-is( pp($dbh, "a = ?" , DBIpp_ph_sp, DBIpp_ph_qm), "a = %s" );
-
-is( pp($dbh, "a = :name", DBIpp_ph_qm, DBIpp_ph_cs), "a = ?" );
-is( pp($dbh, "a = :name", DBIpp_ph_sp, DBIpp_ph_cs), "a = %s" );
-
-is( pp($dbh, "a = ? b = ? c = ?", DBIpp_ph_cn, DBIpp_ph_XX), "a = :p1 b = :p2 c = :p3" );
-
-## Placeholders inside comments (should be ignored where comments style is accepted):
-
-is( pp( $dbh,
- "a = ? /*b = :1*/ c = ?",
- DBIpp_cm_dw|DBIpp_ph_cn,
- DBIpp_cm_cs|DBIpp_ph_qm),
- "a = :p1 -- b = :1\n c = :p2" );
-
-## Placeholders inside single and double quotes (should be ignored):
-
-is( pp( $dbh,
- "a = ? 'b = :1' c = ?",
- DBIpp_ph_cn,
- DBIpp_ph_XX),
- "a = :p1 'b = :1' c = :p2" );
-
-is( pp( $dbh,
- 'a = ? "b = :1" c = ?',
- DBIpp_ph_cn,
- DBIpp_ph_XX),
- 'a = :p1 "b = :1" c = :p2' );
-
-## Comments inside single and double quotes (should be ignored):
-
-is( pp( $dbh,
- "a = ? '{b = :1}' c = ?",
- DBIpp_cm_cs|DBIpp_ph_cn,
- DBIpp_cm_XX|DBIpp_ph_qm),
- "a = :p1 '{b = :1}' c = :p2" );
-
-is( pp( $dbh,
- 'a = ? "/*b = :1*/" c = ?',
- DBIpp_cm_dw|DBIpp_ph_cn,
- DBIpp_cm_XX|DBIpp_ph_qm),
- 'a = :p1 "/*b = :1*/" c = :p2' );
-
-## Single and double quoted strings starting inside comments (should be ignored):
-
-is( pp( $dbh,
- 'a = ? /*"b = :1 */ c = ?',
- DBIpp_cm_br|DBIpp_ph_cn,
- DBIpp_cm_XX|DBIpp_ph_qm),
- 'a = :p1 {"b = :1 } c = :p2' );
-
-## Check error conditions are trapped:
-
-is( pp($dbh, "a = :value and b = :1", DBIpp_ph_qm, DBIpp_ph_cs|DBIpp_ph_cn), undef );
-ok( $DBI::err );
-is( $DBI::errstr, "preparse found mixed placeholder styles (:1 / :name)" );
-
-is( pp($dbh, "a = :1 and b = :3", DBIpp_ph_qm, DBIpp_ph_cn), undef );
-ok( $DBI::err );
-is( $DBI::errstr, "preparse found placeholder :3 out of sequence, expected :2" );
-
-is( pp($dbh, "foo ' comment", 0, 0), "foo ' comment" );
-ok( $DBI::err );
-is( $DBI::errstr, "preparse found unterminated single-quoted string" );
-
-is( pp($dbh, 'foo " comment', 0, 0), 'foo " comment' );
-ok( $DBI::err );
-is( $DBI::errstr, "preparse found unterminated double-quoted string" );
-
-is( pp($dbh, 'foo /* comment', DBIpp_cm_XX, DBIpp_cm_XX), 'foo /* comment' );
-ok( $DBI::err );
-is( $DBI::errstr, "preparse found unterminated bracketed C-style comment" );
-
-is( pp($dbh, 'foo { comment', DBIpp_cm_XX, DBIpp_cm_XX), 'foo { comment' );
-ok( $DBI::err );
-is( $DBI::errstr, "preparse found unterminated bracketed {...} comment" );
-
-# --------------------------------------------------------------------- #
-
-$dbh->disconnect;
-
-1;
+++ /dev/null
-#!perl -w
-$|=1;
-
-use strict;
-
-use DBI;
-
-use Test::More;
-
-plan skip_all => 'Transactions not supported by DBD::Gofer'
- if $ENV{DBI_AUTOPROXY} && $ENV{DBI_AUTOPROXY} =~ /^dbi:Gofer/i;
-
-plan tests => 10;
-
-my $dbh = DBI->connect('dbi:ExampleP(AutoCommit=>1):', undef, undef)
- or die "Unable to connect to ExampleP driver: $DBI::errstr";
-
-print "begin_work...\n";
-ok($dbh->{AutoCommit});
-ok(!$dbh->{BegunWork});
-
-ok($dbh->begin_work);
-ok(!$dbh->{AutoCommit});
-ok($dbh->{BegunWork});
-
-$dbh->commit;
-ok($dbh->{AutoCommit});
-ok(!$dbh->{BegunWork});
-
-ok($dbh->begin_work({}));
-$dbh->rollback;
-ok($dbh->{AutoCommit});
-ok(!$dbh->{BegunWork});
-
-1;
+++ /dev/null
-#!perl -w
-# vim:ts=8:sw=4
-
-use strict;
-
-use Test::More;
-use DBI;
-
-BEGIN {
- plan skip_all => '$h->{Callbacks} attribute not supported for DBI::PurePerl'
- if $DBI::PurePerl && $DBI::PurePerl; # doubled to avoid typo warning
-}
-
-$| = 1;
-my $dsn = "dbi:ExampleP:drv_foo=drv_bar";
-my %called;
-
-ok my $dbh = DBI->connect($dsn, '', ''), "Create dbh";
-
-is $dbh->{Callbacks}, undef, "Callbacks initially undef";
-ok $dbh->{Callbacks} = my $cb = { };
-is ref $dbh->{Callbacks}, 'HASH', "Callbacks can be set to a hash ref";
-is $dbh->{Callbacks}, $cb, "Callbacks set to same hash ref";
-
-$dbh->{Callbacks} = undef;
-is $dbh->{Callbacks}, undef, "Callbacks set to undef again";
-
-ok $dbh->{Callbacks} = {
- ping => sub {
- my $m = $_;
- is $m, 'ping', '$m holds method name';
- is $_, 'ping', '$_ holds method name (not stolen)';
- is @_, 1, '@_ holds 1 values';
- is ref $_[0], 'DBI::db', 'first is $dbh';
- ok tied(%{$_[0]}), '$dbh is tied (outer) handle'
- or DBI::dump_handle($_[0], 'tied?', 10);
- $called{$_}++;
- return;
- },
- quote_identifier => sub {
- is @_, 4, '@_ holds 4 values';
- my $dbh = shift;
- is ref $dbh, 'DBI::db', 'first is $dbh';
- is $_[0], 'foo';
- is $_[1], 'bar';
- is $_[2], undef;
- $_[2] = { baz => 1 };
- $called{$_}++;
- return (1,2,3); # return something - which is not allowed
- },
- disconnect => sub { # test die from within a callback
- die "You can't disconnect that easily!\n";
- },
- "*" => sub {
- $called{$_}++;
- return;
- }
-};
-is keys %{ $dbh->{Callbacks} }, 4;
-
-is ref $dbh->{Callbacks}->{ping}, 'CODE';
-
-$_ = 42;
-ok $dbh->ping;
-is $called{ping}, 1;
-is $_, 42, '$_ not altered by callback';
-
-ok $dbh->ping;
-is $called{ping}, 2;
-
-ok $dbh->type_info_all;
-is $called{type_info_all}, 1, 'fallback callback';
-
-my $attr;
-eval { $dbh->quote_identifier('foo','bar', $attr) };
-is $called{quote_identifier}, 1;
-ok $@, 'quote_identifier callback caused fatal error';
-is ref $attr, 'HASH', 'param modified by callback - not recommended!';
-
-ok !eval { $dbh->disconnect };
-ok $@, "You can't disconnect that easily!\n";
-
-$dbh->{Callbacks} = undef;
-ok $dbh->ping;
-is $called{ping}, 2; # no change
-
-
-# --- test skipping dispatch and fallback callbacks
-
-$dbh->{Callbacks} = {
- ping => sub {
- undef $_; # tell dispatch to not call the method
- return "42 bells";
- },
- data_sources => sub {
- my ($h, $values_to_return) = @_;
- undef $_; # tell dispatch to not call the method
- my @ret = 11..10+($values_to_return||0);
- return @ret;
- },
- commit => sub { # test using set_err within a callback
- my $h = shift;
- undef $_; # tell dispatch to not call the method
- return $h->set_err(42, "faked commit failure");
- },
-};
-
-# these tests are slightly convoluted because messing with the stack is bad for
-# your mental health
-my $rv = $dbh->ping;
-is $rv, "42 bells";
-my @rv = $dbh->ping;
-is scalar @rv, 1, 'should return a single value in list context';
-is "@rv", "42 bells";
-# test returning lists with different number of args to test
-# the stack handling in the dispatch code
-is join(":", $dbh->data_sources()), "";
-is join(":", $dbh->data_sources(0)), "";
-is join(":", $dbh->data_sources(1)), "11";
-is join(":", $dbh->data_sources(2)), "11:12";
-
-{
-local $dbh->{RaiseError} = 1;
-local $dbh->{PrintError} = 0;
-is eval { $dbh->commit }, undef, 'intercepted commit should return undef';
-like $@, '/DBD::\w+::db commit failed: faked commit failure/';
-is $DBI::err, 42;
-is $DBI::errstr, "faked commit failure";
-}
-
-# --- test connect_cached.*
-
-=for comment XXX
-
-The big problem here is that conceptually the Callbacks attribute
-is applied to the $dbh _during_ the $drh->connect() call, so you can't
-set a callback on "connect" on the $dbh because connect isn't called
-on the dbh, but on the $drh.
-
-So a "connect" callback would have to be defined on the $drh, but that's
-cumbersome for the user and then it would apply to all future connects
-using that driver.
-
-The best thing to do is probably to special-case "connect", "connect_cached"
-and (the already special-case) "connect_cached.reused".
-
-=cut
-
-my $driver_dsn = (DBI->parse_dsn($dsn))[4] or die 'panic';
-
-my @args = (
- $dsn, 'u', 'p', {
- Callbacks => {
- "connect_cached.new" => sub {
- my ($dbh, $cb_dsn, $user, $auth, $attr) = @_;
- ok tied(%$dbh), 'connect_cached.new $h is tied (outer) handle'
- if $dbh; # $dbh is typically undef or a dead/disconnected $dbh
- like $cb_dsn, qr/\Q$driver_dsn/, 'dsn';
- is $user, 'u', 'user';
- is $auth, 'p', 'pass';
- $called{new}++;
- return;
- },
- "connect_cached.reused" => sub {
- my ($dbh, $cb_dsn, $user, $auth, $attr) = @_;
- ok tied(%$dbh), 'connect_cached.reused $h is tied (outer) handle';
- like $cb_dsn, qr/\Q$driver_dsn/, 'dsn';
- is $user, 'u', 'user';
- is $auth, 'p', 'pass';
- $called{cached}++;
- return;
- },
- "connect_cached.connected" => sub {
- my ($dbh, $cb_dsn, $user, $auth, $attr) = @_;
- ok tied(%$dbh), 'connect_cached.connected $h is tied (outer) handle';
- like $cb_dsn, qr/\Q$driver_dsn/, 'dsn';
- is $user, 'u', 'user';
- is $auth, 'p', 'pass';
- $called{connected}++;
- return;
- },
- }
- }
-);
-
-%called = ();
-
-ok $dbh = DBI->connect(@args), "Create handle with callbacks";
-is keys %called, 0, 'no callback for plain connect';
-
-ok $dbh = DBI->connect_cached(@args), "Create handle with callbacks";
-is $called{new}, 1, "connect_cached.new called";
-is $called{cached}, undef, "connect_cached.reused not yet called";
-is $called{connected}, 1, "connect_cached.connected called";
-
-ok $dbh = DBI->connect_cached(@args), "Create handle with callbacks";
-is $called{cached}, 1, "connect_cached.reused called";
-is $called{new}, 1, "connect_cached.new not called again";
-is $called{connected}, 1, "connect_cached.connected not called called";
-
-
-# --- test ChildCallbacks.
-%called = ();
-$args[-1] = {
- Callbacks => my $dbh_callbacks = {
- ping => sub { $called{ping}++; return; },
- ChildCallbacks => my $sth_callbacks = {
- execute => sub { $called{execute}++; return; },
- fetch => sub { $called{fetch}++; return; },
- }
- }
-};
-
-ok $dbh = DBI->connect(@args), "Create handle with ChildCallbacks";
-ok $dbh->ping, 'Ping';
-is $called{ping}, 1, 'Ping callback should have been called';
-ok my $sth = $dbh->prepare('SELECT name from t'), 'Prepare a statement handle (child)';
-ok $sth->{Callbacks}, 'child should have Callbacks';
-is $sth->{Callbacks}, $sth_callbacks, "child Callbacks should be ChildCallbacks of parent"
- or diag "(dbh Callbacks is $dbh_callbacks)";
-ok $sth->execute, 'Execute';
-is $called{execute}, 1, 'Execute callback should have been called';
-ok $sth->fetch, 'Fetch';
-is $called{fetch}, 1, 'Fetch callback should have been called';
-
-# stress test for stack reallocation and mark handling -- RT#86744
-my $stress_count = 3000;
-my $place_holders = join(',', ('?') x $stress_count);
-my @params = ('t') x $stress_count;
-my $stress_dbh = DBI->connect( 'DBI:NullP:test');
-my $stress_sth = $stress_dbh->prepare("select 1");
-$stress_sth->{Callbacks}{execute} = sub { return; };
-$stress_sth->execute(@params);
-
-
-done_testing();
-
-__END__
-
-A generic 'transparent' callback looks like this:
-(this assumes only scalar context will be used)
-
- sub {
- my $h = shift;
- return if our $avoid_deep_recursion->{"$h $_"}++;
- my $this = $h->$_(@_);
- undef $_; # tell DBI not to call original method
- return $this; # tell DBI to return this instead
- };
-
-XXX should add a test for this
-XXX even better would be to run chunks of the test suite with that as a '*' callback. In theory everything should pass (except this test file, naturally)..
+++ /dev/null
-#!perl -w
-$|=1;
-
-use strict;
-
-#
-# test script for the ChildHandles attribute
-#
-
-use DBI;
-
-use Test::More;
-
-my $HAS_WEAKEN = eval {
- require Scalar::Util;
- # this will croak() if this Scalar::Util doesn't have a working weaken().
- Scalar::Util::weaken( my $test = [] ); # same test as in DBI.pm
- 1;
-};
-if (!$HAS_WEAKEN) {
- chomp $@;
- print "1..0 # Skipped: Scalar::Util::weaken not available ($@)\n";
- exit 0;
-}
-
-plan tests => 16;
-
-my $using_dbd_gofer = ($ENV{DBI_AUTOPROXY}||'') =~ /^dbi:Gofer.*transport=/i;
-
-my $drh;
-
-{
- # make 10 connections
- my @dbh;
- for (1 .. 10) {
- my $dbh = DBI->connect("dbi:ExampleP:", '', '', { RaiseError=>1 });
- push @dbh, $dbh;
- }
-
- # get the driver handle
- $drh = $dbh[0]->{Driver};
- ok $drh;
-
- # get the kids, should be the same list of connections
- my $db_handles = $drh->{ChildHandles};
- is ref $db_handles, 'ARRAY';
- is scalar @$db_handles, scalar @dbh;
-
- # make sure all the handles are there
- my $found = 0;
- foreach my $h (@dbh) {
- ++$found if grep { $h == $_ } @$db_handles;
- }
- is $found, scalar @dbh;
-}
-
-# now all the out-of-scope DB handles should be gone
-{
- my $handles = $drh->{ChildHandles};
- my @db_handles = grep { defined } @$handles;
- is scalar @db_handles, 0, "All handles should be undef now";
-}
-
-my $dbh = DBI->connect("dbi:ExampleP:", '', '', { RaiseError=>1 });
-
-my $empty = $dbh->{ChildHandles};
-is_deeply $empty, [], "ChildHandles should be an array-ref if wekref is available";
-
-# test child handles for statement handles
-{
- my @sth;
- my $sth_count = 20;
- for (1 .. $sth_count) {
- my $sth = $dbh->prepare('SELECT name FROM t');
- push @sth, $sth;
- }
- my $handles = $dbh->{ChildHandles};
- is scalar @$handles, scalar @sth;
-
- # test a recursive walk like the one in the docs
- my @lines;
- sub show_child_handles {
- my ($h, $level) = @_;
- $level ||= 0;
- push(@lines,
- sprintf "%sh %s %s\n", $h->{Type}, "\t" x $level, $h);
- show_child_handles($_, $level + 1)
- for (grep { defined } @{$h->{ChildHandles}});
- }
- my $drh = $dbh->{Driver};
- show_child_handles($drh, 0);
- print @lines[0..4];
-
- is scalar @lines, $sth_count + 2;
- like $lines[0], qr/^drh/;
- like $lines[1], qr/^dbh/;
- like $lines[2], qr/^sth/;
-}
-
-my $handles = $dbh->{ChildHandles};
-my @live = grep { defined $_ } @$handles;
-is scalar @live, 0, "handles should be gone now";
-
-# test visit_child_handles
-{
- my $info;
- my $visitor = sub {
- my ($h, $info) = @_;
- my $type = $h->{Type};
- ++$info->{ $type }{ ($type eq 'st') ? $h->{Statement} : $h->{Name} };
- return $info;
- };
- DBI->visit_handles($visitor, $info = {});
- is_deeply $info, {
- 'dr' => {
- 'ExampleP' => 1,
- ($using_dbd_gofer) ? (Gofer => 1) : ()
- },
- 'db' => { '' => 1 },
- };
-
- my $sth1 = $dbh->prepare('SELECT name FROM t');
- my $sth2 = $dbh->prepare('SELECT name FROM t');
- DBI->visit_handles($visitor, $info = {});
- is_deeply $info, {
- 'dr' => {
- 'ExampleP' => 1,
- ($using_dbd_gofer) ? (Gofer => 1) : ()
- },
- 'db' => { '' => 1 },
- 'st' => { 'SELECT name FROM t' => 2 }
- };
-
-}
-
-# test that the childhandle array does not grow uncontrollably
-SKIP: {
- skip "slow tests avoided when using DBD::Gofer", 2 if $using_dbd_gofer;
-
- for (1 .. 1000) {
- my $sth = $dbh->prepare('SELECT name FROM t');
- }
- my $handles = $dbh->{ChildHandles};
- cmp_ok scalar @$handles, '<', 1000;
- my @live = grep { defined } @$handles;
- is scalar @live, 0;
-}
-
-1;
+++ /dev/null
-use warnings;
-use strict;
-use Scalar::Util qw( weaken reftype refaddr blessed );
-
-use DBI;
-use B ();
-use Tie::Hash ();
-use Test::More;
-
-my (%weak_dbhs, %weak_caches);
-
-# past this scope everything should be gone
-{
-
-### get two identical connections
- my @dbhs = map { DBI->connect('dbi:ExampleP::memory:', undef, undef, { RaiseError => 1 }) } (1,2);
-
-### get weakrefs on both handles
- %weak_dbhs = map { refdesc($_) => $_ } @dbhs;
- weaken $_ for values %weak_dbhs;
-
-### tie the first one's cache
- if (1) {
- ok(
- tie( my %cache, 'Tie::StdHash'),
- refdesc($dbhs[0]) . ' cache tied'
- );
- $dbhs[0]->{CachedKids} = \%cache;
- }
-
-### prepare something on both
- $_->prepare_cached( 'SELECT name FROM .' )
- for @dbhs;
-
-### get weakrefs of both caches
- %weak_caches = map {
- sprintf( 'statement cache of %s (%s)',
- refdesc($_),
- refdesc($_->{CachedKids})
- ) => $_->{CachedKids}
- } @dbhs;
- weaken $_ for values %weak_caches;
-
-### check both caches have entries
- is (scalar keys %{$weak_caches{$_}}, 1, "One cached statement found in $_")
- for keys %weak_caches;
-
-### check both caches have sane refcounts
- is ( refcount( $weak_caches{$_} ), 1, "Refcount of $_ correct")
- for keys %weak_caches;
-
-### check both dbh have sane refcounts
- is ( refcount( $weak_dbhs{$_} ), 1, "Refcount of $_ correct")
- for keys %weak_dbhs;
-
- note "Exiting scope";
- @dbhs=();
-}
-
-# check both $dbh weakrefs are gone
-is ($weak_dbhs{$_}, undef, "$_ garbage collected")
- for keys %weak_dbhs;
-
-is ($weak_caches{$_}, undef, "$_ garbage collected")
- for keys %weak_caches;
-
-
-
-sub refdesc {
- sprintf '%s%s(0x%x)',
- ( defined( $_[1] = blessed $_[0]) ? "$_[1]=" : '' ),
- reftype $_[0],
- refaddr($_[0]),
- ;
-}
-
-sub refcount {
- B::svref_2object($_[0])->REFCNT;
-}
-
-done_testing;
+++ /dev/null
-#!perl -w # -*- perl -*-
-# vim:sw=4:ts=8
-
-require 5.004;
-use strict;
-
-
-use DBI;
-use Config;
-require VMS::Filespec if $^O eq 'VMS';
-require Cwd;
-
-my $haveFileSpec = eval { require File::Spec };
-my $failed_tests = 0;
-
-$| = 1;
-$^W = 1;
-
-# $\ = "\n"; # XXX Triggers bug, check this later (JW, 1998-12-28)
-
-# Can we load the modules? If not, exit the test immediately:
-# Reason is most probable a missing prerequisite.
-#
-# Is syslog available (required for the server)?
-
-eval {
- local $SIG{__WARN__} = sub { $@ = shift };
- require Storable;
- require DBD::Proxy;
- require DBI::ProxyServer;
- require RPC::PlServer;
- require Net::Daemon::Test;
-};
-if ($@) {
- if ($@ =~ /^Can't locate (\S+)/) {
- print "1..0 # Skipped: modules required for proxy are probably not installed (e.g., $1)\n";
- exit 0;
- }
- die $@;
-}
-
-if ($DBI::PurePerl) {
- # XXX temporary I hope
- print "1..0 # Skipped: DBD::Proxy currently has a problem under DBI::PurePerl\n";
- exit 0;
-}
-
-{
- my $numTest = 0;
- sub _old_Test($;$) {
- my $result = shift; my $str = shift || '';
- printf("%sok %d%s\n", ($result ? "" : "not "), ++$numTest, $str);
- $result;
- }
- sub Test ($;$) {
- my($ok, $msg) = @_;
- $msg = ($msg) ? " ($msg)" : "";
- my $line = (caller)[2];
- ++$numTest;
- ($ok) ? print "ok $numTest at line $line\n" : print "not ok $numTest\n";
- warn "# failed test $numTest at line ".(caller)[2]."$msg\n" unless $ok;
- ++$failed_tests unless $ok;
- return $ok;
- }
-}
-
-
-# Create an empty config file to make sure that settings aren't
-# overloaded by /etc/dbiproxy.conf
-my $config_file = "dbiproxytst.conf";
-unlink $config_file;
-(open(FILE, ">$config_file") and
- (print FILE "{}\n") and
- close(FILE))
- or die "Failed to create config file $config_file: $!";
-
-my $debug = ($ENV{DBI_TRACE}||=0) ? 1 : 0;
-my $dbitracelog = "dbiproxy.dbilog";
-
-my ($handle, $port, @child_args);
-
-my $numTests = 136;
-
-if (@ARGV) {
- $port = $ARGV[0];
-}
-else {
-
- unlink $dbitracelog;
- unlink "dbiproxy.log";
- unlink "dbiproxy.truss";
-
- # Uncommentand adjust this to isolate pure-perl client from server settings:
- # local $ENV{DBI_PUREPERL} = 0;
-
- # If desperate uncomment this and add '-d' after $^X below:
- # local $ENV{PERLDB_OPTS} = "AutoTrace NonStop=1 LineInfo=dbiproxy.dbg";
-
- # pass our @INC to children (e.g., so -Mblib passes through)
- $ENV{PERL5LIB} = join($Config{path_sep}, @INC);
-
- # server DBI trace level always at least 1
- my $dbitracelevel = DBI->trace(0) || 1;
- @child_args = (
- #'truss', '-o', 'dbiproxy.truss',
- $^X, 'dbiproxy', '--test', # --test must be first command line arg
- "--dbitrace=$dbitracelevel=$dbitracelog", # must be second arg
- '--configfile', $config_file,
- ($dbitracelevel >= 2 ? ('--debug') : ()),
- '--mode=single',
- '--logfile=STDERR',
- '--timeout=90'
- );
- warn " starting test dbiproxy process: @child_args\n" if DBI->trace(0);
- ($handle, $port) = Net::Daemon::Test->Child($numTests, @child_args);
-}
-
-my $dsn = "DBI:Proxy:hostname=127.0.0.1;port=$port;debug=$debug;dsn=DBI:ExampleP:";
-
-print "Making a first connection and closing it immediately.\n";
-Test(eval { DBI->connect($dsn, '', '', { 'PrintError' => 1 }) })
- or print "Connect error: " . $DBI::errstr . "\n";
-
-print "Making a second connection.\n";
-my $dbh;
-Test($dbh = eval { DBI->connect($dsn, '', '', { 'PrintError' => 0 }) })
- or print "Connect error: " . $DBI::errstr . "\n";
-
-print "example_driver_path=$dbh->{example_driver_path}\n";
-Test($dbh->{example_driver_path});
-
-print "Setting AutoCommit\n";
-$@ = "old-error"; # should be preserved across DBI calls
-Test($dbh->{AutoCommit} = 1);
-Test($dbh->{AutoCommit});
-Test($@ eq "old-error", "\$@ now '$@'");
-#$dbh->trace(2);
-
-eval {
- local $dbh->{ AutoCommit } = 1; # This breaks die!
- die "BANG!!!\n";
-};
-Test($@ eq "BANG!!!\n", "\$@ value lost");
-
-
-print "begin_work...\n";
-Test($dbh->{AutoCommit});
-Test(!$dbh->{BegunWork});
-
-Test($dbh->begin_work);
-Test(!$dbh->{AutoCommit});
-Test($dbh->{BegunWork});
-
-$dbh->commit;
-Test(!$dbh->{BegunWork});
-Test($dbh->{AutoCommit});
-
-Test($dbh->begin_work({}));
-$dbh->rollback;
-Test($dbh->{AutoCommit});
-Test(!$dbh->{BegunWork});
-
-
-print "Doing a ping.\n";
-$_ = $dbh->ping;
-Test($_);
-Test($_ eq '2'); # ping was DBD::ExampleP's ping
-
-print "Ensure CompatMode enabled.\n";
-Test($dbh->{CompatMode});
-
-print "Trying local quote.\n";
-$dbh->{'proxy_quote'} = 'local';
-Test($dbh->quote("quote's") eq "'quote''s'");
-Test($dbh->quote(undef) eq "NULL");
-
-print "Trying remote quote.\n";
-$dbh->{'proxy_quote'} = 'remote';
-Test($dbh->quote("quote's") eq "'quote''s'");
-Test($dbh->quote(undef) eq "NULL");
-
-# XXX the $optional param is undocumented and may be removed soon
-Test($dbh->quote_identifier('foo') eq '"foo"', $dbh->quote_identifier('foo'));
-Test($dbh->quote_identifier('f"o') eq '"f""o"', $dbh->quote_identifier('f"o'));
-Test($dbh->quote_identifier('foo','bar') eq '"foo"."bar"');
-Test($dbh->quote_identifier('foo',undef,'bar') eq '"foo"."bar"');
-Test($dbh->quote_identifier(undef,undef,'bar') eq '"bar"');
-
-print "Trying commit with invalid number of parameters.\n";
-eval { $dbh->commit('dummy') };
-Test($@ =~ m/^DBI commit: invalid number of arguments:/)
- unless $DBI::PurePerl && Test(1);
-
-print "Trying select with unknown field name.\n";
-my $cursor_e = $dbh->prepare("select unknown_field_name from ?");
-Test(defined $cursor_e);
-Test(!$cursor_e->execute('a'));
-Test($DBI::err);
-Test($DBI::err == $dbh->err);
-Test($DBI::errstr =~ m/unknown_field_name/, $DBI::errstr);
-
-Test($DBI::errstr eq $dbh->errstr);
-Test($dbh->errstr eq $dbh->func('errstr'));
-
-my $dir = Cwd::cwd(); # a dir always readable on all platforms
-$dir = VMS::Filespec::unixify($dir) if $^O eq 'VMS';
-
-print "Trying a real select.\n";
-my $csr_a = $dbh->prepare("select mode,name from ?");
-Test(ref $csr_a);
-Test($csr_a->execute($dir))
- or print "Execute failed: ", $csr_a->errstr(), "\n";
-
-print "Repeating the select with second handle.\n";
-my $csr_b = $dbh->prepare("select mode,name from ?");
-Test(ref $csr_b);
-Test($csr_b->execute($dir));
-Test($csr_a != $csr_b);
-Test($csr_a->{NUM_OF_FIELDS} == 2);
-if ($DBI::PurePerl) {
- $csr_a->trace(2);
- use Data::Dumper;
- warn Dumper($csr_a->{Database});
-}
-Test($csr_a->{Database}->{Driver}->{Name} eq 'Proxy', "Name=$csr_a->{Database}->{Driver}->{Name}");
-$csr_a->trace(0), die if $DBI::PurePerl;
-
-my($col0, $col1);
-my(@row_a, @row_b);
-
-#$csr_a->trace(2);
-print "Trying bind_columns.\n";
-Test($csr_a->bind_columns(undef, \($col0, $col1)) );
-Test($csr_a->execute($dir));
-@row_a = $csr_a->fetchrow_array;
-Test(@row_a);
-Test($row_a[0] eq $col0);
-Test($row_a[1] eq $col1);
-
-print "Trying bind_param.\n";
-Test($csr_b->bind_param(1, $dir));
-Test($csr_b->execute());
-@row_b = @{ $csr_b->fetchrow_arrayref };
-Test(@row_b);
-
-Test("@row_a" eq "@row_b");
-@row_b = $csr_b->fetchrow_array;
-Test("@row_a" ne "@row_b")
- or printf("Expected something different from '%s', got '%s'\n", "@row_a",
- "@row_b");
-
-print "Trying fetchrow_hashref.\n";
-Test($csr_b->execute());
-my $row_b = $csr_b->fetchrow_hashref;
-Test($row_b);
-print "row_a: @{[ @row_a ]}\n";
-print "row_b: @{[ %$row_b ]}\n";
-Test($row_b->{mode} == $row_a[0]);
-Test($row_b->{name} eq $row_a[1]);
-
-print "Trying fetchrow_hashref with FetchHashKeyName.\n";
-do {
-#local $dbh->{TraceLevel} = 9;
-local $dbh->{FetchHashKeyName} = 'NAME_uc';
-Test($dbh->{FetchHashKeyName} eq 'NAME_uc');
-my $csr_c = $dbh->prepare("select mode,name from ?");
-Test($csr_c->execute($dir), $DBI::errstr);
-$row_b = $csr_c->fetchrow_hashref;
-Test($row_b);
-print "row_b: @{[ %$row_b ]}\n";
-Test($row_b->{MODE} eq $row_a[0]);
-};
-
-print "Trying finish.\n";
-Test($csr_a->finish);
-#Test($csr_b->finish);
-Test(1);
-
-print "Forcing destructor.\n";
-$csr_a = undef; # force destruction of this cursor now
-Test(1);
-
-print "Trying fetchall_arrayref.\n";
-Test($csr_b->execute());
-my $r = $csr_b->fetchall_arrayref;
-Test($r);
-Test(@$r);
-Test($r->[0]->[0] == $row_a[0]);
-Test($r->[0]->[1] eq $row_a[1]);
-
-Test($csr_b->finish);
-
-
-print "Retrying unknown field name.\n";
-my $csr_c;
-$csr_c = $dbh->prepare("select unknown_field_name1 from ?");
-Test($csr_c);
-Test(!$csr_c->execute($dir));
-Test($DBI::errstr =~ m/Unknown field names: unknown_field_name1/)
- or printf("Wrong error string: %s", $DBI::errstr);
-
-print "Trying RaiseError.\n";
-$dbh->{RaiseError} = 1;
-Test($dbh->{RaiseError});
-Test($csr_c = $dbh->prepare("select unknown_field_name2 from ?"));
-Test(!eval { $csr_c->execute(); 1 });
-#print "$@\n";
-Test($@ =~ m/Unknown field names: unknown_field_name2/);
-$dbh->{RaiseError} = 0;
-Test(!$dbh->{RaiseError});
-
-print "Trying warnings.\n";
-{
- my @warn;
- local($SIG{__WARN__}) = sub { push @warn, @_ };
- $dbh->{PrintError} = 1;
- Test($dbh->{PrintError});
- Test(($csr_c = $dbh->prepare("select unknown_field_name3 from ?")));
- Test(!$csr_c->execute());
- Test("@warn" =~ m/Unknown field names: unknown_field_name3/);
- $dbh->{PrintError} = 0;
- Test(!$dbh->{PrintError});
-}
-$csr_c->finish();
-
-
-print "Trying type_info_all.\n";
-my $array = $dbh->type_info_all();
-Test($array and ref($array) eq 'ARRAY')
- or printf("Expected ARRAY, got %s, error %s\n", DBI::neat($array),
- $dbh->errstr());
-Test($array->[0] and ref($array->[0]) eq 'HASH');
-my $ok = 1;
-for (my $i = 1; $i < @{$array}; $i++) {
- print "$array->[$i]\n";
- $ok = 0 unless ($array->[$i] and ref($array->[$i]) eq 'ARRAY');
- print "$ok\n";
-}
-Test($ok);
-
-# Test the table_info method
-# First generate a list of all subdirectories
-$dir = $haveFileSpec ? File::Spec->curdir() : ".";
-Test(opendir(DIR, $dir));
-my(%dirs, %unexpected, %missing);
-while (defined(my $file = readdir(DIR))) {
- $dirs{$file} = 1 if -d $file;
-}
-closedir(DIR);
-my $sth = $dbh->table_info(undef, undef, undef, undef);
-Test($sth) or warn "table_info failed: ", $dbh->errstr(), "\n";
-%missing = %dirs;
-%unexpected = ();
-while (my $ref = $sth->fetchrow_hashref()) {
- print "table_info: Found table $ref->{'TABLE_NAME'}\n";
- if (exists($missing{$ref->{'TABLE_NAME'}})) {
- delete $missing{$ref->{'TABLE_NAME'}};
- } else {
- $unexpected{$ref->{'TABLE_NAME'}} = 1;
- }
-}
-Test(!$sth->errstr())
- or print "Fetching table_info rows failed: ", $sth->errstr(), "\n";
-Test(keys %unexpected == 0)
- or print "Unexpected directories: ", join(",", keys %unexpected), "\n";
-Test(keys %missing == 0)
- or print "Missing directories: ", join(",", keys %missing), "\n";
-
-# Test the tables method
-%missing = %dirs;
-%unexpected = ();
-print "Expecting directories ", join(",", keys %dirs), "\n";
-foreach my $table ($dbh->tables()) {
- print "tables: Found table $table\n";
- if (exists($missing{$table})) {
- delete $missing{$table};
- } else {
- $unexpected{$table} = 1;
- }
-}
-Test(!$sth->errstr())
- or print "Fetching table_info rows failed: ", $sth->errstr(), "\n";
-Test(keys %unexpected == 0)
- or print "Unexpected directories: ", join(",", keys %unexpected), "\n";
-Test(keys %missing == 0)
- or print "Missing directories: ", join(",", keys %missing), "\n";
-
-
-# Test large recordsets
-for (my $i = 0; $i <= 300; $i += 100) {
- print "Testing the fake directories ($i).\n";
- Test($csr_a = $dbh->prepare("SELECT name, mode FROM long_list_$i"));
- Test($csr_a->execute(), $DBI::errstr);
- my $ary = $csr_a->fetchall_arrayref;
- Test(!$DBI::errstr, $DBI::errstr);
- Test(@$ary == $i, "expected $i got ".@$ary);
- if ($i) {
- my @n1 = map { $_->[0] } @$ary;
- my @n2 = reverse map { "file$_" } 1..$i;
- Test("@n1" eq "@n2");
- }
- else {
- Test(1);
- }
-}
-
-
-# Test the RowCacheSize attribute
-Test($csr_a = $dbh->prepare("SELECT * FROM ?"));
-Test($dbh->{'RowCacheSize'} == 20);
-Test($csr_a->{'RowCacheSize'} == 20);
-Test($csr_a->execute('long_list_50'));
-Test($csr_a->fetchrow_arrayref());
-Test($csr_a->{'proxy_data'} and @{$csr_a->{'proxy_data'}} == 19);
-Test($csr_a->finish());
-
-Test($dbh->{'RowCacheSize'} = 30);
-Test($dbh->{'RowCacheSize'} == 30);
-Test($csr_a->{'RowCacheSize'} == 30);
-Test($csr_a->execute('long_list_50'));
-Test($csr_a->fetchrow_arrayref());
-Test($csr_a->{'proxy_data'} and @{$csr_a->{'proxy_data'}} == 29)
- or print("Expected 29 records in cache, got " . @{$csr_a->{'proxy_data'}} .
- "\n");
-Test($csr_a->finish());
-
-
-Test($csr_a->{'RowCacheSize'} = 10);
-Test($dbh->{'RowCacheSize'} == 30);
-Test($csr_a->{'RowCacheSize'} == 10);
-Test($csr_a->execute('long_list_50'));
-Test($csr_a->fetchrow_arrayref());
-Test($csr_a->{'proxy_data'} and @{$csr_a->{'proxy_data'}} == 9)
- or print("Expected 9 records in cache, got " . @{$csr_a->{'proxy_data'}} .
- "\n");
-Test($csr_a->finish());
-
-$dbh->disconnect;
-
-# Test $dbh->func()
-# print "Testing \$dbh->func().\n";
-# my %tables = map { $_ =~ /lib/ ? ($_, 1) : () } $dbh->tables();
-# $ok = 1;
-# foreach my $t ($dbh->func('lib', 'examplep_tables')) {
-# defined(delete $tables{$t}) or print "Unexpected table: $t\n";
-# }
-# Test(%tables == 0);
-
-if ($failed_tests) {
- warn "Proxy: @child_args\n";
- for my $class (qw(Net::Daemon RPC::PlServer Storable)) {
- (my $pm = $class) =~ s/::/\//g; $pm .= ".pm";
- my $version = eval { $class->VERSION } || '?';
- warn sprintf "Using %-13s %-6s %s\n", $class, $version, $INC{$pm};
- }
- warn join(", ", map { "$_=$ENV{$_}" } grep { /^LC_|LANG/ } keys %ENV)."\n";
- warn "More info can be found in $dbitracelog\n";
- #system("cat $dbitracelog");
-}
-
-
-END {
- local $?;
- $handle->Terminate() if $handle;
- undef $handle;
- unlink $config_file if $config_file;
- if (!$failed_tests) {
- unlink 'dbiproxy.log';
- unlink $dbitracelog if $dbitracelog;
- }
-};
-
-1;
+++ /dev/null
-#!perl -w # -*- perl -*-
-# vim:sw=4:ts=8
-$|=1;
-
-use strict;
-use warnings;
-
-use Cwd;
-use Config;
-use Data::Dumper;
-use Test::More 0.84;
-use Getopt::Long;
-
-use DBI qw(dbi_time);
-
-if (my $ap = $ENV{DBI_AUTOPROXY}) { # limit the insanity
- plan skip_all => "transport+policy tests skipped with non-gofer DBI_AUTOPROXY"
- if $ap !~ /^dbi:Gofer/i;
- plan skip_all => "transport+policy tests skipped with non-pedantic policy in DBI_AUTOPROXY"
- if $ap !~ /policy=pedantic\b/i;
-}
-
-do "./t/lib.pl";
-
-# 0=SQL::Statement if avail, 1=DBI::SQL::Nano
-# next line forces use of Nano rather than default behaviour
-# $ENV{DBI_SQL_NANO}=1;
-# This is done in zvn_50dbm.t
-
-GetOptions(
- 'c|count=i' => \(my $opt_count = (-t STDOUT ? 100 : 0)),
- 'dbm=s' => \my $opt_dbm,
- 'v|verbose!' => \my $opt_verbose,
- 't|transport=s' => \my $opt_transport,
- 'p|policy=s' => \my $opt_policy,
-) or exit 1;
-
-
-# so users can try others from the command line
-if (!$opt_dbm) {
- # pick first available, starting with SDBM_File
- for (qw( SDBM_File GDBM_File DB_File BerkeleyDB )) {
- if (eval { local $^W; require "$_.pm" }) {
- $opt_dbm = ($_);
- last;
- }
- }
- plan skip_all => 'No DBM modules available' if !$opt_dbm;
-}
-
-my @remote_dsns = DBI->data_sources( "dbi:DBM:", {
- dbm_type => $opt_dbm,
- f_lock => 0,
- f_dir => test_dir() } );
-my $remote_dsn = $remote_dsns[0];
-( my $remote_driver_dsn = $remote_dsn ) =~ s/dbi:dbm://i;
-# Long timeout for slow/overloaded systems (incl virtual machines with low priority)
-my $timeout = 240;
-
-if ($ENV{DBI_AUTOPROXY}) {
- # this means we have DBD::Gofer => DBD::Gofer => DBD::DBM!
- # rather than disable it we let it run because we're twisted
- # and because it helps find more bugs (though debugging can be painful)
- warn "\n$0 is running with DBI_AUTOPROXY enabled ($ENV{DBI_AUTOPROXY})\n"
- unless $0 =~ /\bzv/; # don't warn for t/zvg_85gofer.t
-}
-
-# ensure subprocess (for pipeone and stream transport) will use the same modules as us, ie ./blib
-local $ENV{PERL5LIB} = join $Config{path_sep}, @INC;
-
-my %durations;
-my $getcwd = getcwd();
-my $username = eval { getpwuid($>) } || ''; # fails on windows
-my $can_ssh = ($username && $username eq 'timbo' && -d '.svn'
- && system("sh -c 'echo > /dev/tcp/localhost/22' 2>/dev/null")==0
-);
-my $perl = "$^X -Mblib=$getcwd/blib"; # ensure sameperl and our blib (note two spaces)
-
-my %trials = (
- null => {},
- pipeone => { perl=>$perl, timeout=>$timeout },
- stream => { perl=>$perl, timeout=>$timeout },
- stream_ssh => ($can_ssh)
- ? { perl=>$perl, timeout=>$timeout, url => "ssh:$username\@localhost" }
- : undef,
- #http => { url => "http://localhost:8001/gofer" },
-);
-
-# too dependent on local config to make a standard test
-delete $trials{http} unless $username eq 'timbo' && -d '.svn';
-
-my @transports = ($opt_transport) ? ($opt_transport) : (sort keys %trials);
-note("Transports: @transports");
-my @policies = ($opt_policy) ? ($opt_policy) : qw(pedantic classic rush);
-note("Policies: @policies");
-note("Count: $opt_count");
-
-for my $trial (@transports) {
- (my $transport = $trial) =~ s/_.*//;
- my $trans_attr = $trials{$trial}
- or next;
-
- # XXX temporary restrictions, hopefully
- if ( ($^O eq 'MSWin32') || ($^O eq 'VMS') ) {
- # stream needs Fcntl macro F_GETFL for non-blocking
- # and pipe seems to hang on some windows systems
- next if $transport eq 'stream' or $transport eq 'pipeone';
- }
-
- for my $policy_name (@policies) {
-
- eval { run_tests($transport, $trans_attr, $policy_name) };
- ($@) ? fail("$trial: $@") : pass();
-
- }
-}
-
-# to get baseline for comparisons if doing performance testing
-run_tests('no', {}, 'pedantic') if $opt_count;
-
-while ( my ($activity, $stats_hash) = each %durations ) {
- note("");
- $stats_hash->{'~baseline~'} = delete $stats_hash->{"no+pedantic"};
- for my $perf_tag (reverse sort keys %$stats_hash) {
- my $dur = $stats_hash->{$perf_tag} || 0.0000001;
- note sprintf " %6s %-16s: %.6fsec (%5d/sec)",
- $activity, $perf_tag, $dur/$opt_count, $opt_count/$dur;
- my $baseline_dur = $stats_hash->{'~baseline~'};
- note sprintf " %+5.1fms", (($dur-$baseline_dur)/$opt_count)*1000
- unless $perf_tag eq '~baseline~';
- note "";
- }
-}
-
-
-sub run_tests {
- my ($transport, $trans_attr, $policy_name) = @_;
-
- my $policy = get_policy($policy_name);
- my $skip_gofer_checks = ($transport eq 'no');
-
-
- my $test_run_tag = "Testing $transport transport with $policy_name policy";
- note "=============";
- note "$test_run_tag";
-
- my $driver_dsn = "transport=$transport;policy=$policy_name";
- $driver_dsn .= join ";", '', map { "$_=$trans_attr->{$_}" } keys %$trans_attr
- if %$trans_attr;
-
- my $dsn = "dbi:Gofer:$driver_dsn;dsn=$remote_dsn";
- $dsn = $remote_dsn if $transport eq 'no';
- note " $dsn";
-
- my $dbh = DBI->connect($dsn, undef, undef, { RaiseError => 1, PrintError => 0, ShowErrorStatement => 1 } );
- die "$test_run_tag aborted: $DBI::errstr\n" unless $dbh; # no point continuing
- ok $dbh, sprintf "should connect to %s", $dsn;
-
- is $dbh->{Name}, ($policy->skip_connect_check)
- ? $driver_dsn
- : $remote_driver_dsn;
-
- END { unlink glob "fruit.???" }
- ok $dbh->do("DROP TABLE IF EXISTS fruit");
- ok $dbh->do("CREATE TABLE fruit (dKey INT, dVal VARCHAR(10))");
- die "$test_run_tag aborted ($DBI::errstr)\n" if $DBI::err;
-
- my $sth = do {
- local $dbh->{RaiseError} = 0;
- $dbh->prepare("complete non-sql gibberish");
- };
- ($policy->skip_prepare_check)
- ? isa_ok $sth, 'DBI::st'
- : is $sth, undef, 'should detect prepare failure';
-
- ok my $ins_sth = $dbh->prepare("INSERT INTO fruit VALUES (?,?)");
- ok $ins_sth->execute(1, 'oranges');
- ok $ins_sth->execute(2, 'oranges');
-
- my $rowset;
- ok $rowset = $dbh->selectall_arrayref("SELECT dKey, dVal FROM fruit ORDER BY dKey");
- is_deeply($rowset, [ [ '1', 'oranges' ], [ '2', 'oranges' ] ]);
-
- ok $dbh->do("UPDATE fruit SET dVal='apples' WHERE dVal='oranges'");
- ok $dbh->{go_response}->executed_flag_set, 'go_response executed flag should be true'
- unless $skip_gofer_checks && pass();
-
- ok $sth = $dbh->prepare("SELECT dKey, dVal FROM fruit");
- ok $sth->execute;
- ok $rowset = $sth->fetchall_hashref('dKey');
- is_deeply($rowset, { '1' => { dKey=>1, dVal=>'apples' }, 2 => { dKey=>2, dVal=>'apples' } });
-
- if ($opt_count and $transport ne 'pipeone') {
- note "performance check - $opt_count selects and inserts";
- my $start = dbi_time();
- $dbh->selectall_arrayref("SELECT dKey, dVal FROM fruit")
- for (1000..1000+$opt_count);
- $durations{select}{"$transport+$policy_name"} = dbi_time() - $start;
-
- # some rows in to get a (*very* rough) idea of overheads
- $start = dbi_time();
- $ins_sth->execute($_, 'speed')
- for (1000..1000+$opt_count);
- $durations{insert}{"$transport+$policy_name"} = dbi_time() - $start;
- }
-
- note "Testing go_request_count and caching of simple values";
- my $go_request_count = $dbh->{go_request_count};
- ok $go_request_count
- unless $skip_gofer_checks && pass();
-
- ok $dbh->do("DROP TABLE fruit");
- is ++$go_request_count, $dbh->{go_request_count}
- unless $skip_gofer_checks && pass();
-
- # tests go_request_count, caching, and skip_default_methods policy
- my $use_remote = ($policy->skip_default_methods) ? 0 : 1;
- $use_remote = 1; # XXX since DBI::DBD::SqlEngine::db implements own data_sources this is always done remotely
- note sprintf "use_remote=%s (policy=%s, transport=%s) %s",
- $use_remote, $policy_name, $transport, DBI::neat($dbh->{dbi_default_methods})||'';
-
-SKIP: {
- skip "skip_default_methods checking doesn't work with Gofer over Gofer", 3
- if $ENV{DBI_AUTOPROXY} or $skip_gofer_checks;
- $dbh->data_sources({ foo_bar => $go_request_count });
- is $dbh->{go_request_count}, $go_request_count + 1*$use_remote;
- $dbh->data_sources({ foo_bar => $go_request_count }); # should use cache
- is $dbh->{go_request_count}, $go_request_count + 1*$use_remote;
- @_=$dbh->data_sources({ foo_bar => $go_request_count }); # no cached yet due to wantarray
- is $dbh->{go_request_count}, $go_request_count + 2*$use_remote;
-}
-
-SKIP: {
- skip "caching of metadata methods returning sth not yet implemented", 2;
- note "Testing go_request_count and caching of sth";
- $go_request_count = $dbh->{go_request_count};
- my $sth_ti1 = $dbh->table_info("%", "%", "%", "TABLE", { foo_bar => $go_request_count });
- is $go_request_count + 1, $dbh->{go_request_count};
-
- my $sth_ti2 = $dbh->table_info("%", "%", "%", "TABLE", { foo_bar => $go_request_count }); # should use cache
- is $go_request_count + 1, $dbh->{go_request_count};
-}
-
- ok $dbh->disconnect;
-}
-
-sub get_policy {
- my ($policy_class) = @_;
- $policy_class = "DBD::Gofer::Policy::$policy_class" unless $policy_class =~ /::/;
- _load_class($policy_class) or die $@;
- return $policy_class->new();
-}
-
-sub _load_class { # return true or false+$@
- my $class = shift;
- (my $pm = $class) =~ s{::}{/}g;
- $pm .= ".pm";
- return 1 if eval { require $pm };
- delete $INC{$pm}; # shouldn't be needed (perl bug?) and assigning undef isn't enough
- undef; # error in $@
-}
-
-done_testing;
-
-1;
+++ /dev/null
-#!perl -w # -*- perl -*-
-# vim:sw=4:ts=8
-$|=1;
-
-use strict;
-use warnings;
-
-use DBI;
-use Data::Dumper;
-use Test::More;
-sub between_ok;
-
-# here we test the DBI_GOFER_RANDOM mechanism
-# and how gofer deals with failures
-
-plan skip_all => "requires Callbacks which are not supported with PurePerl" if $DBI::PurePerl;
-
-if (my $ap = $ENV{DBI_AUTOPROXY}) { # limit the insanity
- plan skip_all => "Gofer DBI_AUTOPROXY" if $ap =~ /^dbi:Gofer/i;
-
- # this means we have DBD::Gofer => DBD::Gofer => DBD::whatever
- # rather than disable it we let it run because we're twisted
- # and because it helps find more bugs (though debugging can be painful)
- warn "\n$0 is running with DBI_AUTOPROXY enabled ($ENV{DBI_AUTOPROXY})\n"
- unless $0 =~ /\bzv/; # don't warn for t/zvg_85gofer.t
-}
-
-plan 'no_plan';
-
-my $tmp;
-my $dbh;
-my $fails;
-
-# we'll use the null transport for simplicity and speed
-# and the rush policy to limit the number of interactions with the gofer executor
-
-# silence the "DBI_GOFER_RANDOM..." warnings
-my @warns;
-$SIG{__WARN__} = sub { ("@_" =~ /^DBI_GOFER_RANDOM/) ? push(@warns, @_) : warn @_; };
-
-# --- 100% failure rate
-
-($fails, $dbh) = trial_impact("fail=100%,do", 10, "", sub { $_->do("set foo=1") });
-is $fails, 100, 'should fail 100% of the time';
-ok $@, '$@ should be set';
-like $@, '/fake error from do method induced by DBI_GOFER_RANDOM/';
-ok $dbh->errstr, 'errstr should be set';
-like $dbh->errstr, '/DBI_GOFER_RANDOM/', 'errstr should contain DBI_GOFER_RANDOM';
-ok !$dbh->{go_response}->executed_flag_set, 'go_response executed flag should be false';
-
-
-# XXX randomness can't be predicted, so it's just possible these will fail
-srand(42); # try to limit occasional failures (effect will vary by platform etc)
-
-sub trial_impact {
- my ($spec, $count, $dsn_attr, $code, $verbose) = @_;
- local $ENV{DBI_GOFER_RANDOM} = $spec;
- my $dbh = dbi_connect("policy=rush;$dsn_attr");
- local $_ = $dbh;
- my $fail_percent = percentage_exceptions(200, $code, $verbose);
- return $fail_percent unless wantarray;
- return ($fail_percent, $dbh);
-}
-
-# --- 50% failure rate, with no retries
-
-$fails = trial_impact("fail=50%,do", 200, "retry_limit=0", sub { $_->do("set foo=1") });
-print "target approx 50% random failures, got $fails%\n";
-between_ok $fails, 10, 90, "should fail about 50% of the time, but at least between 10% and 90%";
-
-# --- 50% failure rate, with many retries (should yield low failure rate)
-
-$fails = trial_impact("fail=50%,prepare", 200, "retry_limit=5", sub { $_->prepare("set foo=1") });
-print "target less than 20% effective random failures (ideally 0), got $fails%\n";
-cmp_ok $fails, '<', 20, 'should fail < 20%';
-
-# --- 10% failure rate, with many retries (should yield zero failure rate)
-
-$fails = trial_impact("fail=10,do", 200, "retry_limit=10", sub { $_->do("set foo=1") });
-cmp_ok $fails, '<', 1, 'should fail < 1%';
-
-# --- 50% failure rate, test is_idempotent
-
-$ENV{DBI_GOFER_RANDOM} = "fail=50%,do"; # 50%
-
-# test go_retry_hook and that ReadOnly => 1 retries a non-idempotent statement
-ok my $dbh_50r1ro = dbi_connect("policy=rush;retry_limit=1", {
- go_retry_hook => sub { return ($_[0]->is_idempotent) ? 1 : 0 },
- ReadOnly => 1,
-} );
-between_ok percentage_exceptions(100, sub { $dbh_50r1ro->do("set foo=1") }),
- 10, 40, 'should fail ~25% (ie 50% with one retry)';
-between_ok $dbh_50r1ro->{go_transport}->meta->{request_retry_count},
- 20, 80, 'transport request_retry_count should be around 50';
-
-# test as above but with ReadOnly => 0
-ok my $dbh_50r1rw = dbi_connect("policy=rush;retry_limit=1", {
- go_retry_hook => sub { return ($_[0]->is_idempotent) ? 1 : 0 },
- ReadOnly => 0,
-} );
-between_ok percentage_exceptions(100, sub { $dbh_50r1rw->do("set foo=1") }),
- 20, 80, 'should fail ~50%, ie no retries';
-ok !$dbh_50r1rw->{go_transport}->meta->{request_retry_count},
- 'transport request_retry_count should be zero or undef';
-
-
-# --- check random is random and non-random is non-random
-
-my %fail_percents;
-for (1..5) {
- $fails = trial_impact("fail=50%,do", 10, "", sub { $_->do("set foo=1") });
- ++$fail_percents{$fails};
-}
-cmp_ok scalar keys %fail_percents, '>=', 2, 'positive percentage should fail randomly';
-
-%fail_percents = ();
-for (1..5) {
- $fails = trial_impact("fail=-50%,do", 10, "", sub { $_->do("set foo=1") });
- ++$fail_percents{$fails};
-}
-is scalar keys %fail_percents, 1, 'negative percentage should fail non-randomly';
-
-# ---
-print "Testing random delay\n";
-
-$ENV{DBI_GOFER_RANDOM} = "delay0.1=51%,do"; # odd percentage to force warn()s
-@warns = ();
-ok $dbh = dbi_connect("policy=rush;retry_limit=0");
-is percentage_exceptions(20, sub { $dbh->do("set foo=1") }),
- 0, "should not fail for DBI_GOFER_RANDOM='$ENV{DBI_GOFER_RANDOM}'";
-my $delays = grep { m/delaying execution/ } @warns;
-between_ok $delays, 1, 19, 'should be delayed around 5 times';
-
-exit 0;
-
-# --- subs ---
-#
-sub between_ok {
- my ($got, $min, $max, $label) = @_;
- local $Test::Builder::Level = 2;
- cmp_ok $got, '>=', $min, "$label (got $got)";
- cmp_ok $got, '<=', $max, "$label (got $got)";
-}
-
-sub dbi_connect {
- my ($gdsn, $attr) = @_;
- return DBI->connect("dbi:Gofer:transport=null;$gdsn;dsn=dbi:ExampleP:", 0, 0, {
- RaiseError => 1, PrintError => 0, ($attr) ? %$attr : ()
- });
-}
-
-sub percentage_exceptions {
- my ($count, $sub, $verbose) = @_;
- my $i = $count;
- my $exceptions = 0;
- while ($i--) {
- eval { $sub->() };
- warn sprintf("percentage_exceptions $i: %s\n", $@|| $DBI::errstr || '') if $verbose;
- if ($@) {
- die "Unexpected failure: $@" unless $@ =~ /DBI_GOFER_RANDOM/;
- ++$exceptions;
- }
- }
- warn sprintf "percentage_exceptions %f/%f*100 = %f\n",
- $exceptions, $count, $exceptions/$count*100
- if $verbose;
- return $exceptions/$count*100;
-}
+++ /dev/null
-#!perl -w # -*- perl -*-
-# vim:sw=4:ts=8
-$|=1;
-
-use strict;
-use warnings;
-
-use DBI;
-use Data::Dumper;
-use Test::More;
-use DBI::Util::CacheMemory;
-
-plan skip_all => "Gofer DBI_AUTOPROXY" if (($ENV{DBI_AUTOPROXY}||'') =~ /^dbi:Gofer/i);
-
-plan 'no_plan';
-
-
-my $dsn = "dbi:Gofer:transport=null;policy=classic;dsn=dbi:ExampleP:";
-
-my @cache_classes = qw(DBI::Util::CacheMemory);
-push @cache_classes, "Cache::Memory" if eval { require Cache::Memory };
-push @cache_classes, "1"; # test alias for DBI::Util::CacheMemory
-
-for my $cache_class (@cache_classes) {
- my $cache_obj = ($cache_class eq "1") ? $cache_class : $cache_class->new();
- run_tests($cache_obj);
-}
-
-
-sub run_tests {
- my $cache_obj = shift;
-
- my $tmp;
- print "\n --- using $cache_obj for $dsn\n";
-
- my $dbh = DBI->connect($dsn, undef, undef, {
- go_cache => $cache_obj,
- RaiseError => 1, PrintError => 0, ShowErrorStatement => 1,
- } );
- ok my $go_transport = $dbh->{go_transport};
- ok my $go_cache = $go_transport->go_cache;
-
- # setup
- $go_cache->clear;
- is $go_cache->count, 0, 'cache should be empty after clear';
-
- $go_transport->transmit_count(0);
- is $go_transport->transmit_count, 0, 'transmit_count should be 0';
-
- $go_transport->cache_hit(0);
- $go_transport->cache_miss(0);
- $go_transport->cache_store(0);
-
- # request 1
- ok my $rows1 = $dbh->selectall_arrayref("select name from ?", {}, ".");
- cmp_ok $go_cache->count, '>', 0, 'cache should not be empty after select';
-
- my $expected = ($ENV{DBI_AUTOPROXY}) ? 2 : 1;
- is $go_transport->cache_hit, 0;
- is $go_transport->cache_miss, $expected;
- is $go_transport->cache_store, $expected;
-
- is $go_transport->transmit_count, $expected, "should make $expected round trip";
- $go_transport->transmit_count(0);
- is $go_transport->transmit_count, 0, 'transmit_count should be 0';
-
- # request 2
- ok my $rows2 = $dbh->selectall_arrayref("select name from ?", {}, ".");
- is_deeply $rows2, $rows1;
- is $go_transport->transmit_count, 0, 'should make 0 round trip';
-
- is $go_transport->cache_hit, $expected, 'cache_hit';
- is $go_transport->cache_miss, $expected, 'cache_miss';
- is $go_transport->cache_store, $expected, 'cache_store';
-}
-
-
-print "test per-sth go_cache\n";
-
-my $dbh = DBI->connect($dsn, undef, undef, {
- go_cache => 1,
- RaiseError => 1, PrintError => 0, ShowErrorStatement => 1,
-} );
-ok my $go_transport = $dbh->{go_transport};
-ok my $dbh_cache = $go_transport->go_cache;
-$dbh_cache->clear; # discard ping from connect
-
-my $cache2 = DBI::Util::CacheMemory->new( namespace => "foo2" );
-ok $cache2;
-ok $cache2 != $dbh_cache;
-
-my $sth1 = $dbh->prepare("select name from ?");
-is $sth1->go_cache, $dbh_cache;
-is $dbh_cache->size, 0;
-ok $dbh->selectall_arrayref($sth1, undef, ".");
-ok $dbh_cache->size;
-
-my $sth2 = $dbh->prepare("select * from ?", { go_cache => $cache2 });
-is $sth2->go_cache, $cache2;
-is $cache2->size, 0;
-ok $dbh->selectall_arrayref($sth2, undef, ".");
-ok $cache2->size;
-
-cmp_ok $cache2->size, '>', $dbh_cache->size;
-
-
-
-1;
+++ /dev/null
-# $Id$
-# Test DBI::sql_type_cast
-use strict;
-#use warnings; this script generate warnings deliberately as part of the test
-use Test::More;
-use DBI qw(:sql_types :utils);
-use Config;
-
-my $jx = eval {require JSON::XS;};
-my $dp = eval {require Data::Peek;};
-my $pp = $DBI::PurePerl && $DBI::PurePerl; # doubled to avoid typo warning
-
-# NOTE: would have liked to use DBI::neat to test the cast value is what
-# we expect but unfortunately neat uses SvNIOK(sv) so anything that looks
-# like a number is printed as a number without quotes even if it has
-# a pv.
-
-use constant INVALID_TYPE => -2;
-use constant SV_IS_UNDEF => -1;
-use constant NO_CAST_STRICT => 0;
-use constant NO_CAST_NO_STRICT => 1;
-use constant CAST_OK => 2;
-
-my @tests = (
- ['undef', undef, SQL_INTEGER, SV_IS_UNDEF, -1, q{[null]}],
- ['invalid sql type', '99', 123456789, 0, INVALID_TYPE, q{["99"]}],
- ['non numeric cast to int', 'aa', SQL_INTEGER, 0, NO_CAST_NO_STRICT,
- q{["aa"]}],
- ['non numeric cast to int (strict)', 'aa', SQL_INTEGER,
- DBIstcf_STRICT, NO_CAST_STRICT, q{["aa"]}],
- ['small int cast to int', "99", SQL_INTEGER, 0, CAST_OK, q{["99"]}],
- ['2 byte max signed int cast to int', "32767", SQL_INTEGER, 0,
- CAST_OK, q{["32767"]}],
- ['2 byte max unsigned int cast to int', "65535",
- SQL_INTEGER, 0, CAST_OK, q{["65535"]}],
- ['4 byte max signed int cast to int', "2147483647",
- SQL_INTEGER, 0, CAST_OK, q{["2147483647"]}],
- ['4 byte max unsigned int cast to int', "4294967295",
- SQL_INTEGER, 0, CAST_OK, q{["4294967295"]}],
- ['small int cast to int (discard)',
- '99', SQL_INTEGER, DBIstcf_DISCARD_STRING, CAST_OK, q{[99]}],
-
- ['non numeric cast to numeric', 'aa', SQL_NUMERIC,
- 0, NO_CAST_NO_STRICT, q{["aa"]}],
- ['non numeric cast to numeric (strict)', 'aa', SQL_NUMERIC,
- DBIstcf_STRICT, NO_CAST_STRICT, q{["aa"]}],
- );
-
-if (!$pp) {
- # some tests cannot be performed with PurePerl as numbers don't
- # overflow in the same way as XS.
- push @tests,
- (
- ['very large int cast to int',
- '99999999999999999999', SQL_INTEGER, 0, NO_CAST_NO_STRICT,
- q{["99999999999999999999"]}],
- ['very large int cast to int (strict)',
- '99999999999999999999', SQL_INTEGER, DBIstcf_STRICT,
- NO_CAST_STRICT, q{["99999999999999999999"]}],
- ['float cast to int', '99.99', SQL_INTEGER, 0,
- NO_CAST_NO_STRICT, q{["99.99"]}],
- ['float cast to int (strict)', '99.99', SQL_INTEGER, DBIstcf_STRICT,
- NO_CAST_STRICT, q{["99.99"]}],
- ['float cast to double', '99.99', SQL_DOUBLE, 0, CAST_OK,
- q{["99.99"]}]
- );
- if ($Config{ivsize} == 4) {
- push @tests,
- ['4 byte max unsigned int cast to int (ivsize=4)', "4294967296",
- SQL_INTEGER, 0, NO_CAST_NO_STRICT, q{["4294967296"]}];
- } elsif ($Config{ivsize} >= 8) {
- push @tests,
- ['4 byte max unsigned int cast to int (ivsize>8)', "4294967296",
- SQL_INTEGER, 0, CAST_OK, q{["4294967296"]}];
- }
-}
-
-if ($] >= 5.010001) {
- # Some numeric tests fail the return value test on Perls before 5.10.1
- # because sv_2nv leaves NOK set - changed in 5.10.1 probably via the
- # following change:
- # The public IV and NV flags are now not set if the string
- # value has trailing "garbage". This behaviour is consistent with not
- # setting the public IV or NV flags if the value is out of range for the
- # type.
- push @tests, (
- ['non numeric cast to double', 'aabb', SQL_DOUBLE, 0,
- NO_CAST_NO_STRICT, q{["aabb"]}],
- ['non numeric cast to double (strict)', 'aabb', SQL_DOUBLE,
- DBIstcf_STRICT, NO_CAST_STRICT, q{["aabb"]}]
- );
-}
-
-my $tests = @tests;
-$tests *= 2 if $jx;
-foreach (@tests) {
- $tests++ if ($dp) && ($_->[3] & DBIstcf_DISCARD_STRING);
- $tests++ if ($dp) && ($_->[2] == SQL_DOUBLE);
-}
-
-plan tests => $tests;
-
-foreach my $test(@tests) {
- my $val = $test->[1];
- #diag(join(",", map {neat($_)} Data::Peek::DDual($val)));
- my $result;
- {
- no warnings; # lexical but also affects XS sub
- local $^W = 0; # needed for PurePerl tests
- $result = sql_type_cast($val, $test->[2], $test->[3]);
- }
- is($result, $test->[4], "result, $test->[0]");
- if ($jx) {
-
- SKIP: {
- skip 'DiscardString not supported in PurePerl', 1
- if $pp && ($test->[3] & DBIstcf_DISCARD_STRING);
-
- my $json = JSON::XS->new->encode([$val]);
- #diag(neat($val), ",", $json);
- # This test is about quotation of the value, not about the
- # style/formatting of JSON. Strip all leading/trailing
- # whitespace that is not part of the test, treating '[99]'
- # identical to ' [ 99 ] ' or '[99 ]'
- $json =~ s{^\s*\[\s*(.*?)\s*\]\s*$}{[$1]};
- is($json, $test->[5], "json $test->[0]");
- };
- }
-
- my ($pv, $iv, $nv, $rv, $hm);
- ($pv, $iv, $nv, $rv, $hm) = Data::Peek::DDual($val) if $dp;
-
- if ($dp && ($test->[3] & DBIstcf_DISCARD_STRING)) {
- #diag("D::P ",neat($pv), ",", neat($iv), ",", neat($nv),
- # ",", neat($rv));
- SKIP: {
- skip 'DiscardString not supported in PurePerl', 1 if $pp;
-
- ok(!defined($pv), "discard works, $test->[0]") if $dp;
- };
- }
- if (($test->[2] == SQL_DOUBLE) && ($dp)) {
- #diag("D::P ", neat($pv), ",", neat($iv), ",", neat($nv),
- # ",", neat($rv));
- if ($test->[4] == CAST_OK) {
- ok(defined($nv), "nv defined $test->[0]");
- } else {
- ok(!defined($nv) || !$nv, "nv not defined $test->[0]");
- }
- }
-}
-
-1;
+++ /dev/null
-# Test if a warning can be recorded in the STORE method
-# which it couldn't in DBI 1.628
-# see https://rt.cpan.org/Ticket/Display.html?id=89015
-# This is all started from the fact that the SQLite ODBC Driver cannot set the
-# ReadOnly attribute (which is mapped to ODBC SQL_ACCESS_MODE) - it
-# legitimately returns SQL_SUCCESS_WITH_INFO option value changed.
-# It was decided that this should record a warning but when it was added to DBD::ODBC
-# DBI did not show the warning - keep_err?
-# Tim's comment on #dbi was:
-# the dispatcher has logic to notice if ErrCount went up during a call and disables keep_err in that case.
-# I think something similar might be needed for err. E.g., "if it's defined now but wasn't defined before" then
-# act appropriately.
-
-use strict;
-use warnings;
-use Test::More;
-use DBI;
-
-my $warning;
-
-$SIG{__WARN__} = sub { $warning = $_[0] };
-
-my $dbh = DBI->connect('dbi:NullP:', '', '', {PrintWarn => 1});
-
-is $warning, undef, 'initially not set';
-
-$dbh->set_err("0", "warning plain");
-like $warning, qr/^DBD::\w+::db set_err warning: warning plain/, "Warning recorded by store";
-
-$dbh->set_err(undef, undef);
-undef $warning;
-
-$dbh->set_err("0", "warning \N{U+263A} smiley face");
-like $warning, qr/^DBD::\w+::db set_err warning: warning \x{263A} smiley face/, "Warning recorded by store"
- or warn DBI::data_string_desc($warning);
-
-done_testing;
+++ /dev/null
-#!/usr/bin/perl
-
-# lib.pl is the file where database specific things should live,
-# wherever possible. For example, you define certain constants
-# here and the like.
-
-use strict;
-
-use File::Basename;
-use File::Path;
-use File::Spec;
-
-my $test_dir;
-END { defined( $test_dir ) and rmtree $test_dir }
-
-sub test_dir
-{
- unless( defined( $test_dir ) )
- {
- $test_dir = File::Spec->rel2abs( File::Spec->curdir () );
- $test_dir = File::Spec->catdir ( $test_dir, "test_output_" . $$ );
- $test_dir = VMS::Filespec::unixify($test_dir) if $^O eq 'VMS';
- rmtree $test_dir if -d $test_dir;
- mkpath $test_dir;
- # There must be at least one directory in the test directory,
- # and nothing guarantees that dot or dot-dot directories will exist.
- mkpath ( File::Spec->catdir( $test_dir, '000_just_testing' ) );
- }
-
- return $test_dir;
-}
-
-1;
+++ /dev/null
-#!perl -T
-
-use Test::More;
-eval "use Test::Pod::Coverage 1.04";
-plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@;
-plan skip_all => "Currently a developer-only test" unless -d '.svn' || -d ".git";
-plan skip_all => "Currently FAILS FOR MANY MODULES!";
-all_pod_coverage_ok();
+++ /dev/null
-#!perl -w
-
-use Test::More;
-eval "use Test::Pod 1.41";
-plan skip_all => "Test::Pod 1.41 required for testing POD" if $@;
-all_pod_files_ok();
-
-1;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-require './t/01basics.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-require './t/02dbidrv.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-require './t/03handle.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-require './t/04mods.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-require './t/05concathash.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-require './t/06attrs.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-require './t/07kids.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-require './t/08keeperr.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-require './t/09trace.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-require './t/10examp.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-require './t/11fetch.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-require './t/12quote.t'; # or warn $!;
+++ /dev/null
-#!perl -wT
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-require './t/13taint.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-require './t/14utf8.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-require './t/15array.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-require './t/16destroy.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-require './t/19fhtrace.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-require './t/20meta.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-require './t/30subclass.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-require './t/31methcache.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-use threads;
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-require './t/35thrclone.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-require './t/40profile.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-require './t/41prof_dump.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-require './t/42prof_data.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-require './t/43prof_env.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-require './t/48dbi_dbd_sqlengine.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-require './t/49dbd_file.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-require './t/50dbm_simple.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-require './t/51dbm_file.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-require './t/52dbm_complex.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-require './t/53sqlengine_adv.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-require './t/54_dbd_mem.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-require './t/60preparse.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-require './t/65transact.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-require './t/70callbacks.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-require './t/72childhandles.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-require './t/73cachedkids.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-require './t/80proxy.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-require './t/85gofer.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-require './t/86gofer_fail.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-require './t/87gofer_cache.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-require './t/90sql_type_cast.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-require './t/91_store_warning.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_SQL_NANO} = 1;
-END { delete $ENV{DBI_SQL_NANO}; };
-require './t/48dbi_dbd_sqlengine.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_SQL_NANO} = 1;
-END { delete $ENV{DBI_SQL_NANO}; };
-require './t/49dbd_file.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_SQL_NANO} = 1;
-END { delete $ENV{DBI_SQL_NANO}; };
-require './t/50dbm_simple.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_SQL_NANO} = 1;
-END { delete $ENV{DBI_SQL_NANO}; };
-require './t/51dbm_file.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_SQL_NANO} = 1;
-END { delete $ENV{DBI_SQL_NANO}; };
-require './t/52dbm_complex.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_SQL_NANO} = 1;
-END { delete $ENV{DBI_SQL_NANO}; };
-require './t/85gofer.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/01basics.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/02dbidrv.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/03handle.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/04mods.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/05concathash.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/06attrs.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/07kids.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/08keeperr.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/09trace.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/10examp.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/11fetch.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/12quote.t'; # or warn $!;
+++ /dev/null
-#!perl -wT
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/13taint.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/14utf8.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/15array.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/16destroy.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/19fhtrace.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/20meta.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/30subclass.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/31methcache.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-use threads;
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/35thrclone.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/40profile.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/41prof_dump.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/42prof_data.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/43prof_env.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/48dbi_dbd_sqlengine.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/49dbd_file.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/50dbm_simple.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/51dbm_file.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/52dbm_complex.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/53sqlengine_adv.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/54_dbd_mem.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/60preparse.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/65transact.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/70callbacks.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/72childhandles.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/73cachedkids.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/80proxy.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/85gofer.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/86gofer_fail.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/87gofer_cache.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/90sql_type_cast.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/91_store_warning.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-$ENV{DBI_SQL_NANO} = 1;
-END { delete $ENV{DBI_SQL_NANO}; };
-require './t/48dbi_dbd_sqlengine.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-$ENV{DBI_SQL_NANO} = 1;
-END { delete $ENV{DBI_SQL_NANO}; };
-require './t/49dbd_file.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-$ENV{DBI_SQL_NANO} = 1;
-END { delete $ENV{DBI_SQL_NANO}; };
-require './t/50dbm_simple.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-$ENV{DBI_SQL_NANO} = 1;
-END { delete $ENV{DBI_SQL_NANO}; };
-require './t/51dbm_file.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-$ENV{DBI_SQL_NANO} = 1;
-END { delete $ENV{DBI_SQL_NANO}; };
-require './t/52dbm_complex.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-$ENV{DBI_SQL_NANO} = 1;
-END { delete $ENV{DBI_SQL_NANO}; };
-require './t/85gofer.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-$ENV{DBI_SQL_NANO} = 1;
-END { delete $ENV{DBI_SQL_NANO}; };
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/48dbi_dbd_sqlengine.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-$ENV{DBI_SQL_NANO} = 1;
-END { delete $ENV{DBI_SQL_NANO}; };
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/49dbd_file.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-$ENV{DBI_SQL_NANO} = 1;
-END { delete $ENV{DBI_SQL_NANO}; };
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/50dbm_simple.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-$ENV{DBI_SQL_NANO} = 1;
-END { delete $ENV{DBI_SQL_NANO}; };
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/51dbm_file.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-$ENV{DBI_SQL_NANO} = 1;
-END { delete $ENV{DBI_SQL_NANO}; };
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/52dbm_complex.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-$ENV{DBI_SQL_NANO} = 1;
-END { delete $ENV{DBI_SQL_NANO}; };
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/85gofer.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/01basics.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/02dbidrv.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/03handle.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/04mods.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/05concathash.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/06attrs.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/07kids.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/08keeperr.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/09trace.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/10examp.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/11fetch.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/12quote.t'; # or warn $!;
+++ /dev/null
-#!perl -wT
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/13taint.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/14utf8.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/15array.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/16destroy.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/19fhtrace.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/20meta.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/30subclass.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/31methcache.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-use threads;
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/35thrclone.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/40profile.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/41prof_dump.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/42prof_data.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/43prof_env.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/48dbi_dbd_sqlengine.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/49dbd_file.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/50dbm_simple.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/51dbm_file.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/52dbm_complex.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/53sqlengine_adv.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/54_dbd_mem.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/60preparse.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/65transact.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/70callbacks.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/72childhandles.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/73cachedkids.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/80proxy.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/85gofer.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/86gofer_fail.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/87gofer_cache.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/90sql_type_cast.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_AUTOPROXY} = 'dbi:Gofer:transport=null;policy=pedantic';
-END { delete $ENV{DBI_AUTOPROXY}; };
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/91_store_warning.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_SQL_NANO} = 1;
-END { delete $ENV{DBI_SQL_NANO}; };
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/48dbi_dbd_sqlengine.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_SQL_NANO} = 1;
-END { delete $ENV{DBI_SQL_NANO}; };
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/49dbd_file.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_SQL_NANO} = 1;
-END { delete $ENV{DBI_SQL_NANO}; };
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/50dbm_simple.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_SQL_NANO} = 1;
-END { delete $ENV{DBI_SQL_NANO}; };
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/51dbm_file.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_SQL_NANO} = 1;
-END { delete $ENV{DBI_SQL_NANO}; };
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/52dbm_complex.t'; # or warn $!;
+++ /dev/null
-#!perl -w
-$ENV{DBI_SQL_NANO} = 1;
-END { delete $ENV{DBI_SQL_NANO}; };
-$ENV{DBI_PUREPERL} = 2;
-END { delete $ENV{DBI_PUREPERL}; };
-require './t/85gofer.t'; # or warn $!;
+++ /dev/null
-#!/usr/local/bin/perl -w
-
-# $Id$
-#
-# Copyright (c) 1994-1998 Tim Bunce
-#
-# See COPYRIGHT section in DBI.pm for usage and distribution rights.
-
-
-# This is now mostly an empty shell I experiment with.
-# The real tests have moved to t/*.t
-# See t/*.t for more detailed tests.
-
-
-BEGIN {
- print "$0 @ARGV\n";
- print q{DBI test application $Revision$}."\n";
- $| = 1;
-}
-
-use blib;
-
-use DBI;
-
-use DBI::DBD; # simple test to make sure it's okay
-
-use Config;
-use Getopt::Long;
-use strict;
-
-our $has_devel_leak = eval {
- local $^W = 0; # silence "Use of uninitialized value $DynaLoader::args[0] in subroutine entry";
- require Devel::Leak;
-};
-
-$::opt_d = 0;
-$::opt_l = '';
-$::opt_h = 0;
-$::opt_m = 0; # basic memory leak test: "perl test.pl -m NullP"
-$::opt_t = 0; # thread test
-$::opt_n = 0; # counter for other options
-
-GetOptions(qw(d=i h=i l=s m=i t=i n=i))
- or die "Usage: $0 [-d n] [-h n] [-m n] [-t n] [-n n] [drivername]\n";
-
-my $count = 0;
-my $ps = (-d '/proc') ? "ps -lp " : "ps -l";
-my $driver = $ARGV[0] || ($::opt_m ? 'NullP' : 'ExampleP');
-
-# Now ask for some information from the DBI Switch
-my $switch = DBI->internal;
-$switch->trace($::opt_h); # 2=detailed handle trace
-
-DBI->trace($::opt_d, $::opt_l) if $::opt_d || $::opt_l;
-
-print "Switch: $switch->{'Attribution'}, $switch->{'Version'}\n";
-
-print "Available Drivers: ",join(", ",DBI->available_drivers(1)),"\n";
-
-
-my $dbh = DBI->connect("dbi:$driver:", '', '', { RaiseError=>1 }) or die;
-$dbh->trace($::opt_h);
-
-if (0) {
- DBI->trace(3);
- my $h = DBI->connect('dbi:NullP:','','', { RootClass=>'MyTestDBI', DbTypeSubclass=>'foo, bar' });
- DBI->trace(0);
- { # only works after 5.004_04:
- warn "RaiseError= '$h->{RaiseError}' (pre local)\n";
- local($h->{RaiseError});# = undef;
- warn "RaiseError= '$h->{RaiseError}' (post local)\n";
- }
- warn "RaiseError= '$h->{RaiseError}' (post local block)\n";
- exit 1;
-}
-
-if ($::opt_m) {
- #$dbh->trace(9);
- my $level = $::opt_m;
- my $cnt = $::opt_n || 10000;
-
- print "Using $driver, same dbh...\n";
- for (my $i=0; $i<$cnt; ++$i) { mem_test($dbh, undef, $level, undef, undef, undef) }
-
- print "Using NullP, reconnecting each time...\n";
- for (my $i=0; $i<$cnt; ++$i) { mem_test(undef, ['dbi:NullP:'], $level, undef, undef, undef) }
-
- print "Using ExampleP, reconnecting each time...\n";
- my $r_develleak = 0;
- mem_test(undef, ['dbi:NullP:'], $level, undef, undef, \$r_develleak) while 1;
- #mem_test(undef, ['dbi:mysql:VC'], $level, "select * from campaigns where length(?)>0", 0, undef) while 1;
-}
-elsif ($::opt_t) {
- thread_test();
-}
-else {
-
- # new experimental connect_test_perf method
- DBI->connect_test_perf("dbi:$driver:", '', '', {
- dbi_loops=>3, dbi_par=>20, dbi_verb=>1
- });
-
- require Benchmark;
- print "Testing handle creation speed...\n";
- my $null_dbh = DBI->connect('dbi:NullP:','','');
- my $null_sth = $null_dbh->prepare(''); # create one to warm up
- $count = 20_000;
- $count /= 10 if $ENV{DBI_AUTOPROXY};
- my $i = $count;
- my $t1 = new Benchmark;
- $null_dbh->prepare('') while $i--;
- my $td = Benchmark::timediff(Benchmark->new, $t1);
- my $tds= Benchmark::timestr($td);
- my $dur = $td->cpu_a || (1/$count); # fudge if cpu_a==0
-
- printf "%5d NullP sth/s perl %8s %s (%s %s %s) %fs\n\n",
- $count/$dur, $], $Config{archname},
- $Config{gccversion} ? 'gcc' : $Config{cc},
- (split / /, $Config{gccversion}||$Config{ccversion}||'')[0]||'',
- $Config{optimize},
- $dur/$count;
-
- $null_dbh->disconnect;
-}
-
-$dbh->disconnect;
-
-#DBI->trace(4);
-print "$0 done\n";
-exit 0;
-
-
-sub mem_test { # harness to help find basic leaks
- my ($orig_dbh, $connect, $level, $select, $params, $r_develleak) = @_;
- $select ||= "select mode,ino,name from ?";
- $params ||= [ '.' ];
-
- # this can be used to force a 'leak' to check memory use reporting
- #$main::leak .= " " x 1000;
- system("echo $count; $ps$$") if (($count++ % 2000) == 0);
-
- my $dbh = $orig_dbh || do {
- my ($dsn, $u, $p, $attr) = @$connect;
- $attr->{RaiseError} = 1;
- DBI->connect($dsn, $u, $p, $attr);
- };
- my $cursor_a;
-
- my ($dl_count, $dl_handle);
- if ($has_devel_leak && $$r_develleak++) {
- $dbh->trace(2);
- $dl_count = Devel::Leak::NoteSV($dl_handle);
- }
-
- my $rows;
- $cursor_a = $dbh->prepare($select) if $level >= 2;
- $cursor_a->execute(@$params) if $level >= 3;
- $cursor_a->fetchrow_hashref() if $level >= 4;
- $rows = $cursor_a->fetchall_arrayref({}) if $level >= 4;
- $cursor_a->finish if $cursor_a && $cursor_a->{Active};
- undef $cursor_a;
-
- @{$dbh->{ChildHandles}} = ();
-
- die Devel::Leak::CheckSV($dl_handle)-$dl_count
- if $dl_handle;
-
- $dbh->disconnect unless $orig_dbh;
- undef $dbh;
-
-}
-
-
-sub thread_test {
- require Thread;
- my $dbh = DBI->connect("dbi:ExampleP:.", "", "") || die $DBI::err;
- #$dbh->trace(4);
- my @t;
- print "Starting $::opt_t threads:\n";
- foreach(1..$::opt_t) {
- print "$_\n";
- push @t, Thread->new(\&thread_test_loop, $dbh, $::opt_n||99);
- }
- print "Small sleep to allow threads to progress\n";
- sleep 2;
- print "Joining threads:\n";
- foreach(@t) {
- print "$_\n";
- $_->join
- }
-}
-
-sub thread_test_loop {
- my $dbh = shift;
- my $i = shift || 10;
- while($i-- > 0) {
- $dbh->selectall_arrayref("select * from ?", undef, ".");
- }
-}
-
-# end.
+++ /dev/null
-const char * T_PV
-imp_xxh_t * T_PTROBJ
-DBI_imp_data_ * T_PTROBJ
+++ /dev/null
-192.168.0.16
+++ /dev/null
-192.168.0.16
+++ /dev/null
-#!/bin/bash
-
-ps -eo size,pid,user,command --sort -size | awk '{ hr=$1/1024 ; printf("%13.2f Mb ",hr) } { for ( x=4 ; x<=NF ; x++ ) { printf("%s ",$x) } print "" }' |more
+++ /dev/null
-https://www.tutorialspoint.com/sqlite/sqlite_perl.htm
-set LATEST=1.641
-wget http://search.cpan.org/CPAN/authors/id/T/TI/TIMB/DBI-$LATEST.tar.gz
-tar xvfz DBI-1.625.tar.gz
-cd DBI-1.625
-perl Makefile.PL
-make
-make install
-
-wget http://search.cpan.org/CPAN/authors/id/T/TI/TIMB/DBI-$LATEST.redme.tar.gz
-
-set LATEST=2-.0.33
-wget http://search.cpan.org/CPAN/authors/id/M/MS/MSERGEANT/DBD-SQLite$LATEST.tar.gz
-$ tar xvfz DBD-SQLite-1.11.tar.gz
-$ cd DBD-SQLite-1.11
-$ perl Makefile.PL
-$ make
-$ make install
-
-wget http://search.cpan.org/CPAN/authors/id/M/MS/MSERGEANT/DBD-SQLite$LATEST.readme.tar.gz
lifelog.hopto.org / LifeLog.git / commitdiff